/
updt_standard.R
111 lines (101 loc) · 4.38 KB
/
updt_standard.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
#' Standard Neighborhood Replacement Update for MOEA/D
#'
#' Population update using the standard neighborhood replacement method for the
#' MOEADr package.
#'
#' This routine executes the standard neighborhood replacement operation to
#' update the population matrix of the MOEA/D.
#' This update routine is intended to be used internally by the main [moead()]
#' function, and should not be called directly by the user.
#'
#' @param X Matrix of candidate solutions
#' @param Xt Matrix of incumbent solutions
#' @param Y Matrix of objective function values of `X`
#' @param Yt Matrix of objective function values of `Xt`
#' @param B Neighborhood matrix, generated by [define_neighborhood()].
#' @param V List object containing information about the constraint violations
#' of the candidate solutions, generated by [evaluate_population()]
#' @param Vt List object containing information about the constraint violations
#' of the incumbent solutions, generated by [evaluate_population()]
#' @param sel.indx matrix of selection indices, generated by
#' [order_neighborhood()]
#' @param ... other parameters (included for compatibility with generic call)
#'
#' @return List object containing the update population matrix (`X`),
#' and its corresponding matrix of objective function values (`Y`) and
#' constraint value list (`V`).
#'
#' @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
updt_standard <- function(X, Xt, Y, Yt, V, Vt, sel.indx, B, ...){
# Solution x_i^{t+1} will receive the best solution from the set:
# ${x_i^t, {v_j^t \forall j \in N(i)}} | w_i$
# where $v_j^t$ is the j-th 'offspring' candidate solution, N(i) is the
# neighborhood of i, and $w_i$ is the i-th weight vector.
# Get best selection index for each neighborhood
std.sel.indx <- sel.indx[, 1]
# Function for returning the selected solution (variable or objectives space)
# for a subproblem:
# - i: subproblem index
# - sel.indx: vector of selection indices (see above)
# - XY: matrix of candidate solutions (in variable or objective space)
# - XYt: matrix of incumbent solutions (in variable or objective space)
# - B: matrix of neighborhoods
do.update <- function(i, sel.indx, XY, XYt, B){
if (sel.indx[i] > ncol(B)) return(XYt[i, ]) # last row = incumbent solution
else return(XY[B[i, sel.indx[i]], ])
}
# Update matrix of candidate solutions
Xnext <- t(vapply(X = 1:nrow(X),
FUN = do.update,
FUN.VALUE = numeric(ncol(X)),
sel.indx = std.sel.indx,
XY = X,
XYt = Xt,
B = B,
USE.NAMES = FALSE))
# Update matrix of function values
Ynext <- t(vapply(X = 1:nrow(Y),
FUN = do.update,
FUN.VALUE = numeric(ncol(Y)),
sel.indx = std.sel.indx,
XY = Y,
XYt = Yt,
B = B,
USE.NAMES = FALSE))
# Update list of constraint values
if(is.null(V)){
Vnext <- NULL
} else{
Vnext <- list(Cmatrix = NULL, Vmatrix = NULL, v = NULL)
## 1: Cmatrix
Vnext$Cmatrix <- t(vapply(X = 1:nrow(V$Cmatrix),
FUN = do.update,
FUN.VALUE = numeric(ncol(V$Cmatrix)),
sel.indx = std.sel.indx,
XY = V$Cmatrix,
XYt = Vt$Cmatrix,
B = B,
USE.NAMES = FALSE))
## 2: Vmatrix
Vnext$Vmatrix <- t(vapply(X = 1:nrow(V$Vmatrix),
FUN = do.update,
FUN.VALUE = numeric(ncol(V$Vmatrix)),
sel.indx = std.sel.indx,
XY = V$Vmatrix,
XYt = Vt$Vmatrix,
B = B,
USE.NAMES = FALSE))
## 3: v
Vnext$v <- rowSums(Vnext$Vmatrix)
}
# Output
return(list(X = Xnext,
Y = Ynext,
V = Vnext))
}