overwork operator interface

NAMESPACE

@@ -8,31 +8,31 @@ S3method(getSupportedRepresentations,ecr_operator)
 S3method(is.supported,ecr_operator)
 S3method(print,ecr_control)
 S3method(print,ecr_result)
-export(bitflipMutator)
-export(crossoverRecombinator)
 export(ecr)
 export(ecr.control)
-export(gaussMutator)
 export(getBestIndividual)
 export(getOperatorCheckFunction)
 export(getOperatorDefaultParameters)
 export(getOperatorName)
 export(getSupportedRepresentations)
-export(intermediateRecombinator)
 export(is.supported)
 export(isEcrOperator)
 export(makeBinaryGenerator)
+export(makeBitFlipMutator)
 export(makeConsoleMonitor)
+export(makeCrossoverRecombinator)
+export(makeGaussMutator)
+export(makeIntermediateRecombinator)
 export(makeMaximumIterationsStoppingCondition)
 export(makeMaximumTimeStoppingCondition)
 export(makeMonitor)
 export(makeNullMonitor)
+export(makeNullRecombinator)
 export(makePermutationGenerator)
 export(makeStoppingCondition)
+export(makeSwapMutator)
 export(makeUniformGenerator)
-export(nullRecombinator)
 export(setupStoppingConditions)
-export(swapMutator)
 import(BBmisc)
 import(ParamHelpers)
 import(checkmate)

R/checkOperator.R

@@ -7,12 +7,12 @@ checkOperator = function(operator) {
   assertCharacter(attr(operator, "name"), len = 1L, any.missing = FALSE)
   assertCharacter(attr(operator, "description"), len = 1L, any.missing = FALSE)
   assertCharacter(attr(operator, "supported"), min.len = 1L, any.missing = FALSE)
+  assertList(attr(operator, "defaults"), any.missing = FALSE)
 }
 
 checkMutator = function(mutator) {
   checkOperator(mutator)
   assertClass(mutator, "ecr_mutator")
-  assertList(attr(mutator, "defaults"), any.missing = FALSE)
 }
 
 checkRecombinator = function(recombinator) {

R/ecrControl.R

@@ -62,8 +62,8 @@ ecr.control = function(
   save.population.at = integer(0),
   mating.pool.generator = simpleMatingPoolGenerator,
   generator = makeUniformGenerator(),
-  mutator = list(gaussMutator),
-  recombinator = intermediateRecombinator,
+  mutator = list(makeGaussMutator()),
+  recombinator = makeIntermediateRecombinator(),
   mutator.control = list(),
   recombinator.control = list(),
   monitor = makeConsoleMonitor(),

R/generator.random.binary.R

@@ -26,6 +26,7 @@ makeBinaryGenerator = function() {
   operator = makeOperator(
     operator = generateBinaryPopulation,
     name = "Binary generator",
+    description = "Samples uniformally distributed 0, 1 values.",
     supported = c("binary")
   )
   operator = addClasses(operator, c("ecr_generator"))

R/generator.random.permutation.R

@@ -29,6 +29,7 @@ makePermutationGenerator = function() {
   operator = makeOperator(
     operator = generatePermutationPopulation,
     name = "Permutation generator",
+    description = "Generates random permutations.",
     supported = c("permutation")
   )
   operator = addClasses(operator, c("ecr_generator"))

R/generator.uniform.float.R

@@ -29,7 +29,8 @@ makeUniformGenerator = function() {
   operator = makeOperator(
     operator = generateUniformPopulation,
     name = "Uniform generator",
-    supported = c("float")
+    description = "Samples uniformally distributed points in the design space.",
+    supported = "float"
   )
   operator = addClasses(operator, c("ecr_generator"))
   return(operator)

R/getOperatorCheckFunction.R

@@ -11,5 +11,5 @@ getOperatorCheckFunction = function(operator) {
 
 #' @export
 getOperatorCheckFunction.ecr_operator = function(operator) {
-  attr(operator, "checkFunction")
+  attr(operator, "checker")
 }

R/makeMutator.R

@@ -4,13 +4,21 @@
 #   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, supported = getAvailableRepresentations()) {
-  mutator = makeOperator(mutator, name, supported)
+makeMutator = function(mutator, name, description,
+  supported = getAvailableRepresentations(),
+  defaults = list(),
+  checker = function(operator.control) TRUE) {
+  mutator = makeOperator(mutator, name, description, supported, defaults, checker)
   mutator = addClasses(mutator, c("ecr_mutator"))
   return(mutator)
 }

R/makeOperator.R

@@ -4,18 +4,31 @@
 #   Actual mutation operator.
 # @param name [\code{character(1)}]\cr
 #   Name of the operator.
+# @param description [\code{character(1)}]\cr
+#   Short description of how the mutator works.
 # @param supported [\code{character}]\cr
 #   Vector of names of supported parameter representations. For example
 #   'permutation', 'float', 'binary'.
+# @param defaults [\code{list}]\cr
+#   List of default values for the operators strategy parameters.
 # @return [\code{ecr_operator}]
 #   Operator object.
-makeOperator = function(operator, name, supported = getAvailableRepresentations()) {
+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)
   assertSubset(supported, choices = getAvailableRepresentations(), empty.ok = FALSE)
+  assertList(defaults, unique = TRUE, any.missing = FALSE)
+  assertFunction(checker, args = "operator.control")
 
   attr(operator, "name") = name
+  attr(operator, "description") = description
   attr(operator, "supported") = supported
+  attr(operator, "defaults") = defaults
+  attr(operator, "checker") = checker
 
   operator = addClasses(operator, c("ecr_operator"))
   return(operator)

R/makeRecombinator.R

@@ -12,12 +12,17 @@
 # @return [\code{ecr_recombinator}]
 #   Recombinator object.
 makeRecombinator = function(
-  recombinator, name,
+  recombinator, name, description,
   supported = getAvailableRepresentations(),
-  n.parents = 2L) {
+  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)
-  recombinator = makeOperator(recombinator, name, supported)
   attr(recombinator, "n.parents") = n.parents
+
   recombinator = addClasses(recombinator, c("ecr_recombinator"))
+
   return(recombinator)
 }

R/mutator.bitflip.R

@@ -1,31 +1,35 @@
 #' Bitplip mutation operator.
 #'
-#' @param setOfIndividuals [\code{setOfIndividuals}]\cr
-#'   Set of individuals.
-#' @param control [\code{list}]\cr
-#'   Not used.
-#' @return [\code{setOfIndividuals}]
-#'   Set of individuals.
+#' @param mutator.flip.prob [\code{numeric(1)}]\cr
+#'   Probability to flip a single bit. Default is \code{0.1}.
+#' @return [\code{ecr_mutator}]
 #' @export
-bitflipMutator = function(setOfIndividuals, control) {
-  n.params = ncol(setOfIndividuals$individuals)
-  n = nrow(setOfIndividuals$individuals)
-
-  for (i in seq(n)) {
-    do.mutate = runif(n.params) < control$mutator.flip.prob
-    setOfIndividuals$individuals[i, do.mutate] = 1 - setOfIndividuals$individuals[i, do.mutate]
+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)
   }
-  return(setOfIndividuals)
-}
 
-attr(bitflipMutator, "name") = "Bitplip mutator"
-attr(bitflipMutator, "description") = "Flips each bit of the allele with a specific probability."
-attr(bitflipMutator, "supported") = c("binary")
-attr(bitflipMutator, "class") = c("ecr_operator", "ecr_mutator")
-attr(bitflipMutator, "defaults") = list(mutator.flip.prob = 1 / 10)
+  force(mutator.flip.prob)
+  defaults = list(mutator.flip.prob = mutator.flip.prob)
+  mutatorCheck(defaults)
 
-bitflipMutatorCheck = function(operator.control) {
-  assertNumber(operator.control$mutator.flip.pro, lower = 0.000001, upper = 0.999999, na.ok = FALSE)
-}
+  mutator = function(setOfIndividuals, control = defaults) {
+    n.params = ncol(setOfIndividuals$individuals)
+    n = nrow(setOfIndividuals$individuals)
 
-attr(bitflipMutator, "checkFunction") = bitflipMutator
+    for (i in seq(n)) {
+      do.mutate = runif(n.params) < control$mutator.flip.prob
+      setOfIndividuals$individuals[i, do.mutate] = 1 - setOfIndividuals$individuals[i, do.mutate]
+    }
+    return(setOfIndividuals)
+  }
+
+  makeMutator(
+    mutator = mutator,
+    name = "Bitplip mutator",
+    description = "Flips each bit of the allele with a specific probability.",
+    supported = "binary",
+    defaults = defaults,
+    checker = mutatorCheck
+  )
+}

R/mutator.gauss.R

@@ -1,40 +1,44 @@
 #' Generator of the Gauss mutation operator.
 #'
 #' Default Gauss mutation operator known from Evolutionary Algorithms.
-#' @param setOfIndividuals [\code{setOfIndividuals}]\cr
-#'   Set of individuals.
-#' @param control [\code{list}]\cr
-#'   List containing evolutionary operators for fine-tuning the mutation operator.
-#'   The \code{gaussMutator} function expects the two values:
-#'   \itemize{
-#'     \item{mutator.gauss.prob [\code{numeric(1)}]}{Probability of mutation for the gauss mutation operator.}
-#'     \item{mutator.gauss.sd [\code{numeric(1)}}{Standard deviance of the Gauss mutation, i. e., the mutation strength.}
-#'   }
-#' @return [\code{setOfIndividuals}]
-#'   Set of individuals.
+#'
+#' @param mutator.gauss.prob [\code{numeric(1)}]\cr
+#'   Probability of mutation for the gauss mutation operator.
+#' @param mutator.gauss.sd [\code{numeric(1)}\cr
+#'   Standard deviance of the Gauss mutation, i. e., the mutation strength.
+#' @return [\code{ecr_mutator}]
 #' @export
-gaussMutator = function(setOfIndividuals, control = list(mutator.gauss.prob = 1, mutator.gauss.sd = 0.05)) {
-  n.params = ncol(setOfIndividuals$individuals)
-  n = nrow(setOfIndividuals$individuals)
+makeGaussMutator = function(mutator.gauss.prob = 1L, mutator.gauss.sd = 0.05) {
+  force(mutator.gauss.prob)
+  force(mutator.gauss.sd)
 
-  mutation.bool = matrix(runif(n * n.params) < control$mutator.gauss.prob, ncol = n.params)
-  mutation = matrix(0, ncol = n.params, nrow = n)
-  idx = which(mutation.bool)
-  mutation[idx] = rnorm(length(idx), mean = 0, sd = control$mutator.gauss.sd)
-  setOfIndividuals$individuals = setOfIndividuals$individuals + mutation
+  mutatorCheck = function(operator.control) {
+    assertNumber(operator.control$mutator.gauss.prob, lower = 0, finite = TRUE, na.ok = FALSE)
+    assertNumber(operator.control$mutator.gauss.sd, lower = 0, finite = TRUE, na.ok = FALSE)
+  }
 
-  return(setOfIndividuals)
-}
+  defaults = list(mutator.gauss.prob = mutator.gauss.prob, mutator.gauss.sd = mutator.gauss.sd)
+  mutatorCheck(defaults)
 
-attr(gaussMutator, "name") = "Gauss mutator"
-attr(gaussMutator, "description") = "Adds gaussian noise to each gene"
-attr(gaussMutator, "supported") = c("float")
-attr(gaussMutator, "class") = c("ecr_operator", "ecr_mutator")
-attr(gaussMutator, "defaults") = list(mutator.gauss.prob = 1, mutator.gauss.sd = 0.05)
+  mutator = function(setOfIndividuals, control = defaults) {
+    n.params = ncol(setOfIndividuals$individuals)
+    n = nrow(setOfIndividuals$individuals)
 
-gaussMutatorCheck = function(operator.control) {
-  assertNumber(operator.control$mutator.gauss.prob, lower = 0, finite = TRUE, na.ok = FALSE)
-  assertNumber(operator.control$mutator.gauss.sd, lower = 0, finite = TRUE, na.ok = FALSE)
-}
+    mutation.bool = matrix(runif(n * n.params) < control$mutator.gauss.prob, ncol = n.params)
+    mutation = matrix(0, ncol = n.params, nrow = n)
+    idx = which(mutation.bool)
+    mutation[idx] = rnorm(length(idx), mean = 0, sd = control$mutator.gauss.sd)
+    setOfIndividuals$individuals = setOfIndividuals$individuals + mutation
 
-attr(gaussMutator, "checkFunction") = gaussMutatorCheck
+    return(setOfIndividuals)
+  }
+
+  makeMutator(
+    mutator = mutator,
+    name = "Gauss mutator",
+    description = "Adds gaussian noise to each gene",
+    supported = "float",
+    defaults = defaults,
+    checker = mutatorCheck
+  )
+}

R/mutator.swap.R

@@ -1,34 +1,28 @@
 #' Swap mutation operator.
 #'
-#' @param setOfIndividuals [\code{setOfIndividuals}]\cr
-#'   Set of individuals.
-#' @param control [\code{list}]\cr
-#'   Not used.
-#' @return [\code{setOfIndividuals}]
-#'   Set of individuals.
+#' @return [\code{ecr_mutator}]
 #' @export
-swapMutator = function(setOfIndividuals, control = list()) {
-  n.params = ncol(setOfIndividuals$individuals)
-  n = nrow(setOfIndividuals$individuals)
+makeSwapMutator = function() {
+  mutator = function(setOfIndividuals, control = list()) {
+    n.params = ncol(setOfIndividuals$individuals)
+    n = nrow(setOfIndividuals$individuals)
 
-  for (i in seq(n)) {
-    pos = sample(1:n.params, size = 2)
-    pos1 = pos[1]
-    pos2 = pos[2]
-    #catf("Positions: %i, %i", pos1, pos2)
-    tmp = setOfIndividuals$individuals[i, pos1]
-    setOfIndividuals$individuals[i, pos1] = setOfIndividuals$individuals[i, pos2]
-    setOfIndividuals$individuals[i, pos2] = tmp
+    for (i in seq(n)) {
+      pos = sample(1:n.params, size = 2)
+      pos1 = pos[1]
+      pos2 = pos[2]
+      #catf("Positions: %i, %i", pos1, pos2)
+      tmp = setOfIndividuals$individuals[i, pos1]
+      setOfIndividuals$individuals[i, pos1] = setOfIndividuals$individuals[i, pos2]
+      setOfIndividuals$individuals[i, pos2] = tmp
+    }
+    return(setOfIndividuals)
   }
-  return(setOfIndividuals)
-}
-
-attr(swapMutator, "name") = "Swap mutator"
-attr(swapMutator, "description") = "Swaps two alleles"
-attr(swapMutator, "supported") = c("permutation")
-attr(swapMutator, "class") = c("ecr_operator", "ecr_mutator")
-attr(swapMutator, "defaults") = list()
 
-swapMutatorCheck = function(operator.control) {}
-
-attr(swapMutator, "checkFunction") = swapMutatorCheck
+  makeMutator(
+    mutator = mutator,
+    name = "Swap mutator",
+    description = "Swaps two alleles",
+    supported = "permutation",
+  )
+}