R/execute.R

In rogiersbart/RMT3DMS: Pre- and post-processing of MT3DMS & MT3D-USGS files

#' Execute a MT3DMS or MT3D-USGS model
#' 
#' These functions execute MT3DMS or MT3D-USGS models.
#' 
#' @param code Name of the MT3D variant to use, or path to the executable.
#' @param convergence Character. The message in the terminal output used
#'   to check for convergence.
#' @param bits Character. Can be \code{"single"} (ie. 32 bits) or \code{"double"} (i.e. 64 bits). Specifies if 32 or 64 bit executable are used for the MT3D-USGS executable.
#' @param form Character. Can be \code{'s'} or \code{'b'} (default). Specifies which MT3DMS executable is used, which depends on the value of FORM in the 'filespec.inc' file during compilation. The default 'b' (for binary) should work with FTL files generated by MODFLOW-2000 and newer versions. A value of 's' (for unformatted) should work with FTL files generated by MODFLOW-88 or 96.
#' @return Invisible list with elapsed run time, a logical
#'   indicating normal termination, and the stdout output, when done for an on
#'   disk model. Full `mt3dms` object including all results otherwise (in
#'   memory model).
#' @export
#' @seealso
#' [rmt_install()] for external code installation
rmt_execute <- function(...) {
  UseMethod('rmt_execute')
}

#' @rdname rmt_execute
#' @param path Path to the NAM file. Typically with extension `.nam`.
#' @param ui If NULL (default), MT3D output is shown in the R console. If
#'   `"none"`, the output is suppressed.
#' @export
rmt_execute.character <- function(
  path,
  code = "mt3d-usgs",
  ui = NULL,
  convergence = "Program completed",
  bits = 'single',
  form = 'b'
) {
  # NOTE The convergence argument was foreseen for custom executables.
  # TODO add user supplied bits and form argument
  code <- rmti_find(code, bits = bits, form = form)
  
  # get directory and filename
  dir <- dirname(path)
  file <- basename(path)
  
  # run mt3dms
  mt_stdout <- ! getOption("RMT3DMS.ui") == "none"
  if (!is.null(ui)) mt_stdout <- ! ui == "none"
  out <- processx::run(
    code, file, wd = dir,
    stdout_line_callback = if (mt_stdout) rmti_line_callback else NULL
  )
  out$stdout <- out$stdout %>%
    stringr::str_split("\\r\\n") %>%
    purrr::pluck(1)
  rmt_execute <- list(
    time = out$stdout %>%
      stringr::str_subset("Total CPU time") %>%
      stringr::str_extract("(?<=: ).*") %>%
      tolower() %>%
      lubridate::duration(),
    normal_termination = any(grepl(convergence, out$stdout)),
    stdout = out$stdout
  )
  invisible(rmt_execute)
}

#' @rdname rmt_execute
#' @param mt3dms mt3dms object
#' @export
rmt_execute.mt3dms <- function(
  mt3dms,
  code = "mt3d-usgs",
  ui = NULL,
  convergence = "Program completed",
  bits = 'single',
  form = 'b'
) {
  # TODO change class and top-level S3 to "rmt_model" instead of mt3dms
  # TODO append rmt_execute results to top level list?

  # temporary directory
  old <- setwd(tempdir())
  on.exit(setwd(old), add = TRUE)
  
  # write all files
  rmt_write(mt3dms, file = 'input.nam')
  
  # run modflow
  rmt_execute('input.nam', code = code, ui = ui, convergence = convergence, bits = bits, form = form)
  
  # read all output
  
}

#' Find paths to executables
#'
#' This function tries to locate external code executables.
#'
#' It first looks for the executable in the current working directory. If not
#' there, it looks in the bin subfolder of `getOption("RMT3DMS.path")`, where
#' the software might have been installed by [rmt_install()]. If the executable
#' cannot be found, a final attempt is made by checking the system path
#' variable. If it still cannot be located, an error is thrown.
#' 
#' @inheritParams rmt_execute
#' @param bits Character. Can be \code{"single"} (ie. 32 bits) or \code{"double"} (i.e. 64 bits). Specifies if 32 or 64 bit executable are used for the MT3D-USGS executable.
#' @param form Character. Can be \code{'s'} or \code{'b'} (default). Specifies which MT3DMS executable is used, which depends on the value of FORM in the 'filespec.inc' file during compilation. The default 'b' (for binary) should work with FTL files generated by MODFLOW-2000 and newer versions. A value of 's' (for unformatted) should work with FTL files generated by MODFLOW-88 or 96.
#' @return Path to the executable.
rmti_find <- function(
  code = "usgs",
  bits = "single",
  form = 'b'
) {
  # TODO throw error on 32 bit systems when 64 bit exe is selected
  if (file.exists(code)) return(code)
  if (grepl("USGS", toupper(code))) {
    if (grepl("64", code)) bits <- "double"
    code <- "MT3D-USGS"
    folder <- ""
    rmt_install_bin_folder <- file.path(getOption("RMT3DMS.path"), code,
                                        "bin")
    exes <- list.files(rmt_install_bin_folder)
    executable <- ifelse(bits == "single", grep("32", exes, value = TRUE), grep("64", exes, value = TRUE))
    
    if (!file.exists(executable)) {
      if (file.exists(file.path(rmt_install_bin_folder, executable))) {
        folder <- rmt_install_bin_folder
      } else if (file.exists(Sys.which(executable))) {
        return(Sys.which(executable))
      } else if (file.exists(Sys.which(code))) {
        return(Sys.which(code))
      } else {
        rui::error("Path to {code} executable not found.")
      }
    }
    return(file.path(folder, executable))
  }
  if (toupper(code) == 'MT3DMS') {
    code <- "MT3DMS"
    folder <- ""
    rmt_install_bin_folder <- file.path(getOption("RMT3DMS.path"), code,
                                        "bin")
    exes <- grep('mt3dms', list.files(rmt_install_bin_folder), value = TRUE)
    executable <- ifelse(form == "b", grep('.*b.exe', exes, value = TRUE),  grep('.*s.exe', exes, value = TRUE))
    
    if (!file.exists(executable)) {
      if (file.exists(file.path(rmt_install_bin_folder, executable))) {
        folder <- rmt_install_bin_folder
      } else if (file.exists(Sys.which(executable))) {
        return(Sys.which(executable))
      } else if (file.exists(Sys.which(code))) {
        return(Sys.which(code))
      } else {
        rui::error("Path to {code} executable not found.")
      }
    }
    return(file.path(folder, executable))
  } 
  rui::alert("Finding paths to the executables of codes other than ",
             "MT3D-USGS or MT3DMS is currently not supported.")
  rui::error("Issue with code path.")
}


rmti_line_callback <- function(line, process) {
  line <- stringr::str_squish(line)
  if (line == "") return(invisible())
  if (line %in% c("MT3DMS", "MT3D-USGS")) {
    rui::title(line)
    return(invisible())
  }
  if (grepl("Program completed", line)) {
    rui::approve(line)
    return(invisible())
  }
  if (grepl("FAILED TO MEET SOLVER CONVERGENCE CRITERIA", line)) {
    rui::disapprove(line)
    return(invisible())
  }
  if (grepl("Specified Name does not exist", line)) {
    rui::alert(line)
    rui::error("Issue with the name file path.")
    return(invisible())
  }
  if (grepl("NAME FILE IS EMPTY", line)) {
    rui::alert(line)
    rui::error("Issue with the name file.")
    return(invisible())
  }
  rui::inform(line)
  invisible()
}