add more.args argument to doTheEvolution

R/doTheEvolution.R

@@ -16,24 +16,27 @@
 #'   by individuals generated by the corresponding generator.
 #'   Default is \code{NULL}, i.e., the entire population is generated by the
 #'   population generator.
+#' @param more.args [\code{list}]\cr
+#'   Additional arguments passed to objective function.
 #' @return [\code{\link{ecr_result}}]
 #'
 #' @example examples/ex_doTheEvolution.R
 #' @seealso \code{\link{setupECRControl}}
 #' @export
-doTheEvolution = function(task, control, initial.population = NULL) {
+doTheEvolution = function(task, control, initial.population = NULL, more.args = list()) {
   UseMethod("doTheEvolution")
 }
 
 #' @export
-doTheEvolution.smoof_function = function(task, control, initial.population = NULL) {
+doTheEvolution.smoof_function = function(task, control, initial.population = NULL, more.args = list()) {
   task = makeOptimizationTask(task)
   doTheEvolution(task, control, initial.population)
 }
 
 #' @export
-doTheEvolution.ecr_optimization_task = function(task, control, initial.population = NULL) {
-  doFinalChecks(task, control)
+doTheEvolution.ecr_optimization_task = function(task, control, initial.population = NULL, more.args = list()) {
+  doFinalChecks(task, control, more.args)
+  task$more.args = more.args
 
   population = buildInitialPopulation(control$n.population, task, control, initial.population)
   population$fitness = evaluateFitness(population, task$fitness.fun, task, control)
@@ -69,9 +72,12 @@ doTheEvolution.ecr_optimization_task = function(task, control, initial.populatio
 #   Optimization task.
 # @param control [ecr_control]
 #   Control object.
-doFinalChecks = function(task, control) {
+# @param more.args [list]
+#   Additional arguments for objective function.
+doFinalChecks = function(task, control, more.args) {
   assertClass(task, "ecr_optimization_task")
   assertClass(control, "ecr_control")
+  assertList(more.args)
 
   if (isSmoofFunction(task$fitness.fun) && control$representation == "custom") {
     stopf("Custom representations not possible for smoof functions.")

R/evaluateFitness.R

@@ -30,10 +30,10 @@ evaluateFitness = function(population, fitness.fun, task, control) {
       }
       # vectorized smoof function are continuous only and expect a matrix input,
       # where each column is one input vector
-      fitness = fitness.fun(do.call(cbind, population$individuals))
+      fitness = do.call(fitness.fun, c(list(do.call(cbind, population$individuals)), task$more.args))
     } else {
       # otherwise we simply pass the entire population
-      fitness = fitness.fun(population$individuals)
+      fitness = do.call(fitness.fun, c(list(population$individuals), task$more.args))
     }
     # internally fitness is always a matrix, even in the single-objective case
     if (!is.matrix(fitness)) {
@@ -42,14 +42,13 @@ evaluateFitness = function(population, fitness.fun, task, control) {
     return(fitness)
   }
 
-  # otherwise do or do not parallelization
-  if (getParamNr(task$par.set) == 1L) {
-    # one parameter
-    fitness = parallelMap(fitness.fun, population$individuals, level = "ecr.evaluateFitness")
-  } else {
-    # many parameters, which are explicit defined in function
-    fitness = parallelMap(function(ind) do.call(fitness.fun, ind), population$individuals, level = "ecr.evaluateFitness")
-  }
+  # otherwise do or do not parallelization via parallelMap
+  # We need this wrapper to distinguish between functions of signature
+  # fun(x, ...) where x is a list of parameters of the parameter set and
+  # fun(x, y, z, ...) where each parameter corresponds to an argument.
+  wrapFun = if (getParamNr(task$par.set) == 1L) list else identity
+  fitness = parallelMap(function(x) do.call(fitness.fun, c(wrapFun(x), task$more.args)),
+    population$individuals, level = "ecr.evaluateFitness")
   # force fitness to be stored in a matrix (be consistent for single and
   # multi-objective fitness funs)
   fitness = do.call(cbind, fitness)

tests/testthat/test_ecr.R

@@ -107,6 +107,26 @@ test_that("ecr works on binary representations", {
   }
 })
 
+test_that("ecr works with additional arguments", {
+  obj.fun = makeSingleObjectiveFunction(
+    fn = function(x, shift = 100L) {
+      sum(x^2) + shift
+    },
+    par.set = makeNumericParamSet("x", lower = -10, upper = 10, len = 1L)
+  )
+  control = setupECRControl(
+    n.population = 10L,
+    n.offspring = 5L,
+    representation = "float",
+    survival.strategy = "plus",
+    monitor = NULL,
+    stopping.conditions = list(setupMaximumIterationsTerminator(max.iter = 50L))
+  )
+  res = doTheEvolution(obj.fun, control, more.args = list(shift = 1000))
+  expect_true(res$best.value < 1000.1)
+  expect_true(res$best.param < 0.1)
+})
+
 test_that("ecr works on permutation genomes", {
   # defs
   n.params = 5L

tests/testthat/test_emoa.R

@@ -23,7 +23,7 @@ test_that("preimplemented EMOAs work well", {
     zdt1 = smoof::makeZDT1Function(dimensions = 2L),
     zdt2 = smoof::makeZDT2Function(dimensions = 3L)
   )
-  max.evals = 70L
+  max.evals = 200L
 
   # test NSGA-II
   for (n.pop in c(5, 10, 15)) {