diff --git a/R/R6Experiment.R b/R/R6Experiment.R index 7c94e7c..304fe83 100644 --- a/R/R6Experiment.R +++ b/R/R6Experiment.R @@ -133,9 +133,10 @@ R6Experiment <- R6::R6Class( #' @param checkpoint_frequency Frequency of checkpoints during the experiment. If NULL, defaults to 10 percent of the experimental design. #' @param checkpoint_dir Directory to save checkpoints. Default is NULL. #' @param backend Backend to use for parallelization. Options are future.apply (default) or foreach. + #' @param graceful Logical indicating whether to handle errors gracefully. If TRUE, errors are caught and logged as warnings, and the experiment continues. Default is FALSE. #' @param ... Additional parameters passed to model simulation. #' @return A data.frame containing the results of the experiment. - run = function(checkpoint_frequency = NULL, checkpoint_dir = NULL, backend = "future.apply", ...) { + run = function(checkpoint_frequency = NULL, checkpoint_dir = NULL, backend = "future.apply", graceful = TRUE, ...) { if (missing(checkpoint_dir)) { checkpoint_dir <- file.path("experiments") } @@ -168,7 +169,7 @@ R6Experiment <- R6::R6Class( for (checkpoint_iteration in seq_len(checkpoint_iterations)) { self$run_checkpoint_iteration( - checkpoint_iteration, checkpoint_frequency, remaining_steps, overall_progress, checkpoint_file, completed_steps, backend, ... + checkpoint_iteration, checkpoint_frequency, remaining_steps, overall_progress, checkpoint_file, completed_steps, backend, graceful, ... ) } }) @@ -180,8 +181,9 @@ R6Experiment <- R6::R6Class( #' Run a single experiment #' #' @param policy_design_id ID of the policy design to run + #' @param graceful Logical indicating whether to handle errors gracefully. If TRUE, errors are caught and logged as warnings. Default is FALSE. #' @param ... additional parameters passed to model simulation - run_single_experiment = function(policy_design_id, ...) { + run_single_experiment = function(policy_design_id, graceful, ...) { model <- self$models[[self$policy_design$model.id[policy_design_id]]] id_cols <- c("grid.id", "lhs.id", "params_design.id", "param.id", "model.id", "all.params.id", "policy.exp.id", "rep.id", "seed") @@ -200,7 +202,17 @@ R6Experiment <- R6::R6Class( set.seed(self$policy_design[policy_design_id, ]$seed) } - res <- model$simulate(...) %>% as.data.frame() + # Graceful error handling implementation + if (graceful) { + res <- tryCatch({ + model$simulate(...) %>% as.data.frame() + }, error = function(e) { + warning("Error in experiment ", policy_design_id, ": ", e$message, call. = FALSE) + data.frame(error = e$message) + }) + } else { + res <- model$simulate(...) %>% as.data.frame() + } return(dplyr::bind_cols(self$policy_design[policy_design_id, ], res)) }, @@ -227,21 +239,22 @@ R6Experiment <- R6::R6Class( #' @param checkpoint_file Path to the file where the checkpoint will be saved. #' @param completed_steps Number of steps already completed in the experiment. #' @param backend Backend to use for parallelization. Options are "future.apply" (default) or "foreach". + #' @param graceful Logical indicating whether to handle errors gracefully. If TRUE, errors are caught and logged as warnings. Default is FALSE. #' @param ... Additional parameters passed to model simulation. - run_checkpoint_iteration = function(checkpoint_iteration, checkpoint_frequency, remaining_steps, overall_progress, checkpoint_file, completed_steps, backend, ...) { + run_checkpoint_iteration = function(checkpoint_iteration, checkpoint_frequency, remaining_steps, overall_progress, checkpoint_file, completed_steps, backend, graceful, ...) { checkpoint_start <- completed_steps + (checkpoint_iteration - 1) * checkpoint_frequency + 1 checkpoint_end <- min(completed_steps + checkpoint_iteration * checkpoint_frequency, completed_steps + remaining_steps) if (backend == "future.apply") { checkpoint_results <- future.apply::future_lapply(seq(checkpoint_start, checkpoint_end), function(policy_design_id) { overall_progress(sprintf("Running policy design %d", policy_design_id)) - self$run_single_experiment(policy_design_id, ...) + self$run_single_experiment(policy_design_id, graceful, ...) }, future.seed=TRUE, future.packages = c("dplyr", "R6Sim", "progressr")) checkpoint_results <- dplyr::bind_rows(checkpoint_results) } else if (backend == "foreach") { checkpoint_results <- foreach(policy_design_id = seq(checkpoint_start, checkpoint_end), .combine = dplyr::bind_rows, .options.future = list(seed = TRUE)) %dofuture% { overall_progress(sprintf("Running policy design %d", policy_design_id)) - self$run_single_experiment(policy_design_id, ...) + self$run_single_experiment(policy_design_id, graceful, ...) } } else { stop("Unsupported backend. Please choose either 'future.apply' or 'foreach'.") diff --git a/man/R6Experiment.Rd b/man/R6Experiment.Rd index 1144600..1a9dfb8 100644 --- a/man/R6Experiment.Rd +++ b/man/R6Experiment.Rd @@ -156,6 +156,7 @@ Run Experiment checkpoint_frequency = NULL, checkpoint_dir = NULL, backend = "future.apply", + graceful = FALSE, ... )}\if{html}{\out{}} } @@ -169,6 +170,8 @@ Run Experiment \item{\code{backend}}{Backend to use for parallelization. Options are future.apply (default) or foreach.} +\item{\code{graceful}}{Logical indicating whether to handle errors gracefully. If TRUE, errors are caught and logged as warnings, and the experiment continues. Default is FALSE.} + \item{\code{...}}{Additional parameters passed to model simulation.} } \if{html}{\out{}} @@ -183,7 +186,7 @@ A data.frame containing the results of the experiment. \subsection{Method \code{run_single_experiment()}}{ Run a single experiment \subsection{Usage}{ -\if{html}{\out{
}}\preformatted{R6Experiment$run_single_experiment(policy_design_id, ...)}\if{html}{\out{
}} +\if{html}{\out{
}}\preformatted{R6Experiment$run_single_experiment(policy_design_id, graceful = FALSE, ...)}\if{html}{\out{
}} } \subsection{Arguments}{ @@ -191,6 +194,8 @@ Run a single experiment \describe{ \item{\code{policy_design_id}}{ID of the policy design to run} +\item{\code{graceful}}{Logical indicating whether to handle errors gracefully. If TRUE, errors are caught and logged as warnings. Default is FALSE.} + \item{\code{...}}{additional parameters passed to model simulation} } \if{html}{\out{}} @@ -227,6 +232,7 @@ Run a single checkpoint iteration checkpoint_file, completed_steps, backend, + graceful = FALSE, ... )}\if{html}{\out{}} } @@ -248,6 +254,8 @@ Run a single checkpoint iteration \item{\code{backend}}{Backend to use for parallelization. Options are "future.apply" (default) or "foreach".} +\item{\code{graceful}}{Logical indicating whether to handle errors gracefully. If TRUE, errors are caught and logged as warnings. Default is FALSE.} + \item{\code{...}}{Additional parameters passed to model simulation.} } \if{html}{\out{}} diff --git a/tests/testthat/test-R6Experiment.R b/tests/testthat/test-R6Experiment.R index 9758b55..a83e1f3 100644 --- a/tests/testthat/test-R6Experiment.R +++ b/tests/testthat/test-R6Experiment.R @@ -132,3 +132,145 @@ test_that("R6Experiment produces identical results with the same seed", { unlink(temp_checkpoint_dir1, recursive = TRUE) unlink(temp_checkpoint_dir2, recursive = TRUE) }) + +# Test graceful error handling functionality + +test_that("R6Experiment handles errors gracefully when graceful = TRUE", { + # Create a mock model that will throw an error + ErrorModel <- R6::R6Class( + classname = "ErrorModel", + inherit = R6Sim, + public = list( + should_error = FALSE, + + initialize = function(name) { + super$initialize(name = name) + self$set_input("Test1", 1) + }, + + simulate = function() { + if (self$should_error) { + stop("Simulated error for testing") + } + return(data.frame(result = 42)) + } + ) + ) + + error_model <- ErrorModel$new(name = "error_test") + error_model$should_error <- TRUE + + experiment <- R6Experiment$new(error_model) + experiment$set_parameter(parameter_name = "Test1", experimental_design = "grid", values = c(1, 2)) + experiment$set_design(n_reps = 2) + + # Capture warnings + temp_checkpoint_dir <- tempfile() + + # Test graceful = TRUE + expect_warning( + results_graceful <- experiment$run(checkpoint_dir = temp_checkpoint_dir, graceful = TRUE), + "Error in experiment" + ) + + # Check that results contain error column + expect_true("error" %in% names(results_graceful)) + expect_true(all(results_graceful$error == "Simulated error for testing")) + expect_equal(nrow(results_graceful), nrow(experiment$policy_design)) + + # Clean up + unlink(temp_checkpoint_dir, recursive = TRUE) +}) + +test_that("R6Experiment stops execution when graceful = FALSE and error occurs", { + # Create a mock model that will throw an error + ErrorModel <- R6::R6Class( + classname = "ErrorModel", + inherit = R6Sim, + public = list( + should_error = FALSE, + + initialize = function(name) { + super$initialize(name = name) + self$set_input("Test1", 1) + }, + + simulate = function() { + if (self$should_error) { + stop("Simulated error for testing") + } + return(data.frame(result = 42)) + } + ) + ) + + error_model <- ErrorModel$new(name = "error_test") + error_model$should_error <- TRUE + + experiment <- R6Experiment$new(error_model) + experiment$set_parameter(parameter_name = "Test1", experimental_design = "grid", values = c(1, 2)) + experiment$set_design(n_reps = 2) + + temp_checkpoint_dir <- tempfile() + + # Test graceful = FALSE (default behavior) + expect_error( + experiment$run(checkpoint_dir = temp_checkpoint_dir, graceful = FALSE), + "Simulated error for testing" + ) + + # Clean up + unlink(temp_checkpoint_dir, recursive = TRUE) +}) + +test_that("R6Experiment mixed success and error scenarios with graceful = TRUE", { + # Create a model that errors on specific conditions + ConditionalErrorModel <- R6::R6Class( + classname = "ConditionalErrorModel", + inherit = R6Sim, + public = list( + initialize = function(name) { + super$initialize(name = name) + self$set_input("Test1", 1) + }, + + simulate = function() { + # Error when Test1 == 2 + if (self$inputs$Test1 == 2) { + stop("Error when Test1 equals 2") + } + return(data.frame(result = self$inputs$Test1 * 10)) + } + ) + ) + + conditional_model <- ConditionalErrorModel$new(name = "conditional_test") + + experiment <- R6Experiment$new(conditional_model) + experiment$set_parameter(parameter_name = "Test1", experimental_design = "grid", values = c(1, 2, 3)) + experiment$set_design(n_reps = 1) + + temp_checkpoint_dir <- tempfile() + + # Test with graceful = TRUE + expect_warning( + results <- experiment$run(checkpoint_dir = temp_checkpoint_dir, graceful = TRUE), + "Error in experiment" + ) + + # Check mixed results + expect_equal(nrow(results), 3) + + # Check successful runs + successful_runs <- results[is.na(results$error) | results$error == "", ] + expect_equal(nrow(successful_runs), 2) + expect_true(all(successful_runs$result %in% c(10, 30))) + + # Check error runs + error_runs <- results[!is.na(results$error) & results$error != "", ] + expect_equal(nrow(error_runs), 1) + expect_equal(error_runs$error, "Error when Test1 equals 2") + + # Clean up + unlink(temp_checkpoint_dir, recursive = TRUE) +})