R/ls_dvls.R

In MOEADr: Component-Wise MOEA/D Implementation

#' Differential vector-based local search
#'
#' Differential vector-based local search (DVLS) implementation for the MOEA/D
#'
#' This routine implements the differential vector-based local search for
#' the MOEADr package. Check the references for details.
#'
#' This routine is intended to be used internally by [variation_localsearch()],
#' and should not be called directly by the user.
#'
#' @param Xt Matrix of incumbent solutions
#' @param Yt Matrix of objective function values for Xt
#' @param Vt List object containing information about the constraint violations
#' of the _incumbent solutions_, generated by [evaluate_population()]
#' @param B Neighborhood matrix, generated by [define_neighborhood()].
#' @param W matrix of weights (generated by [generate_weights()]).
#' @param which.x logical vector indicating which subproblems should undergo
#' local search
#' @param trunc.x logical flag indicating whether candidate solutions generated
#' by local search should be truncated to the variable limits of the problem.
#' @param problem list of named problem parameters. See Section
#' `Problem Description` of the [moead()] documentation for details.
#' @param scaling list containing the scaling parameters (see [moead()] for
#' details).
#' @param aggfun List containing the aggregation function parameters. See
#' Section `Scalar Aggregation Functions` of the [moead()] documentation for
#' details.
#' @param constraint list containing the parameters defining the constraint
#' handling method. See Section `Constraint Handling` of the [moead()]
#' documentation for details.
#' @param ... other parameters (included for compatibility with generic call)
#'
#' @section References:
#' B. Chen, W. Zeng, Y. Lin, D. Zhang,
#' "A new local search-based multiobjective optimization algorithm",
#' IEEE Trans. Evolutionary Computation 19(1):50-73, 2015.\cr
#'
#' 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
#'
#' @return List object with fields `X` (matrix containing the modified points,
#' with points that did not undergo local search indicated as NA) and `nfe`
#' (integer value informing how many additional function evaluations were
#' performed).
#'
#' @export

ls_dvls <- function(Xt, Yt, Vt, B, W, which.x, trunc.x,
                    problem, scaling, aggfun, constraint, ...){

  # ========== Error catching and default value definitions
  # All error catching and default value definitions are assumed to have been
  # verified in the calling function perform_variation().
  # ==========

  # ========== Calculate X+ and X-
  # 1. Draw neighborhood indices
  dimX <- dim(Xt)
  Inds <- do.call(rbind,
                  lapply(which(which.x),
                         FUN = function(i, B){sample(x       = B[i, ],
                                                     size    = 2,
                                                     replace = FALSE)},
                         B   = B))

  # 2. Calculate multipliers
  nls <- nrow(Inds)
  ls.Phi <- matrix(stats::rnorm(nls, mean = 0.5, sd = 0.1),
                nrow  = nls,
                ncol  = dimX[2],
                byrow = FALSE)

  # 4. Isolate points for local search
  dvls.B <- matrix(1:nls,
                   ncol = 1)
  dvls.W  <- W[which.x, , drop = FALSE]
  dvls.Xt <- Xt[which.x, , drop = FALSE]
  dvls.Xo <- dvls.Xt
  dvls.Yt <- Yt[which.x, , drop = FALSE]
  dvls.Vt <- Vt

  dvls.Vt$Cmatrix <- dvls.Vt$Cmatrix[which.x, , drop = FALSE]
  dvls.Vt$Vmatrix <- dvls.Vt$Vmatrix[which.x, , drop = FALSE]
  dvls.Vt$v       <- dvls.Vt$v[which.x]

  # ========== Evaluate X+, X-
  for (phi.m in c(-1, 1)){
    # 1. Generate candidate. Truncate if required
    dvls.X  <- dvls.Xo + phi.m * ls.Phi * (Xt[Inds[, 1], , drop = FALSE] - Xt[Inds[, 2], , drop = FALSE])
    if (trunc.x) dvls.X <- matrix(pmax(0, pmin(dvls.X, 1)),
                                  nrow  = nrow(dvls.X),
                                  byrow = FALSE)

    # 2. Evaluate on objective functions and constraints
    dvls.YV <- evaluate_population(X       = dvls.X,
                                   problem = problem,
                                   nfe     = 0)

    # 3. Objective scaling
    dvls.normYs <- scale_objectives(Y       = dvls.YV$Y,
                                    Yt      = dvls.Yt,
                                    scaling = scaling)

    # 4. Scalarization by DVLS neighborhood.
    dvls.bigZ <- scalarize_values(normYs  = dvls.normYs,
                                  W       = dvls.W,
                                  B       = dvls.B,
                                  aggfun  = aggfun)

    # Calculate selection indices for DVLS
    dvls.selin <- order_neighborhood(bigZ       = dvls.bigZ,
                                     B          = dvls.B,
                                     V          = dvls.YV$V,
                                     Vt         = dvls.Vt,
                                     constraint = constraint)

    # Update DVLS "incumbent"
    dvls.out <- updt_standard(X        = dvls.X,
                              Xt       = dvls.Xt,
                              Y        = dvls.YV$Y,
                              Yt       = dvls.Yt,
                              V        = dvls.YV$V,
                              Vt       = dvls.Vt,
                              sel.indx = dvls.selin,
                              B        = dvls.B)
    dvls.Xt  <- dvls.out$X
    dvls.Yt  <- dvls.out$Y
    dvls.Vt  <- dvls.out$V
  }

  dvls.X            <- NA * randM(Xt)
  dvls.X[which.x, ] <- dvls.Xt

  return(list(X   = dvls.X,
              nfe = 2 * sum(which.x)))
}