R/operator.EASelectorTournament.R

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

#' @title
#' k-Tournament selector.
#'
#' @description
#' k individuals from the population are chosen randomly and the best one is
#' selected to be included into the mating pool. This process is repeated until
#' the desired number of individuals for the mating pool is reached.
#'
#' @template arg_fitness
#' @template arg_n_select
#' @param k [\code{integer(1)}]\cr
#'   Number of individuals to participate in each tournament. Default is \code{2L}.
#' @return [\code{integer}] Vector of survivor indizes.
#' @family selectors
#' @export
EASelectorTournament = function(k = 3L) {
  EASelector$new(
    name = "Tournament selector",
    params = list(k = k),
    minimize = TRUE,
    setting = "single",
    direction = "minimize",
    fun = function(fitness, size, k = k) {
      #checkmate::assertInt(k, na.ok = FALSE, lower = 2L)
      fitness = as.numeric(fitness)
      pop.idx = seq_along(fitness)
      #FIXME: can do better with apply-family?
      # Something like:
      # competition.idx = sample(pop.idx, size = size * k, replace = TRUE)
      # competition.fitness = matrix(fitness[competition.idx], ncol = size)
      # idx = apply(competition.fitness, 2L, which.min)
      idx = integer(size)
      for (i in seq(size)) {
        # choose k individuals at random ...
        competitor.idx = sample(pop.idx, size = k, replace = TRUE)
        # ... and store the best
        idx[i] = competitor.idx[which.min(fitness[competitor.idx])]
      }
      return(idx)
    }
  )
} # EASelectorTournament


# EASelectorTournament = R6Class("EASelectorTournament", inherit = EASelector,
#   list(
#     name = "Tournament selector",
#     setting = "single",
#     direction = "minimize",
#     apply = function(fitness, size, k = 3L) {
#       checkmate::assertInt(k, na.ok = FALSE, lower = 2L)
#       fitness = as.numeric(fitness)
#       pop.idx = seq_along(fitness)
#       #FIXME: can do better with apply-family?
#       # Something like:
#       # competition.idx = sample(pop.idx, size = size * k, replace = TRUE)
#       # competition.fitness = matrix(fitness[competition.idx], ncol = size)
#       # idx = apply(competition.fitness, 2L, which.min)
#       idx = integer(size)
#       for (i in seq(size)) {
#         # choose k individuals at random ...
#         competitor.idx = sample(pop.idx, size = k, replace = TRUE)
#         # ... and store the best
#         idx[i] = competitor.idx[which.min(fitness[competitor.idx])]
#       }
#       return(idx)
#     }
#   ) # public
# ) # EASelectorTournament