1#' Summarise built plot objects
2#'
3#' These functions provide summarised information about built ggplot objects.
4#'
5#' There are three types of summary that can be obtained: A summary of the plot layout,
6#' a summary of the plot coord, and a summary of plot layers.
7#'
8#' @section Layout summary:
9#'
10#' The function `summarise_layout()` returns a table that provides information about
11#' the plot panel(s) in the built plot. The table has the following columns:
12#'
13#' \describe{
14#'   \item{`panel`}{A factor indicating the individual plot panels.}
15#'   \item{`row`}{Row number in the grid of panels.}
16#'   \item{`col`}{Column number in the grid of panels.}
17#'   \item{`vars`}{A list of lists. For each panel, the respective list
18#'     provides the variables and their values that specify the panel.}
19#'   \item{`xmin`, `xmax`}{The minimum and maximum values of the variable mapped to
20#'     the x aesthetic, in transformed coordinates.}
21#'   \item{`ymin`, `ymax`}{The minimum and maximum values of the variable mapped to
22#'     the y aesthetic, in transformed coordinates.}
23#'   \item{`xscale`}{The scale object applied to the x aesthetic.}
24#'   \item{`yscale`}{The scale object applied to the y aesthetic.}
25#' }
26#'
27#' Importantly, the values for `xmin`, `xmax`, `ymin`, `ymax`, `xscale`, and `yscale`
28#' are determined by the variables that are mapped to `x` and `y` in the `aes()` call.
29#' So even if a coord changes how x and y are shown in the final plot (as is the case
30#' for `coord_flip()` or `coord_polar()`), these changes have no effect on the results
31#' returned by `summarise_plot()`.
32#'
33#' @section Coord summary:
34#'
35#' The function `summarise_coord()` returns information about the log base for
36#' coordinates that are log-transformed in `coord_trans()`, and it also indicates
37#' whether the coord has flipped the x and y axes.
38#'
39#' @section Layer summary:
40#'
41#' The function `summarise_layers()` returns a table with a single column, `mapping`, which
42#' contains information about aesthetic mapping for each layer.
43#'
44#' @param p A ggplot_built object.
45#'
46#' @examples
47#' p <-
48#'   ggplot(mpg, aes(displ, hwy)) +
49#'   geom_point() +
50#'   facet_wrap(~class)
51#' b <- ggplot_build(p)
52#'
53#' summarise_layout(b)
54#' summarise_coord(b)
55#' summarise_layers(b)
56#'
57#' @keywords internal
58#'
59#' @name summarise_plot
60NULL
61
62#' @rdname summarise_plot
63#' @export
64summarise_layout = function(p) {
65  if (!inherits(p, "ggplot_built")) abort("`p` must be a ggplot_build object")
66  l <- p$layout
67
68  layout <- l$layout
69  layout <- tibble(
70    panel = l$layout$PANEL,
71    row   = l$layout$ROW,
72    col   = l$layout$COL
73  )
74
75  # layout data frame has columns named for facet vars; rename them so we don't
76  # have a naming collision.
77  facet_vars <- l$facet$vars()
78
79  # Add a list-column of panel vars (for facets).
80  layout$vars <- lapply(seq_len(nrow(layout)), function(i) {
81    res <- lapply(facet_vars, function(var) l$layout[[var]][i])
82    setNames(res, facet_vars)
83  })
84
85  xyranges <- lapply(l$panel_params, l$coord$range)
86  layout$xmin <- vapply(xyranges, function(xyrange) xyrange$x[[1]], numeric(1))
87  layout$xmax <- vapply(xyranges, function(xyrange) xyrange$x[[2]], numeric(1))
88  layout$ymin <- vapply(xyranges, function(xyrange) xyrange$y[[1]], numeric(1))
89  layout$ymax <- vapply(xyranges, function(xyrange) xyrange$y[[2]], numeric(1))
90
91  # Put x and y scale objects in list-cols.
92  layout$xscale <- lapply(seq_len(nrow(layout)), function(n) l$get_scales(n)$x)
93  layout$yscale <- lapply(seq_len(nrow(layout)), function(n) l$get_scales(n)$y)
94
95  layout
96}
97
98
99#' @rdname summarise_plot
100#' @export
101summarise_coord = function(p) {
102  if (!inherits(p, "ggplot_built")) abort("`p` must be a ggplot_build object")
103
104  # Given a transform object, find the log base; if the transform object is
105  # NULL, or if it's not a log transform, return NA.
106  trans_get_log_base <- function(trans) {
107    if (!is.null(trans) && grepl("^log-", trans$name)) {
108      environment(trans$transform)$base
109    } else {
110      NA_real_
111    }
112  }
113
114  list(
115    xlog = trans_get_log_base(p$layout$coord$trans$x),
116    ylog = trans_get_log_base(p$layout$coord$trans$y),
117    flip = inherits(p$layout$coord, "CoordFlip")
118  )
119}
120
121
122#' @rdname summarise_plot
123#' @export
124summarise_layers <- function(p) {
125  if (!inherits(p, "ggplot_built")) abort("`p` must be a ggplot_build object")
126
127  # Default mappings. Make sure it's a regular list instead of an uneval
128  # object.
129  default_mapping <- unclass(p$plot$mapping)
130
131  layer_mappings <- lapply(p$plot$layers, function(layer) {
132    defaults(layer$mapping, default_mapping)
133  })
134
135  # This currently only returns the mappings, but in the future, other
136  # information could be added.
137  tibble(
138    mapping = layer_mappings
139  )
140}
141