Forward compatibility: cherry-pick accessors (#6387)

Author: teunbrand

DESCRIPTION

@@ -79,7 +79,7 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.3.1
+RoxygenNote: 7.3.2
 Collate: 
     'ggproto.R'
     'ggplot-global.R'

NAMESPACE

@@ -67,6 +67,7 @@ S3method(ggplot_add,list)
 S3method(ggplot_add,theme)
 S3method(ggplot_add,uneval)
 S3method(ggplot_build,ggplot)
+S3method(ggplot_build,ggplot_built)
 S3method(ggplot_gtable,ggplot_built)
 S3method(grid.draw,absoluteGrob)
 S3method(grid.draw,ggplot)
@@ -420,7 +421,9 @@ export(geom_violin)
 export(geom_vline)
 export(get_alt_text)
 export(get_element_tree)
+export(get_geom_defaults)
 export(get_guide_data)
+export(get_labs)
 export(gg_dep)
 export(ggplot)
 export(ggplotGrob)

NEWS.md

@@ -1,3 +1,11 @@
+# ggplot2 (development version)
+
+* New `get_labs()` function for retrieving completed plot labels 
+  (@teunbrand, #6008).
+* New `get_geom_defaults()` for retrieving resolved default aesthetics.
+* A new `ggplot_build()` S3 method for <ggplot_built> classes was added, which
+  returns input unaltered (@teunbrand, #5800).
+
 # ggplot2 3.5.1
 
 This is a small release focusing on fixing regressions from 3.5.0 and 

R/geom-defaults.R

@@ -53,3 +53,54 @@ update_stat_defaults <- function(stat, new) {
   g$default_aes[names(new)] <- new
   invisible()
 }
+
+#' Resolve and get geom defaults
+#'
+#' @param geom Some definition of a geom:
+#' * A `function` that creates a layer, e.g. `geom_path()`.
+#' * A layer created by such function
+#' * A string naming a geom class in snake case without the `geom_`-prefix,
+#'   e.g. `"contour_filled"`.
+#' * A geom class object.
+#' @param theme A [`theme`] object. Defaults to the current global theme.
+#'
+#' @return A list of aesthetics
+#' @export
+#' @keywords internal
+#'
+#' @examples
+#' # Using a function
+#' get_geom_defaults(geom_raster)
+#'
+#' # Using a layer includes static aesthetics as default
+#' get_geom_defaults(geom_tile(fill = "white"))
+#'
+#' # Using a class name
+#' get_geom_defaults("density_2d")
+#'
+#' # Using a class
+#' get_geom_defaults(GeomPoint)
+#'
+#' # Changed theme
+#' get_geom_defaults("point", theme(geom = element_geom(ink = "purple")))
+get_geom_defaults <- function(geom, theme = theme_get()) {
+  theme <- theme %||% list(geom = .default_geom_element)
+
+  if (is.function(geom)) {
+    geom <- geom()
+  }
+  if (is.layer(geom)) {
+    data <- data_frame0(.id = 1L)
+    data <- geom$compute_geom_2(data = data)
+    data$.id <- NULL
+    return(data)
+  }
+  if (is.character(geom)) {
+    geom <- check_subclass(geom, "Geom")
+  }
+  if (inherits(geom, "Geom")) {
+    out <- geom$use_defaults(data = NULL)
+    return(out)
+  }
+  stop_input_type(geom, as_cli("a layer function, string or {.cls Geom} object"))
+}

R/guide-colorbar.R

@@ -266,6 +266,7 @@ GuideColourbar <- ggproto(
   merge = function(self, params, new_guide, new_params) {
     new_params$key$.label <- new_params$key$.value <- NULL
     params$key <- vec_cbind(params$key, new_params$key)
+    params$aesthetic <- union(params$aesthetic, new_params$aesthetic)
     return(list(guide = self, params = params))
   },
 

R/guide-legend.R

@@ -204,6 +204,7 @@ GuideLegend <- ggproto(
       cli::cli_warn("Duplicated {.arg override.aes} is ignored.")
     }
     params$override.aes <- params$override.aes[!duplicated(nms)]
+    params$aesthetic <- union(params$aesthetic, new_params$aesthetic)
 
     list(guide = self, params = params)
   },

R/guides-.R

@@ -792,9 +792,7 @@ get_guide_data <- function(plot = last_plot(), aesthetic, panel = 1L) {
   check_string(aesthetic, allow_empty = FALSE)
   aesthetic <- standardise_aes_names(aesthetic)
 
-  if (!inherits(plot, "ggplot_built")) {
-    plot <- ggplot_build(plot)
-  }
+  plot <- ggplot_build(plot)
 
   if (!aesthetic %in% c("x", "y", "x.sec", "y.sec", "theta", "r")) {
     # Non position guides: check if aesthetic in colnames of key

R/labels.R

@@ -105,6 +105,39 @@ ggtitle <- function(label, subtitle = waiver()) {
   labs(title = label, subtitle = subtitle)
 }
 
+#' @rdname labs
+#' @export
+#' @param plot A ggplot object
+#' @description
+#' `get_labs()` retrieves completed labels from a plot.
+get_labs <- function(plot = get_last_plot()) {
+  plot <- ggplot_build(plot)
+
+  labs <- plot$plot$labels
+
+  xy_labs <- rename(
+    c(x = plot$layout$resolve_label(plot$layout$panel_scales_x[[1]], labs),
+      y = plot$layout$resolve_label(plot$layout$panel_scales_y[[1]], labs)),
+    c(x.primary = "x", x.secondary = "x.sec",
+      y.primary = "y", y.secondary = "y.sec")
+  )
+
+  labs <- defaults(xy_labs, labs)
+
+  guides <- plot$plot$guides
+  if (length(guides$aesthetics) == 0) {
+    return(labs)
+  }
+
+  for (aes in guides$aesthetics) {
+    param <- guides$get_params(aes)
+    aes   <- param$aesthetic # Can have length > 1 when guide was merged
+    title <- vec_set_names(rep(list(param$title), length(aes)), aes)
+    labs  <- defaults(title, labs)
+  }
+  labs
+}
+
 #' Extract alt text from a plot
 #'
 #' This function returns a text that can be used as alt-text in webpages etc.

R/plot-build.R

@@ -30,6 +30,12 @@ ggplot_build <- function(plot) {
   UseMethod('ggplot_build')
 }
 
+#' @export
+ggplot_build.ggplot_built <- function(plot) {
+  # This is a no-op
+  plot
+}
+
 #' @export
 ggplot_build.ggplot <- function(plot) {
   plot <- plot_clone(plot)