R/paretoArchive.R

In ecr: Evolutionary Computation in R

#' @title
#' Initialize Pareto Archive.
#'
#' @description A Pareto archive is usually used to store all / a part of the
#' non-dominated points stored during a run of an multi-objective evolutionary
#' algorithm.
#'
#' @template arg_control
#' @param max.size [\code{integer(1)}]\cr
#'   Maximum capacity of the Pareto archive, i.e., the maximal number of non-dominated
#'   points which can be stored in the archive. Default is \code{Inf}, i.e., (theoretically)
#'   unbounded capacity.
#' @param trunc.fun [\code{function(archive, inds, fitness, ...)}]\cr
#'   In case the archive is limited in capacity, i.e., \code{max.size} is not infinite,
#'   this function is called internally if an archive overflow occurs. This function
#'   expects the \code{archive}, a list of individuals \code{inds}, a matrix of fitness
#'   values (each column contains the fitness value(s) of one individual) \code{fitness}
#'   and further optional arguments \code{...} which may be used by the internals
#'   of \code{trunc.fun}. The function must return a list with components \dQuote{fitness}
#'   and \dQuote{inds} which shall be the subsets of \code{fitness} and \code{inds}
#'   respectively, which should be kept by the archive.
#' @return [\code{ecr_pareto_archive}]
#' @family ParetoArchive
#' @export
initParetoArchive = function(control, max.size = Inf, trunc.fun = NULL) {
  assertClass(control, "ecr_control")

  if (!is.infinite(max.size)) {
    max.size = asInt(max.size, lower = 1L)
    if (is.null(trunc.fun))
      stopf("Bounded Pareto archive needs a truncation function (trunc.fun) in order to decide
        which elements to drop from the archive if it is overflowing.")
    assertFunction(trunc.fun, args = c("inds", "fitness", "max.size"), ordered = TRUE)
  } else {
    if (!is.null(trunc.fun)) {
      warningf("Truncation function (trunc.fun) will be ignored, since the Pareto archive is not
        bounded.")
    }
  }

  env = new.env()
  env$task = control$task
  env$size = 0L
  env$max.size = max.size
  env$trunc.fun = trunc.fun
  env$minimize = control$task$minimize
  env$fitness = matrix(nrow = control$task$n.objectives, ncol = 0L)
  env$individuals = list()

  makeS3Obj("ecr_pareto_archive", env = env)
}

#' @title Update Pareto Archive.
#'
#' @description This function updates a Pareto archive, i.e., an archive of non-dominated
#' points. It expects the archive, a set of individuals, a matrix of fitness values
#' (each column corresponds to the fitness vector of one individual) and updates
#' the archive \dQuote{in-place}. If the archive has unlimited capacity all non-dominated points of
#' the union of archive and passed individuals are stored. Otherwise, i.e., in case
#' the archive is limited in capacity (argument \code{max.size} of
#' \code{\link{initParetoArchive}} was set to an integer value greater zero), the
#' \code{trunc.fun} function passed to \code{\link{initParetoArchive}} is applied to
#' all non-dominated points to determine which points should be dropped.
#'
#' @param archive [\code{ecr_pareto_archive}]\cr
#'   The archive generated by \code{\link{initParetoArchive}}.
#' @param inds [\code{list}]\cr
#'   List of individuals.
#' @param fitness [\code{matrix}]\cr
#'   Matrix of fitness values (each column contains the fitness value(s) for
#'   one individual) of \code{inds}.
#' @param ... [any]\cr
#'   Furhter arguments passed down to \code{trunc.fun} (set via \code{\link{initParetoArchive}}).
#' @family ParetoArchive
#' @export
updateParetoArchive = function(archive, inds, fitness, ...) {
  assertList(inds)
  assertMatrix(fitness, nrows = nrow(archive$env$fitness))
  n = archive$env$size

  # get union of fitness values
  fitness.union = cbind(archive$env$fitness, fitness)
  # What follows is an ugly hack to make transformFitness work
  # ===
  # Here we imitate a selector (actual function is irelevant)
  dummy.selector = identity
  # ... and we tell it to support minimization since we used which.nondominated later on
  attr(dummy.selector, "supported.opt.direction") = "minimize"
  fitness.union.transformed = transformFitness(fitness.union, archive$env$task, dummy.selector)

  element.union = c(archive$env$individuals, inds)

  # now determine indizes of non-dominated points
  idx.nondom = if (ncol(fitness.union.transformed) <= 1) 1L else which.nondominated(fitness.union.transformed)

  # use above indizes to select from the original fitness values
  new.fitness = fitness.union[, idx.nondom, drop = FALSE]
  new.individuals = element.union[idx.nondom]

  size = ncol(new.fitness)
  archive$env$size = size

  if (!is.infinite(archive$env$max.size)) {
    if (size > archive$env$max.size) {
      #warningf("Archive overflow! Dropping individuals by means of trunc.fun.")
      trunc.res = archive$env$trunc.fun(new.individuals, new.fitness, archive$env$max.size, ...)
      new.fitness = trunc.res$fitness
      new.individuals = trunc.res$individuals
      archive$env$size = ncol(new.fitness)
    }
  }
  archive$env$fitness = new.fitness
  archive$env$individuals = new.individuals
}