|
| 1 | +#' Run simulation for multiple replications, sequentially or in parallel. |
| 2 | +#' |
| 3 | +#' @param param Named list of model parameters. |
| 4 | +#' @param use_future_seeding Logical. If TRUE, the function will use the |
| 5 | +#' seeding mechanism provided by `future.seed = seed`, which is generally |
| 6 | +#' recommended and ensures reproducibility across parallel executions. However, |
| 7 | +#' this will not align exactly with the seeding approach used in `model()`. If |
| 8 | +#' FALSE, the function will override future's default seeding and instead |
| 9 | +#' generate a list of run numbers to use as seeds,similar to `model()`. Be |
| 10 | +#' aware that this approach is not recommended according to `future_lapply` |
| 11 | +#' documentation, which states: "Note that as.list(seq_along(x)) is not a valid |
| 12 | +#' set of such .Random.seed values." |
| 13 | +#' |
| 14 | +#' @importFrom future plan multisession sequential |
| 15 | +#' @importFrom future.apply future_lapply |
| 16 | +#' @importFrom dplyr bind_rows |
| 17 | +#' |
| 18 | +#' @return Named list with three tables: monitored arrivals, monitored |
| 19 | +#' resources, and the processed results from each run. |
| 20 | +#' @export |
| 21 | + |
| 22 | +runner <- function(param, use_future_seeding = TRUE) { |
| 23 | + # Determine the parallel execution plan |
| 24 | + if (param[["cores"]] == 1L) { |
| 25 | + plan(sequential) # Sequential execution |
| 26 | + } else { |
| 27 | + if (param[["cores"]] == -1L) { |
| 28 | + cores <- future::availableCores() - 1L |
| 29 | + } else { |
| 30 | + cores <- param[["cores"]] |
| 31 | + } |
| 32 | + plan(multisession, workers = cores) # Parallel execution |
| 33 | + } |
| 34 | + |
| 35 | + # Set seed for future.seed |
| 36 | + if (isTRUE(use_future_seeding)) { |
| 37 | + # Recommended option - base seed used when generating others by future.seed |
| 38 | + custom_seed <- 123456L |
| 39 | + } else { |
| 40 | + # Not recommended (but will allow match to model()) |
| 41 | + # Generates list of pre-generated seeds set to the run numbers |
| 42 | + create_seeds <- function(seed) { |
| 43 | + set.seed(seed) |
| 44 | + .Random.seed |
| 45 | + } |
| 46 | + custom_seed <- lapply(1L:param[["number_of_runs"]], create_seeds) |
| 47 | + } |
| 48 | + |
| 49 | + # Run simulations (sequentially or in parallel) |
| 50 | + # Mark set_seed as FALSE as we handle this using future.seed(), rather than |
| 51 | + # within the function, and we don't want to override future.seed |
| 52 | + results <- future_lapply( |
| 53 | + 1L:param[["number_of_runs"]], |
| 54 | + function(i) { |
| 55 | + simulation::model(run_number = i, |
| 56 | + param = param, |
| 57 | + set_seed = FALSE) |
| 58 | + }, |
| 59 | + future.seed = custom_seed |
| 60 | + ) |
| 61 | + |
| 62 | + # Combine the results from multiple replications into just two dataframes |
| 63 | + if (param[["number_of_runs"]] == 1L) { |
| 64 | + results <- results[[1L]] |
| 65 | + } else { |
| 66 | + all_arrivals <- do.call( |
| 67 | + rbind, lapply(results, function(x) x[["arrivals"]]) |
| 68 | + ) |
| 69 | + all_occupancy <- do.call( |
| 70 | + rbind, lapply(results, function(x) x[["occupancy"]]) |
| 71 | + ) |
| 72 | + results <- list(arrivals = all_arrivals, |
| 73 | + occupancy = all_occupancy) |
| 74 | + } |
| 75 | + |
| 76 | + results[["occupancy_stats"]] <- get_occupancy_stats(results[["occupancy"]]) |
| 77 | + |
| 78 | + results |
| 79 | +} |
0 commit comments