introduce survival selectors

NAMESPACE

@@ -22,6 +22,7 @@ export(makeConsoleMonitor)
 export(makeCrossoverRecombinator)
 export(makeGaussMutator)
 export(makeGenerator)
+export(makeGreedySelector)
 export(makeInsertionMutator)
 export(makeIntermediateRecombinator)
 export(makeInversionMutator)

R/doTheEvolution.R

@@ -51,7 +51,7 @@ doTheEvolution = function(objective.fun, control) {
   monitor = control$monitor
 
   populationGenerator = control$generator
-  parentSelector = control$selector
+  parentSelector = control$parent.selector
 
   iter = 1L
   start.time = Sys.time()
@@ -89,7 +89,8 @@ doTheEvolution = function(objective.fun, control) {
       offspring,
       n.population,
       strategy = control$survival.strategy,
-      n.elite = control$n.elite
+      n.elite = control$n.elite,
+      control
     )
 
     off.gen.time = difftime(Sys.time(), off.gen.start.time, units = "secs")

R/generateOffspring.R

@@ -19,16 +19,23 @@ generateOffspring = function(matingPool, objective.fun, control, opt.path) {
   offspring = vector("list", n.offspring)
 
   for (i in seq(n.offspring)) {
+    #catf("Parent %i", i)
     parents = getParents(matingPool)
+    #print(parents)
     # pass just the individuals and get a single individual
     child = recombinator(parents, control)
+    #catf("Child %i", i)
+    #print(child)
     mutator.control = mutationStrategyAdaptor(mutator.control, opt.path)
     # pass just the individual and get a single individual
     child = mutator(child, mutator.control, control)
     offspring[[i]] = child
   }
+  #print(offspring)
   offspring.fitness = computeFitness(makePopulation(offspring), objective.fun)
 
+  #print(makePopulation(offspring, offspring.fitness))
+  #stop()
   return(makePopulation(offspring, offspring.fitness))
 }
 

R/makeSelector.R

@@ -14,7 +14,7 @@
 #   selector object.
 makeSelector = function(selector, name, description,
   supported = getAvailableRepresentations()) {
-  assertFunction(selector, args = c("population", "n.mating.pool"), ordered = TRUE)
+  assertFunction(selector, args = c("population", "n.select", "control"), ordered = TRUE)
   selector = makeOperator(selector, name, description, supported)
   selector = addClasses(selector, c("ecr_selector"))
   return(selector)

R/recombinator.crossover.R

@@ -9,6 +9,9 @@ makeCrossoverRecombinator = function() {
     n = length(parent1)
     #FIXME: we have to make sure, that the gene has length > 1. This should not
     # be the case in pratice use, but it causes errors
+    if (n == 1L) {
+      stopf("Crossover recombinator requires genes to have length > 1.")
+    }
     idx = sample(1:(n - 1), size = 1L)
     # at least one allele of each parent should be contained
     child1 = parent1

R/selectForSurvival.R

@@ -18,40 +18,46 @@
 #   Number of fittest individuals of the current generation that shall be copied to the
 #   next generation without changing. Default is 0.
 # @return [\code{setOfIndividuals}]
-selectForSurvival = function(population, offspring, n.population, strategy = "plus", n.elite = 0L) {
+selectForSurvival = function(population, offspring, n.population, strategy = "plus", n.elite = 0L, control) {
   elite = NULL
+  new.population = NULL
+  survivalSelector = control$survival.selector
   if (strategy == "plus") {
+    # print(population)
+    # print(offspring)
+    # stop()
     source.population = mergePopulations(population, offspring)
-    source.individuals = source.population$individuals
-    source.fitness = source.population$fitness
-    to.survive = order(source.fitness)[seq(n.population)]
+    # print(source.population)
+    # stop()
+    new.population = survivalSelector(source.population, n.population, control)
+    # source.individuals = source.population$individuals
+    # source.fitness = source.population$fitness
+    # to.survive = order(source.fitness)[seq(n.population)]
   } else if (strategy == "comma") {
     source.population = offspring
-    source.individuals = source.population$individuals
-    source.fitness = source.population$fitness
+    elite = list()
+
     if (n.elite > 0L) {
       #catf("Elitism with %i candidates out of %i", n.elite, n.population)
+      #FIXME: this is principally done already in the "greedy" selector. We could
+      # use it here
       parent.individuals = population$individuals
       parent.fitness = population$fitness
       to.be.elite = order(parent.fitness)[seq(n.elite)]
-      # Adapt number of individuals taken from the offspring
-      n.population = n.population - n.elite
+
+      # get elite individuals
       elite = makePopulation(
         individuals = parent.individuals[to.be.elite],
         fitness = parent.fitness[to.be.elite]
       )
-    }
-    to.survive = order(source.fitness)[seq(n.population)]
-  }
 
-  population2 = makePopulation(
-    individuals = source.individuals[to.survive],
-    fitness = source.fitness[to.survive]
-  )
-
-  # merge populations if elitism was used
-  if (!is.null(elite)) {
-    population2 = mergePopulations(population2, elite)
+      # Adapt number of individuals taken from the offspring and select non-elite individuals
+      n.population = n.population - n.elite
+    }
+    new.population = survivalSelector(offspring, n.population, control)
+    if (length(elite) > 0L) {
+      new.population = mergePopulations(new.population, elite)
+    }
   }
-  return(population2)
+  return(new.population)
 }

R/selector.k-tournament.R

@@ -12,14 +12,14 @@
 makeTournamentSelector = function(k = 3L) {
   force(k)
 
-  selector = function(population, n.mating.pool) {
+  selector = function(population, n.select, control) {
     inds = population$individuals
     fitness = population$fitness
     n.population = length(fitness)
     pop.idx = seq(n.population)
 
-    idx = integer(n.mating.pool)
-    for (i in seq(n.mating.pool)) {
+    idx = integer(n.select)
+    for (i in seq(n.select)) {
       # choose k individuals at random ...
       competitor.idx = sample(pop.idx, size = k)
       # ... and store the best

R/selector.roulettewheel.R

@@ -9,7 +9,7 @@
 #' @return [\code{setOfIndividuals}]
 #' @export
 makeRouletteWheelSelector = function() {
-  selector = function(population, n.mating.pool) {
+  selector = function(population, n.select, control) {
     #FIXME: We do minimization; Roulette-Wheel selection cannot be used in
     # minimization in general, since low fitness values lead to low selection
     # probabilities. Another problem are negative fitness values.
@@ -26,7 +26,7 @@ makeRouletteWheelSelector = function() {
     fitness = 1 / fitness
     n.population = length(inds)
     prob = fitness / sum(fitness)
-    idx = sample(n.population, size = n.mating.pool, replace = TRUE, prob = prob)
+    idx = sample(n.population, size = n.select, replace = TRUE, prob = prob)
     return(makePopulation(inds[idx], population$fitness[idx]))
   }
   makeSelector(

R/selector.simple.R

@@ -6,7 +6,7 @@
 #' @return [\code{setOfIndividuals}]
 #' @export
 makeSimpleSelector = function() {
-  selector = function(population, n.mating.pool) {
+  selector = function(population, n.select, control) {
     # inds = population$individuals
     # fitn = population$fitness
     # n = length(inds)

R/setupEvolutionaryOperators.R

@@ -6,12 +6,15 @@
 #'
 #' @param control [\code{ecr_control}]\cr
 #'   ECR control object generated via \code{\link{setupECRControl}}.
-#' @param selector [\code{ecr_selector}]\cr
-#'   Selection operator which implements a procedure to copy individuals from a
-#'   given population to the mating pool, i. e., allow them to become parents.
 #' @param generator [\code{ecr_generator}]\cr
 #'   Generator operator of type \code{ecr_generator} for the generation of the initial
 #'   population.
+#' @param parent.selector [\code{ecr_selector}]\cr
+#'   Selection operator which implements a procedure to copy individuals from a
+#'   given population to the mating pool, i. e., allow them to become parents.
+#' @param survival.selector [\code{ecr_selector}]\cr
+#'   Selection operator which implements a procedurce to extract individuals from
+#'   a given set, which should survive and set up the next generation.
 #' @param mutator [\code{ecr_mutator}]\cr
 #'   Mutation operator of type \code{ecr_mutator}.
 #' @param mutationStrategyAdaptor [\code{function}]\cr
@@ -34,7 +37,8 @@
 #' @export
 setupEvolutionaryOperators = function(
   control,
-  selector = getDefaultEvolutionaryOperators(control$representation, "selector"),
+  parent.selector = getDefaultEvolutionaryOperators(control$representation, "selector"),
+  survival.selector = getDefaultEvolutionaryOperators(control$representation, "selector"),
   generator = getDefaultEvolutionaryOperators(control$representation, "generator"),
   mutator = getDefaultEvolutionaryOperators(control$representation, "mutator"),
   #FIXME: this stuff is experimental.
@@ -52,8 +56,9 @@ setupEvolutionaryOperators = function(
   assertFunction(mutationStrategyAdaptor, args = c("operator.control", "opt.path"), ordered = TRUE)
   assertList(recombinator.control, any.missing = FALSE)
 
-  # check passed selector
-  checkCorrectOperatorType(selector, "ecr_selector", "Selector")
+  # check passed selector(s)
+  checkCorrectOperatorType(parent.selector, "ecr_selector", "Parent selector")
+  checkCorrectOperatorType(survival.selector, "ecr_selector", "Survival selector")
 
   # Check passed mutator
   checkCorrectOperatorType(mutator, "ecr_mutator", "Mutator")
@@ -77,7 +82,8 @@ setupEvolutionaryOperators = function(
   })
 
   # store stuff in control object
-  control$selector = selector
+  control$parent.selector = parent.selector
+  control$survival.selector = survival.selector
   control$generator = generator
   control$mutator = mutator
   control$mutationStrategyAdaptor = mutationStrategyAdaptor

examples/ex_doTheEvolution.R

@@ -64,8 +64,9 @@ ctrl = setupECRControl(
 )
 ctrl = setupEvolutionaryOperators(
  ctrl,
- selector = makeRouletteWheelSelector(),
- recombinator = makeCrossoverRecombinator()
+ parent.selector = makeRouletteWheelSelector(),
+ recombinator = makeCrossoverRecombinator(),
+ survival.selector = makeGreedySelector()
 )
 res = doTheEvolution(obj.fn, ctrl)
 print(res)

inst/examples/1plus1_GA_example.R

@@ -45,6 +45,7 @@ control = setupEvolutionaryOperators(
   generator = makeBinaryGenerator(),
   mutator = makeBitFlipMutator(),
   recombinator = makeCrossoverRecombinator(),
+  survival.selector = makeGreedySelector(),
   # see the literature on 1+1 GA for this parameter recommendation
   mutator.control = list(mutator.flip.prob = 1 / n.params)
 )

inst/examples/smoof_example.R

@@ -48,7 +48,10 @@ control = setupECRControl(
   stopping.conditions = setupStoppingConditions(max.iter = 25L)
 )
 # use default operators
-control = setupEvolutionaryOperators(control)
+control = setupEvolutionaryOperators(
+  control,
+  survival.selector = makeGreedySelector()
+)
 
 # do the evolutionary magic
 set.seed(123)

inst/examples/sms_emoa_example.R

@@ -0,0 +1,63 @@
+library(smoof)
+library(ecr)
+
+ctrl = setupECRControl(
+  n.population = 10L,
+  n.offspring = 1L,
+  representation = "float",
+  n.targets = 2L,
+  monitor = makeConsoleMonitor()
+)
+
+ctrl = setupEvolutionaryOperators(
+  ctrl,
+  selector = makeTournamentSelector(),
+  mutator = makeGaussMutator(),
+  recombinator = makeCrossoverRecombinator(),
+  survivalSelector = makeNondominatedSetSelector()
+)
+
+# Get set of dominated individuals.
+#
+# @param x [list]
+#   Set of 2D fitness values.
+# @param fn [function]
+#   Fitness function.
+# @return [list]
+getDominatedSet = function(x) {
+  n = length(x)
+
+  # initialize set of dominated individuals
+  dom.set = integer()
+  dom.nrs = integer(n)
+
+  for (i in seq(n)) {
+    for (j in seq(n)) {
+      if (i == j) {
+        next
+      }
+      if (all(x[[j]] <= x[[i]])) {
+        dom.nrs[i] = dom.nrs[i] + 1L
+      }
+    }
+  }
+  return(list(
+    dom.set = which(dom.nrs != 0L),
+    dom.nrs = dom.nrs
+  ))
+}
+
+# Determine the number of elements for each individual by which it is dominated.
+#
+# @param x [list]
+#   Set of fitness values.
+# @return [integer]
+#   Each position contains the number of individuals by which this one is dominated.
+getDominanceNumber = function()
+inds = list(c(1, 2), c(2, 1), c(2, 2), c(1, 3), c(1.5, 1.3))
+
+print(getDominatedSet(inds))
+
+
+obj.fn = smoof::makeZDT1Function(2L)
+

inst/examples/tspmeta_example.R

@@ -15,7 +15,7 @@ load_all(".")
 set.seed(352)
 
 # generate instance
-n.nodes = 25L
+n.nodes = 20L
 inst = random_instance(size = n.nodes)
 
 # The target fun is the length of a given tour
@@ -37,8 +37,11 @@ control = setupECRControl(
   n.elite = 1L,
   stopping.conditions = list(makeMaximumIterationsStoppingCondition(max.iter = 2000L))
 )
-# here we stick to the defaults
-control = setupEvolutionaryOperators(control)
+# here we select the 100 fittest indiviuals to survive
+control = setupEvolutionaryOperators(
+  control,
+  survival.selector = makeGreedySelector()
+)
 print(control)
 
 res = doTheEvolution(obj.fun, control = control)

man/doTheEvolution.Rd

@@ -96,14 +96,15 @@ ctrl = setupECRControl(
 )
 ctrl = setupEvolutionaryOperators(
  ctrl,
- selector = makeRouletteWheelSelector(),
- recombinator = makeCrossoverRecombinator()
+ parent.selector = makeRouletteWheelSelector(),
+ recombinator = makeCrossoverRecombinator(),
+ survival.selector = makeGreedySelector()
 )
 res = doTheEvolution(obj.fn, ctrl)
 print(res)
-# \dontrun{
-#   autoplot(res, show.process = TRUE)
-# }
+\dontrun{
+  autoplot(res, show.process = TRUE)
+}
 }
 \seealso{
 \code{\link{setupECRControl}}

man/setupEvolutionaryOperators.Rd

@@ -6,7 +6,9 @@
 your problem.}
 \usage{
 setupEvolutionaryOperators(control,
-  selector = getDefaultEvolutionaryOperators(control$representation,
+  parent.selector = getDefaultEvolutionaryOperators(control$representation,
+  "selector"),
+  survival.selector = getDefaultEvolutionaryOperators(control$representation,
   "selector"),
   generator = getDefaultEvolutionaryOperators(control$representation,
   "generator"),
@@ -20,10 +22,14 @@ setupEvolutionaryOperators(control,
 \item{control}{[\code{ecr_control}]\cr
 ECR control object generated via \code{\link{setupECRControl}}.}
 
-\item{selector}{[\code{ecr_selector}]\cr
+\item{parent.selector}{[\code{ecr_selector}]\cr
 Selection operator which implements a procedure to copy individuals from a
 given population to the mating pool, i. e., allow them to become parents.}
 
+\item{survival.selector}{[\code{ecr_selector}]\cr
+Selection operator which implements a procedurce to extract individuals from
+a given set, which should survive and set up the next generation.}
+
 \item{generator}{[\code{ecr_generator}]\cr
 Generator operator of type \code{ecr_generator} for the generation of the initial
 population.}