* R/: Use local_preserve_seed() before calling targetRunner or targe…

…tEvaluator.

NEWS.md

@@ -10,6 +10,10 @@
 
 ## New features and improvements
 
+ * When `targetRunner` or `targetEvaluator` are implemented in R, using random
+   numbers within those functions does not affect the sequence of random
+   numbers within irace.
+
  * `psRace()` gains a `psrace_logFile` argument to avoid overwriting `scenario$logFile`.
 
 ## Fixes

R/ablation.R

@@ -400,12 +400,14 @@ ablation <- function(iraceResults, src = 1L, target = NULL,
 
   race_state$start_parallel(scenario)
   on.exit(race_state$stop_parallel(), add = TRUE)
-  target_output <- execute_experiments(race_state, experiments, scenario)
-  if (!is.null(scenario$targetEvaluator))
-    target_output <- execute_evaluator (race_state$target_evaluator, experiments, scenario, target_output,
-                                        src_configuration)
+  # We cannot let targetRunner or targetEvaluator modify our random seed, so we save it.
+  withr::with_preserve_seed({
+    target_output <- execute_experiments(race_state, experiments, scenario)
+    if (!is.null(scenario$targetEvaluator))
+      target_output <- execute_evaluator(race_state$target_evaluator, experiments, scenario, target_output)
+  })
   # Save results
-  output <- sapply(target_output, getElement, "cost") 
+  output <- unlist_element(target_output, "cost") 
   results <- matrix(NA_real_, ncol = 1L, nrow = nrow(race_state$instances_log), 
                     dimnames = list(seq_nrow(race_state$instances_log), 1L))
   results[,1L] <- output[seq_nrow(race_state$instances_log)]

R/irace.R

@@ -1160,7 +1160,6 @@ irace_run <- function(scenario)
     # race_state$experiment_log here. Doing the two steps in a different order
     # would be more robust but would need a smarter recovery routine that
     # checks for duplicates.
-    withr::local_options(warn=2)
     race_state$experiment_log <- rbindlist(list(race_state$experiment_log, raceResults$experiment_log),
       use.names=TRUE)
     # Merge new results.

R/main.R

@@ -417,11 +417,12 @@ checkTargetFiles <- function(scenario)
   race_state <- RaceState$new(scenario)
   race_state$start_parallel(scenario)
   on.exit(race_state$stop_parallel(), add = TRUE)
-
   # FIXME: Create a function try.call(err.msg,warn.msg, fun, ...)
   # Executing targetRunner
   cat("# Executing targetRunner (", nrow(configurations), "times)...\n")
   result <- TRUE
+  # We cannot let targetRunner or targetEvaluator modify our random seed, so we save it.
+  withr::local_preserve_seed()
   output <-  withCallingHandlers(
     tryCatch(execute_experiments(race_state, experiments, scenario),
              error = function(e) {
@@ -447,8 +448,7 @@ checkTargetFiles <- function(scenario)
   if (!is.null(scenario$targetEvaluator)) {
     cat("# Executing targetEvaluator...\n")
     output <-  withCallingHandlers(
-      tryCatch(execute_evaluator(race_state$target_evaluator,
-        experiments, scenario, output, configurations[[".ID."]]),
+      tryCatch(execute_evaluator(race_state$target_evaluator, experiments, scenario, output),
                  error = function(e) {
                    cat(sep = "\n",
                        "\n# Error ocurred while executing targetEvaluator:",

R/race-wrapper.R

@@ -608,13 +608,9 @@ execute_experiments <- function(race_state, experiments, scenario)
   target_output
 }
 
-execute_evaluator <- function(target_evaluator, experiments, scenario, target_output, configurations_id)
+execute_evaluator <- function(target_evaluator, experiments, scenario, target_output)
 {
-  ## FIXME: We do not need the configurations_id argument:
-  irace.assert(isTRUE(all.equal(configurations_id,
-    unique(sapply(experiments, getElement, "id_configuration")))))
-  configurations_id <- unique(unlist(lapply(experiments, getElement, "id_configuration"),
-    recursive = FALSE, use.names = FALSE))
+  configurations_id <- unique(unlist_element(experiments, "id_configuration"))
   nconfs <- length(configurations_id)
   # Evaluate configurations sequentially.
   for (k in seq_along(experiments)) {

R/race.R

@@ -93,13 +93,11 @@ race_wrapper_helper <- function(race_state, configurations, instance_idx, bounds
     # If targetEvaluator is NULL, then target_output must contain the right
     # output already.  Otherwise, targetEvaluator considers all experiments.
     if (!is.null(scenario$targetEvaluator)) {
-      target_output <- execute_evaluator(race_state$target_evaluator, experiments, scenario, target_output,
-        configurations_id = configurations[[".ID."]])
+      target_output <- execute_evaluator(race_state$target_evaluator, experiments, scenario, target_output)
     } else if (any(!is_exe))  {
       experiments <- experiments[is_exe]
       instance_idx <- instance_idx[is_exe]
     }
-    withr::local_options(warn=2)
     target_output <- rbindlist(target_output, fill=TRUE, use.names=TRUE)
     set(target_output, j = setdiff(colnames(target_output), c("cost", "time")), value = NULL)
     if ("time" %notin% colnames(target_output))
@@ -1173,7 +1171,6 @@ elitist_race <- function(race_state, maxExp,
     irace.note ("Memory used in race():\n")
     race_state$print_mem_used()
   }
-  withr::local_options(warn=2)
   local_experiment_log <- race_state$reset_race_experiment_log()
 
   # nrow(Results) may be smaller, equal or larger than current_task.

R/testing.R

@@ -51,20 +51,22 @@ testConfigurations <- function(configurations, scenario)
   }
   race_state$start_parallel(scenario)
   on.exit(race_state$stop_parallel())
+  # We cannot let targetRunner or targetEvaluator modify our random seed, so we save it.
+  withr::local_preserve_seed()
   target_output <- execute_experiments(race_state, experiments, scenario)
   # targetEvaluator may be NULL. If so, target_output must contain the right
   # output already.
   if (!is.null(scenario$targetEvaluator))
     target_output <- execute_evaluator(race_state$target_evaluator, experiments,
-      scenario, target_output, configurations[[".ID."]])
+      scenario, target_output)
 
-  # FIXME: It would be much faster to get convert target_output$cost to a
-  # vector, then initialize the matrix with the vector.
+  # FIXME: It would be much faster to convert target_output to a data.table like we do in race_wrapper(),
+  # then dcast() to a matrix like we do elsewhere.
   testResults <- matrix(NA, ncol = nrow(configurations), nrow = length(testInstances),
                         # dimnames = list(rownames, colnames)
                         dimnames = list(instances_id, configurations$.ID.))
 
-  cost <- sapply(target_output, getElement, "cost")
+  cost <- unlist_element(target_output, "cost")
   if (scenario$capping)
     cost <- applyPAR(cost, boundMax = scenario$boundMax, boundPar = scenario$boundPar)
   # FIXME: Vectorize this loop