R/scalarize_values.R

In fcampelo/MOEADr: Component-Wise MOEA/D Implementation

#' Scalarize values for MOEA/D
#'
#' Perform scalarization for the MOEADr package.
#'
#' This routine calculates the scalarized performance values for the MOEA/D.
#'
#' The list of available scalarization methods can be generated using
#' \code{get_scalarization_methods()}
#'
#' @param normYs List generated by [scale_objectives()], containing two matrices
#' of scaled objective values (`normYs$Y` and `normYs$Yt`) and two vectors,
#' containing the current estimates of the ideal (`normYs$minP`) and nadir
#' (`normYs$maxP`) points. See [scale_objectives()] for details.
#' @param B neighborhood matrix, generated by [define_neighborhood()].
#' @param W matrix of weights, generated by [generate_weights()].
#' @param aggfun List containing the aggregation function parameters. See
#' Section `Scalar Aggregation Functions` of the [moead()] documentation for
#' details.
#'
#' @return `[ (T+1) x N ]` matrix of scalarized performance values. Each column
#' contains the T scalarized performances of the candidate solutions in the
#' neighborhood of a given subproblem, plus the scalarized performance value
#' for the incumbent solution for that subproblem.
#'
#' @export
#'
#' @section References:
#' F. Campelo, L.S. Batista, C. Aranha (2020): The {MOEADr} Package: A
#' Component-Based Framework for Multiobjective Evolutionary Algorithms Based on
#' Decomposition. Journal of Statistical Software \doi{10.18637/jss.v092.i06}\cr
#'

scalarize_values <- function(normYs, W, B, aggfun){

  # ========== Error catching and default value definitions
  assertthat::assert_that(is.matrix(normYs$Y), is.numeric(normYs$Y),
                          is.matrix(normYs$Yt), is.numeric(normYs$Yt),
                          identical(dim(normYs$Y), dim(normYs$Yt)),
                          is.matrix(B), is.numeric(B),
                          all(B == as.integer(B)),
                          nrow(normYs$Y) == nrow(B),
                          is.numeric(normYs$minP),
                          is.numeric(normYs$maxP),
                          length(normYs$minP) == length(normYs$maxP))
  # ==========

  # Get matrix of objective values for each neighborhood, ordered by
  # subproblem. It's a (nrow(X) * T) x m matrix
  bigY <- normYs$Y[as.vector(t(B)), , drop = FALSE]

  # Get matrix of weight vectors for each subproblem, replicated for the
  # neighborhoods. It's a (nrow(X) * T) x m matrix
  bigW <- W[rep(1:nrow(W),
                each  = ncol(B)), , drop = FALSE]

  # Prepare bigZ matrix
  bigZ <- matrix(numeric(),
                 ncol = nrow(B),
                 nrow = ncol(B) + 1)

  # Scalarization function to be used
  function_name <- paste0("scalarization_", tolower(aggfun$name))

  # Fill in the scalarized function values for the candidate solutions
  bigZ[1:ncol(B), ] <- matrix(do.call(function_name,
                                      args = list(Y      = bigY,
                                                  W      = bigW,
                                                  aggfun = aggfun,
                                                  minP   = normYs$minP,
                                                  maxP   = normYs$maxP)),
                                      ncol  = nrow(W),
                                      byrow = FALSE)

  # Fill in the scalarized function values for the incumbent solutions
  bigZ[nrow(bigZ), ] <- do.call(function_name,
                                args = list(Y      = normYs$Yt,
                                            W      = W,
                                            aggfun = aggfun,
                                            minP   = normYs$minP,
                                            maxP   = normYs$maxP))

  # Return matrix bigZ
  return(bigZ)
}