add (1+1) genetic algorithm

NAMESPACE

@@ -76,6 +76,7 @@ export(makeTournamentSelector)
 export(makeUniformGenerator)
 export(makeUniformMutator)
 export(nsga2)
+export(onePlusOneGA)
 export(rescalePoints)
 export(setupECRControl)
 export(setupEvolutionaryOperators)

R/ea.oneplusoneGA.R

@@ -0,0 +1,82 @@
+#' @title
+#' Simple (1 + 1) Genetic Algorithm.
+#'
+#' @description
+#' The simplest evolutionary algorithm one can imagine, namely the (1+1) EA/GA.
+#' Maintains a population of a single individual x and uses just bitplip mutation
+#' to generate a child y (obviously no recombination takes place), i.e., each gene
+#' of x is flipped with probability \code{p} independently. The best individual
+#' survives.
+#' This algorithm is of particular interest in the theory of evolutionary algorithms
+#' and its performance is well understood for different function families.
+#' A lot of interesting results exist.
+#'
+#' @note This helper function hides the regular \pkg{ecr} interface and offers a more
+#' R like interface to a simple evolutionary algorithm which works on binary valued
+#' vectors.
+#'
+#' @keywords optimize
+#'
+#' @template arg_optimization_task
+#' @param p [\code{numeric(1)}]\cr
+#'   Mutation probability for bitplip mutation.
+#'   Default is \eqn{1/n} where n is the length of the gene.
+#' @template arg_max_iter
+#' @template arg_max_evals
+#' @template arg_max_time
+#' @param ... [any]\cr
+#'   Further arguments passed to \code{\link{setupECRControl}}.
+#' @return [\code{ecr_single_objective_result}]
+#' @export
+onePlusOneGA = function(
+  task,
+  p = NULL,
+  max.iter = NULL,
+  max.evals = NULL,
+  max.time = NULL, ...) {
+
+  if (isSmoofFunction(task)) {
+    task = makeOptimizationTask(task)
+  }
+  assertClass(task, "ecr_optimization_task")
+  if (!isSmoofFunction(task$fitness.fun)) {
+    stopf("Objective fun needs to be of type smoof_function.")
+  }
+  if (!isNumeric(task$par.set, include.int = FALSE)) {
+    stopf("(1+1)-GA works for numeric functions only.")
+  }
+
+  if (!is.null(p)) {
+    assertNumber(p, lower = 0, upper = 1, na.ok = FALSE)
+  }
+
+  # get lengths of genome to determine best theoretical mutation probability 1/n
+  par.set = task$par.set
+  n = getParamLengths(par.set)
+
+  # control object
+  ctrl = setupECRControl(
+    n.population = 1L,
+    n.mating.pool = 1L,
+    n.offspring = 1L,
+    survival.strategy = "plus",
+    representation = "binary",
+    stopping.conditions = list(
+      makeMaximumEvaluationsStoppingCondition(max.evals),
+      makeMaximumTimeStoppingCondition(max.time),
+      makeMaximumIterationsStoppingCondition(max.iter)
+    ),
+    ...
+  )
+
+  # operator setup
+  ctrl = setupEvolutionaryOperators(
+    ctrl,
+    parent.selector = makeSimpleSelector(),
+    recombinator = makeNullRecombinator(), # no recombination at all
+    mutator = makeBitFlipMutator(p = coalesce(p, 1.0 / n)),
+    survival.selector = makeGreedySelector()
+  )
+
+  return(doTheEvolution(task, ctrl))
+}

tests/testthat/helper_zzz.R

@@ -1,4 +1,4 @@
-set.seed(1234)
+set.seed(1)
 
 makeOneMinFunction = function(dimensions) {
   assertInteger(dimensions, len = 1L, lower = 2L, upper = 100L)

tests/testthat/test_ea.R

@@ -1,8 +1,21 @@
 context("Single-Objective Algorithms")
 
-test_that("preimplemented EAs work well", {
+test_that("simpleEA work well", {
   fn = makeSphereFunction(2L)
   res = simpleEA(fn, n.population = 30L, max.iter = 30L, monitor = makeNullMonitor())
   expect_is(res, "ecr_single_objective_result")
   expect_true(abs(res$best.value - getGlobalOptimum(fn)$value) < 0.1)
 })
+
+test_that("(1+1) GA works well", {
+  gene.length = 10L
+  fn = makeSingleObjectiveFunction(
+    name = "One-Max",
+    fn = function(x) length(x) - sum(x),
+    par.set = makeNumericParamSet("bin", lower = 0, upper = 1, len = gene.length)
+  )
+  res = onePlusOneGA(fn, max.iter = 100L, monitor = makeNullMonitor())
+  expect_is(res, "ecr_single_objective_result")
+  expect_true(res$best.value == 0)
+  expect_equal(sum(res$best.param), gene.length)
+})