add special trace methods (unclutter doTheEvolution)

jakobbossek · Apr 21, 2015 · 12fd0f7 · 12fd0f7
1 parent bf702be
commit 12fd0f7
Show file tree

Hide file tree

Showing 9 changed files with 185 additions and 42 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -1,6 +1,6 @@
 # Generated by roxygen2 (4.1.0): do not edit by hand
 
-S3method(autoplot,ecr_result)
+S3method(autoplot,ecr_single_objective_result)
 S3method(getOperatorCheckFunction,ecr_operator)
 S3method(getOperatorDefaultParameters,ecr_operator)
 S3method(getOperatorName,ecr_operator)

diff --git a/R/autoplotECRResult.R b/R/autoplotECRResult.R
@@ -20,7 +20,7 @@
 #'   Not used.
 #' @return [\code{invisible(TRUE)}]
 #' @export
-autoplot.ecr_result = function(object, xlim = NULL, ylim = NULL, show.process = FALSE
+autoplot.ecr_single_objective_result = function(object, xlim = NULL, ylim = NULL, show.process = FALSE
                                , log.fitness = FALSE, complete.trace = FALSE, ...) {
   assertFlag(show.process, na.ok = FALSE)
   assertFlag(complete.trace, na.ok = FALSE)

diff --git a/R/doTheEvolution.R b/R/doTheEvolution.R
@@ -20,6 +20,18 @@
 #' @example examples/ex_doTheEvolution.R
 #' @seealso \code{\link{setupECRControl}}
 #' @export
+#FIXME: get rid of the global optimum stuff. Only useful for single-objective termination
+# criterion
+#FIXME: addBestToOptPath is not a proper name since in the mo case, there is in general no
+# single best. Maybe call it better updateOptPath
+#FIXME: for standard representations: save all stuff in opt.path, i.e., make opt path the
+# population storage?
+#FIXME: optPath funs need option to make x and par.set optional
+#FIXME: we can extract the number of objectives from the smoof function, but what do we
+# do if we use custom representations and there is not par.set? We should force the user to pass
+# n.objectives to the control object!
+#FIXME: for custom representations we need to store the the best parameter since it cannot be
+# saved in the opt path :-(
 doTheEvolution = function(objective.fun, control) {
   repr = control$representation
   par.set = NULL
@@ -48,7 +60,7 @@ doTheEvolution = function(objective.fun, control) {
     }
   } else {
     # dummy par.set
-    par.set = makeParamSet(makeNumericParam("dummy", lower = 0, upper = 1))
+    control$par.set = makeParamSet(makeNumericParam("dummy", lower = 0, upper = 1))
   }
 
   # check compatibility of selectors and #objectives
@@ -61,32 +73,29 @@ doTheEvolution = function(objective.fun, control) {
     }
   })
 
+  # extract basic information
   y.names = paste0("y", seq(n.objectives))
-
   n.population = control$n.population
   n.mating.pool = control$n.mating.pool
   n.offspring = control$n.offspring
   monitor = control$monitor
 
+  # extract generator and selector
   populationGenerator = control$generator
   parentSelector = control$parent.selector
 
+  # init some vars
   iter = 1L
   start.time = Sys.time()
 
+  # generate intial population
   population = populationGenerator(n.population, control)
   population$fitness = computeFitness(population, objective.fun)
-  best = NULL
-  #best = getBestIndividual(population)
-
   pop.gen.time = difftime(Sys.time(), start.time, units = "secs")
 
-  opt.path = makeOptPathDF(par.set, y.names = y.names, minimize = rep(TRUE, n.objectives),
-    include.extra = TRUE, include.exec.time = TRUE)
-
-  opt.path = addBestToOptPath(opt.path, par.set, best, population$fitness,
-    generation = iter, extra = getListOfExtras(iter, population, start.time, control),
-    exec.time = pop.gen.time, control)
+  # initialize trace (depends on #objectives)
+  trace = initTrace(control, population, n.objectives, y.names)
+  trace = updateTrace(trace, iter, population, start.time, pop.gen.time, control)
 
   population.storage = namedList(paste0("gen.", control$save.population.at))
   # store start population
@@ -97,12 +106,17 @@ doTheEvolution = function(objective.fun, control) {
   monitor$before()
 
   repeat {
+    # monitoring
     monitor$step()
+
+    # measure time of offspring generation
     off.gen.start.time = Sys.time()
 
+    # actually create offspring
     matingPool = parentSelector(population, n.mating.pool)
-    offspring = generateOffspring(matingPool, objective.fun, control, opt.path)
+    offspring = generateOffspring(matingPool, objective.fun, control, trace$opt.path)
 
+    # apply survival selection and set up the (i+1)-th generation
     population = selectForSurvival(
       population,
       offspring,
@@ -114,17 +128,14 @@ doTheEvolution = function(objective.fun, control) {
 
     off.gen.time = difftime(Sys.time(), off.gen.start.time, units = "secs")
 
+    # some bookkeeping
     if (iter %in% control$save.population.at) {
       population.storage[[paste0("gen.", as.character(iter))]] = population
     }
+    trace = updateTrace(trace, iter, population, start.time, off.gen.time, control)
 
-    best = NULL
-    #best = getBestIndividual(population)
-    opt.path = addBestToOptPath(opt.path, par.set, best, population$fitness,
-      generation = iter, extra = getListOfExtras(iter, population, start.time, control),
-      exec.time = off.gen.time, control)
-
-    stop.object = doTerminate(control$stopping.conditions, opt.path)
+    # check if any termination criterion is met
+    stop.object = doTerminate(control$stopping.conditions, trace$opt.path)
     if (length(stop.object) > 0L) {
       break
     }
@@ -134,22 +145,75 @@ doTheEvolution = function(objective.fun, control) {
 
   monitor$after()
 
-  #FIXME: single vs multi-objective result
-  return(
-    structure(list(
-      objective.fun = objective.fun,
-      control = control,
-      best.param = best$individual,
-      pareto.set = population$individuals,
-      pareto.front = population$fitness,
-      # best.param = setColNames(t(data.frame(best$individual)),
-      #   getParamIds(par.set, repeated = TRUE, with.nr = TRUE)),
-      best.value = best$fitness,
+  # generate result object
+  if (n.objectives == 1L) {
+    makeECRSingleObjectiveResult(objective.fun, trace$best, trace$opt.path, control,
+      population.storage = NULL, stop.object)
+  } else {
+    makeECRMultiObjectiveResult(objective.fun, trace$opt.path, control,
+      population.storage, stop.object)
+  }
+}
+
+
+initTrace = function(control, population, n.objectives, y.names) {
+  par.set = control$par.set
+  opt.path = makeOptPathDF(par.set, y.names = y.names, minimize = rep(TRUE, n.objectives), include.extra = TRUE, include.exec.time = TRUE)
+
+  if (n.objectives == 1L) {
+    best = getBestIndividual(population)
+    return(makeS3Obj(
       opt.path = opt.path,
-      population.storage = population.storage,
-      message = stop.object$message
-      ), class = "ecr_result")
-    )
+      best = best,
+      classes = c("ecr_single_objective_trace")
+    ))
+  }
+  return(makeS3Obj(
+    opt.path = opt.path,
+    classes = c("ecr_multi_objective_trace")
+  ))
+}
+
+updateTrace = function(trace, iter, population, start.time, pop.gen.time, control) {
+  UseMethod("updateTrace")
+}
+
+updateTrace.ecr_single_objective_trace = function(trace, iter, population, start.time, pop.gen.time, control) {
+  par.set = control$par.set
+  best = getBestIndividual(population)
+  extras = getListOfExtras(iter, population, start.time, control)
+  if (length(par.set$pars) == 1L) {
+    best.param.values = list(best$individual)
+    names(best.param.values) = getParamIds(par.set)
+  } else {
+    best.param.values = as.list(best$individual)
+    names(best.param.values) = getParamIds(par.set, repeated = TRUE, with.nr = TRUE)
+  }
+  #FIXME: dummy value for custom representation
+  if (control$representation == "custom") {
+    best.param.values = list("x" = 0.5)
+  }
+  addOptPathEl(trace$opt.path, x = best.param.values, y = unlist(best$fitness), dob = iter,
+    exec.time = 0, extra = extras, check.feasible = FALSE)
+  trace$best = best
+  return(trace)
+}
+
+updateTrace.ecr_multi_objective_trace = function(trace, iter, population, start.time, pop.gen.time, control) {
+  par.set = control$par.set
+  extras = getListOfExtras(iter, population, start.time, control)
+  if (control$representation == "custom") {
+    stopf("Multi-objective optimization with custom genotypes is not yet finished.")
+    best.param.values = list("x" = 0.5)
+  }
+  n.population = length(population$individuals)
+  for (i in seq(n.population)) {
+    x = as.list(population$individuals[[i]])
+    names(x) = getParamIds(control$par.set, with.nr = TRUE, repeated = TRUE)
+    addOptPathEl(trace$opt.path, x = x, y = population$fitness[, i], dob = iter,
+    exec.time = 0, extra = extras, check.feasible = FALSE)
+  }
+  return(trace)
 }
 
 #' Print the result of an ecr run.

diff --git a/R/makeECRResult.R b/R/makeECRResult.R
@@ -0,0 +1,51 @@
+#' Single objective result object.
+#'
+#' Object returned by \code{\link{doTheEvolution}} in case of the objective function
+#' being single-objective.
+#'
+#' It contains ...
+#' @name ECRSingleObjectiveResult
+#' @rdname ECRSingleObjectiveResult
+#FIXME: finish this
+NULL
+
+makeECRSingleObjectiveResult = function(
+  objective.fun, best, opt.path, control,
+  population.storage = NULL, stop.object) {
+  makeS3Obj(
+    objective.fun = objective.fun,
+    control = control,
+    best.param = best$individual,
+    best.value = best$fitness,
+    opt.path = opt.path,
+    population.storage = population.storage,
+    message = stop.object$message,
+    classes = "ecr_single_objective_result"
+  )
+}
+
+#' Multi objective result object.
+#'
+#' Object returned by \code{\link{doTheEvolution}} in case of the objective function
+#' being single-objective.
+#'
+#' It contains ...
+#' @name ECRMultiObjectiveResult
+#' @rdname ECRMultiObjectiveResult
+#FIXME: finish this
+NULL
+
+makeECRMultiObjectiveResult = function(
+  objective.fun, opt.path, control,
+  population.storage, stop.object) {
+  pareto.inds = getOptPathParetoFront(opt.path, index = TRUE)
+  makeS3Obj(
+    objective.fun = objective.fun,
+    control = control,
+    opt.path = opt.path,
+    pareto.front = getOptPathY(opt.path)[pareto.inds, , drop = FALSE],
+    pareto.set = lapply(pareto.inds, function(i) getOptPathEl(opt.path, i)$x),
+    pareto.inds = pareto.inds,
+    classes = "ecr_multi_objective_result"
+  )
+}
diff --git a/inst/examples/custom_example.R b/inst/examples/custom_example.R
@@ -78,7 +78,8 @@ ctrl = setupEvolutionaryOperators(
   parent.selector = makeTournamentSelector(),
   generator = myGenerator,
   mutator = myMutator,
-  recombinator = myRecombinator
+  recombinator = myRecombinator,
+  survival.selector = makeGreedySelector()
 )
 
 res = doTheEvolution(fitness, ctrl)

diff --git a/man/ECRMultiObjectiveResult.Rd b/man/ECRMultiObjectiveResult.Rd
@@ -0,0 +1,13 @@
+% Generated by roxygen2 (4.1.0): do not edit by hand
+% Please edit documentation in R/makeECRResult.R
+\name{ECRMultiObjectiveResult}
+\alias{ECRMultiObjectiveResult}
+\title{Multi objective result object.}
+\description{
+Object returned by \code{\link{doTheEvolution}} in case of the objective function
+being single-objective.
+}
+\details{
+It contains ...
+}
+
diff --git a/man/ECRSingleObjectiveResult.Rd b/man/ECRSingleObjectiveResult.Rd
@@ -0,0 +1,13 @@
+% Generated by roxygen2 (4.1.0): do not edit by hand
+% Please edit documentation in R/makeECRResult.R
+\name{ECRSingleObjectiveResult}
+\alias{ECRSingleObjectiveResult}
+\title{Single objective result object.}
+\description{
+Object returned by \code{\link{doTheEvolution}} in case of the objective function
+being single-objective.
+}
+\details{
+It contains ...
+}
+
diff --git a/man/autoplot.ecr_result.Rd → man/autoplot.ecr_single_objective_result.Rd b/man/autoplot.ecr_result.Rd → man/autoplot.ecr_single_objective_result.Rd
@@ -1,11 +1,12 @@
 % Generated by roxygen2 (4.1.0): do not edit by hand
 % Please edit documentation in R/autoplotECRResult.R
-\name{autoplot.ecr_result}
-\alias{autoplot.ecr_result}
+\name{autoplot.ecr_single_objective_result}
+\alias{autoplot.ecr_single_objective_result}
 \title{Plot optimization trace.}
 \usage{
-\method{autoplot}{ecr_result}(object, xlim = NULL, ylim = NULL,
-  show.process = FALSE, log.fitness = FALSE, complete.trace = FALSE, ...)
+\method{autoplot}{ecr_single_objective_result}(object, xlim = NULL,
+  ylim = NULL, show.process = FALSE, log.fitness = FALSE,
+  complete.trace = FALSE, ...)
 }
 \arguments{
 \item{object}{[\code{ecr_result}]\cr

diff --git a/man/getSupportedRepresentations.Rd b/man/getSupportedRepresentations.Rd
@@ -1,5 +1,5 @@
 % Generated by roxygen2 (4.1.0): do not edit by hand
-% Please edit documentation in R/getOperatorsTags.R
+% Please edit documentation in R/getSupportedRepresentations.R
 \name{getSupportedRepresentations}
 \alias{getSupportedRepresentations}
 \title{Returns the character vector of tags which describe a specific operator.}