R/core.EA.R

In jakobbossek/ecr3: Evolutionary Computation in R - Version 3

EA = R6Class("EA",
  public = list(
    algo.name = NULL,
    control = NULL,
    genotype = NULL,
    stats = NULL,
    mu = NULL,
    lambda = NULL,
    n.elite = NULL,
    pm = NULL,
    pr = NULL,
    strategy = NULL,
    terminators = NULL,

    # initial population
    initial = NULL,
    wrapper = NULL,

    initialize = function(control, mu, lambda, stats = NULL, strategy = "plus", n.elite = 1L, pm = 1, pr = 0.2, terminators = list(EATerminatorGens$new(100L)), algo.name = "EA", initial = NULL, wrapper = makeIndividual) {
      # FIXME: checks
      # FIXME: add getters/setters
      self$control = control
      self$genotype = control$genotype
      self$stats = stats
      self$mu = mu
      self$lambda = lambda
      self$n.elite = n.elite
      self$pm = pm
      self$pr = pr
      self$strategy = strategy
      self$terminators = terminators
      self$algo.name = algo.name
      self$initial = initial
      self$wrapper = wrapper
    },

    run = function(reps = 1L, ...) {
      # res = future.apply::future_lapply(seq_len(reps), function(run) {
      #   self$run2(...)
      # }, future.stdout = NA)
      #FIXME: traceback messages useless if future is used. Hence, for debugging we stick to lapply.
      res = lapply(seq_len(reps), function(run) {
        lg$info("Starting iteration %i% of %i of algorithm %s.", run, reps, self$algo.name)
        self$run2(...)
      })
      if (reps == 1L)
        return(res[[1L]])
      return(EAResultCollection$new(res))
    },

    run2 = function(...) {
      # generate population
      gen = 1L
      evals = 0L
      stats.record = list()

      # generate population
      lg$debug("Generating population.")
      X = self$control$populate(self$mu, self$initial, self$wrapper)

      lg$debug("Evaluating initial population.")
      X = control$evaluate(X, ...)

      # print(X)
      # print(plotScatter(extractFX(X)))
      # BBmisc::pause()

      # initialize bookkeeping
      log = EALogger$new(self$control, stats = self$stats)
      if (!is.null(self$stats))
        stats.record = self$stats$calculate(X)
      log$update(1L, evals = self$lambda, stats.record = stats.record, X = X)

      # evolutionary loop - do the evolution baby!!!
      t.offspring = 0
      t.evaluate = 0
      t.logging = 0
      t.termination = 0
      t.selection = 0

      repeat {
        lg$debug("Starting iteration/generation %i.", gen)
        # generate offspring individuals
        st = system.time({
        #Y = control$mutate(X, p = self$pm)
        Y = control$generateOffspring(X, size = self$lambda, pr = self$pr, pm = self$pm)
        }, gcFirst = FALSE)
        t.offspring = t.offspring + st[3L]

        st = system.time({
        Y = control$evaluate(Y, ...)
        }, gcFirst = FALSE)
        t.evaluate = t.evaluate + st[3L]

        # survival of the fittest!
        st = system.time({
        X = self$control$selectSurvivors(X, Y, size = self$mu, self$strategy, self$n.elite)
        }, gcFirst = FALSE)
        t.selection = t.selection + st[3L]

        # print(plotScatter(extractFX(X)))
        # BBmisc::pause()

        # show some progress
        if (log$gen %% 100L == 0)
          cat(".")

        # update log
        st = system.time({
        gen = gen + 1L
        if (!is.null(self$stats))
          stats.record = self$stats$calculate(X)
        log$update(gen, evals = self$control$getLastEvaluationCount(), stats.record = stats.record, X = X)
        }, gcFirst = FALSE)
        t.logging = t.logging + st[3L]

        # time to stop?
        st = system.time({
        do.stop = control$shouldStop(log, self$terminators)
        if (length(do.stop)) {
          lg$debug("Stopping condition met: %s", do.stop$message)
          break
        }
        }, gcFirst = FALSE)
        t.termination = t.termination + st[3L]
      }

      lg$info("Terminated successfully after %i iterations (%i f-evaluations).", log$gen, log$evals)
      BBmisc::catf("Offspring  : %.3f", t.offspring)
      BBmisc::catf("Evaluation : %.3f", t.evaluate)
      BBmisc::catf("Selection  : %.3f", t.selection)
      BBmisc::catf("Logging    : %.3f", t.logging)
      BBmisc::catf("Termination: %.3f", t.termination)

      BBmisc::catf("Best x   : %s", BBmisc::collapse(log$incumbant.x, sep = ", "))
      BBmisc::catf("Best f(x): %f", log$incumbant.fx)

      return(EAResult$new(
        X = X,
        control = self$control,
        log = log,
        algo.name = self$algo.name))
    }
  ) # public
) # EA