R/bootstrap.r

In Certara.RsNLME: Pharmacometric Modeling

#' Executes an NLME Bootstrap
#'
#' Method to execute an NLME Bootstrap
#'
#' @inheritParams fitmodel
#' @param  bootParams Bootstrap parameters. See \code{\link{BootstrapParams}}.
#' If \code{missing}, default parameters generated by BootstrapParams() are used.
#' @param  hostPlatform Host definition for model execution. See \code{\link{hostParams}}.
#' If \code{missing}, multicore local host with 4 threads is used.
#' @param  params Engine parameters. See \code{\link{engineParams}}.
#' If \code{missing}, default parameters generated by engineParams(model) are used.
#' @param ... Additional class initializer arguments for \code{\link{BootstrapParams}} or
#' \code{\link{hostParams}}, or arguments available inside \code{\link{engineParams}} functions.
#' If \code{\link{engineParams}} arguments are supplied through both \code{params} argument
#' and additional argument (i.e., ellipsis), then the arguments in \code{params} will be ignored
#' and only the additional arguments will be used with warning.
#' If \code{\link{hostParams}} arguments are supplied through both \code{hostPlatform}
#'  argument and additional argument, then its values will be overridden by additional arguments.
#'  In addition, if \code{\link{BootstrapParams}} arguments are supplied through both
#'  \code{bootParams} argument and additional argument,
#'  then its slots will be overridden by additional arguments.
#'
#' @return if \code{runInBackground = FALSE}, a list is returned with bootstrap results, i.e.
#' "BootOverall", "BootTheta", "BootOmega", "BootOmegaStderr", "BootVarCoVar" comma separated files.
#' Otherwise the \code{BootNlmeJob} class object is returned.
#'
#' @seealso \code{\link{hostParams}, \link{engineParams}, \link{BootstrapParams}}
#'
#' @examples
#' \donttest{
#' input_data <- pkData
#'
#' model <-
#'   pkmodel(
#'     numCompartments = 2,
#'     data = input_data,
#'     ID = "Subject",
#'     Time = "Act_Time",
#'     A1 = "Amount",
#'     CObs = "Conc"
#'   )
#'
#' # multicore
#' multicoreHost <- hostParams(
#'   parallelMethod = "Multicore",
#'   hostName = "local_multicore",
#'   numCores = 4
#' )
#'
#' bootstrapdf <- bootstrap(model,
#'   hostPlatform = multicoreHost,
#'   params = engineParams(model),
#'   numReplicates = 5,
#'   randomNumSeed = 1234,
#'   runInBackground = FALSE
#' )
#' }
#'
#' @export
bootstrap <- function(model,
                      hostPlatform = NULL,
                      params,
                      bootParams,
                      runInBackground = FALSE,
                      ...) {
  if (missing(model)) {
    stop("model argument is required for run.")
  } else {
    stopifnot(inherits(model, "NlmePmlModel"))
  }

  ellipsisArgs <- list(...)
  hostPlatform <-
    .load_hostPlatform(hostPlatform,
      ellipsisArgs,
      model = model,
      mode = "multicore"
    )

  if (missing(bootParams)) {
    bootParams <- BootstrapParams()
    if (length(intersect(slotNames(bootParams), names(ellipsisArgs))) == 0) {
      message(
        "\nbootParams argument is not given. ",
        "Using default parameters."
      )
    }
  } else {
    stopifnot(inherits(bootParams, "BootstrapParams"))
  }

  bootParams <- .modify_s4class(bootParams, ellipsisArgs)

  params <- .load_engineParams(model, params, ellipsisArgs)

  dataset <- model@dataset
  model@modelInfo@workingDir <-
    .prepare_wd(model@modelInfo@workingDir)
  cwd <- model@modelInfo@workingDir

  writeDefaultFiles(
    model = model,
    dataset = dataset
  )

  workFlow <- "WorkFlow"

  if (hostPlatform@hostType == "Windows" && runInBackground) {
    warning("`runInBackground = TRUE` is not available on Windows. Setting argument to `FALSE`.")
    runInBackground <- FALSE
  } else {
    stopifnot(is.logical(runInBackground))
  }

  argsFile <- GenerateControlfile(
    dataset = model@dataset,
    params = params,
    workFlow = workFlow,
    bootStratify = bootParams@stratifyColumns,
    workingDir = cwd
  )

  argsFileLines <- unlist(strsplit(argsFile, "\n"))
  extraArgsFile <- get_extraArgsFile(argsFileLines)

  filesToCopy <- argsFileLines[2]

  argsList <-
    list(
      parallel_mechanism = hostPlatform@parallelMethod@method,
      install_dir = hostPlatform@installationDirectory,
      shared_directory = hostPlatform@sharedDirectory,
      localWorkingDir = cwd,
      engine = params@method,
      num_iterations = params@numIterations,
      num_samples = bootParams@numReplicates,
      max_tries = bootParams@numRetries,
      model_file = model@dataset@modelFile,
      column_def_file = model@dataset@colDefFile,
      data_file = model@dataset@dataFile,
      start_seed = bootParams@randomNumSeed,
      extra_args_file = extraArgsFile,
      files_to_copy = filesToCopy,
      NumProc = hostPlatform@numCores,
      ConfidenceLevel = bootParams@confidenceLevel,
      gridDirectory = workFlow
    )

  bootstrapdfNames <-
    paste0(
      c(
        "BootOverall",
        "BootTheta",
        "BootOmega",
        "BootOmegaStderr",
        "BootVarCoVar",
        "BootSecondary"
      ),
      ".csv"
    )
  bootstrapdfNamesExist <-
    list.files(cwd, pattern = paste0("(", bootstrapdfNames, ")", collapse = "|"))
  file.remove(file.path(cwd, bootstrapdfNamesExist))

  job <- BootNlmeJob(
    jobType = "Bootstrap",
    localDir = cwd,
    remoteDir = cwd,
    host = hostPlatform,
    argsList = argsList,
    argsFile = names(argsFile),
    workflow = workFlow,
    runInBackground = runInBackground,
    boot = bootParams
  )

  .log_Execution(Model = model,
                 EngineParams = params,
                 RunMode = "Bootstrap",
                 Host = hostPlatform)

  status <- executeJob(job)

  if (runInBackground) {
    .report_BackgroundJob(hostPlatform@isLocal,
                          LocalWorkingDir = cwd,
                          RemoteDir = hostPlatform@sharedDirectory)
    status
  } else {
    result_list <- list()

    bootstrapdfNamesWOSecondary <-
      bootstrapdfNames[bootstrapdfNames != "BootSecondary.csv"]
    file.existsVector <-
      file.exists(file.path(cwd, bootstrapdfNamesWOSecondary))
    if (any(!file.existsVector)) {
      warning(
        "Current result files were not created:\n",
        paste0(bootstrapdfNames[!file.existsVector], collapse = ", "),
        immediate. = TRUE
      )
      if (file.exists(file.path(cwd, "NlmeRemote.LOG"))) {
        message("\nNlmeRemote.LOG can help with the problem understanding:\n")
        NlmeRemote.LOG <-
          readLines(file.path(cwd, "NlmeRemote.LOG"))
        cat(NlmeRemote.LOG, sep = "\n ")
      }
    }

    for (bootstrapdfName in bootstrapdfNames) {
      bootstrapFile <- file.path(cwd, bootstrapdfName)
      if (file.exists(bootstrapFile)) {
        bootstrapdf <- data.table::fread(bootstrapFile, fill = TRUE)
        if (bootstrapdfName == "BootOmega.csv") {
          omegaRow <- which(bootstrapdf$Label == "Omega", arr.ind = TRUE)
          CorrelationRow <-
            which(bootstrapdf$Label == "Correlation", arr.ind = TRUE)
          if (length(omegaRow) > 0 && length(CorrelationRow) > 0) {
            BootOmegaCorrelation <-
              bootstrapdf[(CorrelationRow + 1):nrow(bootstrapdf), ]
            result_list[["BootOmega"]] <-
              bootstrapdf[(omegaRow + 1):(CorrelationRow - 1), ]
            result_list[["BootOmegaCorrelation"]] <-
              bootstrapdf[(CorrelationRow + 1):nrow(bootstrapdf), ]
          }
        } else {
          result_list[[tools::file_path_sans_ext(bootstrapdfName)]] <-
            bootstrapdf
        }
      }
    }

    result_list
  }
}