Release 3.5.2

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: ggplot2
-Version: 3.5.0.9000
+Version: 3.5.1
 Title: Create Elegant Data Visualisations Using the Grammar of Graphics
 Authors@R: c(
     person("Hadley", "Wickham", , "hadley@posit.co", role = "aut",
@@ -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)
@@ -455,6 +458,21 @@ export(is.facet)
 export(is.ggplot)
 export(is.ggproto)
 export(is.theme)
+export(is_coord)
+export(is_facet)
+export(is_geom)
+export(is_ggplot)
+export(is_ggproto)
+export(is_guide)
+export(is_guides)
+export(is_layer)
+export(is_mapping)
+export(is_margin)
+export(is_position)
+export(is_scale)
+export(is_stat)
+export(is_theme)
+export(is_theme_element)
 export(label_both)
 export(label_bquote)
 export(label_context)

R/aes.R

@@ -102,6 +102,10 @@ aes <- function(x, y, ...) {
   rename_aes(aes)
 }
 
+#' @export
+#' @rdname is_tests
+is_mapping <- function(x) inherits(x, "uneval")
+
 # Wrap symbolic objects in quosures but pull out constants out of
 # quosures for backward-compatibility
 new_aesthetic <- function(x, env = globalenv()) {

R/coord-.R

@@ -204,11 +204,17 @@ Coord <- ggproto("Coord",
   }
 )
 
-#' Is this object a coordinate system?
-#'
-#' @export is.Coord
-#' @keywords internal
-is.Coord <- function(x) inherits(x, "Coord")
+#' @export
+#' @rdname is_tests
+is_coord <- function(x) inherits(x, "Coord")
+
+#' @export
+#' @rdname is_tests
+#' @usage is.Coord(x) # Deprecated
+is.Coord <- function(x) {
+  deprecate_soft0("3.5.2", "is.Coord()", "is_coord()")
+  is_coord(x)
+}
 
 # Renders an axis with the correct orientation or zeroGrob if no axis should be
 # generated

R/coord-cartesian-.R

@@ -159,7 +159,7 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) {
 }
 
 panel_guides_grob <- function(guides, position, theme, labels = NULL) {
-  if (!inherits(guides, "Guides")) {
+  if (!is_guides(guides)) {
     return(zeroGrob())
   }
   pair <- guides$get_position(position)

R/facet-.R

@@ -239,13 +239,17 @@ vars <- function(...) {
   quos(...)
 }
 
+#' @export
+#' @rdname is_tests
+is_facet <- function(x) inherits(x, "Facet")
 
-#' Is this object a faceting specification?
-#'
-#' @param x object to test
-#' @keywords internal
 #' @export
-is.facet <- function(x) inherits(x, "Facet")
+#' @rdname is_tests
+#' @usage is.facet(x) # Deprecated
+is.facet <- function(x) {
+  deprecate_soft0("3.5.2", "is.facet()", "is_facet()")
+  is_facet(x)
+}
 
 # A "special" value, currently not used but could be used to determine
 # if faceting is active
@@ -324,7 +328,7 @@ as_facets_list <- function(x) {
 }
 
 validate_facets <- function(x) {
-  if (inherits(x, "uneval")) {
+  if (is_mapping(x)) {
     cli::cli_abort("Please use {.fn vars} to supply facet variables.")
   }
   # Native pipe have higher precedence than + so any type of gg object can be

R/fortify.R

@@ -82,7 +82,7 @@ fortify.default <- function(model, data, ...) {
     "or an object coercible by {{.fn fortify}}, or a valid ",
     "{{.cls data.frame}}-like object coercible by {{.fn as.data.frame}}"
   )
-  if (inherits(model, "uneval")) {
+  if (is_mapping(model)) {
     msg <- c(
       glue(msg0, ", not {obj_type_friendly(model)}."),
       "i" = "Did you accidentally pass {.fn aes} to the {.arg data} argument?"

R/geom-.R

@@ -222,6 +222,9 @@ Geom <- ggproto("Geom",
 
 )
 
+#' @export
+#' @rdname is_tests
+is_geom <- function(x) inherits(x, "Geom")
 
 #' Graphical units
 #'

R/geom-defaults.R

@@ -53,3 +53,51 @@ 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)
+get_geom_defaults <- function(geom, theme = theme_get()) {
+  theme <- theme %||% list()
+
+  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/ggproto.R

@@ -52,7 +52,7 @@
 #'     self$x
 #'   }
 #'  )
-#' is.ggproto(Adder)
+#' is_ggproto(Adder)
 #'
 #' Adder$add(10)
 #' Adder$add(10)
@@ -88,7 +88,7 @@ ggproto <- function(`_class` = NULL, `_inherit` = NULL, ...) {
 
   super <- find_super()
   if (!is.null(super)) {
-    check_object(super, is.ggproto, "a {.cls ggproto} object", arg = "_inherit")
+    check_object(super, is_ggproto, "a {.cls ggproto} object", arg = "_inherit")
     e$super <- find_super
     class(e) <- c(`_class`, class(super))
   } else {
@@ -106,10 +106,17 @@ ggproto_parent <- function(parent, self) {
   structure(list(parent = parent, self = self), class = "ggproto_parent")
 }
 
-#' @param x An object to test.
 #' @export
-#' @rdname ggproto
-is.ggproto <- function(x) inherits(x, "ggproto")
+#' @rdname is_tests
+is_ggproto <- function(x) inherits(x, "ggproto")
+
+#' @export
+#' @rdname is_tests
+#' @usage is.ggproto(x) # Deprecated
+is.ggproto <- function(x) {
+  deprecate_soft0("3.5.2", "is.ggproto()", "is_ggproto()")
+  is_ggproto(x)
+}
 
 fetch_ggproto <- function(x, name) {
   res <- NULL
@@ -305,7 +312,7 @@ object_summaries <- function(x, exclude = NULL, flat = TRUE) {
   values <- vapply(obj_names, function(name) {
     obj <- x[[name]]
     if (is.function(obj)) "function"
-    else if (is.ggproto(obj)) format(obj, flat = flat)
+    else if (is_ggproto(obj)) format(obj, flat = flat)
     else if (is.environment(obj)) "environment"
     else if (is.null(obj)) "NULL"
     else if (is.atomic(obj)) trim(paste(as.character(obj), collapse = " "))

R/guide-.R

@@ -50,7 +50,7 @@ new_guide <- function(..., available_aes = "any", super) {
 
   # Validate theme settings
   if (!is.null(params$theme)) {
-    check_object(params$theme, is.theme, what = "a {.cls theme} object")
+    check_object(params$theme, is_theme, what = "a {.cls theme} object")
     validate_theme(params$theme, call = caller_env())
     params$direction <- params$direction %||% params$theme$legend.direction
   }
@@ -66,6 +66,10 @@ new_guide <- function(..., available_aes = "any", super) {
   )
 }
 
+#' @export
+#' @rdname is_tests
+is_guide <- function(x) inherits(x, "Guide")
+
 #' @section Guides:
 #'
 #' The `guide_*()` functions, such as `guide_legend()` return an object that
@@ -377,10 +381,10 @@ Guide <- ggproto(
   # Renders tickmarks
   build_ticks = function(key, elements, params, position = params$position,
                          length = elements$ticks_length) {
-    if (!inherits(elements, "element")) {
+    if (!is_theme_element(elements)) {
       elements <- elements$ticks
     }
-    if (!inherits(elements, "element_line")) {
+    if (!is_theme_element(elements, "line")) {
       return(zeroGrob())
     }
 

R/guide-axis.R

@@ -240,7 +240,7 @@ GuideAxis <- ggproto(
 
   override_elements = function(params, elements, theme) {
     label <- elements$text
-    if (!inherits(label, "element_text")) {
+    if (!is_theme_element(label, "text")) {
       return(elements)
     }
     label_overrides <- axis_label_element_overrides(

R/guide-colorbar.R

@@ -6,7 +6,7 @@ NULL
 #' Colour bar guide shows continuous colour scales mapped onto values.
 #' Colour bar is available with `scale_fill` and `scale_colour`.
 #' For more information, see the inspiration for this function:
-#' \href{http://www.mathworks.com/help/techdoc/ref/colorbar.html}{Matlab's colorbar function}.
+#' \href{https://www.mathworks.com/help/techdoc/ref/colorbar.html}{Matlab's colorbar function}.
 #'
 #' Guides can be specified in each `scale_*` or in [guides()].
 #' `guide="legend"` in `scale_*` is syntactic sugar for
@@ -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)
   },
@@ -786,7 +787,7 @@ deprecated_guide_args <- function(
 
   # Set as theme
   theme <- compact(theme)
-  if (!is.theme(theme)) {
+  if (!is_theme(theme)) {
     theme <- inject(theme(!!!theme))
   }
   theme

R/guides-.R

@@ -109,9 +109,13 @@ guides <- function(...) {
   NULL
 }
 
+#' @export
+#' @rdname is_tests
+is_guides <- function(x) inherits(x, "Guides")
+
 update_guides <- function(p, guides) {
   p <- plot_clone(p)
-  if (inherits(p$guides, "Guides")) {
+  if (is_guides(p$guides)) {
     old <- p$guides
     new <- ggproto(NULL, old)
     new$add(guides)
@@ -151,7 +155,7 @@ Guides <- ggproto(
     if (is.null(guides)) {
       return(invisible())
     }
-    if (inherits(guides, "Guides")) {
+    if (is_guides(guides)) {
       guides <- guides$guides
     }
     self$guides <- defaults(guides, self$guides)
@@ -792,9 +796,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
@@ -900,7 +902,7 @@ validate_guide <- function(guide) {
       guide <- fun()
     }
   }
-  if (inherits(guide, "Guide")) {
+  if (is_guide(guide)) {
     return(guide)
   }
   if (inherits(guide, "guide") && is.list(guide)) {