Skip to content

Commit 316d210

Browse files
philchalmersphilchalmers
committed
add internal switch
1 parent f1b946a commit 316d210

File tree

4 files changed

+31
-17
lines changed

4 files changed

+31
-17
lines changed

‎R/analysis.R‎

Lines changed: 10 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -5,8 +5,8 @@ Analysis <- function(Functions, condition, replications, fixed_objects, cl, MPI,
55
export_funs, summarise_asis, warnings_as_errors, progress, store_results,
66
allow_na, allow_nan, use_try, stop_on_fatal, store_warning_seeds,
77
include_replication_index, packages, .options.mpi, useFuture, multirow,
8-
allow_gen_errors, max_time, max_RAM, store_Random.seeds,
9-
save_results_filename = NULL, arrayID = NULL)
8+
allow_gen_errors, max_time, max_RAM, store_Random.seeds, useGenerate,
9+
useAnalyseHandler, save_results_filename = NULL, arrayID = NULL)
1010
{
1111
# This defines the work-flow for the Monte Carlo simulation given the condition (row in Design)
1212
# and number of replications desired
@@ -23,8 +23,8 @@ Analysis <- function(Functions, condition, replications, fixed_objects, cl, MPI,
2323
store_warning_seeds=store_warning_seeds,
2424
save_results_out_rootdir=save_results_out_rootdir,
2525
store_Random.seeds=store_Random.seeds,
26-
save_seeds=save_seeds,
27-
load_seed=load_seed,
26+
save_seeds=save_seeds, useAnalyseHandler=useAnalyseHandler,
27+
load_seed=load_seed, useGenerate=useGenerate,
2828
save_seeds_dirname=save_seeds_dirname,
2929
warnings_as_errors=warnings_as_errors,
3030
include_replication_index=include_replication_index,
@@ -45,6 +45,7 @@ Analysis <- function(Functions, condition, replications, fixed_objects, cl, MPI,
4545
save_seeds=save_seeds, load_seed=load_seed,
4646
save_seeds_dirname=save_seeds_dirname,
4747
warnings_as_errors=warnings_as_errors,
48+
useGenerate=useGenerate, useAnalyseHandler=useAnalyseHandler,
4849
include_replication_index=include_replication_index,
4950
allow_na=allow_na, allow_nan=allow_nan, use_try=use_try,
5051
allow_gen_errors=allow_gen_errors), TRUE)
@@ -62,6 +63,7 @@ Analysis <- function(Functions, condition, replications, fixed_objects, cl, MPI,
6263
store_warning_seeds=store_warning_seeds,
6364
save_seeds_dirname=save_seeds_dirname,
6465
warnings_as_errors=warnings_as_errors,
66+
useGenerate=useGenerate, useAnalyseHandler=useAnalyseHandler,
6567
include_replication_index=include_replication_index,
6668
allow_na=allow_na, allow_nan=allow_nan, use_try=use_try,
6769
allow_gen_errors=allow_gen_errors), TRUE)
@@ -81,27 +83,27 @@ Analysis <- function(Functions, condition, replications, fixed_objects, cl, MPI,
8183
condition=condition, generate=Functions$generate,
8284
analyse=Functions$analyse, load_seed=load_seed,
8385
fixed_objects=fixed_objects, save=save,
84-
store_Random.seeds=store_Random.seeds,
86+
store_Random.seeds=store_Random.seeds, useGenerate=useGenerate,
8587
save_results_out_rootdir=save_results_out_rootdir,
8688
max_errors=max_errors, store_warning_seeds=store_warning_seeds,
8789
save_seeds=save_seeds, save_seeds_dirname=save_seeds_dirname,
8890
warnings_as_errors=warnings_as_errors, allow_na=allow_na,
8991
include_replication_index=include_replication_index,
9092
allow_nan=allow_nan, allow_gen_errors=allow_gen_errors,
91-
use_try=use_try, cl=cl), TRUE)
93+
useAnalyseHandler=useAnalyseHandler, use_try=use_try, cl=cl), TRUE)
9294
} else {
9395
try(parallel::parLapply(cl, 1L:replications, mainsim,
9496
condition=condition, generate=Functions$generate,
9597
analyse=Functions$analyse, load_seed=load_seed,
9698
store_Random.seeds=store_Random.seeds,
97-
fixed_objects=fixed_objects, save=save,
99+
fixed_objects=fixed_objects, save=save, useGenerate=useGenerate,
98100
save_results_out_rootdir=save_results_out_rootdir,
99101
max_errors=max_errors, store_warning_seeds=store_warning_seeds,
100102
save_seeds=save_seeds, save_seeds_dirname=save_seeds_dirname,
101103
warnings_as_errors=warnings_as_errors, allow_na=allow_na,
102104
include_replication_index=include_replication_index,
103105
allow_nan=allow_nan, allow_gen_errors=allow_gen_errors,
104-
use_try=use_try), TRUE)
106+
useAnalyseHandler=useAnalyseHandler, use_try=use_try), TRUE)
105107
}
106108
}
107109
}

‎R/functions.R‎

Lines changed: 12 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -280,7 +280,7 @@ Summarise <- function(condition, results, fixed_objects) NULL
280280
mainsim <- function(index, condition, generate, analyse, fixed_objects, max_errors, save_results_out_rootdir,
281281
save, allow_na, allow_nan, save_seeds, save_seeds_dirname, load_seed,
282282
warnings_as_errors, store_Random.seeds, store_warning_seeds, use_try, include_replication_index,
283-
p = NULL, future = FALSE, allow_gen_errors = TRUE){
283+
useGenerate, useAnalyseHandler, p = NULL, future = FALSE, allow_gen_errors = TRUE){
284284

285285
if(!is.null(p)) p(sprintf("replication = %g", index))
286286
if(include_replication_index) condition$REPLICATION <- index
@@ -307,10 +307,12 @@ mainsim <- function(index, condition, generate, analyse, fixed_objects, max_erro
307307
}
308308
if(!is.null(load_seed))
309309
.GlobalEnv$.Random.seed <- load_seed
310-
simlist <- if(allow_gen_errors)
311-
try(withCallingHandlers(generate(condition=condition,
312-
fixed_objects=fixed_objects), warning=wHandler), TRUE)
313-
else generate(condition=condition, fixed_objects=fixed_objects)
310+
simlist <- if(useGenerate){
311+
if(allow_gen_errors)
312+
try(withCallingHandlers(generate(condition=condition,
313+
fixed_objects=fixed_objects), warning=wHandler), TRUE)
314+
else generate(condition=condition, fixed_objects=fixed_objects)
315+
} else NA
314316
if(!use_try){
315317
if(is(simlist, 'try-error')){
316318
.GlobalEnv$.Random.seed <- current_Random.seed
@@ -335,8 +337,11 @@ mainsim <- function(index, condition, generate, analyse, fixed_objects, max_erro
335337
try_error_seeds <- rbind(try_error_seeds, current_Random.seed)
336338
next
337339
}
338-
res <- try(withCallingHandlers(analyse(dat=simlist, condition=condition,
339-
fixed_objects=fixed_objects), warning=wHandler), silent=TRUE)
340+
res <- if(useAnalyseHandler)
341+
try(withCallingHandlers(analyse(dat=simlist, condition=condition,
342+
fixed_objects=fixed_objects), warning=wHandler), silent=TRUE)
343+
else try(analyse(dat=simlist, condition=condition,
344+
fixed_objects=fixed_objects), silent=TRUE)
340345
if(!valid_results(res))
341346
stop("Invalid object returned from Analyse()", call.=FALSE)
342347
if(!use_try){

‎R/runSimulation.R‎

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1007,6 +1007,8 @@ runSimulation <- function(design, replications, generate, analyse, summarise,
10071007
all(names(save_details) %in% valid_save_details.list()))
10081008
}
10091009
if(is.null(control$global_fun_level)) control$global_fun_level <- 2
1010+
if(is.null(control$useAnalyseHandler)) control$useAnalyseHandler <- TRUE
1011+
useAnalyseHandler <- control$useAnalyseHandler
10101012
if(replications < 3L){
10111013
if(verbose)
10121014
message('save, stop_on_fatal, and print_RAM flags disabled for testing purposes')
@@ -1035,8 +1037,11 @@ runSimulation <- function(design, replications, generate, analyse, summarise,
10351037
seed <- seed[as.integer(tmp[2L])]
10361038
}
10371039
}
1038-
if(missing(generate) && !missing(analyse))
1040+
useGenerate <- TRUE
1041+
if(missing(generate) && !missing(analyse)){
10391042
generate <- function(condition, dat, fixed_objects){}
1043+
useGenerate <- FALSE
1044+
}
10401045
if(is.list(generate)){
10411046
if(debug %in% c('all', 'generate'))
10421047
stop('debug input not supported when generate is a list', call.=FALSE)
@@ -1447,6 +1452,7 @@ runSimulation <- function(design, replications, generate, analyse, summarise,
14471452
save_results_filename=save_results_filename,
14481453
arrayID=save_details$arrayID,
14491454
multirow=nrow(design) > 1L,
1455+
useGenerate=useGenerate, useAnalyseHandler=useAnalyseHandler,
14501456
save_seeds=save_seeds, summarise_asis=summarise_asis,
14511457
save_seeds_dirname=save_seeds_dirname,
14521458
max_errors=max_errors, packages=packages,
@@ -1487,6 +1493,7 @@ runSimulation <- function(design, replications, generate, analyse, summarise,
14871493
save_seeds_dirname=save_seeds_dirname,
14881494
arrayID=save_details$arrayID,
14891495
multirow=nrow(design) > 1L,
1496+
useGenerate=useGenerate, useAnalyseHandler=useAnalyseHandler,
14901497
max_errors=max_errors, packages=packages,
14911498
include_replication_index=include_replication_index,
14921499
load_seed=load_seed, export_funs=export_funs,

‎R/util.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -959,7 +959,7 @@ valid_control.list <- function()
959959
"store_warning_seeds", "include_replication_index", "include_reps", "try_all_analyse",
960960
"allow_na", "allow_nan", "type", "print_RAM", "max_time", "max_RAM",
961961
"tol", "summarise.reg_data", "rel.tol", "k.success", "interpolate.R", "bolster",
962-
"include_reps", 'global_fun_level')
962+
"include_reps", 'global_fun_level', 'useAnalyseHander')
963963

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

0 commit comments

Comments
 (0)