Merge branch 'master' of github.com:jakobbossek/ecr

NAMESPACE

@@ -43,12 +43,15 @@ export(makeInversionMutator)
 export(makeMaximumIterationsStoppingCondition)
 export(makeMaximumTimeStoppingCondition)
 export(makeMonitor)
+export(makeMutator)
 export(makeNullMonitor)
 export(makeNullRecombinator)
 export(makePMXRecombinator)
 export(makePermutationGenerator)
+export(makeRecombinator)
 export(makeRouletteWheelSelector)
 export(makeScrambleMutator)
+export(makeSelector)
 export(makeSimpleSelector)
 export(makeStoppingCondition)
 export(makeSwapMutator)

R/generateOffspring.R

@@ -14,22 +14,36 @@ generateOffspring = function(matingPool, objective.fun, control, opt.path) {
   mutationStrategyAdaptor = control$mutationStrategyAdaptor
   mutator.control = control$mutator.control
   recombinator = control$recombinator
+  recombinator.control = control$recombinator.control
   n.offspring = control$n.offspring
 
   offspring = vector("list", n.offspring)
 
-  for (i in seq(n.offspring)) {
-    #catf("Parent %i", i)
+  i.offspring = 1
+  while (i.offspring < n.offspring) {
+    #catf("Parent %i", i.offspring)
     parents = getParents(matingPool)
     #print(parents)
     # pass just the individuals and get a single individual
-    child = recombinator(parents, control)
-    #catf("Child %i", i)
+    child = recombinator(parents, recombinator.control, control)
+    #catf("Child %i", i.offspring)
     #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
+    # mutate the child or children
+    if (isTRUE(attr(child, "children"))) {
+      max.children = min(length(child), n.offspring - i.offspring + 1)
+      for (i.child in seq(max.children)) {
+        # pass just the individual and get a single individual
+        child[[i.child]] = mutator(child[[i.child]], mutator.control, control)
+        offspring[[i.offspring]] = child[[i.child]]
+        i.offspring = i.offspring + 1
+      }
+    } else {
+      # pass just the individual and get a single individual
+      child = mutator(child, mutator.control, control)
+      offspring[[i.offspring]] = child
+      i.offspring = i.offspring + 1
+    }
   }
   #print(offspring)
   offspring.fitness = computeFitness(makePopulation(offspring), objective.fun)

R/makeMutator.R

@@ -1,23 +1,31 @@
-# Helper function which constructs a mutator, i. e., a mutation operator.
-#
-# @param mutator [\code{function}]\cr
-#   Actual mutation operator.
-# @param name [\code{character(1)}]\cr
-#   Name of the mutator.
-# @param description [\code{character(1)}]\cr
-#   Short description of how the mutator works.
-# @param supported [\code{character}]\cr
-#   Vector of strings/names of supported parameter representations. For example
-#   'permutation', 'float', 'binary'.
-# @param checker [\code{function}]\cr
-#   Check object, which performs a sanity check in mutator strategy parameters
-#   passed to the control object.
-# @return [\code{ecr_mutator}]
-#   Mutator object.
-makeMutator = function(mutator, name, description,
-  supported = getAvailableRepresentations(),
-  defaults = list(),
-  checker = function(operator.control) TRUE) {
+#' @title 
+#'   Construct a mutation operator
+#' @description
+#'   Helper function which constructs a mutator, i.e., a mutation operator.
+#'   
+#' @param mutator [\code{function}]\cr
+#'   Actual mutation operator.
+#' @param name [\code{character(1)}]\cr
+#'   Name of the mutator.
+#' @param description [\code{character(1)}]\cr
+#'   Short description of how the mutator works.
+#' @param supported [\code{character}]\cr
+#'   Vector of strings/names of supported parameter representations. Possible are
+#'   'permutation', 'binary', 'float', 'custom'.
+#' @param defaults [\code{list}]\cr
+#'   List of default values for the operators strategy parameters.
+#' @param checker [\code{function}]\cr
+#'   Check object, which performs a sanity check in mutator strategy parameters
+#'   passed to the control object.
+#' @return [\code{ecr_mutator}]
+#'   Mutator object.
+#' @export
+makeMutator = function(mutator, name, description
+                       , supported = getAvailableRepresentations()
+                       , defaults = list()
+                       , checker = function(operator.control) TRUE
+                       ) {
+  # create operator
   mutator = makeOperator(mutator, name, description, supported, defaults, checker)
   mutator = addClasses(mutator, c("ecr_mutator"))
   return(mutator)

R/makeOperator.R

@@ -13,13 +13,14 @@
 #   List of default values for the operators strategy parameters.
 # @return [\code{ecr_operator}]
 #   Operator object.
-makeOperator = function(operator, name, description,
-  supported = getAvailableRepresentations(),
-  defaults = list(),
-  checker = function(operator.control) TRUE) {
+makeOperator = function(operator, name, description
+                        , supported = getAvailableRepresentations()
+                        , defaults = list()
+                        , checker = function(operator.control) TRUE
+                        ) {
   assertFunction(operator)
-  assertCharacter(name, len = 1L, any.missing = FALSE)
-  assertCharacter(description, len = 1L, any.missing = FALSE)
+  assertString(name)
+  assertString(description)
   assertSubset(supported, choices = getAvailableRepresentations(), empty.ok = FALSE)
   assertList(defaults, unique = TRUE, any.missing = FALSE)
   assertFunction(checker, args = "operator.control")

R/makeRecombinator.R

@@ -1,22 +1,33 @@
-# Helper function which constructs a recombinator, i. e., a recombination operator.
-#
-# @param recombinator [\code{function}]\cr
-#   Actual mutation operator.
-# @param name [\code{character(1)}]\cr
-#   Name of the recombinator.
-# @param supported [\code{character}]\cr
-#   Vector of strings/names of supported parameter representations. For example
-#   'permutation', 'float', 'binary'.
-# @param n.parents [\code{integer(1)}]\cr
-#   Number of parents supported.
-# @return [\code{ecr_recombinator}]
-#   Recombinator object.
-makeRecombinator = function(
-  recombinator, name, description,
-  supported = getAvailableRepresentations(),
-  n.parents = 2L,
-  defaults = list(),
-  checker = function(operator.control) TRUE) {
+#' @title
+#'   Construct a recombination operator
+#' @description 
+#'   Helper function which constructs a recombinator, i.e., a recombination operator.
+#'   
+#' @param recombinator [\code{function}]\cr
+#'   Actual mutation operator.
+#' @param name [\code{character(1)}]\cr
+#'   Name of the recombinator.
+#' @param description [\code{character(1)}]\cr
+#'   Short description of how the recombinator works.
+#' @param supported [\code{character}]\cr
+#'   Vector of strings/names of supported parameter representations. For example
+#'   'permutation', 'float', 'binary'.
+#' @param n.parents [\code{integer(1)}]\cr
+#'   Number of parents supported.
+#' @param defaults [\code{list}]\cr
+#'   List of default values for the operators strategy parameters.
+#' @param checker [\code{function}]\cr
+#'   Check object, which performs a sanity check in mutator strategy parameters
+#'   passed to the control object.
+#' @return [\code{ecr_recombinator}]
+#'   Recombinator object.
+#' @export
+makeRecombinator = function(recombinator, name, description
+                            , supported = getAvailableRepresentations()
+                            , n.parents = 2L
+                            , defaults = list()
+                            , checker = function(operator.control) TRUE
+                            ) {
   recombinator = makeOperator(recombinator, name, description, supported, defaults)
 
   assertInteger(n.parents, len = 1L, lower = 2L, any.missing = FALSE)

R/makeSelector.R

@@ -1,28 +1,34 @@
-# Helper function which defines a selector method, i. e., an operator which
-# takes the population return a part of it for mating.
-#
-# @param selector [\code{function}]\cr
-#   Actual selection operator.
-# @param name [\code{character(1)}]\cr
-#   Name of the selector.
-# @param description [\code{character(1)}]\cr
-#   Short description of how the selector works.
-# @param supported [\code{character}]\cr
-#   Vector of strings/names of supported parameter representations. For example
-#   'permutation', 'float', 'binary'.
-# @param supported.objectives [\code{character}]\cr
-#   At least one of \dQuote{single-objective} or \dQuote{multi-objective}.
-# @return [\code{ecr_selector}]
-#   selector object.
-makeSelector = function(
-  selector,
-  name, description,
-  supported = getAvailableRepresentations(),
-  supported.objectives) {
+#' @title
+#'   Construct a selection operator
+#' @description 
+#'   Helper function which defines a selector method, i.e., an operator which
+#'   takes the population return a part of it for mating.
+#'
+#' @param selector [\code{function}]\cr
+#'   Actual selection operator.
+#' @param name [\code{character(1)}]\cr
+#'   Name of the selector.
+#' @param description [\code{character(1)}]\cr
+#'   Short description of how the selector works.
+#' @param supported [\code{character}]\cr
+#'   Vector of strings/names of supported parameter representations. For example
+#'   'permutation', 'float', 'binary'.
+#' @param supported.objectives [\code{character}]\cr
+#'   At least one of \dQuote{single-objective} or \dQuote{multi-objective}.
+#' @return [\code{ecr_selector}]
+#'   selector object.
+#' @export
+makeSelector = function(selector, name, description
+                        , supported = getAvailableRepresentations()
+                        , supported.objectives
+                        ) {
+  # argument check
   assertFunction(selector, args = c("population", "n.select", "control"), ordered = TRUE)
   assertSubset(supported.objectives, c("single-objective", "multi-objective"))
+
   selector = makeOperator(selector, name, description, supported)
   selector = setAttribute(selector, "supported.objectives", supported.objectives)
   selector = addClasses(selector, c("ecr_selector"))
+
   return(selector)
 }

R/mutator.bitflip.R

@@ -6,7 +6,7 @@
 #' @export
 makeBitFlipMutator = function(mutator.flip.prob = 0.1) {
   mutatorCheck = function(operator.control) {
-    assertNumber(operator.control$mutator.flip.pro, lower = 0.000001, upper = 0.999999, na.ok = FALSE)
+    assertNumber(operator.control$mutator.flip.prob, lower = 0.000001, upper = 0.999999, na.ok = FALSE)
   }
 
   force(mutator.flip.prob)
@@ -22,7 +22,7 @@ makeBitFlipMutator = function(mutator.flip.prob = 0.1) {
 
   makeMutator(
     mutator = mutator,
-    name = "Bitplip mutator",
+    name = "Bitflip mutator",
     description = "Flips each bit of the allele with a specific probability.",
     supported = "binary",
     defaults = defaults,

R/recombinator.crossover.R

@@ -1,9 +1,21 @@
 #' Generator of the One-point crossover recombination operator.
 #'
+#' @param recombinator.crossover.prob [\code{numeric(1)}]\cr
+#'   Cross over probability to form an offspring. Default is \code{1}.
 #' @return [\code{ecr_recombinator}]
 #' @export
-makeCrossoverRecombinator = function() {
-  recombinator = function(inds, control = list()) {
+makeCrossoverRecombinator = function(recombinator.crossover.prob = 1) {
+  recombinatorCheck = function(operator.control) {
+    assertNumber(operator.control$recombinator.crossover.prob
+                 , lower = 0, upper = 1, na.ok = FALSE
+    )
+  }
+
+  force(recombinator.crossover.prob)
+  defaults = list(recombinator.crossover.prob = recombinator.crossover.prob)
+  recombinatorCheck(defaults)
+
+  recombinator = function(inds, args = defaults, control = list()) {
     parent1 = inds[[1]]
     parent2 = inds[[2]]
     n = length(parent1)
@@ -12,21 +24,28 @@ makeCrossoverRecombinator = function() {
     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
     child2 = parent2
-    child1[(idx + 1L):n] = parent2[(idx + 1L):n]
-    child2[1:idx] = parent1[1:idx]
-    #FIXME: here we just return one offspring for now
-    return(child1)
+    do.recombinate = runif(1L) < args$recombinator.crossover.prob
+    if (do.recombinate) {
+      idx = sample(1:(n - 1), size = 1L)
+      child1[(idx + 1L):n] = parent2[(idx + 1L):n]
+      child2[1:idx] = parent1[1:idx]
+    }
+    # return two offsprings
+    children = list(child1, child2)
+    attr(children, "children") = TRUE
+    return(children)
   }
 
   makeRecombinator(
     recombinator = recombinator,
     name = "Crossover recombinator",
     description = "Performs classical one-point crossover.",
     n.parents = 2L,
-    supported = c("float", "binary")
+    supported = c("float", "binary"),
+    defaults = defaults,
+    checker = recombinatorCheck
   )
 }

R/recombinator.intermediate.R

@@ -3,7 +3,7 @@
 #' @return [\code{ecr_recombinator}]
 #' @export
 makeIntermediateRecombinator = function() {
-  recombinator = function(inds, control = list()) {
+  recombinator = function(inds, args = list(), control = list()) {
     n = length(inds[[1]])
     child = rep(0, n)
     for (i in 1:length(inds)) {

R/recombinator.null.R

@@ -3,7 +3,7 @@
 #' @return [\code{ecr_recombinator}]
 #' @export
 makeNullRecombinator = function() {
-  recombinator = function(inds, control=list()) {
+  recombinator = function(inds, args = list(), control=list()) {
     return(inds[[1L]])
   }
 

R/recombinator.pmx.R

@@ -8,7 +8,7 @@
 #' @return [\code{ecr_recombinator}]
 #' @export
 makePMXRecombinator = function() {
-  recombinator = function(inds, control = list()) {
+  recombinator = function(inds, args = list(), control = list()) {
     p1 = inds[[1]]
     p2 = inds[[2]]
     n = length(p1)
@@ -51,8 +51,10 @@ makePMXRecombinator = function() {
         c2[i] = ins
       }
     }
-    #FIXME: until now we only allow to return one individual, but we created two
-    return(c1)
+    # return two offsprings
+    children = list(c1, c2)
+    attr(children, "children") = TRUE
+    return(children)
   }
 
   makeRecombinator(

inst/examples/custom_example.R

@@ -65,7 +65,7 @@ myMutator = makeMutator(
 )
 
 myRecombinator = makeRecombinator(
-  recombinator = function(x, control) {
+  recombinator = function(x, args, control) {
     x[[1]]
   },
   name = "Convex-Combination recombinator",

man/makeCrossoverRecombinator.Rd

@@ -4,7 +4,11 @@
 \alias{makeCrossoverRecombinator}
 \title{Generator of the One-point crossover recombination operator.}
 \usage{
-makeCrossoverRecombinator()
+makeCrossoverRecombinator(recombinator.crossover.prob = 1)
+}
+\arguments{
+\item{recombinator.crossover.prob}{[\code{numeric(1)}]\cr
+Cross over probability to form an offspring. Default is \code{1}.}
 }
 \value{
 [\code{ecr_recombinator}]