#' Make a multirun simulation using a set of variable input parameters.
#'
#' Wrapper function for \code{\link{run_LWFB90}} to make multiple simulations
#' parallel, with varying input parameters.
#'
#' @param paramvar Data.frame of variable input parameters. For each row, a
#' simulation is performed, with the elements in \code{param_b90} being
#' replaced by the respective column of \code{paramvar}. All parameter names
#' (column names) in \code{paramvar} must be found in \code{param_b90}. See
#' section \code{Parameter updating}.
#' @param param_b90 Named list of parameters, in which the parameters defined in
#' \code{paramvar} will be replaced.
#' @param paramvar_nms Names of the parameters in \code{paramvar} to be replaced
#' in \code{param_b90}.
#' @param cores Number of CPUs to use for parallel processing. Default is 2.
#' @param show_progress Logical: Show progress bar? Default is TRUE. See also
#' section \code{Progress bar} below.
#' @param ... Additional arguments passed to \code{\link{run_LWFB90}}: provide
#' at least the arguments that have no defaults such as \code{options_b90} and
#' \code{climate}).
#'
#' @return A named list with the results of the single runs as returned by
#' \code{\link{run_LWFB90}}. Simulation or processing errors are passed on.
#'
#' @section Parameter updating:
#' The transfer of values from a row in \code{paramvar} to \code{param_b90}
#' before each single run simulation is done by matching names from
#' \code{paramvar} and \code{param_b90}. In order to address data.frame or
#' vector elements in \code{param_b90} by a column name in \code{paramvar}, the
#' respective column name has to be set up from its name and index in
#' \code{param_b90}. To replace, e.g., the 2nd value of \code{ths} in the
#' \code{soil_materials} data.frame, the respective column name in
#' \code{paramvar} has to be called 'soil_materials.ths2'. In order to replace
#' the 3rd value of \code{maxlai} vector in \code{param_b90}, the column has to
#' be named 'maxlai3'.
#'
#' @section Data management:
#' The returned list of single run results can become very large, if many
#' simulations are performed and the selected output contains daily resolution
#' data sets, especially daily layer-wise soil moisture data. To not overload
#' memory, it is advised to reduce the returned simulation results to a minimum,
#' by carefully selecting the output, and make use of the option to pass a list
#' of functions to \code{\link{run_LWFB90}} via argument \code{output_fun}.
#' These functions perform directly on the output of a single run simulation,
#' and can be used for aggregating model output on-the-fly, or for writing
#' results to a file or database. The regular output of
#' \code{\link{run_LWFB90}} can be suppressed by setting \code{rtrn.output =
#' FALSE}, for exclusively returning the output of such functions.
#'
#' @section Progress bar:
#' This function provides a progress bar via the package \CRANpkg{progressr} if
#' \code{show_progress=TRUE}. The parallel computation is then wrapped with
#' \code{progressr::with_progress()} to enable progress reporting from
#' distributed calculations. The appearance of the progress bar (including
#' audible notification) can be customized by the user for the entire session
#' using \code{progressr::handlers()} (see \code{vignette('progressr-intro')}).
#'
#' @export
#'
#' @example inst/examples/run_multi_LWFB90-help.R
#'
run_multi_LWFB90 <- function(paramvar,
param_b90,
paramvar_nms = names(paramvar),
cores = 2,
show_progress = TRUE,
...){
if(cores > parallelly::availableCores()) {
warning(paste("Can not run on", cores, "cores. Will use only", parallelly::availableCores(),
"available core(s)." ))
cores <- parallelly::availableCores()
}
# to pass CRAN check Notes
`%dopar%` <- foreach::`%dopar%`
i <- NULL
nRuns <- nrow(paramvar)
# determine list and vector elements in param_b90
is_ll <- lapply(param_b90, function(x) is.list(x) | length(x) > 1 )
# which of paramvar's columns belong to the list-parameters?
param_ll <- sapply(names(param_b90[names(is_ll)[which(is_ll == TRUE)]]),
simplify = FALSE,
FUN = function(x) {
which(grepl(x,paramvar_nms, fixed = TRUE) &
grepl("[[:digit:].]",paramvar_nms))
})
# determine number of nonzero list entries
param_ll_len <- length(param_ll[sapply(param_ll, function(x) length(x) > 0)])
# check if all the names of paramvar can be found in param_b90
if (param_ll_len > 0L) { #length > 1 included in paramvar
# remove zeros
param_ll <- param_ll[sapply(param_ll, function(x) length(x) > 0)]
singlepar_nms <- paramvar_nms[-unlist(param_ll)]
nms <- c(names(param_ll), paramvar_nms[-unlist(param_ll)])
} else {
singlepar_nms <- paramvar_nms
nms <- paramvar_nms
}
if (!all(nms %in% names(param_b90))) {
stop( paste( "Not all names of 'paramvar' were found in 'param_b90'! Check names:",
paste(nms[which(!nms %in% names(param_b90))], collapse =", ") ))
}
# set up Cluster and foreach-Loop --------------------------------------------
# plan multisession does makeClusterPSOCK() in the background
# cluster is stopped automagically on exit
# a future plan that might have existed before will be restored on exit
oplan <- future::plan(future::multisession, workers=cores)
on.exit(future::plan(oplan), add=TRUE)
doFuture::registerDoFuture()
foreach_loop <- function(){
foreach::foreach(
i = 1:nRuns,
.final = function(x) stats::setNames(x, paste0("RunNo.", 1:nRuns)),
.errorhandling = "pass",
.export = "param_b90") %dopar% {
# replace single value parameters
param_b90[match(singlepar_nms, names(param_b90))] <- paramvar[i, match(singlepar_nms, paramvar_nms, nomatch = 0)]
# replace parameters in data.frames and vector elements
if (param_ll_len > 0) {
for (l in 1:length(param_ll)){
list_ind <- which(names(param_b90) == names(param_ll)[l])
param_b90[[list_ind]] <- replace_vecelements(param_b90[[list_ind]],
varnms = paramvar_nms[param_ll[[l]]],
vals = unlist(paramvar[i, unlist(param_ll[[l]])]))
}
}
# Run LWFBrook90
res <- run_LWFB90(param_b90 = param_b90, ...)
increment_progressbar()
return(res)
}
}
# with progressbar if wanted
if(isTRUE(show_progress)){
progressr::with_progress({
increment_progressbar <- progressr::progressor(steps=nRuns)
results <- foreach_loop()
})
} else {
increment_progressbar <- function(){}
results <- foreach_loop()
}
return(results)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.