add another selector from SMS-EMOA paper (Algorithm 3)

NAMESPACE

@@ -135,6 +135,7 @@ export(registerECROperator)
 export(replaceMuCommaLambda)
 export(replaceMuPlusLambda)
 export(selDomHV)
+export(selDomNumberPlusHV)
 export(selGreedy)
 export(selNondom)
 export(selRanking)

R/operator.selector.domNumberPlusHV.R

@@ -0,0 +1,76 @@
+#' @title
+#' Modified dominated Hypervolume selector.
+#'
+#' @description
+#' Alternative SMS-EMOA survival selection as proposed in Algorithm 3 of [1]. Performs non-dominated
+#' sorting first. If the number of non-domination levels is at least two the algorithm
+#' drops the individual with the highest number of dominating points (ties are
+#' broken at random) from the last layer. If there is just one non-domination layer,
+#' i.e., all points are non-domianted the method drops the individual with minimal
+#' hypervolume contribution. This selector is the basis of the
+#' S-Metric Selection Evolutionary Multi-Objective Algorithm, termed SMS-EMOA
+#' (see \code{\link{smsemoa}}).
+#'
+#' @references
+#' [1] Beume, Nicola, Boris Naujoks and M. Emmerich. SMS-EMOA: Multiobjective selection
+#' based on dominated hypervolume.” European Journal of Operational Research. 181 (2007): 1653-1669.
+#'
+#' @note Note that the current implementation expects \code{n.select = ncol(fitness) - 1}
+#' and the selection process quits with an error message if \code{n.select} is greater
+#' than 1.
+#'
+#' @template arg_fitness
+#' @template arg_n_select
+#' @param ref.point [\code{numeric}]\cr
+#'   Reference point for hypervolume computation.
+#' @return [\code{integer}] Vector of survivor indizes.
+#' @family selectors
+#' @export
+selDomNumberPlusHV = makeSelector(
+  selector = function(fitness, n.select, ref.point) {
+    checkmate::assertMatrix(fitness, mode = "numeric", min.rows = 2L, min.cols = 2L, any.missing = FALSE, all.missing = FALSE)
+    checkmate::assertNumeric(ref.point, any.missing = FALSE, all.missing = FALSE)
+
+    n = ncol(fitness)
+    if (n.select != (n - 1)) {
+      BBmisc::stopf("[ecr::selDomNumberPlusHV] Note that selDomNumberPlusHV always drops a single individual
+        and hence (ncol(fitness) - 1) individuals are selected. Your choice of
+        n.select (= %i) is not allowed since (ncol(fitness) - 1) equals %i. Check your setup!", n.select, (n - 1L))
+    }
+
+    all.idx = seq_len(n)
+
+    # do non-dominated sorting
+    nds.res = doNondominatedSorting(fitness)
+    ranks = nds.res$ranks
+    dom.counter = nds.res$dom.counter
+
+    # get the maximum rank/level
+    max.rank = max(ranks)
+
+    if (max.rank > 1) {
+      # If there are at least two ranks/levels use the domination number to drop individuals:
+      # Get IDs of individuals on last level
+      idx.max.rank = which(ranks == max.rank)
+
+        # there is exactly one individual that is "maximally" dominated
+      if (length(idx.max.rank) == 1L) {
+        return(setdiff(all.idx, idx.max.rank))
+      }
+
+      # get IDs with maximum number of dominating points
+      max.rank.domcounts  = dom.counter[idx.max.rank]
+      max.rank.domcounts.ids = idx.max.rank[max.rank.domcounts == max(max.rank.domcounts)]
+      if (length(max.rank.domcounts.ids) > 1L) {
+        max.rank.domcounts.ids = sample(max.rank.domcounts.ids, size = 1L)
+      }
+      return(setdiff(all.idx, max.rank.domcounts.ids))
+    }
+
+    # compute exclusive hypervolume contributions and remove the one with the smallest
+    hvctrbs = computeHVContr(fitness, ref.point = ref.point)
+    die.idx = getMinIndex(hvctrbs)
+
+    return(setdiff(all.idx, die.idx))
+  },
+  supported.objectives = "multi-objective")

src/RcppExports.cpp

@@ -24,24 +24,24 @@ BEGIN_RCPP
 END_RCPP
 }
 
-RcppExport SEXP computeCrowdingDistanceC(void *);
-RcppExport SEXP computeHVC(void *, void *);
-RcppExport SEXP computeHVContributionC(void *, void *);
-RcppExport SEXP computeRIndicatorC(void *, void *, void *, void *, void *);
-RcppExport SEXP dominatedC(void *);
-RcppExport SEXP doNondominatedSortingC(void *);
-RcppExport SEXP emoaIndEpsC(void *, void *);
-RcppExport SEXP polynomialMutationC(void *, void *, void *, void *, void *);
-RcppExport SEXP simulatedBinaryCrossoverC(void *, void *, void *, void *, void *);
+RcppExport SEXP computeCrowdingDistanceC(SEXP);
+RcppExport SEXP computeHVC(SEXP, SEXP);
+RcppExport SEXP computeHVContributionC(SEXP, SEXP);
+RcppExport SEXP computeRIndicatorC(SEXP, SEXP, SEXP, SEXP, SEXP);
+RcppExport SEXP doNondominatedSortingC(SEXP);
+RcppExport SEXP dominatedC(SEXP);
+RcppExport SEXP emoaIndEpsC(SEXP, SEXP);
+RcppExport SEXP polynomialMutationC(SEXP, SEXP, SEXP, SEXP, SEXP);
+RcppExport SEXP simulatedBinaryCrossoverC(SEXP, SEXP, SEXP, SEXP, SEXP);
 
 static const R_CallMethodDef CallEntries[] = {
     {"_ecr_computeGenerationalDistanceC", (DL_FUNC) &_ecr_computeGenerationalDistanceC, 3},
     {"computeCrowdingDistanceC",          (DL_FUNC) &computeCrowdingDistanceC,          1},
     {"computeHVC",                        (DL_FUNC) &computeHVC,                        2},
     {"computeHVContributionC",            (DL_FUNC) &computeHVContributionC,            2},
     {"computeRIndicatorC",                (DL_FUNC) &computeRIndicatorC,                5},
-    {"dominatedC",                        (DL_FUNC) &dominatedC,                        1},
     {"doNondominatedSortingC",            (DL_FUNC) &doNondominatedSortingC,            1},
+    {"dominatedC",                        (DL_FUNC) &dominatedC,                        1},
     {"emoaIndEpsC",                       (DL_FUNC) &emoaIndEpsC,                       2},
     {"polynomialMutationC",               (DL_FUNC) &polynomialMutationC,               5},
     {"simulatedBinaryCrossoverC",         (DL_FUNC) &simulatedBinaryCrossoverC,         5},