R/simulation_progress.R

In campsis: Generic PK/PD Simulation Platform Campsis

#'
#' Simulation progress class.
#'
#' @slot replicates total number of replicates to simulate
#' @slot scenarios total number of scenarios to simulate
#' @slot iterations total number of iterations to simulate
#' @slot slices total number of slices to simulate
#' @slot replicate current replicate number being simulated
#' @slot scenario current scenario number being simulated
#' @slot iteration current iteration number being simulated
#' @slot slice current slice number being simulated
#' @slot progressor progressr progressor
#' @slot hardware hardware settings
#' @export
setClass(
  "simulation_progress",
  representation(
    replicates = "integer", # Known upfront
    scenarios = "integer", # Known upfront
    iterations = "integer", # May vary based on the dataset (see getEventIterations())
    slices = "integer", # May vary based on number of subjects in dataset (which can change in scenarios)
    replicate = "integer",
    scenario = "integer",
    iteration = "integer",
    slice = "integer",
    progressor = "ANY",
    hardware = "hardware_settings"
  ),
  validity = function(object) {
    return(c(
      expect_one(object, "replicates"),
      expect_one(object, "scenarios"),
      expect_one(object, "iterations"),
      expect_one(object, "slices"),
      expect_one(object, "replicate"),
      expect_one(object, "iteration"),
      expect_one(object, "scenario"),
      expect_one(object, "slice")
    ))
  },
  prototype = prototype(slices = 0L, replicate = 0L, scenario = 0L, iteration = 0L, slice = 0L)
)

#'
#' Create a simulation progress object.
#'
#' @param replicates total number of replicates to simulate
#' @param scenarios total number of scenarios to simulate
#' @param progressor progressr progressor
#' @param hardware hardware settings
#' @return a progress bar
#' @importFrom progressr progressor
#' @export
SimulationProgress <- function(replicates = 1, scenarios = 1, progressor = NULL, hardware = NULL) {
  if (is.null(hardware)) {
    hardware <- Hardware()
  }
  return(new(
    "simulation_progress",
    replicates = as.integer(replicates),
    scenarios = as.integer(scenarios),
    iterations = 1L,
    progressor = progressor,
    hardware = hardware
  ))
}

#' Compute incremental progress.
#'
#' @param object simulation progress object
#' @param tick_slice tick progress on slices
#' @return incremental progress, in percentage
#' @keywords internal
compute_incremental_progress <- function(object, tick_slice) {
  if (tick_slice) {
    incrementalWorkPercentage <- 1 / (object@replicates * object@scenarios * object@iterations * object@slices)
  } else {
    incrementalWorkPercentage <- 1 / (object@replicates * object@scenarios * object@iterations)
  }
  return(incrementalWorkPercentage * 100)
}

tick <- function(object, tick_slice) {
  increment <- object %>% compute_incremental_progress(tick_slice = tick_slice)
  if (object@replicates > 1) {
    customMessage <- paste0("Simulating replicate ", object@replicate, "/", object@replicates)
  } else if (object@scenarios > 1) {
    customMessage <- paste0("Simulating scenario ", object@scenario, "/", object@scenarios)
  } else if (object@iterations > 1) {
    customMessage <- paste0("Simulating iteration ", object@iteration, "/", object@iterations)
  } else {
    customMessage <- paste0("Simulating slice ", object@slice, "/", object@slices)
  }
  if (object@hardware@cpu > 1) {
    cpus <- paste0("cpu=", object@hardware@cpu)
    if (object@hardware@replicate_parallel) {
      customMessage <- paste0("Simulating replicates in parallel (", cpus, ")")
    } else if (object@hardware@scenario_parallel) {
      customMessage <- paste0("Simulating scenarios in parallel (", cpus, ")")
    } else {
      customMessage <- paste0("Running simulation in parallel (", cpus, ")")
    }
  }
  object@progressor(message = customMessage, amount = increment)
  return(object)
}

update_replicate <- function(object, index) {
  object@replicate <- as.integer(index)
  object@scenario <- 0L
  object@iteration <- 0L
  object@slice <- 0L
  return(object)
}

update_scenario <- function(object, index) {
  object@scenario <- as.integer(index)
  object@iteration <- 0L
  object@slice <- 0L
  return(object)
}

update_iteration <- function(object, index) {
  object@iteration <- as.integer(index)
  object@slice <- 0L
  return(object)
}

update_slice <- function(object, index) {
  object@slice <- as.integer(index)
  return(object)
}

#' Suggested Campsis handler for showing the progress bar.
#'
#' @return a progressr handler list
#' @export
campsis_handler <- function() {
  return(list(
    progressr::handler_progress(
      format = " :message [:bar] :percent eta: :eta",
      width = 100
    )
  ))
}