/
plot.R
212 lines (202 loc) · 7.81 KB
/
plot.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
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
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
#' Plotting of dimRed* objects
#'
#' Plots a object of class dimRedResult and dimRedData. For the
#' documentation of the plotting function in base see here:
#' \code{\link{plot.default}}.
#'
#' Plotting functions for the classes usind in \code{dimRed}. they are
#' intended to give a quick overview over the results, so they are
#' somewhat inflexible, e.g. it is hard to modify color scales or
#' plotting parameters.
#'
#' If you require more control over plotting, it is better to convert
#' the object to a \code{data.frame} first and use the standard
#' functions for plotting.
#'
#' @param x dimRedResult/dimRedData class, e.g. output of
#' embedded/loadDataSet
#' @param y Ignored
#' @param type plot type, one of \code{c("pairs", "parpl", "2vars",
#' "3vars", "3varsrgl")}
#' @param col the columns of the meta slot to use for coloring, can be
#' referenced as the column names or number of x@data
#' @param vars the axes of the embedding to use for plotting
#' @param ... handed over to the underlying plotting function.
#'
#' @examples
#' scurve = loadDataSet("3D S Curve")
#' if(requireNamespace("graphics", quietly = TRUE))
#' plot(scurve, type = "pairs", main = "pairs plot of S curve")
#' if(requireNamespace("MASS", quietly = TRUE))
#' plot(scurve, type = "parpl")
#' if(requireNamespace("graphics", quietly = TRUE))
#' plot(scurve, type = "2vars", vars = c("y", "z"))
#' if(requireNamespace("scatterplot3d", quietly = TRUE))
#' plot(scurve, type = "3vars")
#' if(requireNamespace("rgl", quietly = TRUE))
#' plot(scurve, type = "3varsrgl")
#'
#' @include mixColorSpaces.R
#' @include dimRedData-class.R
#' @importFrom graphics plot
#'
#' @aliases plot.dimRed
#' @export
setGeneric(
"plot", function(x, y, ...) standardGeneric("plot"),
useAsDefault = graphics::plot
)
#' @describeIn plot Ploting of dimRedData objects
#' @aliases plot.dimRedData
#' @export
setMethod(
f = "plot",
signature = c("dimRedData"),
definition = function(x, type = "pairs",
vars = seq_len(ncol(x@data)),
col = seq_len(min(3, ncol(x@meta))), ...) {
cols <- colorize(x@meta[, col, drop = FALSE])
switch(
type,
"pairs" = {
chckpkg("graphics")
graphics::pairs(x@data[, vars], col = cols, ... )
},
"parpl" = {
chckpkg("MASS")
MASS::parcoord(x@data[, vars], col = cols, ... )
},
"2vars" = {
chckpkg("graphics")
graphics::plot(x@data[, vars[1:2]], col = cols, ... )
},
"3vars" = {
chckpkg("scatterplot3d")
scatterplot3d::scatterplot3d(x@data[, vars[1:3]],
color = cols,
...)
},
"3varsrgl" = {
chckpkg("rgl")
rgl::plot3d(x@data[, vars[1:3]], col = cols, ... )
},
stop("wrong argument to plot.dimRedData")
)
}
)
#' @describeIn plot Ploting of dimRedResult objects.
#' @aliases plot.dimRedResult
#' @export
setMethod(
f = "plot",
signature = c("dimRedResult"),
definition = function (x, type = "pairs",
vars = seq_len(ncol(x@data@data)),
col = seq_len(min(3, ncol(x@data@meta))), ...) {
plot(x = x@data, type = type, vars = vars, col = col, ...)
}
)
#' plot_R_NX
#'
#' Plot the R_NX curve for different embeddings. Takes a list of
#' \code{\link{dimRedResult}} objects as input.
#' Also the Area under the curve values are computed for a weighted K
#' (see \link{AUC_lnK_R_NX} for details) and appear in the legend.
#'
#' @param x a list of \code{\link{dimRedResult}} objects. The names of the list
#' will appear in the legend with the AUC_lnK value.
#' @param ndim the number of dimensions, if \code{NA} the original number of
#' embedding dimensions is used, can be a vector giving the embedding
#' dimensionality for each single list element of \code{x}.
#' @param weight the weight function used for K when calculating the AUC, one of
#' \code{c("inv", "log", "log10")}
#' @family Quality scores for dimensionality reduction
#' @return A ggplot object, the design can be changed by appending
#' \code{theme(...)}
#'
#' @examples
#' if(requireNamespace(c("RSpectra", "igraph", "RANN", "ggplot", "tidyr", "scales"), quietly = TRUE)) {
#' ## define which methods to apply
#' embed_methods <- c("Isomap", "PCA")
#' ## load test data set
#' data_set <- loadDataSet("3D S Curve", n = 200)
#' ## apply dimensionality reduction
#' data_emb <- lapply(embed_methods, function(x) embed(data_set, x))
#' names(data_emb) <- embed_methods
#' ## plot the R_NX curves:
#' plot_R_NX(data_emb) +
#' ggplot2::theme(legend.title = ggplot2::element_blank(),
#' legend.position = c(0.5, 0.1),
#' legend.justification = c(0.5, 0.1))
#' }
#' @export
plot_R_NX <- function(x, ndim = NA, weight = "inv") {
chckpkg("ggplot2")
chckpkg("tidyr")
chckpkg("scales")
lapply(
x,
function(x)
if (!inherits(x, "dimRedResult"))
stop("x must be a list and ",
"all items must inherit from 'dimRedResult'")
)
rnx <- mapply(function(x, ndim) if(is.na(ndim)) R_NX(x) else R_NX(x, ndim),
x = x, ndim = ndim)
weight <- match.arg(weight, c("inv", "ln", "log", "log10"))
w_fun <- switch(
weight,
inv = auc_ln_k_inv,
log = auc_log_k,
ln = auc_log_k,
log10 = auc_log10_k,
stop("wrong parameter for weight")
)
auc <- apply(rnx, 2, w_fun)
df <- as.data.frame(rnx)
df$K <- seq_len(nrow(df))
qnxgrid <- expand.grid(K = df$K,
rnx = seq(0.1, 0.9, by = 0.1))
## TODO: FIND OUT WHY THIS AS IN THE PUBLICATION BUT IS WRONG!
qnxgrid$qnx <- rnx2qnx(qnxgrid$rnx, K = qnxgrid$K, N = nrow(df)) #
qnxgrid$rnx_group <- factor(qnxgrid$rnx)
df <- tidyr::gather_(df,
key_col = "embedding",
value_col = "R_NX",
names(x))
ggplot2::ggplot(df) +
ggplot2::geom_line(ggplot2::aes_string(y = "R_NX", x = "K",
color = "embedding")) +
## TODO: find out if this is wrong:
## ggplot2::geom_line(data = qnxgrid,
## mapping = ggplot2::aes_string(x = "K", y = "qnx",
## group = "rnx_group"),
## linetype = 2,
## size = 0.1) +
ggplot2::geom_line(data = qnxgrid,
mapping = ggplot2::aes_string(x = "K", y = "rnx",
group = "rnx_group"),
linetype = 3,
size = 0.1) +
ggplot2::scale_x_log10(
labels = scales::trans_format("log10",
scales::math_format()),
expand = c(0, 0)
) +
ggplot2::scale_y_continuous(expression(R[NX]),
limits = c(0, 1),
expand = c(0, 0)) +
ggplot2::annotation_logticks(sides = "b") +
ggplot2::scale_color_discrete(
breaks = names(x),
labels = paste(format(auc, digits = 3),
names(x))) +
ggplot2::labs(title = paste0(
"R_NX vs. K",
if (length(ndim) == 1 && !is.na(ndim))
paste0(", d = ", ndim)
else
""
)) +
ggplot2::theme_classic()
}