Skip to content

Commit

Permalink
add internal switch
Browse files Browse the repository at this point in the history
  • Loading branch information
@philchalmers
philchalmers committed Feb 13, 2025
1 parent f1b946a commit 316d210
Show file tree
Hide file tree
Showing 4 changed files with 31 additions and 17 deletions.
18 changes: 10 additions & 8 deletions R/analysis.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5,8 +5,8 @@ Analysis <- function(Functions, condition, replications, fixed_objects, cl, MPI,
export_funs, summarise_asis, warnings_as_errors, progress, store_results,
allow_na, allow_nan, use_try, stop_on_fatal, store_warning_seeds,
include_replication_index, packages, .options.mpi, useFuture, multirow,
allow_gen_errors, max_time, max_RAM, store_Random.seeds,
save_results_filename = NULL, arrayID = NULL)
allow_gen_errors, max_time, max_RAM, store_Random.seeds, useGenerate,
useAnalyseHandler, save_results_filename = NULL, arrayID = NULL)
{
# This defines the work-flow for the Monte Carlo simulation given the condition (row in Design)
# and number of replications desired
Expand All @@ -23,8 +23,8 @@ Analysis <- function(Functions, condition, replications, fixed_objects, cl, MPI,
store_warning_seeds=store_warning_seeds,
save_results_out_rootdir=save_results_out_rootdir,
store_Random.seeds=store_Random.seeds,
save_seeds=save_seeds,
load_seed=load_seed,
save_seeds=save_seeds, useAnalyseHandler=useAnalyseHandler,
load_seed=load_seed, useGenerate=useGenerate,
save_seeds_dirname=save_seeds_dirname,
warnings_as_errors=warnings_as_errors,
include_replication_index=include_replication_index,
Expand All @@ -45,6 +45,7 @@ Analysis <- function(Functions, condition, replications, fixed_objects, cl, MPI,
save_seeds=save_seeds, load_seed=load_seed,
save_seeds_dirname=save_seeds_dirname,
warnings_as_errors=warnings_as_errors,
useGenerate=useGenerate, useAnalyseHandler=useAnalyseHandler,
include_replication_index=include_replication_index,
allow_na=allow_na, allow_nan=allow_nan, use_try=use_try,
allow_gen_errors=allow_gen_errors), TRUE)
Expand All @@ -62,6 +63,7 @@ Analysis <- function(Functions, condition, replications, fixed_objects, cl, MPI,
store_warning_seeds=store_warning_seeds,
save_seeds_dirname=save_seeds_dirname,
warnings_as_errors=warnings_as_errors,
useGenerate=useGenerate, useAnalyseHandler=useAnalyseHandler,
include_replication_index=include_replication_index,
allow_na=allow_na, allow_nan=allow_nan, use_try=use_try,
allow_gen_errors=allow_gen_errors), TRUE)
Expand All @@ -81,27 +83,27 @@ Analysis <- function(Functions, condition, replications, fixed_objects, cl, MPI,
condition=condition, generate=Functions$generate,
analyse=Functions$analyse, load_seed=load_seed,
fixed_objects=fixed_objects, save=save,
store_Random.seeds=store_Random.seeds,
store_Random.seeds=store_Random.seeds, useGenerate=useGenerate,
save_results_out_rootdir=save_results_out_rootdir,
max_errors=max_errors, store_warning_seeds=store_warning_seeds,
save_seeds=save_seeds, save_seeds_dirname=save_seeds_dirname,
warnings_as_errors=warnings_as_errors, allow_na=allow_na,
include_replication_index=include_replication_index,
allow_nan=allow_nan, allow_gen_errors=allow_gen_errors,
use_try=use_try, cl=cl), TRUE)
useAnalyseHandler=useAnalyseHandler, use_try=use_try, cl=cl), TRUE)
} else {
try(parallel::parLapply(cl, 1L:replications, mainsim,
condition=condition, generate=Functions$generate,
analyse=Functions$analyse, load_seed=load_seed,
store_Random.seeds=store_Random.seeds,
fixed_objects=fixed_objects, save=save,
fixed_objects=fixed_objects, save=save, useGenerate=useGenerate,
save_results_out_rootdir=save_results_out_rootdir,
max_errors=max_errors, store_warning_seeds=store_warning_seeds,
save_seeds=save_seeds, save_seeds_dirname=save_seeds_dirname,
warnings_as_errors=warnings_as_errors, allow_na=allow_na,
include_replication_index=include_replication_index,
allow_nan=allow_nan, allow_gen_errors=allow_gen_errors,
use_try=use_try), TRUE)
useAnalyseHandler=useAnalyseHandler, use_try=use_try), TRUE)
}
}
}
Expand Down
19 changes: 12 additions & 7 deletions R/functions.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -280,7 +280,7 @@ Summarise <- function(condition, results, fixed_objects) NULL
mainsim <- function(index, condition, generate, analyse, fixed_objects, max_errors, save_results_out_rootdir,
save, allow_na, allow_nan, save_seeds, save_seeds_dirname, load_seed,
warnings_as_errors, store_Random.seeds, store_warning_seeds, use_try, include_replication_index,
p = NULL, future = FALSE, allow_gen_errors = TRUE){
useGenerate, useAnalyseHandler, p = NULL, future = FALSE, allow_gen_errors = TRUE){

if(!is.null(p)) p(sprintf("replication = %g", index))
if(include_replication_index) condition$REPLICATION <- index
Expand All @@ -307,10 +307,12 @@ mainsim <- function(index, condition, generate, analyse, fixed_objects, max_erro
}
if(!is.null(load_seed))
.GlobalEnv$.Random.seed <- load_seed
simlist <- if(allow_gen_errors)
try(withCallingHandlers(generate(condition=condition,
fixed_objects=fixed_objects), warning=wHandler), TRUE)
else generate(condition=condition, fixed_objects=fixed_objects)
simlist <- if(useGenerate){
if(allow_gen_errors)
try(withCallingHandlers(generate(condition=condition,
fixed_objects=fixed_objects), warning=wHandler), TRUE)
else generate(condition=condition, fixed_objects=fixed_objects)
} else NA
if(!use_try){
if(is(simlist, 'try-error')){
.GlobalEnv$.Random.seed <- current_Random.seed
Expand All @@ -335,8 +337,11 @@ mainsim <- function(index, condition, generate, analyse, fixed_objects, max_erro
try_error_seeds <- rbind(try_error_seeds, current_Random.seed)
next
}
res <- try(withCallingHandlers(analyse(dat=simlist, condition=condition,
fixed_objects=fixed_objects), warning=wHandler), silent=TRUE)
res <- if(useAnalyseHandler)
try(withCallingHandlers(analyse(dat=simlist, condition=condition,
fixed_objects=fixed_objects), warning=wHandler), silent=TRUE)
else try(analyse(dat=simlist, condition=condition,
fixed_objects=fixed_objects), silent=TRUE)
if(!valid_results(res))
stop("Invalid object returned from Analyse()", call.=FALSE)
if(!use_try){
Expand Down
9 changes: 8 additions & 1 deletion R/runSimulation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1007,6 +1007,8 @@ runSimulation <- function(design, replications, generate, analyse, summarise,
all(names(save_details) %in% valid_save_details.list()))
}
if(is.null(control$global_fun_level)) control$global_fun_level <- 2
if(is.null(control$useAnalyseHandler)) control$useAnalyseHandler <- TRUE
useAnalyseHandler <- control$useAnalyseHandler
if(replications < 3L){
if(verbose)
message('save, stop_on_fatal, and print_RAM flags disabled for testing purposes')
Expand Down Expand Up @@ -1035,8 +1037,11 @@ runSimulation <- function(design, replications, generate, analyse, summarise,
seed <- seed[as.integer(tmp[2L])]
}
}
if(missing(generate) && !missing(analyse))
useGenerate <- TRUE
if(missing(generate) && !missing(analyse)){
generate <- function(condition, dat, fixed_objects){}
useGenerate <- FALSE
}
if(is.list(generate)){
if(debug %in% c('all', 'generate'))
stop('debug input not supported when generate is a list', call.=FALSE)
Expand Down Expand Up @@ -1447,6 +1452,7 @@ runSimulation <- function(design, replications, generate, analyse, summarise,
save_results_filename=save_results_filename,
arrayID=save_details$arrayID,
multirow=nrow(design) > 1L,
useGenerate=useGenerate, useAnalyseHandler=useAnalyseHandler,
save_seeds=save_seeds, summarise_asis=summarise_asis,
save_seeds_dirname=save_seeds_dirname,
max_errors=max_errors, packages=packages,
Expand Down Expand Up @@ -1487,6 +1493,7 @@ runSimulation <- function(design, replications, generate, analyse, summarise,
save_seeds_dirname=save_seeds_dirname,
arrayID=save_details$arrayID,
multirow=nrow(design) > 1L,
useGenerate=useGenerate, useAnalyseHandler=useAnalyseHandler,
max_errors=max_errors, packages=packages,
include_replication_index=include_replication_index,
load_seed=load_seed, export_funs=export_funs,
Expand Down
2 changes: 1 addition & 1 deletion R/util.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -959,7 +959,7 @@ valid_control.list <- function()
"store_warning_seeds", "include_replication_index", "include_reps", "try_all_analyse",
"allow_na", "allow_nan", "type", "print_RAM", "max_time", "max_RAM",
"tol", "summarise.reg_data", "rel.tol", "k.success", "interpolate.R", "bolster",
"include_reps", 'global_fun_level')
"include_reps", 'global_fun_level', 'useAnalyseHander')

valid_save_details.list <- function()
c("safe", "compname", "out_rootdir", "save_results_dirname", "save_results_filename",
Expand Down

0 comments on commit 316d210

Please sign in to comment.