#'
#' Simulation progress class.
#'
#' @param replicates total number of replicates to simulate
#' @param scenarios total number of scenarios to simulate
#' @param iterations total number of iterations to simulate
#' @param slices total number of slices to simulate
#' @param replicate current replicate number being simulated
#' @param scenario current scenario number being simulated
#' @param iteration current iteration number being simulated
#' @param slice current slice number being simulated
#' @param progressor progressr progressor
#' @param 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(expectOne(object, "replicates"),
expectOne(object, "scenarios"),
expectOne(object, "iterations"),
expectOne(object, "slices"),
expectOne(object, "replicate"),
expectOne(object, "iteration"),
expectOne(object, "scenario"),
expectOne(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
computeIncrementalProgress <- 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 %>% computeIncrementalProgress(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)
}
updateReplicate <- function(object, index) {
object@replicate <- as.integer(index)
object@scenario <- 0L
object@iteration <- 0L
object@slice <- 0L
return(object)
}
updateScenario <- function(object, index) {
object@scenario <- as.integer(index)
object@iteration <- 0L
object@slice <- 0L
return(object)
}
updateIteration <- function(object, index) {
object@iteration <- as.integer(index)
object@slice <- 0L
return(object)
}
updateSlice <- 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
)
))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.