R/run_metamodel.R

In Certara.RsNLME: Pharmacometric Modeling

#' Fit the NLME metamodel
#'
#' Use for simple model execution given information contained in mmdl file.
#'
#' @param mmdlfile The metamodel file path; relative paths are acceptable.
#' @param directoryToRun The directory where the final results should be stored
#' If `missing`, the mmdlfile base directory is used.
#' @param nlme_hostPath json file with host definition for model execution.
#' Generated by Pirana application. Consider using `host` argument
#' when running from R.
#' @param host [NlmeParallelHost()] class instance.
#'
#' @return
#' the results of [fitmodel()] run are returned if singular ESTARGS block is
#' provided; otherwise a list of [fitmodel()] and [simmodel()] results
#' are returned.
#'
#' @details
#' See
#' \href{https://certara.github.io/R-RsNLME/articles/metamodels_overview.html#metamodel-overview}{Metamodel
#' documentation}.
#'
#' If both `nlme_hostPath` and `host` specified, the former is used.
#' If `nlme_hostPath` is `missing`, `host` is used instead.
#' If both are `missing`, MPI local host with 4 threads is used for simple estimation
#' mode, multicore host is used for the others.
#'
#' Multiple ESTARGS/SIMARGS are supported, they are applied for the model sequentially,
#' the results of previous estimation are applied to the model before the next one.
#' ESTARGS queue is executed first, SIMARGS queue is executed the second.
#'
#' @examples
#' \donttest{
#' # path to metamodel should be specified
#' host <- hostParams(
#'   parallelMethod = "LOCAL_MPI",
#'   hostName = "local_mpi",
#'   numCores = 4
#' )
#' directoryToRun <- normalizePath("./NLME/")
#' run_metamodel("metamodel.mmdl", directoryToRun)
#' }
#'
#' @seealso NlmeParallelHost, fitmodel
#' @md
#' @export
#' @keywords internal
run_metamodel <-
  function(mmdlfile,
           directoryToRun,
           nlme_hostPath,
           host) {
    if (missing(directoryToRun)) {
      mmdlfilePath <- dirname(normalizePath(mmdlfile))
      directoryToRun <-
        file.path(mmdlfilePath,
                  paste0("fitmodel_",
                         tools::file_path_sans_ext(basename(mmdlfile))))

      directoryToRun <-
        normalizePath(directoryToRun, winslash = "/", mustWork = FALSE)

      dirList <- list.dirs(mmdlfilePath, recursive = FALSE)
      for (index in 1:999) {
        workingDir <- sprintf("%s_%02d", directoryToRun, index)
        if (!workingDir %in% dirList) {
          directoryToRun <- .prepare_wd(workingDir)
          break()
        }
      }
      if (index == 999) {
        stop("cannot create working directory")
      }
    } else {
      directoryToRun <- .prepare_wd(directoryToRun)
    }

    Sys.setenv("NLME_ROOT_DIRECTORY" = directoryToRun)
    fitmodel_args <-
      create_model_from_metamodel(mmdlfile = mmdlfile,
                                  directoryToRun = directoryToRun)

    if (missing(nlme_hostPath) && missing(host)) {
      INSTALLDIR <- Sys.getenv("INSTALLDIR")
      if (!all(
        Certara.NLME8::checkInstallDir(INSTALLDIR),
        Certara.NLME8::checkLicenseFile(INSTALLDIR)
      )) {
        stop("Cannot use NLME without valid NLME executables")
      }

      host <- NULL
    } else {
      if (!missing(nlme_hostPath)) {
        if (dirname(nlme_hostPath) == ".") {
          nlme_hostPath <- file.path(directoryToRun, nlme_hostPath)
        }
        nlme_host <- jsonlite::read_json(nlme_hostPath)
        host <- .prepare_NLMEhost(nlme_host)
      } else {
        stopifnot(inherits(host, "NlmeParallelHost"))
      }
    }

    if (inherits(fitmodel_args$params, "NlmeEngineExtraParams")) {
      # for compatibility retain old part
      fitmodel_results <- fitmodel(fitmodel_args$model,
                                   hostPlatform = host,
                                   params = fitmodel_args$params)
    } else {
      fitmodel_results <- list()
      for (ParametersSetIndex in seq_along(fitmodel_args$params)) {
        ParametersSet <- fitmodel_args$params[[ParametersSetIndex]]
        if (ParametersSetIndex != 1 &&
            inherits(fitmodel_args$params[[ParametersSetIndex - 1]], "NlmeEngineExtraParams")) {
          # need to apply previous results to test.mdl
          tempModelFile <-
            Certara.NLME8::UpdateMDLfrom_dmptxt(
              dmpfile = "dmp.txt",
              SharedWorkingDir = directoryToRun,
              model_file = fitmodel_args$model@dataset@modelFile,
              compile = FALSE
            )

          fitmodel_args$model@statements <-
            as.list(readLines(tempModelFile, warn = FALSE))
        }

        if (inherits(ParametersSet, "NlmeEngineExtraParams")) {
          fitmodel_results[[ParametersSetIndex]] <-
            fitmodel(
              model = fitmodel_args$model,
              hostPlatform = host,
              params = ParametersSet
            )
        } else {
          # simParamsBlock
          simParamsArgument <-
            NlmeSimulationParams(numReplicates = ParametersSet@numReplicates,
                                 seed = ParametersSet@seed)

          paramsArgument <-
            engineParams(
              model = fitmodel_args$model,
              ODE = ParametersSet@ODE,
              rtolODE = ParametersSet@rtolODE,
              atolODE = ParametersSet@atolODE,
              maxStepsODE = ParametersSet@maxStepsODE
            )

          fitmodel_results[[ParametersSetIndex]] <-
            simmodel(
              model = fitmodel_args$model,
              simParams = simParamsArgument,
              params = paramsArgument,
              hostPlatform = host
            )
        }
      }
    }

    # for remote runs dmp.txt is not loaded
    if (!exists("dmp.txt") &&
        file.exists(file.path(directoryToRun, "dmp.txt"))) {
      source(file.path(directoryToRun, "dmp.txt"), local = TRUE)
    }

    if (exists("dmp.txt")) {
      jsonName <-
        normalizePath(file.path(directoryToRun,
                                "dmp.json"),
                      mustWork = FALSE)

      # numeric vectors (fixefs) lost the names, so converting it to df
      dmp.txt$coefficients$fixed <-
        as.data.frame(as.list(dmp.txt$coefficients$fixed))
      jsonlite::write_json(
        x = rapply(
          dmp.txt,
          as.data.frame,
          classes = "matrix",
          how = "replace"
        ),
        path = jsonName,
        digits = NA,
        force = TRUE
      )
    }

    return(fitmodel_results)
  }

#' Create NlmeParallelHost object from json file with host definition
#'
#' Create NlmeParallelHost object from json file with host definition
#'
#' @param nlme_hostPath json file with host definition for model execution.
#' See \code{NlmeParallelHost} class definition.
#' If \code{missing}, MPI local host with 4 threads is used for simple estimation
#' mode, multicore host is used for the others.
#'
#' @return
#' the \code{NlmeParallelHost} class object is returned.
#' @export
#' @keywords internal
#' @examples
#' \donttest{
#' # path nlme_hostPath should be specified
#'
#' host <- parse_NLMEHosts(nlme_hostPath)
#' }
# see NlmeParallelHost class for description of slots used
parse_NLMEHosts <- function(nlme_hostPath) {
  nlme_hosts <- jsonlite::read_json(nlme_hostPath)
  hosts <- c()
  for (nlme_host in nlme_hosts) {
    host <- .prepare_NLMEhost(nlme_host)
    hosts <- c(hosts, host)
  }
  return(hosts)
}

.prepare_NLMEhost <- function(nlme_host) {
  # visual name
  hostName <- nlme_host$profile_name

  # hostName (Local or Remote)
  machineName <- nlme_host$hostname
  if (is.null(machineName)) {
    machineName <- "LocalHost"
    warning("Host IP is not given in the host selected; \nresetting to 1",
            call. = FALSE)
    isLocal <- TRUE
  } else if (is.na(machineName) ||
             machineName %in% c("", "127.0.0.1", Sys.info()[["nodename"]]) ||
             grepl("^localhost$", machineName, ignore.case = TRUE)) {
    machineName <- "LocalHost"
    isLocal <- TRUE
  } else {
    isLocal <- FALSE
  }

  # hostType (windows or linux)
  hostType <- nlme_host$os
  if (isLocal) {
    hostType <- .Platform$OS.type
  } else if (is.null(hostType)) {
    stop("OS platform for the remote host ",
         machineName,
         " is not specified.")
  } else if (grepl("unix|linux", hostType, ignore.case = TRUE)) {
    hostType <- "linux"
  } else if (grepl("windows", hostType, ignore.case = TRUE)) {
    hostType <- "windows"
  }

  # numCores: num of Cores to be used
  numCores <- nlme_host$cores_number
  if (is.null(numCores)) {
    warning("Cores number is not given in the host selected;",
            "\nresetting to 1",
            call. = FALSE)
    numCores <- 1
  } else if (!grepl("^\\s*\\d+\\s*$", numCores)) {
    warning("Number of cores specified is not integer; resetting to 1",
            call. = FALSE)
    numCores <- 1
  } else {
    numCores <- as.integer(numCores)
  }

  # parallelization method
  parallelMethod <- trimws(nlme_host$parallel_mode)

  knownMethods <- .get_supportedMethods(hostType)

  if (is.null(parallelMethod)) {
    warning("parallelMethod is not given in the host selected;",
            "\nresetting to none",
            call. = FALSE)
    parallelMethod <- "none"
  } else {
    greplMethod <-
      grepl(parallelMethod, knownMethods, ignore.case = TRUE)
    if (sum(greplMethod, na.rm = TRUE) == 0) {
      stop(
        "parallel method selected (",
        parallelMethod,
        ") is not supported",
        "\nfor ",
        hostType,
        " platform. Supported methods are: \n",
        paste0(knownMethods, collapse = ", ")
      )
    }
  }

  parallelMethod <- NlmeParallelMethod(parallelMethod)

  # authentication for remote only
  if (isLocal) {
    userAuthentication <- NlmeUserAuthentication()
  } else {
    userName <- nlme_host$username
    if (is.null(userName)) {
      userName <- ""
    } else if (is.na(userName)) {
      userName <- ""
    }

    userPassword <- nlme_host$password
    if (is.null(userPassword)) {
      userPassword <- ""
    }

    privateKeyFile <- nlme_host$private_key_filename
    if (!is.null(privateKeyFile) &&
        !is.na(privateKeyFile) && privateKeyFile != "") {
      if (!file.exists(privateKeyFile)) {
        stop("SSH key file ", privateKeyFile, "\nnot found")
      }

      sshKey <- readLines(privateKeyFile)
      if (length(sshKey) < 2 ||
          sshKey[1] != "-----BEGIN RSA PRIVATE KEY-----") {
        stop("SSH private key given is not in OpenSSH PEM format")
      }
    } else {
      privateKeyFile <- NULL
    }

    userAuthentication <- NlmeUserAuthentication(
      userName = userName,
      userPassword = userPassword,
      privateKeyFile = privateKeyFile
    )
  }

  # scriptPath
  scriptPath <- nlme_host$startup_script
  if (is.null(scriptPath)) {
    scriptPath <- ""
  }

  if (!is.na(scriptPath) &&
      scriptPath != "" &&
      !file.exists(scriptPath) &&
      isLocal) {
    stop("Script specified ", scriptPath, " does not exist.")
  }

  # NLME Root directory
  sharedDirectory <- nlme_host$shared_folder
  if (isLocal) {
    # ignoring shared directory for the local runs
    sharedDirectory <- Sys.getenv("NLME_ROOT_DIRECTORY")
    if (sharedDirectory == "") {
      sharedDirectory <- normalizePath(".", winslash = "/", mustWork = FALSE)
    }
  } else if (is.null(sharedDirectory)) {
    sharedDirectory <- ""
  }

  # INSTALLDIR is specified only if the host is not local
  if (isLocal) {
    installationDirectory <- Sys.getenv("INSTALLDIR")
  } else {
    if (!is.null(nlme_host$install_dir) &&
        nlme_host$install_dir != "") {
      installationDirectory <- nlme_host$install_dir
    } else {
      installationDirectory <- ""
    }
  }

  # remote R location
  rLocation <- nlme_host$r_folder
  if (is.null(rLocation)) {
    rLocation <- ""
  } else if (is.na(rLocation)) {
    rLocation <- ""
  }

  return(
    NlmeParallelHost(
      sharedDirectory = sharedDirectory,
      installationDirectory = installationDirectory,
      hostName = hostName,
      machineName = machineName,
      hostType = hostType,
      numCores = numCores,
      isLocal = isLocal,
      rLocation = rLocation,
      scriptPath = scriptPath,
      userAuthentication = userAuthentication,
      parallelMethod = parallelMethod
    )
  )
}