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 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 369
|
# Plot methods for renderOptPathPlot. Nearly the same interface for all plot functions
# Not all functions do have all arguments.
# @param op
# The optimization path
# @param .alpha [\code{numeric}]\cr
# Vector of alpha values for the points in the plots.
# @param .type [\code{factor}]\cr
# Vector of types of the points, factor levels are init, seq, prob and marked.
# @param dob [\code{numeric}]\cr
# Vector of dobs
# @param log[\code{character}]\cr
# Vector of variables to be logarithmized
# @param names [\code{character}]\cr
# Vector of the names of the variables. Used to identify variables for the plot.
# @param short.names [\code{character}]\cr
# Vector of the short names of the variables. This names will be printed in the plot.
# Must be the same length as names
# @param space[\code{character}]
# If the X-Space is plotted, space = "x", if the Y-Space is plotted, space = "y".
# Special case 1D -> 1D also "both" is possible.
# @param iter [\code{integer(1)}]\cr
# Current iteration.
# @param classes [\code{character(2)}]\cr
# Classes of the variables (numeric or factor) in 2D plots.
# @param xlim, ylim [\code{numeric(2)}]\cr
# Limits for the x and y axis respectively.
# @param colours [\code{character(4)}]\cr
# Colours of the points/lines for the three point types init, seq, prob and marked.
# @param size [\code{numeric(1)} | NULL]\cr
# Size of points / lines.
# @return A ggplot object.
# Plot method for a one-dimensional numeric X- or Y-Space
# Here we use geom_density and geom_rug
# And we know both names and short.names have length 1
plot1DNum = function(op, .alpha, .type, log, names, short.names,
space, iter, xlim, colours, ggplot.theme) {
op$.alpha = .alpha
op$.type = .type
if (space == "x") {
title = ggplot2::ggtitle("X-Space")
}
if (space == "y") {
title = ggplot2::ggtitle("Y-Space")
}
pl = ggplot2::ggplot(op, ggplot2::aes(x = .data[[names]]))
pl = pl + ggplot2::geom_density(colour = "black")
pl = pl + title
pl = pl + ggplot2::xlab(short.names)
pl = pl + ggplot2::geom_rug(ggplot2::aes(alpha = .data$.alpha, colour = .data$.type),
sides = "b", linewidth = 2L, data = op)
if (names %in% log) {
pl = pl + ggplot2::coord_trans(xtrans = "log10", limx = xlim)
} else {
pl = pl + ggplot2::coord_cartesian(xlim = xlim)
}
pl = pl + ggplot2::guides(alpha = "none")
pl = pl + ggplot2::scale_alpha_continuous(range = c(max(1 / (iter + 1), 0.1), 1L))
pl = pl + ggplot2::scale_colour_manual(name = "type",
values = c(init = colours[1L], seq = colours[2L], prop = colours[3L], marked = colours[4L]))
pl = pl + ggplot.theme
return(pl)
}
# Plot method for a one-dimensional discrete X- or Y-Space
# Here we use geom_bar
plot1DDisc = function(op, .alpha, .type, log, names, short.names,
space, iter, ylim, colours, ggplot.theme) {
op$.alpha = as.factor(.alpha)
op$.type = .type
if (space == "x") {
title = ggplot2::ggtitle("X-Space")
}
if (space == "y") {
title = ggplot2::ggtitle("Y-Space")
}
pl = ggplot2::ggplot(op, ggplot2::aes(x = .data[[names[1L]]], fill = .data$.type, alpha = .data$.alpha))
pl = pl + ggplot2::geom_bar()
pl = pl + title
pl = pl + ggplot2::xlab(short.names)
pl = pl + ggplot2::ylim(ylim)
pl = pl + ggplot2::scale_alpha_ordinal(range = c(max(1 / (iter + 1), 0.1), 1L))
pl = pl + ggplot2::scale_fill_manual(name = "type",
values = c(init = colours[1L], seq = colours[2L], prop = colours[3L], marked = colours[4L]))
pl = pl + ggplot.theme
pl = pl + ggplot2::guides(alpha = "none")
return(pl)
}
# Plot method for a two-dimensional X- or Y-Space
# We use geom_point and jitter for discrete variables
# y.name: we can plot contour-lines for a singel y-variable if both x-variables
# are numeric. in this case, op.y is the data.frame containing the y.variable
plot2D = function(op, .alpha, .type, log, names, short.names, y.name = NULL, op.y = NULL,
space, iter, classes, xlim, ylim, colours, size, ggplot.theme) {
op$.alpha = .alpha
op$.type = .type
if (space == "x") {
title = ggplot2::ggtitle("X-Space")
}
if (space == "y") {
title = ggplot2::ggtitle("Y-Space")
}
if (space == "both") {
title = ggplot2::ggtitle("X- and Y-Space")
}
factor.classes = classes == "factor"
if (any(factor.classes)) {
# Jitter only in the discrete directions
pos = ggplot2::position_jitter(w = 0.1 * factor.classes[1],
h = 0.1 * factor.classes[2])
} else {
pos = "identity"
}
# prepare contour plot
if (!is.null(y.name)) {
requirePackages(c("akima", "reshape2"), why = "renderOptPathPlot plot2D")
fld = with(cbind(op, op.y), akima::interp(x = get(names[1L]), y = get(names[2L]), z = get(y.name)))
df = reshape2::melt(fld$z, na.rm = TRUE)
names(df) = c(names, y.name)
df[[names[1L]]] = fld$x[df[[names[1L]]]]
df[[names[2L]]] = fld$y[df[[names[2L]]]]
}
pl = ggplot2::ggplot()
pl = pl + ggplot2::geom_point(data = op, ggplot2::aes(x = .data[[names[1L]]], y = .data[[names[2L]]],
shape = .data$.type, colour = .data$.type, alpha = .data$.alpha), size = size, position = pos)
# add contour
if (!is.null(y.name)) {
pl = pl + ggplot2::stat_contour(ggplot2::aes(x = .data[[names[1L]]], y = .data[[names[2L]]], z = .data[[y.name]]), data = df)
}
pl = pl + title
pl = pl + ggplot2::xlab(short.names[1L]) + ggplot2::ylab(short.names[2L])
pl = pl + ggplot2::guides(alpha = "none")
pl = pl + ggplot2::scale_colour_manual(name = "type",
values = c(init = colours[1L], seq = colours[2L], prop = colours[3L], marked = colours[4L]))
pl = pl + ggplot2::scale_shape_manual(name = "type",
values = c(init = 15L, seq = 16L, prop = 17L, marked = 18L))
pl = pl + ggplot2::scale_alpha_continuous(range = c(max(1 / (iter + 1), 0.1), 1L))
pl = pl + ggplot.theme
if (classes[1L] == "numeric") {
if (names[1L] %in% log) {
pl = pl + ggplot2::scale_x_log10(limits = xlim)
} else {
pl = pl + ggplot2::xlim(xlim)
}
}
if (classes[2L] == "numeric") {
if (names[2L] %in% log) {
pl = pl + ggplot2::scale_y_log10(limits = ylim)
} else {
pl = pl + ggplot2::ylim(ylim)
}
}
return(pl)
}
# Plot method for a multi-dimensional X- or Y-Space
# Here we make a PCP using GGally::ggparcoord
plotMultiD = function(op, .alpha, .type, log, names, short.names,
space, iter, colours, size, scale, ggplot.theme) {
args = list(columns = seq_along(names))
# make every variable numeric and check for a log trafo
for (var in names) {
op[, var] = as.numeric(op[, var])
if (var %in% log) {
op[, var] = log10(op[, var])
}
}
op$.alpha = .alpha
# minimal alpha value:
op$.type = .type
args$data = op
args$alphaLines = ".alpha"
args$groupColumn = ncol(op)
args$scale = scale
args$mapping = eval(substitute(ggplot2::aes(linewidth = size), list(size = size)))
if (space == "x") {
title = ggplot2::ggtitle("X-Space")
} else {
title = ggplot2::ggtitle("Y-Space")
}
pl = do.call(GGally::ggparcoord, args)
pl = pl + ggplot2::ylab("scaled values")
pl = pl + ggplot2::scale_x_discrete(labels = short.names)
pl = pl + title
pl = pl + ggplot2::guides(alpha = "none", size = "none")
pl = pl + ggplot2::scale_colour_manual(name = "type",
values = c(init = colours[1L], seq = colours[2L], prop = colours[3L], marked = colours[4L]))
pl = pl + ggplot.theme
return(pl)
}
# Function to plot one or more numeric variables over time
# names: all corresponding variables must be numeric
# short.names: short names of the variables given by names
multiVariablesOverTime = function(op, .alpha, dob, log, names, short.names,
space, iter, colours, ggplot.theme) {
# For rest variables, we can get a NA data.frame here. In this case, no plot
if (all(is.na(op[, names]))) {
return(NULL)
}
# allow only log trafo of all variables in this plot
log.var = names %in% log
if (any(log.var) && !all(log.var)) {
stop("If you want to apply a log trafo in an over.time.plot, you have to apply it to every variable.")
}
for (var in names) {
if (!is.numeric(op[, var])) {
warning(paste("Converting variable ", var, "to numeric for over time plot."))
}
op[, var] = as.numeric(op[, var])
}
op2 = op[, names]
op2$dob = dob
op2$.alpha = .alpha
# mean over dob
op2 = aggregate(op2, list(op2$dob), mean)[, -1]
# reshape into long format
op2 = reshape(op2, ids = row.names(op2),
times = names, timevar = "variable",
varying = list(names), direction = "long", v.names = c("value"))
pl = ggplot2::ggplot(op2, ggplot2::aes(x = .data$dob, y = .data$value, group = .data$variable,
linetype = .data$variable))
pl = pl + ggplot2::geom_point()
pl = pl + ggplot2::geom_line()
pl = pl + ggplot2::scale_linetype_discrete(labels = short.names)
# For the x axis: only whole numbers as breaks
pl = pl + ggplot2::scale_x_continuous(breaks = function(x) pretty(x, n = min(5, iter + 1)))
# fixed number of decimals:
fmt = function() {
function(x) format(x, nsmall = 3, scientific = FALSE)
}
if (all(log.var)) {
pl = pl + ggplot2::scale_y_log10(labels = fmt())
} else {
pl = pl + ggplot2::scale_y_continuous(labels = fmt())
}
pl = pl + ggplot.theme
return(pl)
}
# Plots One variable versus the DOB. name is the name of the variable to be plotted
oneVariableOverTime = function(op, .alpha, .type, dob, log, names, short.names, iter,
size.points, size.lines, colours, ggplot.theme) {
# For rest variables, we can get a NA data.frame here. In this case, no plot
if (all(is.na(op[, names]))) {
return(NULL)
}
# convert factor variables to numeric
if (!is.numeric(op[, names])) {
warning(paste("Converting variable ", names, "to numeric for over time plot."))
}
op[, names] = as.numeric(op[, names])
# Some data preproc. 2 Different datasets - one for init design, one for rest
op = cbind(op, dob = dob, .alpha = .alpha, .type = .type)
init.des.inds = dob == 0
op.init.des = op[init.des.inds, , drop = FALSE]
op.seq.opt = op[!init.des.inds, , drop = FALSE]
# if we want to log and all values are negative, make them positive.
# this is special treatment for our ei.
if (names %in% log && all(na.omit(op[, names] <= 0))) {
op.init.des[, names] = -op.init.des[, names]
op.seq.opt[, names] = -op.seq.opt[, names]
}
aes.points = ggplot2::aes(x = .data$dob, y = .data[[names]], shape = .data$.type,
colour = .data$.type, alpha = .data$.alpha)
pl = ggplot2::ggplot(op, ggplot2::aes(x = .data$dob, y = .data[[names]]))
# add initial design points allays with jitter in x-direction,
# if discrete also with jitter in y-direction
if (length(na.omit(op.init.des[, names])) > 0L) {
if (is.numeric(op[, names])) {
pl = pl + ggplot2::geom_point(data = op.init.des, mapping = aes.points, size = size.points,
position = ggplot2::position_jitter(height = 0.1))
} else {
pl = pl + ggplot2::geom_point(data = op.init.des, mapping = aes.points, size = size.points,
position = ggplot2::position_jitter(height = 0.1, width = 0.1))
}
}
# add sequential points, if discrete with jitter in y-direction
# Add jitter for discrete variable
if (length(na.omit(op.seq.opt[, names])) > 0L) {
if (is.numeric(op[, names])) {
pl = pl + ggplot2::geom_point(data = op.seq.opt, mapping = aes.points, size = size.points)
} else {
pl = pl + ggplot2::geom_point(data = op.seq.opt, mapping = aes.points, size = size.points,
position = ggplot2::position_jitter(height = 0.1, width = 0.1))
}
# mean data for line plot for sequential data - only for numeric vars
# Also ylims are only useful for numeric vars
if (is.numeric(op[, names])) {
op.seq.means = op.seq.opt[!duplicated(op.seq.opt$dob), ]
op.seq.means[, names] = tapply(op.seq.opt[, names], op.seq.opt[, "dob"], mean)
pl = pl + ggplot2::geom_line(data = op.seq.means, ggplot2::aes(x = .data$dob, y = .data[[names]]), alpha = 0.3)
}
}
# fixed number of decimals:
fmt = function() {
function(x) format(x, nsmall = 3, scientific = FALSE)
}
if (names %in% log) {
pl = pl + ggplot2::scale_y_log10(labels = fmt())
} else {
pl = pl + ggplot2::scale_y_continuous(labels = fmt())
}
pl = pl + ggplot2::geom_vline(xintercept = 0.5)
pl = pl + ggplot2::guides(alpha = "none")
pl = pl + ggplot2::ylab(short.names)
pl = pl + ggplot2::scale_colour_manual(name = "type",
values = c(init = colours[1L], seq = colours[2L], prop = colours[3L], marked = colours[4L]))
pl = pl + ggplot2::scale_shape_manual(name = "type",
values = c(init = 15L, seq = 16L, prop = 17L, marked = 18L))
# set range for alpha scale, so that extra variables (that may not exist in
# iteration 0) will have the same alpha values as all other variables.
range = c(max(min(op$.alpha[!is.na(op[, names])]), 0.1), 1L)
pl = pl + ggplot2::scale_alpha_continuous(range = range)
# For the x axis: only whole numbers as breaks
pl = pl + ggplot2::scale_x_continuous(limits = c(-0.5, NA_real_),
breaks = function(x) pretty(x, n = min(5, iter + 1)))
pl = pl + ggplot.theme
return(pl)
}
|