R/run_javastics.R

In SticsRPacks/SticsOnR: Manage STICS Simulations Running the Executable or JavaStics,

#' @title Running one or several usms from a javastics workspace
#'
#' @description This function uses basically Stics through his
#' JavaStics command line interface
#'
#' @param javastics Path of JavaStics
#' @param workspace Path of a JavaStics workspace
#' @param usm Vector of USM names. Optional, if provided, the function runs
#' only the given USMs.
#' If not provided, the function runs all the USMs included in workspace.
#' @param keep_history Logical value (optional) to keep a copy of history file
#' use `TRUE` (default), `FALSE` otherwise
#' @param optim Logical value (optional), `TRUE` to force code_optim value to 1,
#' `FALSE` otherwise (default)
#' @param verbose Logical value for displaying information while running
#' @param stics_exe The name, executable or path of the stics executable to use
#'  (optional, default to "modulostics", see details)
#' @param java_cmd The java virtual machine command name or executable path
#' @param workspace_path `r lifecycle::badge("deprecated")` `workspace_path`
#'   is no longer supported, use `workspace` instead.
#' @param javastics_path `r lifecycle::badge("deprecated")` `javastics_path`
#'   is no longer supported, use `javastics` instead.
#' @param usms_list `r lifecycle::badge("deprecated")` `usms_list` is no
#'   longer supported, use `usm` instead.
#'
#' @details `stics_exe` may be :
#' 1. a model name pointing to a stics executable as done in JavaStics, e.g.
#' "modulostics" for `stics_modulo.exe`, the standard version of the model
#' shipping with JavaStics;
#' 2. a stics executable file available from the bin folder in JavaStics, e.g.
#' "stics_modulo.exe";
#' 3. a path to a stics executable file, eg.
#' "C:/Users/username/Desktop/stics.exe". NB: this file cannot be named
#' `stics_modulo.exe` because it is the name of the standard STICS shipping
#' with JavaStics (overwriting is not allowed).
#'
#' @return A list in which each element contains: usm "name", "error" status
#' (logical) and an output "message" (JavaStics commandline execution output)
#'
#'
#' @examples
#' \dontrun{
#' run_javastics("/path/to/JavaSTICS/folder", "example")
#' run_javastics("/path/to/JavaSTICS/folder", "/path/to/workspace")
#' run_javastics("/path/to/JavaSTICS/folder", "example", c("wheat", "pea"))
#' run_javastics("/path/to/JavaSTICS/folder", usm = c("wheat", "pea"))
#' run_javastics("/path/to/JavaSTICS/folder",
#' usm = c("wheat", "pea"), optim = TRUE)
#' }
#'
#' @export
#'
run_javastics <- function(javastics,
                          workspace = NULL,
                          usm = NULL,
                          keep_history = TRUE,
                          optim = FALSE,
                          verbose = TRUE,
                          stics_exe = "modulostics",
                          java_cmd = "java",
                          javastics_path = lifecycle::deprecated(),
                          workspace_path = lifecycle::deprecated(),
                          usms_list = lifecycle::deprecated()) {

  if (lifecycle::is_present(javastics_path)) {
    lifecycle::deprecate_warn("1.0.0", "run_javastics(javastics_path)",
                              "run_javastics(javastics)")
  } else {
    javastics_path <- javastics # to remove when we update inside the function
  }
  if (lifecycle::is_present(workspace_path)) {
    lifecycle::deprecate_warn("1.0.0", "run_javastics(workspace_path)",
                              "run_javastics(workspace)")
  } else {
    workspace_path <- workspace # to remove when we update inside the function
  }
  if (lifecycle::is_present(usms_list)) {
    lifecycle::deprecate_warn("1.0.0", "run_javastics(usms_list)",
                              "run_javastics(usm)")
  } else {
    usms_list <- usm # to remove when we update inside the function
  }

  # Ensure that the user working directory is unchanged after
  # the function has run
  current_wd <- getwd()
  on.exit(setwd(current_wd))

  # Use absolute path from now on:
  javastics_path <- normalizePath(javastics_path, winslash = "/")
  workspace_path <- normalizePath(workspace_path, winslash = "/",
                                  mustWork = FALSE)

  # Help people that don't remember well the standard name:
  if (stics_exe == "stics_modulo" || stics_exe == "sticsmodulo") {
    stics_exe <- "modulostics"
  }

  # Checking javastics path
  SticsRFiles:::check_java_path(javastics_path)

  # Getting right executable name for the platform
  if (stics_exe == "modulostics") {
    # using the exe name instead of the identifier to select the right one
    # for the user's OS
    stics_exe <- paste0("stics_modulo", SticsRFiles:::os_suffix())
  }

  # Model path
  stics_path <- file.path(javastics_path, "bin", stics_exe)

  # On exit, return to the version used before:
  on.exit(set_stics_exe(
    javastics = javastics_path,
    stics_exe = list_stics_exe(javastics_path)$current[[1]],
    verbose = FALSE
  ),
  add = TRUE
  )

  set_stics_exe(
    javastics = javastics_path, stics_exe = stics_exe,
    overwrite = TRUE, verbose = verbose
  )

  # Fixing the JavaStics path
  setwd(javastics_path)

  # Checking and getting JavaStics workspace path
  ws <- SticsRFiles:::check_java_workspace(javastics_path, workspace_path)
  if (is.null(ws)) {
    return()
  }

  # Retrieving usms names list from the usms.xml file
  full_usms_list <- SticsRFiles::get_usms_list(file.path(ws, "usms.xml"))

  # Checking and selecting usms, if needed
  if (is.null(usms_list)) {
    usms_list <- full_usms_list
  } else {
    usm_exist <- full_usms_list %in% usms_list

    # No usm
    if (!any(usm_exist)) {
      stop("Not any usm exist in the workspace !")
    }

    # Selecting existing usms
    if (sum(usm_exist) != length(usms_list)) {
      unknown_usms <- setdiff(full_usms_list[usm_exist], usms_list)
      warning("At least one usm does not exist in the usms.xml file : ",
              unknown_usms)
      usms_list <- full_usms_list[usm_exist]
    }
  }

  nb_usms <- length(usms_list)
  usms_out <- vector("list", nb_usms)


  # Getting arguments to give to the system2 command
  # for executing files conversion or simulation runs
  # using JavaStics command line interface
  cmd_type <- "run"
  if (optim) cmd_type <- "generate"
  cmd_list <- SticsRFiles:::get_javastics_cmd(javastics_path,
                                              java_cmd = java_cmd,
                                              type = cmd_type,
                                              workspace = ws,
                                              verbose = verbose
  )
  command <- cmd_list[[1]]
  cmd_string <- cmd_list[[2]]



  histo_file <- file.path(workspace_path, "modhistory.sti")

  for (i in 1:nb_usms) {
    usm_name <- usms_list[i]
    usm_out <- list()
    usm_out$name <- usm_name

    # Managing historical files
    if (file.exists(histo_file)) {
      file.remove(histo_file)
    }
    histo_copy <- file.path(workspace_path, paste0("modhistory_",
                                                   usm_name, ".sti"))
    if (file.exists(histo_copy)) {
      file.remove(histo_copy)
    }

    #if (verbose) {
      print(usm_name)
    #}

    if (optim) {
      system2(
        command = command, args = paste(cmd_string, usm_name),
        stdout = if (verbose) {
          ""
        } else {
          NULL
        }
      )
      tmp <- run_system(stics_path, workspace_path)

      usm_out$error <- tmp[[1]]$error
      usm_out$message <- tmp[[1]]$message
    } else {
        status <- system2(
        command = command, args = paste(cmd_string, usm_name),
        stdout = TRUE,
        stderr = TRUE,
      )

      if (verbose)
        print(status)

      err <- grep(pattern = "[eE]rror", tolower(status))
      if (length(err) > 0) {# | status != 0) {
        # Any error, keeping the line with Error message
        usm_out$error <- TRUE
        usm_out$message <- status
      } else {
        # No errors: keeping lines of JavaSticsCmd execution
        usm_out$error <- FALSE
        usm_out$message <- paste(status, sep = "\n")
      }
    }

    # Keeping a copy of modhistory file !
    if (keep_history && file.exists(histo_file)) {
      file.copy(histo_file, histo_copy)
    }

    # Storing usm output infos
    usms_out[[i]] <- usm_out
  }

  # Naming the list elements
  # Final message:
  worked <- !unlist(lapply(usms_out, function(x) x$error))

  if (verbose) {
    if (all(worked)) {
      cli::cli_alert_success("\nAll usms ran successfully!")
    } else {
      cli::cli_alert_danger(
        "Error during simulation of usm{?s} {.val {usms_list[!worked]}}")
    }
  }

  # Returning usms list with execution return
  return(invisible(usms_out))
}