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
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
|
#' Interactively choose according to empirical attainment function differences
#'
#' Creates the same plot as [eafdiffplot()] but waits for the user to click in
#' one of the sides. Then it returns the rectangles the give the differences in
#' favour of the chosen side. These rectangles may be used for interactive
#' decision-making as shown in \citet{DiaLop2020ejor}. The function
#' [choose_eafdiff()] may be used in a non-interactive context.
#'
#' @param data.left,data.right Data frames corresponding to the input data of
#' left and right sides, respectively. Each data frame has at least three
#' columns, the third one being the set of each point. See also
#' [read_datasets()].
#'
#' @param intervals (`integer(1)`|`character()`) \cr The absolute range of the
#' differences \eqn{[0, 1]} is partitioned into the number of intervals
#' provided. If an integer is provided, then labels for each interval are
#' computed automatically. If a character vector is provided, its length is
#' taken as the number of intervals.
#'
#' @template arg_maximise
#'
#' @param title.left,title.right Title for left and right panels, respectively.
#'
#' @param ... Other graphical parameters are passed down to
#' [eafdiffplot()].
#'
#'
#' @return `matrix` where the first 4 columns give the coordinates of two
#' corners of each rectangle and the last column. In both cases, the last
#' column gives the positive differences in favor of the chosen side.
#'
#' @seealso [read_datasets()], [eafdiffplot()], [whv_rect()]
#'
#' @examples
#'
#' \donttest{
#' extdata_dir <- system.file(package="eaf", "extdata")
#' A1 <- read_datasets(file.path(extdata_dir, "wrots_l100w10_dat"))
#' A2 <- read_datasets(file.path(extdata_dir, "wrots_l10w100_dat"))
#' if (interactive()) {
#' rectangles <- choose_eafdiffplot(A1, A2, intervals = 5)
#' } else { # Choose A1
#' rectangles <- eafdiff(A1, A2, intervals = 5, rectangles = TRUE)
#' rectangles <- choose_eafdiff(rectangles, left = TRUE)
#' }
#' reference <- c(max(A1[, 1], A2[, 1]), max(A1[, 2], A2[, 2]))
#' x <- split.data.frame(A1[,1:2], A1[,3])
#' hv_A1 <- sapply(split.data.frame(A1[, 1:2], A1[, 3]),
#' hypervolume, reference=reference)
#' hv_A2 <- sapply(split.data.frame(A2[, 1:2], A2[, 3]),
#' hypervolume, reference=reference)
#' boxplot(list(A1=hv_A1, A2=hv_A2), main = "Hypervolume")
#'
#' whv_A1 <- sapply(split.data.frame(A1[, 1:2], A1[, 3]),
#' whv_rect, rectangles=rectangles, reference=reference)
#' whv_A2 <- sapply(split.data.frame(A2[, 1:2], A2[, 3]),
#' whv_rect, rectangles=rectangles, reference=reference)
#' boxplot(list(A1=whv_A1, A2=whv_A2), main = "Weighted hypervolume")
#' }
#'
#'@references
#' \insertAllCited{}
#' @concept visualisation
#' @export
choose_eafdiffplot <- function(data.left, data.right, intervals = 5,
maximise = c(FALSE, FALSE),
title.left = deparse(substitute(data.left)),
title.right = deparse(substitute(data.right)),
...)
{
op <- options(locatorBell = FALSE)
on.exit(options(op))
eafdiffplot(data.left, data.right, title.left= title.left, title.right = title.right,
intervals = intervals, maximise = maximise, ...)
# FIXME: Avoid calculating eafdiff twice.
DIFF <- eafdiff(data.left, data.right, intervals = intervals, maximise = maximise,
rectangles = TRUE)
coord <- grid::grid.locator("npc")
left <- coord$x[[1]] < 0.5
if (left) cat("LEFT!\n") else cat("RIGHT!\n")
choose_eafdiff(DIFF, left=left)
}
#' Identify largest EAF differences
#'
#' Given a list of datasets, return the indexes of the pair with the largest
#' EAF differences according to the method proposed by \citet{DiaLop2020ejor}.
#'
#'
#' @param data (`list(1)`) A list of matrices with at least 3 columns
#'
#' @template arg_maximise
#'
#' @param intervals (`integer(1)`) \cr The absolute range of the differences
#' \eqn{[0, 1]} is partitioned into the number of intervals provided.
#'
#' @template arg_refpoint
#'
#' @template arg_ideal_null
#'
#' @return (`list()`) A list with two components `pair` and `value`.
#'
#'@examples
#' # FIXME: This example is too large, we need a smaller one.
#' files <- c("wrots_l100w10_dat","wrots_l10w100_dat")
#' data <- lapply(files, function(x)
#' read_datasets(file.path(system.file(package="eaf"),
#' "extdata", x)))
#' nadir <- apply(do.call(rbind, data)[,1:2], 2, max)
#' x <- largest_eafdiff(data, reference = nadir)
#' str(x)
#'
#'@references
#' \insertAllCited{}
#'
#'@concept eaf
#'@export
largest_eafdiff <- function(data, maximise = FALSE, intervals = 5, reference,
ideal = NULL)
{
nobjs <- 2
maximise <- as.logical(rep_len(maximise, nobjs))
if (nobjs != 2) stop("Only 2 objectives currently supported")
n <- length(data)
stopifnot(n > 1)
best_pair <- NULL
best_value <- 0
if (is.null(ideal)) {
# This should be equivalent to
# cbind(c(range(data[[1]][,1]),range(data[[2]][,1])),
# c(range(data[[1]][,2]),range(data[[2]][,2])))
data_agg <- t(do.call(cbind, lapply(data, function(x) matrixStats::colRanges(x[,1:nobjs]))))
ideal <- get_ideal(data_agg, maximise = maximise)
}
# Convert to a 1-row matrix
if (is.null(dim(ideal))) dim(ideal) <- c(1,nobjs)
for (a in 1:(n-1)) {
for (b in (a+1):n) {
DIFF <- eafdiff(data[[a]], data[[b]], intervals = intervals,
maximise = maximise, rectangles = TRUE)
# Set color to 1
a_rectangles <- DIFF[ DIFF[, 5] >= 1L, , drop = FALSE]
a_rectangles[, ncol(a_rectangles)] <- 1
a_value <- whv_rect(ideal, a_rectangles, reference, maximise)
b_rectangles <- DIFF[ DIFF[, 5] <= -1L, , drop = FALSE]
b_rectangles[, ncol(b_rectangles)] <- 1
b_value <- whv_rect(ideal, b_rectangles, reference, maximise)
value <- min(a_value, b_value)
if (value > best_value) {
best_value <- value
best_pair <- c(a, b)
}
}
}
list(pair=best_pair, value = best_value)
}
#' @param x (`matrix()`) Matrix of rectangles representing EAF differences
#' (returned by [eafdiff()] with `rectangles=TRUE`).
#'
#' @param left (`logical(1)`) With `left=TRUE` return the rectangles with
#' positive differences, otherwise return those with negative differences but
#' differences are converted to positive.
#'
#' @rdname choose_eafdiffplot
#'@concept eaf
#'@export
choose_eafdiff <- function(x, left = stop("'left' must be either TRUE or FALSE"))
{
if (left) return (x[ x[, ncol(x)] > 0L, , drop = FALSE])
x <- x[ x[, ncol(x)] < 0L, , drop = FALSE]
# We always return positive colors.
x[, ncol(x)] <- abs(x[, ncol(x)])
x
}
|
