add tests for OptPath logging monitor

R/autoplotECRResult.R

@@ -32,16 +32,16 @@ autoplot.ecr_single_objective_result = function(object, xlim = NULL, ylim = NULL
     stopf("Cannot plot optimization trace, since obviously no logging took place.")
   }
 
-
-  op = as.data.frame(object$opt.path)
+  op = object$opt.path
+  op.df = as.data.frame(op, strings.as.factors = TRUE)
   # we start with the second dob, since otherwise there is not enough info to plot
-  unique.dobs = unique(op$dob)[-1]
+  unique.dobs = unique(op.df$dob)[-1]
   if (complete.trace) {
     unique.dobs = tail(unique.dobs, 1)
   }
   for (dob in unique.dobs) {
-    pl.trace = plotTrace(op[which(op$dob <= dob), ], xlim, ylim, log.fitness, ...)
-    pl.trace = pl.trace + ggtitle(sprintf("Optimization trace for function '%s'", getName(obj.fun)))
+    pl.trace = plotTrace(op.df[which(op.df$dob <= dob), ], xlim, ylim, log.fitness, ...)
+    pl.trace = pl.trace + ggtitle("Optimization trace")
     if (show.process) {
       if (object$final.opt.state$control$representation == "custom") {
         stopf("Process cannot be visualized if custom representation was used.")
@@ -79,11 +79,10 @@ autoplot.ecr_single_objective_result = function(object, xlim = NULL, ylim = NULL
         pl.fun = pl.fun + geom_hline(yintercept = opt.dir.fun(df.points[[y.name]]), linetype = "dashed", colour = "gray")
       }
 
-      #FIXME: this seems to fail!
       BBmisc::requirePackages(c("grid", "gridExtra"), why = "ecr")
       #FIXME: next line returns errors in 'test_autoplot.R'
-      pl = do.call(gridExtra::arrangeGrob, list(pl.fun, pl.trace, ncol = 1))
-      #pl = pl.trace
+      pl = do.call(gridExtra::grid.arrange, list(pl.fun, pl.trace, ncol = 1L))
+      print(pl)
     } else {
       pl = pl.trace
     }

R/makeOptPathLoggerMonitor.R

@@ -46,42 +46,21 @@ makeOptPathLoggingMonitor = function(step = 1L, log.extras.fun = NULL) {
         minimize = task$minimize,
         include.extra = TRUE, include.exec.time = FALSE
       )
+
+      # now add initial population
+      extras = getListOfExtras(opt.state, log.extras.fun)
+      addIndividualsToOptPath(opt.state, extras)
     },
     step = function(opt.state, ...) {
       iter = opt.state$iter
 
       if ((iter %% step) == 0L) {
-
         # extract data
         task = opt.state$task
-        par.set = task$par.set
-        n.objectives = task$n.objectives
 
         # handle extra logging stuff
         extras = getListOfExtras(opt.state, log.extras.fun)
-
-        # extract relevant data
-        individuals = opt.state$population$individuals
-        fitness = opt.state$population$fitness
-
-        n.population = ncol(fitness)
-        n.pars = length(par.set$pars)
-
-        # now iterate over the population and store all individuals
-        for (i in seq(n.population)) {
-          x = individuals[[i]]
-          if (opt.state$control$representation == "custom") {
-            # serialization of custom represetation
-            x = serializeIndividual(x)
-          }
-          if (n.pars == 1L) {
-            x = list(x)
-          }
-          y = fitness[, i]
-          addOptPathEl(opt.state$opt.path, x = x, y = y, dob = iter,
-            extra = extras, check.feasible = FALSE
-          )
-        }
+        addIndividualsToOptPath(opt.state, extras)
       }
     },
     after = function(opt.state, ...) {
@@ -90,6 +69,38 @@ makeOptPathLoggingMonitor = function(step = 1L, log.extras.fun = NULL) {
   )
 }
 
+# @title
+# Actually add individuals to OptPath.
+#
+# @param opt.state [\code{ecr_opt_state}]\cr
+#   Current iteration/generation.
+addIndividualsToOptPath = function(opt.state, extras) {
+  par.set = opt.state$task$par.set
+
+  individuals = opt.state$population$individuals
+  fitness = opt.state$population$fitness
+
+  n.population = ncol(fitness)
+  n.pars = length(par.set$pars)
+
+  # now iterate over the population and store all individuals
+  for (i in seq(n.population)) {
+    x = individuals[[i]]
+    if (opt.state$control$representation == "custom") {
+      # serialization of custom represetation
+      x = serializeIndividual(x)
+    }
+    if (n.pars == 1L) {
+      x = list(x)
+    }
+    y = fitness[, i]
+    addOptPathEl(opt.state$opt.path, x = x, y = y, dob = opt.state$iter,
+      extra = extras, check.feasible = FALSE
+    )
+  }
+  invisible()
+}
+
 # @title
 # Generate 'extras' argument for opt.path.
 #

inst/examples/smoof_2d_example.R

@@ -19,21 +19,21 @@ load_all(".", reset = TRUE)
 # Monitoring function. For details on the expected formal parameters
 # see the help pages for makeMonitor and makeConsoleMonitor.
 myMonitorStep = function(opt.state, ...) {
-  control = opt.state$control
-  n.targets = control$n.targets
-  population = opt.state$population
-  task = opt.state$task
-
-  x = seq(-5, 5, by = 0.05)
-  df = expand.grid(x, x)
-  names(df) = paste0("x", 1:2)
-  df.points = as.data.frame(do.call(rbind, population$individuals))
-  names(df.points) = names(df)
-  df$y = apply(df, 1L, task$fitness.fun)
-
-  pl = ggplot(data = df, aes(x = x1, y = x2, z = y)) + geom_contour(colour = "gray")
-  pl = pl + geom_point(data = df.points, aes(z = NULL), colour = "tomato")
-  print(pl)
+  # control = opt.state$control
+  # n.targets = control$n.targets
+  # population = opt.state$population
+  # task = opt.state$task
+
+  # x = seq(-5, 5, by = 0.05)
+  # df = expand.grid(x, x)
+  # names(df) = paste0("x", 1:2)
+  # df.points = as.data.frame(do.call(rbind, population$individuals))
+  # names(df.points) = names(df)
+  # df$y = apply(df, 1L, task$fitness.fun)
+
+  # pl = ggplot(data = df, aes(x = x1, y = x2, z = y)) + geom_contour(colour = "gray")
+  # pl = pl + geom_point(data = df.points, aes(z = NULL), colour = "tomato")
+  # print(pl)
 }
 
 myMonitor = makeMonitor(step = myMonitorStep)
@@ -48,6 +48,7 @@ control = setupECRControl(
   survival.strategy = "plus",
   representation = "float",
   monitor = myMonitor,
+  logger = makeOptPathLoggingMonitor(),
   stopping.conditions = setupStoppingConditions(max.iter = 100L)
 )
 # use default operators

tests/testthat/test_optPathLoggingMonitor.R

@@ -0,0 +1,79 @@
+context("opt path logging")
+
+test_that("logging with ParamHelpers::OptPath works well", {
+  n.population = 10L
+  n.offspring = 4L
+  max.iter = 3L
+
+  fn = makeSphereFunction(2L)
+
+  control = setupECRControl(
+    n.population = n.population,
+    n.offspring = n.offspring,
+    representation = "float",
+    logger = makeOptPathLoggingMonitor(),
+    monitor = makeNullMonitor(),
+    stopping.conditions = list(makeMaximumIterationsStoppingCondition(max.iter = max.iter))
+  )
+
+  res = doTheEvolution(fn, control = control)
+  expect_is(res$opt.path, c("OptPath", "OptPathDF"))
+
+  op = as.data.frame(res$opt.path)
+  objective.name = res$task$objective.names
+  decision.names = getParamIds(getParamSet(fn), with.nr = TRUE, repeated = TRUE)
+  expect_equal(nrow(op), n.population * (max.iter + 1L)) # initial population + 3 generations
+
+  # check contents for plausibility
+  expect_true(all(objective.name %in% colnames(op)))
+  expect_true(all(decision.names %in% colnames(op)))
+  expect_true(max(op$dob) == max.iter)
+
+  # check plots
+  pl = autoplot(res, complete.trace = TRUE)
+  expect_true(pl)
+
+  pl = autoplot(res, complete.trace = TRUE, log.fitness = TRUE)
+  expect_true(pl)
+
+  pl = autoplot(res, complete.trace = TRUE, show.process = TRUE)
+  expect_true(pl)
+})
+
+test_that("user defined extras are stored in OptPath", {
+  fn = makeSphereFunction(10L)
+
+  # define our extras fun which computes more or less useful stuff
+  log.extras.fun = function(opt.state, ...) {
+    population = opt.state$population
+    list(
+      "ex.num1" = sd(population$fitness), # stuff
+      "ex.num2" = min(sapply(population$individuals, min)), # individuals
+      "ex.disc" = sample(letters[1:10], 1L) # discrete stuff
+    )
+  }
+
+  control = setupECRControl(
+    n.population = 5L,
+    n.offspring = 3L,
+    survival.strategy = "plus",
+    representation = "float",
+    monitor = makeNullMonitor(),
+    logger = makeOptPathLoggingMonitor(log.extras.fun = log.extras.fun),
+    stopping.conditions = setupStoppingConditions(max.iter = 2L)
+  )
+
+  res = doTheEvolution(fn, control)
+  op = as.data.frame(res$opt.path)
+
+  # check that corresponding column names exist
+  expected.names = c("ex.num1", "ex.num2", "ex.disc")
+  expect_true(isSubset(expected.names, colnames(op)))
+
+  # check that they have the correct type
+  expect_true(is.numeric(op[["ex.num1"]]))
+  expect_true(is.numeric(op[["ex.num2"]]))
+  expect_true(is.factor(op[["ex.disc"]]))
+  expect_true(all(as.character(op[["ex.disc"]]) %in% letters[1:10]))
+})
+