R/PA.EMOA.approximateRefSets.R

In ecr: Evolutionary Computation in R

#' @title Helper function to estimate reference set(s).
#'
#' @description The function takes an data frame with columns at least
#' specified by \code{obj.cols} and \dQuote{prob}. The reference set for
#' each unique problem in column \dQuote{prob} is then obtained by
#' combining all approximation sets generated by all considered algorithms
#' for the corresponding problem and filtering the non-dominated solutions.
#'
#' @param df [\code{data.frame}]\cr
#'   Data frame with the required structure.
#' @param obj.cols [\code{character(>= 2)}]\cr
#'   Column names of the objective functions.
#' @param as.df [\code{logical(1)}]\cr
#'   Should a data.frame be returned?
#'   Default is \code{FALSE}. In this case a named list is returned.
#' @return [\code{list} | \code{data.frame}] Named list of matrizes
#' (names are the problems) or data frame with columns \code{obj.cols} and \dQuote{prob}.
#' @family EMOA performance assessment tools
#' @export
approximateRefSets = function(df, obj.cols, as.df = FALSE) {
  assertDataFrame(df, min.cols = 3L)
  assertCharacter(obj.cols, min.len = 2L)
  assertFlag(as.df)

  # split by prob(lem)
  ref.sets = by(df, list(df$prob), function(x) {
    # get data points
    pf.approx = t(as.matrix(x[, obj.cols, drop = FALSE]))
    # compute reference point
    ref.set = pf.approx[, ecr::nondominated(pf.approx), drop = FALSE]
    # return a list with component prob
    res = list()
    res[[as.character(x$prob[1L])]] = ref.set
    return(res)
  })
  # drop "by" class and attributes
  attr(ref.sets, "call") = NULL
  ref.sets = unclass(ref.sets)
  # eventually convert to data.frame
  if (as.df) {
    probs = names(ref.sets)
    for (prob in probs) {
      ref.sets[[prob]] = as.data.frame(t(ref.sets[[prob]]))
      ref.sets[[prob]]$prob = prob
    }
    ref.sets = do.call(rbind, unname(ref.sets))
  }
  return(ref.sets)
}