R/core.EAOperators.R

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

EAOperator = R6Class("EAOperator",
  public = list(
    name = NULL,
    params = NULL,
    default.params = NULL,
    fun = NULL,
    representations = NULL,

    initialize = function(name, params = list(), fun, representations) {
      checkmate::assertString(name)
      checkmate::assertList(params, min.len = 0L)
      checkmate::assertFunction(fun)
      checkmate::assertSubset(representations, choices = c("binary", "real", "permutation", "custom"))
      self$name = name
      self$params = params
      self$default.params = params
      self$fun = fun
      self$representations = representations
      return(invisible(self))
    },

    getName = function() {
      self$name
    },

    hasSupportFor = function(representation) {
      representation %in% self$representations
    },

    getSupportedRepresentations = function() {
      self$representations
    },

    getParameters = function(to.string = FALSE) {
      if (!to.string)
        return(self$params)
      pns = names(self$params)
      vals = unname(unlist(self$params))
      BBmisc::collapse(paste(pns, vals, sep = "="), sep = ", ")
    },

    getDefaultParameters = function(to.string = FALSE) {
      self$default.params
    },

    setParameters = function(params) {
      checkmate::assertList(params, min.len = 0L)
      self$params = BBmisc::insert(self$params, params)
      return(invisible(self))
    },

    resetParameters = function() {
      self$params = self$default.params
      return(invisible(self))
    },

    run = function(x = NULL, ...) {
      # Combine stored parameters and passed parameters
      final.params = BBmisc::insert(self$getParameters(), list(...))
      #BBmisc::catf("Applying %s with stored params %s and final params %s.", self$getName(), self$getParameters(TRUE), collapse(paste(names(final.params), unname(unlist(final.params)), sep = "="), sep = ", "))
      # Generators do not require a first argument
      x = if (is.null(x)) list() else list(x)
      # finally call the runner
      do.call(self$fun, c(x, final.params))
    }
  ) # public
) # EAOperator

EAMutator = R6Class("EAMutator",
  inherit = EAOperator,
  public = list() # public
) # EAMutator

EARecombinator = R6Class("EARecombinator",
  inherit = EAOperator,
  public = list(
    n.parents = NULL,
    n.children = NULL,
    initialize = function(name, params = list(), fun, representations, n.parents, n.children) {
      super$initialize(name, params, fun, representations)

      self$n.parents = checkmate::asCount(n.parents, positive = TRUE)
      self$n.children = checkmate::asCount(n.children, positive = TRUE)
      return(invisible(self))
    },

    getNumberOfParentsNeededForMating = function() {
      self$n.parents
    },

    getNumberOfChildren = function() {
      self$n.children
    }
  ) # public
) # EARecombinator

EASelector = R6Class("EASelector",
  inherit = EAOperator,
  public = list(
    minimize = NULL,
    setting = NULL,
    direction = NULL,

    initialize = function(name, params = list(), fun, minimize, setting, direction) {
      super$initialize(name, params, fun, representations = c("binary", "real", "permutation", "custom"))
      checkmate::assertFlag(minimize)
      checkmate::assertSubset(setting, choices = c("single", "multi"), empty.ok = FALSE)
      checkmate::assertChoice(direction, choices = c("minimize", "maximize"))
      self$minimize = minimize
      self$setting = setting
      self$direction = direction
      return(invisible(self))
    },

    requiresMinimization = function() {
      self$minimize
    },

    hasSupportForObjectives = function(obj) {
      (obj == 1L && self$isForSingleObjectiveSetting()) || (obj >= 2L && self$isForMultiObjectiveSetting())
    },

    isForSingleObjectiveSetting = function() {
      "single" %in% self$setting
    },

    isForMultiObjectiveSetting = function() {
      "multi" %in% self$setting
    },

    getDirection = function() {
      self$direction
    },

    getSetting = function() {
      if (length(self$setting) == 2L) {
        sprintf("{%s}-objective", collapse(self$setting, sep = ", "))
      } else {
        sprintf("%s-objective", self$setting)
      }
    }
  ) # public
) # EASelector

EAGenerator = R6Class("EAGenerator",
  inherit = EAOperator,
  list() # public
) # EAGenerator

EATerminator = R6Class("EATerminator",
  inherit = EAOperator,
  public = list(
    message = NULL,
    setting = "single",

    initialize = function(name, params, fun, message, setting = c("single", "multi")) {
      checkmate::assertString(message)
      checkmate::assertFunction(fun, args = "logbook")
      checkmate::assertSubset(setting, choices = c("single", "multi"))
      super$initialize(name, params, fun, representations = c("binary", "real", "permutation", "custom"))
      self$message = message
      self$setting = setting
      return(invisible(TRUE))
    },

    shouldStop = function(logbook) {
      args = c(list(logbook = logbook), self$params)
      do.call(self$fun, args)
    },

    getMessage = function() {
      self$message
    }
  ) # public
) # EATerminator