R/apsim_classic.R

In apsimx: Inspect, Read, Edit and Run 'APSIM' "Next Generation" and 'APSIM' Classic

#' Run an APSIM (7.x) \sQuote{Classic} Simulation
#' 
#' A valid apsim file can be run from within R. The main goal is to make running APSIM-X
#' simple, especially for large scale simulations or parameter optimization
#' 
#' @title Run an APSIM (7.x) \sQuote{Classic} simulation
#' @name apsim
#' @description Run apsim from R. It's for Windows only. It uses \sQuote{shell}.
#' @param file file name to be run (the extension .apsim is optional)
#' @param src.dir directory containing the .apsim file to be run (defaults to the current directory)
#' @param silent whether to print messages from apsim simulation
#' @param value how much output to return: \cr
#'              option \sQuote{report} returns only the \sQuote{main} report component;
#'              option \sQuote{all} returns all components of the simulation; \cr
#'              option \sQuote{none} runs simulation but does not return a data frame; \cr
#'              option \sQuote{user-defined} should be the name of a specific output file.
#' @param cleanup logical. Whether to delete the .out and .sum files generated by APSIM. Default is FALSE.
#' @param simplify whether to return a single data frame when multiple simulations are present. If FALSE it will return a list.
#' @return This function returns a data frame with APSIM output, but it depends on the argument \sQuote{value} above.
#' @export
#' @examples 
#' \donttest{
#' ## See function 'apsim_example' 
#' }
#'

apsim <- function(file = "", src.dir = ".",
                  silent = FALSE, 
                  value = "report",
                  cleanup = FALSE,
                  simplify = TRUE){
  
  if(.Platform$OS.type != "windows"){
    stop("This is only for windows. Use apsimx instead.")
  }
    
  if(file == "") stop("need to specify file name")
  
  ## This checks that there are no spaces in the path
  ## this would create a problem when running things at the command line
  .check_apsim_name(.file = file)
  .check_apsim_name(.file = src.dir)
  
  if(src.dir != ".") stop("In APSIM Classic you can only run a file from the current directory.")
  
  ## Extra checking, not sure if it will be triggered
  file.names <- dir(path = src.dir, pattern = ".apsim$", ignore.case = TRUE)
  
  if(length(file.names) == 0){
    stop("There are no .apsim files in the specified directory to run.")
  }
  
  file <- match.arg(file, file.names, several.ok = FALSE)
  
  file.name.path <- file.path(src.dir, file)
  
  ## Can you run in APSIM 'Classic' from any directory or only from the current one?
  ## I'm assuming only from the current one
  # if(src.dir != "."){
  #   file.copy(file.name.path, ".")
  # }
  
  ada <- auto_detect_apsim()
  run.strng <- paste0(ada, " ", src.dir, "/", file) ## This is a command not a file.path
  shell(cmd = run.strng, translate = TRUE, intern = TRUE)
  
  ## It turns out that the name of the .out file is not as simple
  ## as the name of the input file
  output.names <- .find_output_names(.file = file, .src.dir = src.dir)
  
  ## With the current implementation the source directory will
  ## always be the current one
  if(value != "none"){
    if(value == "report" || value == "all"){
      if(length(output.names) == 1){
        ans <- read_apsim(file = output.names, src.dir = src.dir, 
                          value = value, silent = silent)
      }else{
        ## This will only work when output files have the same columns
        ## If simplify is TRUE
        ans <- read_apsim_all(filenames = output.names, 
                              src.dir = src.dir, value = "report",
                              simplify = simplify, silent = silent)
      }      
    }else{
      if(length(value) != 1)
        stop("'value' should be a string of length one.")
      output.name <- grep(value, output.names, value = TRUE) 
      if(length(output.name) == 0){
        cat("Available output names": output.names, "\n")
        stop(paste(value, "does not match any available output names"), call. = FALSE)
      }
      ## This is singular, just one output.name
      ans <- read_apsim(file = output.name, src.dir = src.dir, 
                            value = "report", silent = silent)
    }
  }else{
    if(value == "none" && !silent){
      cat("APSIM created .out files, but nothing is returned \n")
    }
  }
  
  if(cleanup){
    ## Default is not to cleanup
    if(value == "none") stop("do not clean up if you choose value = 'none' ")
    ## Delete the apsim-generated out file
    for(i in seq_along(output.names)){
        file.remove(output.names[i])
        file.remove(sub("out$","sum", output.names[i]))
      }
  }
  
  if(value != "none")
    return(ans)
}

## Local function used to detect APSIM Classic install
#' @noRd
auto_detect_apsim <- function(){

  if(.Platform$OS.type != "windows"){
    stop("This is only for windows. Use auto_detect_apsimx instead.")
  }
  
  ## Internal function to split APSIM name
  fev <- function(x) as.numeric(strsplit(x, "r", fixed = TRUE)[[1]][2])
  fmv <- function(x){
    tmp <- strsplit(x, "-", fixed = TRUE)[[1]][1]
    ans <- as.numeric(strsplit(tmp, "(M|m)")[[1]][2])
    ans
  } 
  ## I need to deal with the fact that there might be multiple versions
  ## of APSIM installed
  
  st1 <- "C:/PROGRA~2/"
  laf <- list.files(st1)
  find.apsim <- grep("APSIM", laf, ignore.case = TRUE)
  
  if(length(find.apsim) == 0 && is.na(apsimx::apsim.options$exe.path)){
    ## Try the registry approach only if there is no 'exe.path'
    ## HCR hive is for HKEY_CLASSES_ROOT, HLM is for HKEY_LOCAL_MACHINE and HCU is for HKEY_CURRENT_USER
    regcmd <- try(utils::readRegistry("APSIMFile\\shell\\open\\command", "HCR")[[1]], silent = TRUE)
    if(inherits(regcmd, "try-error")) regcmd <- try(utils::readRegistry("APSIMFile\\shell\\open\\command", "HCU")[[1]], silent = TRUE)
    if(inherits(regcmd, "try-error")) regcmd <- try(utils::readRegistry("APSIMFile\\shell\\open\\command", "HLM")[[1]], silent = TRUE)
    if(inherits(regcmd, "try-error")) stop("Could not find APSIM Classic in the Windows Registry")
    regcmd2 <- gsub("\\\\", "/", strsplit(regcmd, "\"")[[1]][2])
    apsim_dir <- gsub("UI", "Models", regcmd2)
    if(length(apsim_dir) == 0) stop("APSIM Classic was not found and no 'exe.path' exists.")
    if(grepl("\\s", apsim_dir)) stop("Found a space in the path. Please provide the path manually to APSIM using exe.path in apsim_options.")
    return(apsim_dir)
  } 

  if(length(find.apsim) == 1){
    apsim.name <- laf[find.apsim]
  }
  
  if(length(find.apsim) > 1){
    apsim.versions <- laf[find.apsim]
    max.main.version <- max(sapply(apsim.versions, fmv))
    if(any(is.na(max.main.version))){
      max.main.version <- max.main.version[!is.na(max.main.version)]
    }
    if(length(max.main.version) == 0){
      stop("It is likely that APSIM Next Gen was found when looking for APSIM Classic. Please set the path manually.", call. = FALSE) 
    }
    which.main.versions <- grep(max.main.version, apsim.versions)
    versions <- sapply(apsim.versions[which.main.versions], fev)
    newest.version <- apsim.versions[which.max(versions)]
    if(apsimx::apsim.options$warn.versions &&
       is.na(apsimx::apsim.options$exe.path)){
      warning(paste("Multiple versions of APSIM installed. \n
                    Choosing the newest one:", newest.version))
      }
    ## apsim.name <- grep(newest.version, apsim.versions, value = TRUE)
    apsim.name <- newest.version
  }
  
  ## APSIM executable
  st3 <- "/Model/Apsim.exe" 
  if(is.na(apsimx::apsim.options$exe.path)){
    if(length(apsim.name) >= 1){
      apsim_dir <- paste0(st1, apsim.name, st3)  
    }else{
      stop("APSIM not found. Please try setting the path manually through 'apsim_options'", call. = FALSE)
    }
  }
  
  if(!is.na(apsimx::apsim.options$exe.path)){
    ## Windows paths can contain white spaces which are
    ## problematic when running them at the command line
    ## I will simply not allow white spaces
    if(grepl("\\s", apsimx::apsim.options$exe.path))
      stop("White spaces are not allowed in APSIM Classic exe.path")
    apsim_dir <- apsimx::apsim.options$exe.path
  }
  return(apsim_dir)
}

#' Auto detect where APSIM (7.x) \sQuote{Classic} examples are located 
#' 
#' @title Auto detect where apsim examples are located
#' @name auto_detect_apsim_examples
#' @description simple function to detect where APSIM \sQuote{Classic} examples are located
#' @return will create a directory pointing to APSIM \sQuote{Classic} distributed examples
#' @export
#' @examples 
#' \dontrun{
#' ex.dir <- auto_detect_apsim_examples()
#' }
#' 

auto_detect_apsim_examples <- function(){
  
  if(.Platform$OS.type != "windows"){
    stop("This is only for windows. Use auto_detect_apsimx_examples instead.")
  }
  
  ## Internal function to split APSIM name
  fev <- function(x) as.numeric(strsplit(x, "r", fixed = TRUE)[[1]][2])
  
  st1 <- "C:/PROGRA~2"
  laf <- list.files(st1)
  find.apsim <- grep("APSIM",laf, ignore.case = TRUE)
  
  if(length(find.apsim) == 0) stop("APSIM 'Classic' not found")
  
  apsim.versions <- laf[find.apsim]
  if(length(apsim.versions) > 1){
      versions <- sapply(apsim.versions, fev)
      newest.version <- sort(versions, decreasing = TRUE)[1]
      if(apsimx::apsim.options$warn.versions){
        warning(paste("Multiple versions of APSIM installed. \n
                      Choosing the newest one:",newest.version))
      }
      apsim.name <- grep(newest.version, apsim.versions, value = TRUE)
    }else{
      apsim.name <- apsim.versions
    }
    ## APSIM path to examples
    st3 <- "/Examples" 
    apsim_ex_dir <- paste0(st1, "/", apsim.name,st3)
  
  if(!is.na(apsimx::apsim.options$examples.path)){
    ## Not sure if I need shQuote here
    if(grepl("\\s", apsimx::apsim.options$examples.path))
      stop("White spaces are not allowed in APSIM Classic examples.path")
    apsim_ex_dir <- apsimx::apsim.options$examples.path
  }
  return(apsim_ex_dir)
}

#'
#' @title Access Example APSIM Simulations
#' @name apsim_example
#' @description simple function to run some of the built-in APSIM examples
#' @param example run an example from built-in APSIM. Options are all of the ones included with the APSIM distribution, except \sQuote{Graph}.
#' @param silent whether to print standard output from the APSIM execution
#' @param tmp.dir temporary directory where to write files
#' @note This function creates a new column \sQuote{Date} which is in the R \sQuote{Date} format which is convenient for graphics.
#' @details This function creates a temporary copy of the example file distributed with APSIM to avoid writing a .out file 
#'          to the directory where the \sQuote{Examples} are located. It is not a good practice and there is no guarantee that 
#'          the user has read/write permissions in that directory.
#' @return This function returns a data frame with APSIM output 
#' @export
#' @examples 
#' \dontrun{
#' ## Only run these if you have APSIM 'Classic' installed (Windows only)
#' millet <- apsim_example("Millet")
#' potato <- apsim_example("Potato")
#' sugar <- apsim_example("Sugar")
#' ## The 'Date' column is created by this function, based on apsim output.
#' require(ggplot2)
#' ggplot(data = millet , aes(x = Date, y = millet_biomass)) + 
#'   geom_line()
#' }
#' 

apsim_example <- function(example = "Millet", silent = FALSE, tmp.dir = NULL){

  if(.Platform$OS.type != "windows"){
    stop("This is only for windows. Use apsimx_example instead.")
  }
  ## Write to a temp dir only
  if(missing(tmp.dir)) tmp.dir <- "."
  ## Run a limited set of examples
  ## Now the only one missing is Graph, which I assume is about
  ## graphics and not that relevant to apsim
  ## Examples not supported: Several
  ex.ch <- c("agpasture", "Canopy", "Centro", "Millet", "Potato", "Sugar")
  
  example <- match.arg(example, choices = ex.ch)
  
  ada <- auto_detect_apsim()
  ex.dir <- auto_detect_apsim_examples()
  ex <- file.path(ex.dir, paste0(example, ".apsim"))
  
  if(!file.exists(ex)) stop("cannot find example files")
  ## Make a temporary copy of the file to the current directory
  ## Do not transfer permissions?
  file.copy(from = ex, to = tmp.dir, copy.mode = FALSE)
  
  run.strng <- paste0(ada, " ", paste0(tmp.dir, "/", example, ".apsim"))
  shell(cmd = run.strng, translate = TRUE, intern = TRUE)
  
  ## Create database connection
  ## I don't need to specify the directory as it should be the current one
  ## I do need to find out the output name
  out.name <- .find_output_names(paste0(example,".apsim"), .src.dir = tmp.dir)
  if(length(out.name) == 1){
    ans <- read_apsim(out.name, value = "report")
  }
  if(length(out.name) > 1){
    stop("not ready to handle this yet")
  }
  ## OS independent cleanup (risky?)
  for(i in out.name){
    file.remove(paste0(tmp.dir, "/", i))
    file.remove(paste0(tmp.dir, "/", strsplit(i, ".", fixed=TRUE)[[1]][1], ".sum"))
  }
  file.remove(paste0(tmp.dir, "/", example, ".apsim"))
  ## Return data frame
  return(ans)
}

#' Read APSIM generated .out files
#' 
#' @title Read APSIM generated .out files
#' @name read_apsim
#' @description read \sQuote{output} databases created by APSIM runs (.out and .sim). One file at a time.
#' @param file file name
#' @param src.dir source directory where file is located
#' @param value either \sQuote{report} (data.frame), \sQuote{user-defined} or \sQuote{all} (list)
#' @param date.format format for adding \sQuote{Date} column 
#' @param silent whether to issue warnings or suppress them
#' @return This function returns a data frame with APSIM output or a list if value equals \sQuote{all}
#' @seealso \code{\link{read_apsim_all}}
#' @export
#' @examples 
#' \dontrun{
#' extd.dir <- system.file("extdata", package = "apsimx")
#' maize.out <- read_apsim("Maize", src.dir = extd.dir, value = "report")
#' millet.out <- read_apsim("Millet", src.dir = extd.dir, value = "report")
#' }
#' 

read_apsim <- function(file = "", src.dir = ".",
                       value = c("report", "all"),
                       date.format = "%d/%m/%Y",
                       silent = FALSE){
  
  if(file == "") stop("need to specify file name")
  
  file.names <- dir(path = src.dir, pattern = ".out$", ignore.case=TRUE)
  
  if(length(file.names) == 0){
    stop("There are no .out files in the specified directory to read.")
  }
  
  value <- match.arg(value)
  
  if(length(grep(".out$", file)) != 0){
    ## I assume the extention was included
    ## Only use the name from here 
    ## This strips the extension
    file <- tools::file_path_sans_ext(file)
  }
  
  file.name.path <- paste0(src.dir, "/", file, ".out")
  
  ## How many rows to skip might be title plus one
  skip.out.lines <- -1
  rdlns <- readLines(con = file.name.path, n = 6)
  for(i in 1:5){
    if(grepl("^Title =", rdlns[i])){
      skip.out.lines <- i
    }    
  }
  
  if(skip.out.lines < 0)
    stop("Was expecting to find a line with 'Title' in the output, but nothing was found.
         Is the output empty?", call. = FALSE)

  ## Read output file
  hdr <- as.character(sapply(as.vector(read.table(file = file.name.path, 
                                                  header = FALSE,
                                                  sep = "", 
                                                  nrows = 1, 
                                                  skip = skip.out.lines)[1,]), 
                             FUN = function(x) x[[1]]))

  out.file <- read.table(file = file.name.path, header = FALSE, sep = "", skip = c(skip.out.lines + 2))
  
  if(length(hdr) != dim(out.file)[2]){
    cat("length header", length(hdr), " number of columns", dim(out.file)[2], "\n")
    stop("header names are not equal to number of columns")
  }
  
  names(out.file) <- hdr
  ## Read summary file, but fail more or less gracefully
  file.name.summary <- paste0(src.dir, "/", file, ".sum")
  sum.file <- suppressWarnings(try(readLines(con = file.name.summary), silent = TRUE))
  if(inherits(sum.file, "try-error")){
    lf.sum <- list.files(path = src.dir, pattern = "sum$")
    if(length(lf.sum) == 0){
      if(!silent) warning("Could not find summary file.")  
    }
    if(length(lf.sum) == 1){
      ## This means that this is likely the correct file
      sum.file <- try(readLines(con = lf.sum), silent = TRUE)    
      if(inherits(sum.file, "try-error"))
        if(!silent) warning("Could not read summary file.")
    }
    if(length(lf.sum) > 1)
      if(!silent) warning("Multiple 'sum' files. Don't know which one is the correct one.")
  }
  
  if(any(grepl("Date", hdr, ignore.case = TRUE))){
    wcid <- grep("Date", hdr, ignore.case = TRUE) ## The short name stands for 'which column is date'
    ## If there is more than one, I will select the first one
    if(length(wcid) > 1){
      wcid <- wcid[1]
      if(!silent) warning("More than one column with 'Date'. Picking the first one.")
    }
      
    try.date <- try(as.Date(out.file[,wcid], format = date.format), silent=TRUE)
    
    if(inherits(try.date, "try-error")){
      warning("Could not create Date column")
    }else{
      out.file$Date <- try.date   
    }
  }
  ## Return list
  if(value == "all"){
    ans <- list(Report = out.file, Summary = sum.file)
  }
  ## Return data.frame
  if(value == "report"){
    ans <- out.file
  }
  return(ans)
}

#' Read all APSIM generated .out files in a directory
#' 
#' @title Read all APSIM generated .out files in a directory
#' @name read_apsim_all
#' @description Like \code{\link{read_apsim}}, but it can read many .out files in a directory. 
#' It will read all of them unless these are filtered using a regular expression as an argument
#' to \sQuote{value}.
#' @param filenames names of files to be read
#' @param src.dir source directory where files are located
#' @param value either \sQuote{report}, \sQuote{user-defined} or \sQuote{all} (not implemented at the moment)
#' @param date.format format for adding \sQuote{Date} column 
#' @param simplify whether to return a single data frame or a list. 
#' @param silent whether to issue warnings or suppress them
#' @return returns a data frame or a list depending on the argument \sQuote{simplify} above.
#' @note Warning: very simple function at the moment, not optimized for memory or speed.
#' @export
#' 

read_apsim_all <- function(filenames, src.dir = ".", 
                           value = "report",
                           date.format = "%d/%m/%Y", 
                           simplify = TRUE,
                           silent = FALSE){
  
  ## This is memory hungry and not efficient at all, but it might work 
  ## for now

  if(simplify && value == "all") stop("Cannot simplify when value = all")
  
  file.names <- dir(path = src.dir, pattern=".out$", ignore.case = TRUE)
  
  if(!missing(filenames)){
   file.names <- filenames
  }
  
  col.names <- matrix(nrow = length(file.names), ncol = 1000)
  col.num <- numeric(length(file.names))
  
  if(value != "report" && value != "all"){
    ## Here the argument value is defined by the user
    outfiles <- grep(value, file.names, value = TRUE)
    
    if(length(outfiles) == 0)
      stop("When 'value' is not 'all' or 'report' it should match at least one of the outfile names.", call. = FALSE)
  
    if(length(outfiles) == 1){
      ans <- read_apsim(outfiles, src.dir = src.dir, value = "report", date.format = date.format, silent = silent)  
    }else{
      if(simplify){
        ans <- NULL
        for(i in outfiles){
          tmp <- read_apsim(i, src.dir = src.dir, value = value, date.format = date.format, silent = silent)
          tmp.d <- data.frame(outfile = i, tmp)
          ans <- try(rbind(ans, tmp.d), silent = TRUE)
          if(inherits(ans, "try-error")){
            stop("Could not simplify output files into a single data.frame \n
             Choose simplify = FALSE.", call. = FALSE)
          }
        }
      }else{
        ans <- vector("list", length = length(outfiles))
        names(ans) <- outfiles
        for(i in outfiles){
          ans[[i]] <- read_apsim(i, value = value, date.format = date.format, silent = silent)
        }    
      }      
    }  
  }else{
    if(simplify){
      ans <- NULL
      for(i in file.names){
        tmp <- read_apsim(i, src.dir = src.dir, value = value, date.format = date.format, silent = silent)
        tmp.d <- data.frame(outfile = i, tmp)
        ans <- try(rbind(ans, tmp.d), silent = TRUE)
        if(inherits(ans, "try-error")){
          stop("Could not simplify output files into a single data.frame \n
             Choose simplify = FALSE.", call. = FALSE)
        }
      }
    }else{
      ans <- vector("list", length = length(file.names))
      names(ans) <- file.names
      for(i in file.names){
        ans[[i]] <- read_apsim(i, value = value, date.format = date.format, silent = silent)
      }    
    }    
  }
  
  return(ans)
}

#' Set apsim options
#' 
#' @title Setting some options specific to APSIM (7.x) \sQuote{Classic}
#' @name apsim_options
#' @description Set the path to the APSIM executable, examples and warning suppression. 
#' @param exe.path path to apsim executable
#' @param examples.path path to apsim examples
#' @param warn.versions logical. warning if multiple versions of APSIM are detected.
#' @note It is possible that APSIM 7.x \sQuote{Classic} is installed in some alternative location other than the 
#'       defaults ones. Guessing this can be difficult and then the auto_detect functions might
#'       fail. Also, if multiple versions of APSIM are installed apsim will choose the newest
#'       one but it will issue a warning. Suppress the warning by setting warn.versions = FLASE.
#' @return It modifies the \sQuote{apsim.options} environment as a side effect.
#' @export
#' @examples 
#'\dontrun{
#' names(apsim.options)
#' apsim_options(exe.path = "some-new-path-to-executable")
#' apsim.options$exe.path
#' }

apsim_options <- function(exe.path = NA, examples.path = NA, warn.versions = TRUE){
  assign('exe.path', exe.path, apsim.options)
  assign('examples.path', examples.path, apsim.options)
  assign('warn.versions', warn.versions, apsim.options)
}

#' Environment which stores APSIM options
#' 
#' @title Environment which stores APSIM options
#' @name apsim.options
#' @description Environment which can store the path to the executable and where examples are located.
#'              Creating an environment avoids the use of global variables or other similar practices
#'              which would have possible undesriable consequences. 
#' @return This is an environment, so nothing to return.
#' @export
#' @examples 
#' \dontrun{
#' names(apsim.options)
#' apsim_options(exe.path = "some-new-path-to-executable")
#' apsim.options$exe.path
#' }
#' 

apsim.options <- new.env(parent = emptyenv())
assign('exe.path', NA, apsim.options)
assign('examples.path', NA, apsim.options)
assign('warn.versions', TRUE, apsim.options)