Add prepare function for condition-level object preparation

DESCRIPTION

@@ -5,7 +5,7 @@ Authors@R: c(person("Phil", "Chalmers", email = "rphilip.chalmers@gmail.com", ro
                     comment = c(ORCID="0000-0001-5332-2810")),
              person("Matthew", "Sigal", role = c("ctb")),
              person("Ogreden", family="Oguzhan", role = c("ctb")),
-             person("Mikko ", family="Ronkko", role = c("ctb")),
+             person("Mikko", family="Rönkkö", role = c("aut")),
              person("Moritz", family="Ketzer", role = c("ctb")))
 Description: Provides tools to safely and efficiently organize and execute 
     Monte Carlo simulation experiments in R.

NEWS.md

@@ -1,5 +1,23 @@
 # NEWS file for SimDesign
 
+## Changes in SimDesign 2.22
+
+- `runSimulation()` gains a `prepare` function argument for loading or preparing
+  condition-specific objects before replications are executed. This function executes
+  once per simulation condition and is particularly useful for loading pre-computed
+  expensive objects (e.g., correlation matrices, design matrices) from disk in cluster
+  workflows. 
+
+- Added `load_seed_prepare` parameter to `runSimulation()` for debugging the `prepare()`
+  function by reproducing exact RNG states. Works similarly to `load_seed` but specifically
+  for the prepare step. Prepare seeds can be extracted using
+  `SimExtract(res, 'prepare_seeds')` when `store_Random.seeds=TRUE`, and error seeds
+  can be extracted with `SimExtract(res, 'prepare_error_seed')`.
+
+- Progress reporting in non-interactive mode (e.g., SLURM clusters) has been improved.
+  Progress bars now display correctly when running batch jobs on cluster systems,
+  providing better visibility into long-running simulations.
+
 ## Changes in SimDesign 2.21
 
 - `createDesign()` gains a `fully.crossed = TRUE` argument. When disabled (`FALSE`) will create a 

R/SimExtract.R

@@ -17,6 +17,10 @@
 #'   \code{runSimulation(..., control = list(store_Random.seeds=TRUE))}),
 #'   \code{'error_seeds'} and \code{'warning_seeds'}
 #'   to extract the associated \code{.Random.seed} values associated with the ERROR/WARNING messages,
+#'   \code{'prepare_seeds'} to extract the \code{.Random.seed} states captured before
+#'   \code{prepare()} was called for each condition, \code{'prepare_error_seed'} to extract the
+#'   \code{.Random.seed} state when \code{prepare()} encountered an error (useful for debugging with
+#'   \code{load_seed_prepare}),
 #'   \code{'results'} to extract the simulation results if the option \code{store_results} was passed to
 #'   \code{\link{runSimulation}}, \code{'filename'} and \code{'save_results_dirname'} for extracting
 #'   the saved file/directory name information (if used), \code{'functions'} to extract the defined functions
@@ -113,6 +117,10 @@ SimExtract <- function(object, what, fuzzy = TRUE, append = TRUE){
         if(length(wrn) && append) cbind(Design, wrn) else wrn
     } else if(what == 'warning_seeds'){
         extract_warning_seeds(object)
+    } else if(what == 'prepare_seeds'){
+        extract_prepare_seeds(object)
+    } else if(what == 'prepare_error_seed'){
+        extract_prepare_error_seed(object)
     } else if(what == 'save_results_dirname'){
         attr(object, 'extra_info')$save_info['save_results_dirname']
     } else if(what == 'filename'){
@@ -188,6 +196,18 @@ extract_functions <- function(object){
     ret
 }
 
+extract_prepare_seeds <- function(object){
+    extra_info <- attr(object, 'extra_info')
+    ret <- extra_info$prepare_seeds
+    ret
+}
+
+extract_prepare_error_seed <- function(object){
+    extra_info <- attr(object, 'extra_info')
+    ret <- extra_info$prepare_error_seeds
+    ret
+}
+
 fuzzy_reduce <- function(df){
     if(!length(df)) return(df)
     nms <- colnames(df)

R/analysis.R

@@ -1,4 +1,5 @@
-Analysis <- function(Functions, condition, replications, fixed_objects, cl, MPI, seed, save,
+Analysis <- function(Functions, condition, replications, fixed_objects, prepare = NULL,
+                     load_seed_prepare = NULL, cl, MPI, seed, save,
                      save_results, save_results_out_rootdir, save_results_dirname, max_errors,
                      boot_method, boot_draws, CI,
                      save_seeds, save_seeds_dirname, load_seed,
@@ -10,6 +11,43 @@ Analysis <- function(Functions, condition, replications, fixed_objects, cl, MPI,
 {
     # This defines the work-flow for the Monte Carlo simulation given the condition (row in Design)
     #  and number of replications desired
+
+    # Call prepare function once per condition if provided
+    prepare_error_seed <- NULL
+    prepare_Random.seed <- NULL
+    if(!is.null(prepare)) {
+        # Restore seed if debugging prepare
+        if(!is.null(load_seed_prepare))
+            .GlobalEnv$.Random.seed <- load_seed_prepare
+
+        # Capture seed state before prepare (similar to mainsim line 296)
+        prepare_Random.seed <- .GlobalEnv$.Random.seed
+
+        # Save seed to disk if requested
+        if(save_seeds){
+            filename <- paste0(save_seeds_dirname, '/design-row-', condition$ID, '/prepare-seed')
+            dir.create(dirname(file.path(save_results_out_rootdir, filename)),
+                       showWarnings = FALSE, recursive = TRUE)
+            write(prepare_Random.seed, file.path(save_results_out_rootdir, filename), sep = ' ')
+        }
+
+        prep_result <- try(prepare(condition=condition, fixed_objects=fixed_objects), silent=FALSE)
+
+        if(is(prep_result, 'try-error')){
+            # Capture seed on error (similar to mainsim)
+            prepare_error_seed <- prepare_Random.seed
+            stop(sprintf('prepare() failed for condition %i with error: %s',
+                         condition$ID, as.character(prep_result)), call.=FALSE)
+        }
+        fixed_objects <- prep_result
+    }
+
+    # Configure pbapply for non-interactive mode (e.g., SLURM cluster logs)
+    if(progress && !interactive()) {
+        old_pboptions <- pbapply::pboptions(type = "txt", char = "=", style = 3)
+        on.exit(pbapply::pboptions(old_pboptions), add = TRUE)
+    }
+
     used_mainsim <- if(is.finite(max_time)) mainsim_maxtime else mainsim
     if(useFuture){
         if(!is.null(seed)) set_seed(seed[condition$ID])
@@ -205,9 +243,17 @@ Analysis <- function(Functions, condition, replications, fixed_objects, cl, MPI,
     attr(ret, 'error_seeds') <- try_error_seeds
     attr(ret, 'warning_seeds') <- warning_message_seeds
     attr(ret, 'summarise_list') <- summarise_list
+    if(!is.null(prepare_error_seed))
+        attr(ret, 'prepare_error_seed') <- prepare_error_seed
+
     if(store_results)
         attr(ret, 'full_results') <- tabled_results
-    if(store_Random.seeds)
+    if(store_Random.seeds){
         attr(ret, 'stored_Random.seeds') <- stored_Random.seeds
+        # Store prepare seed information
+        if(!is.null(prepare)) {
+            attr(ret, 'prepare_Random.seed') <- prepare_Random.seed
+        }
+    }
     ret
 }