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
|
#' Summarise built plot objects
#'
#' These functions provide summarised information about built ggplot objects.
#'
#' There are three types of summary that can be obtained: A summary of the plot layout,
#' a summary of the plot coord, and a summary of plot layers.
#'
#' @section Layout summary:
#'
#' The function `summarise_layout()` returns a table that provides information about
#' the plot panel(s) in the built plot. The table has the following columns:
#'
#' \describe{
#' \item{`panel`}{A factor indicating the individual plot panels.}
#' \item{`row`}{Row number in the grid of panels.}
#' \item{`col`}{Column number in the grid of panels.}
#' \item{`vars`}{A list of lists. For each panel, the respective list
#' provides the variables and their values that specify the panel.}
#' \item{`xmin`, `xmax`}{The minimum and maximum values of the variable mapped to
#' the x aesthetic, in transformed coordinates.}
#' \item{`ymin`, `ymax`}{The minimum and maximum values of the variable mapped to
#' the y aesthetic, in transformed coordinates.}
#' \item{`xscale`}{The scale object applied to the x aesthetic.}
#' \item{`yscale`}{The scale object applied to the y aesthetic.}
#' }
#'
#' Importantly, the values for `xmin`, `xmax`, `ymin`, `ymax`, `xscale`, and `yscale`
#' are determined by the variables that are mapped to `x` and `y` in the `aes()` call.
#' So even if a coord changes how x and y are shown in the final plot (as is the case
#' for `coord_flip()` or `coord_polar()`), these changes have no effect on the results
#' returned by `summarise_plot()`.
#'
#' @section Coord summary:
#'
#' The function `summarise_coord()` returns information about the log base for
#' coordinates that are log-transformed in `coord_trans()`, and it also indicates
#' whether the coord has flipped the x and y axes.
#'
#' @section Layer summary:
#'
#' The function `summarise_layers()` returns a table with a single column, `mapping`, which
#' contains information about aesthetic mapping for each layer.
#'
#' @param p A ggplot_built object.
#'
#' @examples
#' p <-
#' ggplot(mpg, aes(displ, hwy)) +
#' geom_point() +
#' facet_wrap(~class)
#' b <- ggplot_build(p)
#'
#' summarise_layout(b)
#' summarise_coord(b)
#' summarise_layers(b)
#'
#' @keywords internal
#'
#' @name summarise_plot
NULL
#' @rdname summarise_plot
#' @export
summarise_layout = function(p) {
if (!inherits(p, "ggplot_built")) {
cli::cli_abort("{.arg p} must be a {.cls ggplot_build} object")
}
l <- p$layout
layout <- l$layout
layout <- tibble(
panel = l$layout$PANEL,
row = l$layout$ROW,
col = l$layout$COL
)
# layout data frame has columns named for facet vars; rename them so we don't
# have a naming collision.
facet_vars <- l$facet$vars()
# Add a list-column of panel vars (for facets).
layout$vars <- lapply(seq_len(nrow(layout)), function(i) {
res <- lapply(facet_vars, function(var) l$layout[[var]][i])
setNames(res, facet_vars)
})
xyranges <- lapply(l$panel_params, l$coord$range)
layout$xmin <- vapply(xyranges, function(xyrange) xyrange$x[[1]], numeric(1))
layout$xmax <- vapply(xyranges, function(xyrange) xyrange$x[[2]], numeric(1))
layout$ymin <- vapply(xyranges, function(xyrange) xyrange$y[[1]], numeric(1))
layout$ymax <- vapply(xyranges, function(xyrange) xyrange$y[[2]], numeric(1))
# Put x and y scale objects in list-cols.
layout$xscale <- lapply(seq_len(nrow(layout)), function(n) l$get_scales(n)$x)
layout$yscale <- lapply(seq_len(nrow(layout)), function(n) l$get_scales(n)$y)
layout
}
#' @rdname summarise_plot
#' @export
summarise_coord = function(p) {
if (!inherits(p, "ggplot_built")) {
cli::cli_abort("{.arg p} must be a {.cls ggplot_build} object")
}
# Given a transform object, find the log base; if the transform object is
# NULL, or if it's not a log transform, return NA.
trans_get_log_base <- function(trans) {
if (!is.null(trans) && grepl("^log-", trans$name)) {
environment(trans$transform)$base
} else {
NA_real_
}
}
list(
xlog = trans_get_log_base(p$layout$coord$trans$x),
ylog = trans_get_log_base(p$layout$coord$trans$y),
flip = inherits(p$layout$coord, "CoordFlip")
)
}
#' @rdname summarise_plot
#' @export
summarise_layers <- function(p) {
if (!inherits(p, "ggplot_built")) {
cli::cli_abort("{.arg p} must be a {.cls ggplot_build} object")
}
# Default mappings. Make sure it's a regular list instead of an uneval
# object.
default_mapping <- unclass(p$plot$mapping)
layer_mappings <- lapply(p$plot$layers, function(layer) {
defaults(layer$mapping, default_mapping)
})
# This currently only returns the mappings, but in the future, other
# information could be added.
tibble(
mapping = layer_mappings
)
}
|
