R/mbo.R

In compstat-lmu/mobafeas: Model Based Feature Selection

#' @title Start mobafeas MBO
#'
#' A wrapper around `mlrMBO::mbo()` that performs the mobafeas-specific black-box / white-box two-criteria
#' optimization for feature selection.
#'
#' @param fun `[smoof_function]` smoof function with additional attributes `"co.objective"` and `"nadir"`.
#'   `"co.objective"` is a `function` taking the design `data.frame` and returning a vector of second-objective-values.
#'   `"nadir"` is a `numeric(2)` nadir-point for objective 1 (of the `fun` return value) and 2 (the `"co.objective"`
#'   return value). This should probably be generated using `makeMobafeasObjective()`.
#' @param population `[list]` list of parameter values for initial design.
#' @param learner `[Learner | NULL]` an `mlr` `Learner` object, usually created using `constructMBFLearner()` or
#'   `constructRFSurrogate()`. Giving `NULL` uses the `mlrMBO` default learner (a `"regr.km"` or `"regr.randomForest"`,
#'   depending on whether the decision space has discrete variables, configured for mbo).
#' @param control `[MBOControl]` A control object, generated by `makeMBFControl()`
#' @param show.info `[logical(1)]` whether to output run progress information.
#' @param more.args `[list]` arguments to give to the objective function. Should be an empty list in most cases.
#' @return `MBOSingleObjResult` the optimization result, should probably be analyzed using `collectMBFResult()`.
#' @export
mobafeasMBO <- function(fun, population, learner = constructMBFLearner(getParamSet(fun)), control, show.info = getOption("mlrMBO.show.info", TRUE), more.args = list()) {
  if (!all.equal(attr(fun, "n.objectives"), 1)) {
    stop("fun must be a 1-objective SMOOF function.")
  }
  nullfeat <- population[[1]]
  nullfeat$selector.selection <- 0L * nullfeat$selector.selection
  population <- c(population, list(nullfeat))
  ps <- getParamSet(fun)

  control$co.objective <- attr(fun, "co.objective")
  assertFunction(control$co.objective, nargs = 1)
  control$nadir <- attr(fun, "nadir")
  assertNumeric(control$nadir, any.missing = FALSE, len = 2)

  mbo(fun = fun, design = listToDf(population, ps), learner = learner, control = control, show.info = show.info, more.args = more.args)
  ## ymatrix <- sapply(population, function(v) {
  ##   trafoValue(ps, v) %>% valuesFromNames(paramset = ps) %>% fun
  ## })
  ## rownames(ymatrix) <- ctrl$y.name
  ## design <- cbind(listToDf(population, ps), t(ymatrix))
  ## initSMBO(par.set = getParamSet(fun), design = design, learner = learner, control = control, show.info = show.info)
}