/
plot_eval.R
131 lines (128 loc) · 5.98 KB
/
plot_eval.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
#' Plot a metric's value for each method
#'
#' When the evaluted metric is scalar-valued, this functions makes a boxplot of
#' this metric for each method. When the metric is vector-valued, this function
#' makes a curve with this metric on the y-axis, with one curve for each method
#' (the x-axis is the corresponding entry of that metric's vector). If evals is
#' a \code{listofEvals}, then each model will be its own plot.
#'
#' @param object an object of class \code{\linkS4class{Simulation}},
#' \code{\linkS4class{Evals}}, or \code{listofEvals}
#' @param metric_name the name of a metric to plot
#' @param use_ggplot2 whether to use \code{ggplot2} (requires installation
#' of \code{ggplot2})
#' @param main title of plot. Default is \code{model_label} when evals is
#' a single Evals.
#' @param facet_mains only to be used when evals is a \code{listofEvals}
#' and should be of the same length. Default will be the model_label
#' for each model.
#' @param ylab the y-axis label (default is \code{metric_label})
#' @param ylim the y-axis limits to use (across all plots)
#' @param include_zero whether ylim should include 0. Ignored if ylim
#' is passed explicitly
#' @param angle angle of labels (only when \code{use_ggplot2 = FALSE})
#' @param ... additional arguments to pass to \code{boxplot} (only when
#' \code{use_ggplot2 = FALSE}).
#' @export
#' @seealso \code{\link{plot_evals}} \code{\link{plot_eval_by}}
#' \code{\link{tabulate_eval}}
#' @examples
#' \dontrun{
#' # suppose previously we had run the following:
#' sim <- new_simulation(name = "normal-example",
#' label = "Normal Mean Estimation",
#' dir = tempdir()) %>%
#' generate_model(make_my_example_model, n = 20) %>%
#' simulate_from_model(nsim = 50, index = 1:3) %>%
#' run_method(my_example_method) %>%
#' evaluate(my_example_loss)
#' # then we could plot this
#' plot_eval(sim, "myloss") # "myloss" is my_example_loss@name
#' }
plot_eval <- function(object, metric_name, use_ggplot2 = TRUE, main,
facet_mains, ylab, ylim, include_zero = FALSE, angle = 0,
...) {
ev_list <- get_evals_list(object)
if (length(ev_list) == 0) stop("Passed object does not have Evals to plot.")
if (!any(unlist(lapply(ev_list,
function(e) metric_name %in% e@metric_name)))) {
stop("Passed object does not have Evals with this metric name.")
}
if (length(ev_list) == 1) {
if (missing(main))
main <- ev_list[[1]]@model_label
facet_mains <- main
} else {
# we have multiple facets
if (missing(facet_mains))
facet_mains <- unlist(lapply(ev_list, function(e) e@model_label))
}
if (missing(ylab))
ylab <- ev_list[[1]]@metric_label[ev_list[[1]]@metric_name == metric_name]
ev_list <- subset_evals(ev_list, metric_names = metric_name)
evals_df <- as.data.frame(ev_list)
if(any(table(evals_df[, c("Model", "Method", "Draw")]) != 1)) {
return(plot_evals(object, metric_name_x = NULL, metric_name_y = metric_name,
use_ggplot2 = use_ggplot2, main = main, facet_mains = facet_mains,
ylab = ylab, ylim = ylim, include_zero = include_zero))
}
if (missing(ylim)) {
ylim <- range(evals_df[[metric_name]])
if (include_zero) ylim <- range(ylim, 0)
}
method_names <- unique(unlist(lapply(ev_list, function(e) e@method_name)))
method_labels <- unique(unlist(lapply(ev_list, function(e) e@method_label)))
nrow <- floor(sqrt(length(ev_list)))
ncol <- ceiling(length(ev_list) / nrow)
if (use_ggplot2) return(ggplot_eval(evals_df, metric_name, method_names,
method_labels, main, facet_mains, ylab,
ylim, nrow, ncol))
if (nrow != 1 | ncol != 1)
par(mfrow = c(nrow, ncol))
for (i in seq_along(ev_list)) {
evals_df <- as.data.frame(ev_list[[i]])
if (angle == 0) {
boxplot(as.formula(paste0(metric_name, "~ Method")), data = evals_df,
names = ev_list[[i]]@method_label, ylab = ylab, xlab = "Method",
main = facet_mains[i], ylim = ylim, ...)
} else {
boxplot(as.formula(paste0(metric_name, "~ Method")), data = evals_df,
names = ev_list[[i]]@method_label, xaxt = "n", ylab = ylab,
xlab = "Method",
main = facet_mains[i], ylim = ylim, ...)
axis(1, labels=FALSE)
text(x = seq_along(ev_list[[i]]@method_label),
y = par("usr")[3] - 0.03 * diff(par("usr"))[3],
srt = angle,
adj = 1, labels = ev_list[[i]]@method_label, xpd = TRUE)
}
}
if (!missing(main) & length(ev_list) > 1)
title(main, outer = TRUE, line = -1)
}
#' Make a boxplot of a metric for each method using ggplot2
#' @keywords internal
ggplot_eval <- function(evals_df, metric_name, method_name, method_label,
main, facet_mains, ylab, ylim, nrow, ncol) {
if (!requireNamespace("ggplot2", quietly = TRUE)) {
stop("To use this function, ggplot2 must be installed.", call. = FALSE)
}
if (missing(main)) main <- NULL
if (length(unique(evals_df[["Model"]])) == 1) {
return(ggplot2::ggplot(evals_df, ggplot2::aes_string("Method", metric_name)) +
ggplot2::geom_boxplot() +
ggplot2::labs(x = "Method", y = ylab, title = main) +
ggplot2::scale_x_discrete(breaks = method_name, labels = method_label) +
ggplot2::scale_y_continuous(limits = ylim))
}
# display multiple facets...
if (length(unique(facet_mains)) < length(facet_mains))
stop("Labels of individual plots must be unique. Pass facet_mains explicitly.")
levels(evals_df$Model) <- facet_mains
ggplot2::ggplot(evals_df, ggplot2::aes_string("Method", metric_name)) +
ggplot2::geom_boxplot() +
ggplot2::labs(x = "Method", y = ylab, title = main) +
ggplot2::scale_x_discrete(breaks = method_name, labels = method_label) +
ggplot2::facet_wrap("Model", nrow = nrow, ncol = ncol) +
ggplot2::scale_y_continuous(limits = ylim)
}