R/OptimizerBatchLocalSearch.R

In bbotk: Black-Box Optimization Toolkit

#' @title Optimization via Local Search
#'
#' @include Optimizer.R
#' @name mlr_optimizers_local_search
#'
#' @description
#' `OptimizerBatchLocalSearch` class that implements a simple Local Search.
#' Local Search starts by determining the `n_initial_points` initial best points present in the [Archive] of the [OptimInstance].
#' If fewer points than `n_initial_points` are present, additional `initial_random_sample_size` points sampled uniformly at random are evaluated and the best `n_initial_points` initial points are determined.
#'
#' In each iteration, for each of the `n_initial_points` initial best points, `neighbors_per_point` neighbors are generated by local mutation.
#' Local mutation generates a neighbor by sampling a single parameter that is to be mutated and then proceeds as follows: Double parameters ([paradox::p_dbl()]) are mutated via Gaussian mutation (with a prior standardization to `[0, 1]` and retransformation after mutation).
#' Integer parameters ([paradox::p_int()]) undergo the same mutation but are rounded to the closest integer after mutation.
#' Categorical parameters ([paradox::p_fct()] and [paradox::p_lgl()]) are mutated via uniform mutation.
#' Note that parameters that are conditioned on (i.e., they are parents of a [paradox::Condition], see the dependencies of the search space) are not mutated.
#'
#' @templateVar id local_search
#' @template section_dictionary_optimizers
#'
#' @section Parameters:
#' \describe{
#' \item{`n_initial_points`}{`integer(1)`\cr
#'   Size of the set of initial best points which are used as starting points for the Local Search.
#'   Default is `10`.}
#' \item{`initial_random_sample_size`}{`integer(1)`\cr
#'   Number of points that are sampled uniformly at random before the best `n_initial_points` initial points are determined, if fewer points than `n_initial_points` are present in the [Archive] of the [OptimInstance].
#'   Default is `100`.}
#' \item{`neighbors_per_point`}{`integer(1)`\cr
#'   Number of neighboring points to generate for each of the `n_initial_points` best starting points in each iteration.
#'   Default is `100`.}
#' \item{`mutation_sd`}{`numeric(1)`\cr
#'   Standard deviation used to create neighbors during mutation of numeric parameters on the standardized `[0, 1]` scale.
#'   Default is `0.1`.}
#' }
#'
#' @section Archive:
#' The [bbotk::Archive] holds the following additional column that is specific to the algorithm:
#'   * `.point_id` (`integer(1)`)\cr
#'     The id (`1, ..., n_initial_points`) indicating from which of the `n_initial_points` best points the evaluated point was generated from.
#'
#' @template section_progress_bars
#'
#' @export
#' @examples
#' search_space = domain = ps(x = p_dbl(lower = -1, upper = 1))
#'
#' codomain = ps(y = p_dbl(tags = "minimize"))
#'
#' objective_function = function(xs) {
#'   list(y = as.numeric(xs)^2)
#' }
#'
#' objective = ObjectiveRFun$new(
#'  fun = objective_function,
#'  domain = domain,
#'  codomain = codomain)
#'
#' instance = OptimInstanceBatchSingleCrit$new(
#'  objective = objective,
#'  search_space = search_space,
#'  terminator = trm("evals", n_evals = 100))
#'
#' # evaluate an initial sample of 10 points uniformly at random
#' # choose the best 3 points as the initial points
#' # for each of these points generate 10 neighbors
#' # repeat this process
#' optimizer = opt("local_search",
#'   n_initial_points = 3,
#'   initial_random_sample_size = 10,
#'   neighbors_per_point = 10)
#'
#' # modifies the instance by reference
#' optimizer$optimize(instance)
#'
#' # returns best scoring evaluation
#' instance$result
#'
#' # allows access of data.table of full path of all evaluations
#' as.data.table(instance$archive$data)
OptimizerBatchLocalSearch = R6Class("OptimizerBatchLocalSearch",
  inherit = bbotk::OptimizerBatch,
  public = list(

    #' @description
    #' Creates a new instance of this [R6][R6::R6Class] class.
    initialize = function() {
      param_set = ps(
        n_initial_points = p_int(lower = 1L, default = 10L),
        initial_random_sample_size = p_int(lower = 1L, default = 100L),
        neighbors_per_point = p_int(lower = 1L, default = 100L),
        mutation_sd = p_dbl(lower = 0L, default = 0.1)
      )
      param_set$values = list(n_initial_points = 10L, initial_random_sample_size = 100L, neighbors_per_point = 100L, mutation_sd = 0.1)

      super$initialize(
        id = "local_search",
        param_set = param_set,
        param_classes = c("ParamLgl", "ParamInt", "ParamDbl", "ParamFct"),
        properties = c("dependencies", "single-crit"), # NOTE: think about multi-crit version
        label = "Local Search",
        man = "bbotk::mlr_optimizers_local_search"
      )
    }
  ),
  private = list(
    .optimize = function(inst) {
      n_initial_points = self$param_set$values$n_initial_points
      n_initial_points_seq = seq_len(n_initial_points)
      neighbors_per_point = self$param_set$values$neighbors_per_point
      neighbors_per_point_seq = seq_len(neighbors_per_point)
      mutation_sd = self$param_set$values$mutation_sd

      # if fewer than `n_initial_points` points are present in the archive, generate `initial_random_sample_size` points by sampling them uniformly at random and evaluate them
      if (inst$archive$n_evals < n_initial_points) {
        data = generate_design_random(inst$search_space, n = self$param_set$values$initial_random_sample_size)$data
        inst$eval_batch(data)
      }
      points = inst$archive$best(n_select = n_initial_points)[, c(inst$archive$cols_x, inst$archive$cols_y), with = FALSE]

      # we do not mutate parents of conditions
      ids_to_mutate = setdiff(inst$search_space$ids(), unique(inst$search_space$deps$on))
      ids_numeric = intersect(inst$search_space$ids(class = c("ParamDbl", "ParamInt")), ids_to_mutate)
      ids_categorical = intersect(inst$search_space$ids(class = c("ParamLgl", "ParamFct")), ids_to_mutate)
      ids_categorical = intersect(ids_categorical, inst$search_space$ids()[inst$search_space$nlevels > 1L])

      # get the classes of all parameters
      search_space_classes = inst$search_space$class

      # get the bounds of numeric parameters
      search_space_bounds = list(lower = inst$search_space$lower, upper = inst$search_space$upper)

      # get the levels of all categorical parameters
      search_space_levels = inst$search_space$levels

      point_id = ".point_id"

      repeat { # iterate until we have an exception from eval_batch
        # generate neighbors
        neighbors = map_dtr(n_initial_points_seq, function(i) {
          neighbors_i = map_dtr(neighbors_per_point_seq, function(j) {
            # NOTE: mutating is currently quite slow because we sample the id to be mutated and the actual mutation for each neighbor and new point
            mutate_point(points[i, inst$archive$cols_x, with = FALSE],
              search_space_classes = search_space_classes,
              search_space_bounds = search_space_bounds,
              search_space_levels = search_space_levels,
              ids_numeric = ids_numeric,
              ids_categorical = ids_categorical,
              mutation_sd = mutation_sd)
          })
          set(neighbors_i, j = point_id, value = i)
        })

        # evaluate neighbors
        inst$eval_batch(neighbors)

        # update `n_initial_points` points if better neighbor found
        for (i in n_initial_points_seq) {
          tmp = inst$archive$data[batch_nr == inst$archive$n_batch & get(point_id) == i]
          difference = (tmp[[inst$archive$cols_y]] * inst$objective_multiplicator) - (points[i, ][[inst$archive$cols_y]] * inst$objective_multiplicator)
          if (any(difference < 0)) {
            best = which.min(difference)
            points[i, ] = tmp[best, c(inst$archive$cols_x, inst$archive$cols_y), with = FALSE]
          }
        }
      }
    }
  )
)

mlr_optimizers$add("local_search", OptimizerBatchLocalSearch)

mutate_point = function(point, search_space_classes, search_space_bounds, search_space_levels, ids_numeric, ids_categorical, mutation_sd) {
  neighbor = copy(point)
  valid_numeric_to_mutate = intersect(names(which(!map_lgl(neighbor, is.na))), ids_numeric)
  valid_cateorical_to_mutate = intersect(names(which(!map_lgl(neighbor, is.na))), ids_categorical)
  id = sample(c(valid_numeric_to_mutate, valid_cateorical_to_mutate), size = 1L)
  neighbor[1L, ][[id]] = mutate(neighbor[1L, ][[id]],
    class = search_space_classes[id],
    lower = search_space_bounds$lower[id],
    upper = search_space_bounds$upper[id],
    levels = search_space_levels[id],
    mutation_sd = mutation_sd)
  neighbor
}

mutate = function(value, class, lower, upper, levels, mutation_sd) {
  if (class %in% c("ParamDbl", "ParamInt")) {
    value_ = (value - lower) / (upper - lower)
    value_ = max(0, min(value_ + stats::rnorm(1L, mean = 0, sd = mutation_sd), 1))
    value = (value_ * (upper - lower)) + lower
    if (class == "ParamInt") {
      value = round(value, 0L)
    }
    value = min(max(value, lower), upper)
  } else if (class %in% c("ParamFct", "ParamLgl")) {
    value = sample(setdiff(levels[[1L]], value), size = 1L)
  }
  value
}