R/core.EATerminator.R

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

#' @title
#' Stopping conditions
#'
#' @description
#' Stop the EA after a fixed number of fitness function evaluations, after
#' a predefined number of generations/iterations, a given cutoff time or
#' if the known optimal function value is approximated (only for single-objective optimization).
#'
#' @param max.evals [\code{integer(1)}]\cr
#'   Maximal number of function evaluations.
#'   Default is \code{Inf}.
#' @param max.iter [\code{integer(1)}]\cr
#'   Maximal number of iterations/generations.
#'   Default is \code{Inf}.
#' @param max.time [\code{integer(1)}]\cr
#'   Time limit in seconds.
#'   Default is \code{Inf}.
#' @param opt.y [\code{numeric(1)}]\cr
#'   Optimal scalar fitness function value.
#' @param eps [\code{numeric(1)}]\cr
#'   Stop if absolute deviation from \code{opt.y} is lower than \code{eps}.
#' @return [\code{ecr_terminator}]
#' @family stopping conditions
#' @rdname stoppingConditions
#' @name stoppingConditions
#' @export
EATerminatorIterations = function(max.iter) {
  EATerminator$new(
    name = "Terminator (generations)",
    params = list(max.iter = max.iter),
    message = sprintf("Finished after %i function evaluations.", max.iter),
    fun = function(logbook, max.iter) {
      return (logbook$gen > max.iter)
    }
  )
} # EATerminatorGens

EATerminatorStagnation = function(limit, measure) {
  EATerminator$new(
    name = "Terminator (stagnation)",
    params = list(limit = limit, measure = measure),
    message = sprintf("Finished due to stagnation of measure '%s' in %i iterations/generations.", limit),
    fun = function(logbook, limit, measure) {
      # Compare last two entries
      #print(log$logbook)
      improved = logbook$logbook[logbook$gen, measure] > logbook$logbook[logbook$gen - 1L, measure]
      if (improved)
        self$params$counter = 0L
      else
        self$params$counter = self$params$counter + 1L

      return(self$params$counter >= self$params$limit)
    }
  )
} # EATerminatorStagnation
EATerminatorEvaluations = function(max.evals) {
  force(max.evals)
  checkmate::assertInt(max.evals, lower = 1L, na.ok = FALSE)
  EATerminator$new(
    name = "Terminator (evaluations)",
    params = list(max.evals = max.evals),
    message = sprintf("Maximum number of %i objective function evaluations reached.", max.evals),
    fun = function(logbook, max.evals) {
      return(logbook$evals >= max.evals)
    }
  )
} # EATerminatorEvaluations

#' @rdname stoppingConditions
#' @export
# FIXME: this is meaningful for single-objective optimization only!
EATerminatorOptY = function(opt.y, eps) {
  checkmate::assertNumber(eps, lower = 0)
  checkmate::assertNumber(opt.y)

  EATerminator$new(
    name = "Terminator (opt-y)",
    params = list(opt.y = opt.y, eps = eps),
    message = sprintf("Best function value close to optimum, i.e., |y_OPT - y_EA| < %.5f.", opt.y),
    fun = function(logbook, opt.y, eps) {
      stats = logbook$stats
      cur.it = logbook$cur.line
      # FIXME: actually we need to check the incumbant stored in logger only. Way easier!
      if (!("y.min" %in% names(stats))) {
        BBmisc::warningf("[ecr3] EATerminatorOptY: Needs column 'y.min' in log. Not found!")
        return(FALSE)
      }
      return(abs(stats[cur.it, "y.min"] - opt.y) < eps)
    },
    # only meaningful in single-objective optimization
    setting = "single"
  )
} # EATerminatorOptY

#' @rdname stoppingConditions
#' @export
EATerminatorTime = function(max.time) {
  checkmate::assertInt(max.time, lower = 1L, na.ok = FALSE)

  EATerminator$new(
    name = "Terminator (time limit)",
    params = list(max.time = max.time),
    message = sprintf("Time limit reached: '%s' [seconds]", max.time),
    fun = function(logbook, max.time) {
      return(logbook$time.passed >= max.time)
    }
  )
} # EATerminatorTime