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