R/import_apsim_db.R

In adriancorrendo/metrica: Prediction Performance Metrics

#' @title Import SQLite databases generated by APSIM NextGen
#' @name import_apsim_db
#' @description Imports data from SQLite databases (*.db) applied by APSIM
#' Next Generation. It reads one file at a time.
#' @note This function was adapted from apsimx package (Miguez, 2022). 
#' For reference, we recommend to check and use the function 
#' apsimx::read_apsimx() as an alternative. 
#' Source: https://github.com/femiguez/apsimx by F. Miguez.
#' @param filename file name including the file extension ("*.db"), as a string ("").
#' @param folder source folder/directory containing the file, as a string ("").
#' @param value either \sQuote{report}, \sQuote{all} (list) or user-defined for a specific report.
#' @param simplify if TRUE will attempt to simplify multiple reports into a single data.frame. 
#' If FALSE it will return a list. Default: TRUE.
#' @return An object of class `data.frame`, but it depends on the argument \sQuote{value} above
#' @references
#' Miguez, F. (2022)
#' apsimx: Inspect, Read, Edit and Run 'APSIM' "Next Generation" and 'APSIM' Classic. 
#' _R package version 2.3.1,_ \url{https://CRAN.R-project.org/package=apsimx}
#' @examples 
#' \donttest{
#' ## See [documentation](https://adriancorrendo.github.io/metrica/index.html)
#' }
#' @rdname import_apsim_db
#' @importFrom RSQLite SQLite dbListTables
#' @importFrom DBI dbGetQuery
#' @export
#' 

import_apsim_db <- function(filename = "", folder = ".", value = "report", simplify = TRUE){
  
  if(filename == "") stop("need to specify file name")
  
  file.name.path <- file.path(folder, filename)
  
  con <- DBI::dbConnect(RSQLite::SQLite(), file.name.path,
                        # Adding a READ-ONLY flag, no "write access" permission.
                        flags = RSQLite::SQLITE_RO)
  ## create data frame for each table
  ## Find table names first
  table.names <- RSQLite::dbListTables(con)
  other.tables <- grep("^_", table.names, value = TRUE)
  report.names <- setdiff(table.names, other.tables)
  
  ## F. Miguez: I guess I always expect to find a table, but not always... better to catch it here
  if(length(report.names) < 1)
    stop("No report tables found")    
  
  if(length(report.names) == 1L){
    tbl0 <- DBI::dbGetQuery(con, paste("SELECT * FROM ", report.names))  
    
    if(nrow(tbl0) == 0)
      warning("Report table has no data")
    
    if(any(grepl("Clock.Today", names(tbl0)))){
      if(nrow(tbl0) > 0){
        tbl0$Date <- try(as.Date(sapply(tbl0$Clock.Today, function(x) strsplit(x, " ")[[1]][1])), silent = TRUE)  
      }
    }
  }
  
  # Simplify if multiple reports present
  if(length(report.names) > 1L && value %in% c("report", "all")){
    
    if(simplify){ lst0 <- NULL
      for(i in seq_along(report.names)){ tbl0 <- DBI::dbGetQuery(con, paste("SELECT * FROM ", report.names[i]))
        if(nrow(tbl0) == 0)
          warning(paste("Report", report.names[i]), "has no data")
        if(any(grepl("Clock.Today", names(tbl0)))){ if(nrow(tbl0) > 0){tbl0$Date <- try(as.Date(sapply(tbl0$Clock.Today, function(x) strsplit(x, " ")[[1]][1])), silent = TRUE) }
        }
        dat0 <- data.frame(report = report.names[i], tbl0)
        lst0 <- try(rbind(lst0, dat0), silent = TRUE)
        if(inherits(lst0, "try-error")){
          stop("Could not simplify reports into a single data.frame \n
             Choose simplify = FALSE or modify your reports.")  }
      }
    }else{ lst0 <- vector("list", length = length(report.names))
      for(i in seq_along(report.names)){
        tbl0 <- DBI::dbGetQuery(con, paste("SELECT * FROM ", report.names[i]))
        if(any(grepl("Clock.Today", names(tbl0)))){ tbl0$Date <- try(as.Date(sapply(tbl0$Clock.Today, function(x) strsplit(x, " ")[[1]][1])), silent = TRUE) }
        lst0[[i]] <- tbl0   
      }
      names(lst0) <- report.names ## Name the lists with report names
    }
  }
  
  if(!value %in% c("report", "all") && length(report.names) > 1L){
    if(!value %in% report.names){ cat("Available table names: ", report.names ,"\n")
      stop("user defined report name is not in the list of available tables", call. = FALSE)
    }
    tbl0 <- DBI::dbGetQuery(con, paste("SELECT * FROM ", value))
    if(any(grepl("Clock.Today", names(tbl0)))){ tbl0$Date <- try(as.Date(sapply(tbl0$Clock.Today, function(x) strsplit(x, " ")[[1]][1])), silent = TRUE) }
  }
  
  ####
  if(value == "all"){
    other.tables.list <- vector("list", length = length(other.tables))
    for(i in seq_along(other.tables)){
      other.tables.list[[i]] <- DBI::dbGetQuery(con, paste("SELECT * FROM ", other.tables[i]))
    }
    names(other.tables.list) <- gsub("_", "", other.tables, fixed = TRUE)
  }
  ## Disconnect
  DBI::dbDisconnect(con)
  
  ## Return a list if there is only one report, whatever the name and value == "all"
  if(value == "all" && length(report.names) == 1L){
    lst1 <- list(Report = tbl0)
    ans <- do.call(c, list(lst1, other.tables.list)) }
  if(value == "all" && length(report.names) > 1L){ ans <- do.call(c, list(lst0, other.tables.list))  }
  if(value == "report" && length(report.names) > 1L){
    ans <- lst0  }
  ## Return data.frame if report and length 1 or user defined
  if((value == "report" && length(report.names) == 1L) || (!value %in% c("report", "all"))){
    ans <- tbl0  }
  
  return(ans)
}