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
|
#' Arrange plots in a grid
#'
#' The `bayesplot_grid` function makes it simple to juxtapose plots using
#' common \eqn{x} and/or \eqn{y} axes.
#'
#' @export
#' @param ... One or more ggplot objects.
#' @param plots A list of ggplot objects. Can be used as an alternative to
#' specifying plot objects via `...`.
#' @param grid_args An optional named list of arguments to pass to
#' [gridExtra::arrangeGrob()] (`nrow`, `ncol`,
#' `widths`, etc.).
#' @param titles,subtitles Optional character vectors of plot titles and
#' subtitles. If specified, `titles` and `subtitles` must must have
#' length equal to the number of plots specified.
#' @param xlim,ylim Optionally, numeric vectors of length 2 specifying lower and
#' upper limits for the axes that will be shared across all plots.
#' @param legends If any of the plots have legends should they be displayed?
#' Defaults to `TRUE`.
#' @param save_gg_objects If `TRUE`, the default, then the ggplot objects
#' specified in `...` or via the `plots` argument are saved in a
#' list in the `"bayesplots"` component of the returned object.
#' Setting this to `FALSE` will make the returned object smaller but
#' these individual plot objects will not be available.
#'
#' @return An object of class `"bayesplot_grid"` (essentially a gtable object
#' from [gridExtra::arrangeGrob()]), which has a `plot` method.
#'
#' @examples
#' y <- example_y_data()
#' yrep <- example_yrep_draws()
#' stats <- c("sd", "median", "max", "min")
#'
#' color_scheme_set("pink")
#' bayesplot_grid(
#' plots = lapply(stats, function(s) ppc_stat(y, yrep, stat = s)),
#' titles = stats,
#' legends = FALSE,
#' grid_args = list(ncol = 1)
#' )
#'
#' \dontrun{
#' library(rstanarm)
#' mtcars$log_mpg <- log(mtcars$mpg)
#' fit1 <- stan_glm(mpg ~ wt, data = mtcars, refresh = 0)
#' fit2 <- stan_glm(log_mpg ~ wt, data = mtcars, refresh = 0)
#'
#' y <- mtcars$mpg
#' yrep1 <- posterior_predict(fit1, draws = 50)
#' yrep2 <- posterior_predict(fit2, fun = exp, draws = 50)
#'
#' color_scheme_set("blue")
#' ppc1 <- ppc_dens_overlay(y, yrep1)
#' ppc1
#' ppc1 + yaxis_text()
#'
#' color_scheme_set("red")
#' ppc2 <- ppc_dens_overlay(y, yrep2)
#' bayesplot_grid(ppc1, ppc2)
#'
#' # make sure the plots use the same limits for the axes
#' bayesplot_grid(ppc1, ppc2, xlim = c(-5, 60), ylim = c(0, 0.2))
#'
#' # remove the legends and add text
#' bayesplot_grid(ppc1, ppc2, xlim = c(-5, 60), ylim = c(0, 0.2),
#' legends = FALSE, subtitles = rep("Predicted MPG", 2))
#' }
#'
bayesplot_grid <-
function(...,
plots = list(),
xlim = NULL,
ylim = NULL,
grid_args = list(),
titles = character(),
subtitles = character(),
legends = TRUE,
save_gg_objects = TRUE) {
suggested_package("gridExtra")
dots <- list(...)
if (length(dots) && length(plots)) {
abort("Arguments '...' and 'plots' can't both be specified.")
} else if (length(plots)) {
if (!is.list(plots) || !all_ggplot(plots))
abort("'plots' must be a list of ggplot objects.")
} else if (length(dots)) {
if (!all_ggplot(dots))
abort("All objects in '...' must be ggplot objects.")
plots <- dots
} else {
abort("No plots specified.")
}
if (length(titles)) {
stopifnot(is.character(titles), length(titles) == length(plots))
plots <- lapply(seq_along(plots), function(j)
plots[[j]] + ggtitle(titles[j]))
}
if (length(subtitles)) {
stopifnot(is.character(subtitles), length(subtitles) == length(plots))
plots <- lapply(seq_along(plots), function(j)
plots[[j]] + labs(subtitle = subtitles[j]))
}
if (!legends)
plots <- lapply(plots, function(p)
p + legend_none())
if (!is.null(xlim))
plots <- lapply(plots, function(p)
p + ggplot2::xlim(xlim))
if (!is.null(ylim))
plots <- lapply(plots, function(p)
p + ggplot2::ylim(ylim))
grid_args$grobs <- plots
g <- do.call(gridExtra::arrangeGrob, args = grid_args)
if (save_gg_objects) {
g$bayesplots <- plots
}
as_bayesplot_grid(g)
}
# internal ----------------------------------------------------------------
as_bayesplot_grid <- function(x) {
structure(x, class = unique(c("bayesplot_grid", class(x))))
}
is_bayesplot_grid <- function(x) {
inherits(x, "bayesplot_grid")
}
all_ggplot <- function(x) {
all(sapply(x, "inherits", what = "ggplot"))
}
#' @export
print.bayesplot_grid <- function(x, ...) {
gridExtra::grid.arrange(x, ...)
}
#' @export
plot.bayesplot_grid <- print.bayesplot_grid
|
