Clear merge debris

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: ggplot2
+Version: 3.5.2.9000
 Title: Create Elegant Data Visualisations Using the Grammar of Graphics
-Version: 3.5.1.9000
 Authors@R: c(
     person("Hadley", "Wickham", , "[email protected]", role = "aut",
            comment = c(ORCID = "0000-0003-4757-117X")),

NAMESPACE

@@ -470,22 +470,26 @@ export(guide_transform)
 export(guides)
 export(has_flipped_aes)
 export(is.Coord)
-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(is.waiver)
+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(is_waiver)
 export(label_both)
 export(label_bquote)
 export(label_context)

R/aes.R

@@ -111,7 +111,7 @@ aes <- function(x, y, ...) {
 
 #' @export
 #' @rdname is_tests
-is.mapping <- function(x) inherits(x, "uneval")
+is_mapping <- function(x) inherits(x, "uneval")
 
 # Wrap symbolic objects in quosures but pull out constants out of
 # quosures for backward-compatibility
@@ -302,7 +302,7 @@ aes_ <- function(x, y, ...) {
   caller_env <- parent.frame()
 
   as_quosure_aes <- function(x) {
-    if (is.formula(x) && length(x) == 2) {
+    if (is_formula(x) && length(x) == 2) {
       as_quosure(x)
     } else if (is.null(x) || is.call(x) || is.name(x) || is.atomic(x)) {
       new_aesthetic(x, caller_env)

R/axis-secondary.R

@@ -124,19 +124,19 @@ dup_axis <- function(transform = identity, name = derive(), breaks = derive(),
   sec_axis(transform, trans = trans, name, breaks, labels, guide)
 }
 
-is.sec_axis <- function(x) {
+is_sec_axis <- function(x) {
   inherits(x, "AxisSecondary")
 }
 
 set_sec_axis <- function(sec.axis, scale) {
-  if (!is.waiver(sec.axis)) {
+  if (!is_waiver(sec.axis)) {
     if (scale$is_discrete()) {
       if (!identical(.subset2(sec.axis, "trans"), identity)) {
         cli::cli_abort("Discrete secondary axes must have the {.fn identity} transformation.")
       }
     }
-    if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis)
-    if (!is.sec_axis(sec.axis)) {
+    if (is_formula(sec.axis)) sec.axis <- sec_axis(sec.axis)
+    if (!is_sec_axis(sec.axis)) {
       cli::cli_abort("Secondary axes must be specified using {.fn sec_axis}.")
     }
     scale$secondary.axis <- sec.axis
@@ -150,7 +150,7 @@ set_sec_axis <- function(sec.axis, scale) {
 derive <- function() {
   structure(list(), class = "derived")
 }
-is.derived <- function(x) {
+is_derived <- function(x) {
   inherits(x, "derived")
 }
 #' @rdname ggplot2-ggproto
@@ -182,9 +182,9 @@ AxisSecondary <- ggproto("AxisSecondary", NULL,
     if (!is.function(transform)) {
       cli::cli_abort("Transformation for secondary axes must be a function.")
     }
-    if (is.derived(self$name) && !is.waiver(scale$name)) self$name <- scale$name
-    if (is.derived(self$breaks)) self$breaks <- scale$breaks
-    if (is.waiver(self$breaks)) {
+    if (is_derived(self$name) && !is_waiver(scale$name)) self$name <- scale$name
+    if (is_derived(self$breaks)) self$breaks <- scale$breaks
+    if (is_waiver(self$breaks)) {
       if (scale$is_discrete()) {
         self$breaks <- setNames(nm = scale$get_breaks())
       } else {
@@ -197,8 +197,8 @@ AxisSecondary <- ggproto("AxisSecondary", NULL,
         }
       }
     }
-    if (is.derived(self$labels)) self$labels <- scale$labels
-    if (is.derived(self$guide)) self$guide <- scale$guide
+    if (is_derived(self$labels)) self$labels <- scale$labels
+    if (is_derived(self$guide)) self$guide <- scale$guide
   },
 
   transform_range = function(self, range) {

R/bin.R

@@ -120,15 +120,15 @@ compute_bins <- function(x, scale = NULL, breaks = NULL, binwidth = NULL, bins =
                          center = NULL, boundary = NULL,
                          closed = c("right", "left")) {
 
-  range <- if (is.scale(scale)) scale$dimension() else range(x)
+  range <- if (is_scale(scale)) scale$dimension() else range(x)
   check_length(range, 2L)
 
   if (!is.null(breaks)) {
     breaks <- allow_lambda(breaks)
     if (is.function(breaks)) {
       breaks <- breaks(x)
     }
-    if (is.scale(scale) && !scale$is_discrete()) {
+    if (is_scale(scale) && !scale$is_discrete()) {
       breaks <- scale$transform(breaks)
     }
     check_numeric(breaks)

R/coord-.R

@@ -225,17 +225,16 @@ Coord <- ggproto("Coord",
   }
 )
 
-
 #' @export
 #' @rdname is_tests
-is.coord <- function(x) inherits(x, "Coord")
+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)
+  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

R/coord-cartesian-.R

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

R/coord-sf.R

@@ -116,7 +116,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     x_breaks <- graticule$degree[graticule$type == "E"]
     if (is.null(scale_x$labels)) {
       x_labels <- rep(NA, length(x_breaks))
-    } else if (is.waiver(scale_x$labels)) {
+    } else if (is_waiver(scale_x$labels)) {
       x_labels <- graticule$degree_label[graticule$type == "E"]
       needs_autoparsing[graticule$type == "E"] <- TRUE
     } else {
@@ -141,7 +141,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     y_breaks <- graticule$degree[graticule$type == "N"]
     if (is.null(scale_y$labels)) {
       y_labels <- rep(NA, length(y_breaks))
-    } else if (is.waiver(scale_y$labels)) {
+    } else if (is_waiver(scale_y$labels)) {
       y_labels <- graticule$degree_label[graticule$type == "N"]
       needs_autoparsing[graticule$type == "N"] <- TRUE
     } else {
@@ -334,7 +334,7 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
 
     # we don't draw the graticules if the major panel grid is
     # turned off
-    if (inherits(el, "element_blank")) {
+    if (is_theme_element(el, "blank")) {
       grobs <- list(element_render(theme, "panel.background"))
     } else {
       line_gp <- gg_par(
@@ -553,7 +553,7 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE,
                      ndiscr = 100, default = FALSE, clip = "on",
                      reverse = "none") {
 
-  if (is.waiver(label_graticule) && is.waiver(label_axes)) {
+  if (is_waiver(label_graticule) && is_waiver(label_axes)) {
     # if both `label_graticule` and `label_axes` are set to waive then we
     # use the default of labels on the left and at the bottom
     label_graticule <- ""
@@ -640,13 +640,13 @@ sf_breaks <- function(scale_x, scale_y, bbox, crs) {
       bbox[is.na(bbox)] <- c(-180, -90, 180, 90)[is.na(bbox)]
     }
 
-    if (!(is.waiver(scale_x$breaks) && is.null(scale_x$n.breaks))) {
+    if (!(is_waiver(scale_x$breaks) && is.null(scale_x$n.breaks))) {
       x_breaks <- scale_x$get_breaks(limits = bbox[c(1, 3)])
       finite <- is.finite(x_breaks)
       x_breaks <- if (any(finite)) x_breaks[finite] else NULL
     }
 
-    if (!(is.waiver(scale_y$breaks) && is.null(scale_y$n.breaks))) {
+    if (!(is_waiver(scale_y$breaks) && is.null(scale_y$n.breaks))) {
       y_breaks <- scale_y$get_breaks(limits = bbox[c(2, 4)])
       finite <- is.finite(y_breaks)
       y_breaks <- if (any(finite)) y_breaks[finite] else NULL
@@ -769,7 +769,7 @@ view_scales_from_graticule <- function(graticule, scale, aesthetic,
   if (scale$position != position) {
     # Try to use secondary axis' guide
     guide <- scale$secondary.axis$guide %||% waiver()
-    if (is.derived(guide)) {
+    if (is_derived(guide)) {
       guide <- scale$guide
     }
   } else {

R/facet-.R

@@ -9,8 +9,8 @@ NULL
 #' rendered.
 #'
 #' Extending facets can range from the simple modifications of current facets,
-#' to very laborious rewrites with a lot of [gtable()] manipulation.
-#' For some examples of both, please see the extension vignette.
+#' to very laborious rewrites with a lot of [`gtable()`][gtable::gtable()]
+#' manipulation. For some examples of both, please see the extension vignette.
 #'
 #' `Facet` subclasses, like other extendible ggproto classes, have a range
 #' of methods that can be modified. Some of these are required for all new
@@ -49,7 +49,7 @@ NULL
 #'
 #'   - `setup_panel_params`: modifies the x and y ranges for each panel. This is
 #'     used to allow the `Facet` to interact with the `panel_params`.
-#' 
+#'
 #'   - `init_scales`: Given a master scale for x and y, create panel
 #'   specific scales for each panel defined in the layout. The default is to
 #'   simply clone the master scale.
@@ -318,10 +318,6 @@ Facet <- ggproto("Facet", NULL,
   }
 )
 
-#' @export
-#' @rdname is_tests
-is.facet <- function(x) inherits(x, "Facet")
-
 # Helpers -----------------------------------------------------------------
 
 #' Quote faceting variables
@@ -383,6 +379,18 @@ vars <- function(...) {
   quos(...)
 }
 
+#' @export
+#' @rdname is_tests
+is_facet <- function(x) inherits(x, "Facet")
+
+#' @export
+#' @rdname is_tests
+#' @usage is.facet(x) # Deprecated
+is.facet <- function(x) {
+  deprecate_soft0("3.5.2", "is.facet()", "is_facet()")
+  is_facet(x)
+}
+
 #' Accessing a plot's facet strip labels
 #'
 #' This functions retrieves labels from facet strips with the labeller applied.
@@ -493,7 +501,7 @@ as_facets_list <- function(x) {
 }
 
 check_vars <- function(x) {
-  if (is.mapping(x)) {
+  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/facet-grid-.R

@@ -430,7 +430,7 @@ ulevels <- function(x, na.last = TRUE) {
 
 table_has_grob <- function(table, pattern) {
   grobs <- table$grobs[grep(pattern, table$layout$name)]
-  !all(vapply(grobs, is.zero, logical(1)))
+  !all(vapply(grobs, is_zero, logical(1)))
 }
 
 seam_table <- function(table, grobs = NULL, side, shift = 1, name, z = 1,

R/facet-null.R

@@ -30,9 +30,9 @@ FacetNull <- ggproto("FacetNull", Facet,
     layout_null()
   },
   map_data = function(data, layout, params) {
-    # Need the is.waiver check for special case where no data, but aesthetics
+    # Need the is_waiver check for special case where no data, but aesthetics
     # are mapped to vectors
-    if (is.waiver(data))
+    if (is_waiver(data))
       return(data_frame0(PANEL = factor()))
 
     if (empty(data))

R/facet-wrap.R

@@ -327,7 +327,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
     if (length(empty_bottom) > 0) {
       x_axes <- original$x$bottom[matched[empty_bottom]]
       clash["bottom"] <- strip == "bottom" && !inside && !free$x &&
-        !all(vapply(x_axes, is.zero, logical(1)))
+        !all(vapply(x_axes, is_zero, logical(1)))
       if (!clash["bottom"]) {
         bottom[empty_bottom] <- x_axes
       }
@@ -336,7 +336,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
     if (length(empty_top) > 0) {
       x_axes <- original$x$top[matched[empty_top]]
       clash["top"] <- strip == "top" && !inside && !free$x &&
-        !all(vapply(x_axes, is.zero, logical(1)))
+        !all(vapply(x_axes, is_zero, logical(1)))
       if (!clash["top"]) {
         top[empty_top] <- x_axes
       }
@@ -345,7 +345,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
     if (length(empty_right) > 0) {
       y_axes <- original$y$right[matched[empty_right]]
       clash["right"]  <- strip == "right" && !inside && !free$y &&
-        !all(vapply(y_axes, is.zero, logical(1)))
+        !all(vapply(y_axes, is_zero, logical(1)))
       if (!clash["right"]) {
         right[empty_right] <- y_axes
       }
@@ -354,7 +354,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
     if (length(empty_left) > 0) {
       y_axes <- original$y$left[matched[empty_left]]
       clash["left"]  <- strip == "left" && !inside && !free$y &&
-        !all(vapply(y_axes, is.zero, logical(1)))
+        !all(vapply(y_axes, is_zero, logical(1)))
       if (!clash["left"]) {
         left[empty_left] <- y_axes
       }
@@ -410,7 +410,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
 
     if (!inside) {
       axes  <- grepl(paste0("axis-", pos), table$layout$name)
-      has_axes <- !vapply(table$grobs[axes], is.zero, logical(1))
+      has_axes <- !vapply(table$grobs[axes], is_zero, logical(1))
       has_axes <- split(has_axes, table$layout[[pos]][axes])
       has_axes <- vapply(has_axes, sum, numeric(1)) > 0
       padding  <- rep(padding, length(has_axes))

R/fortify.R

@@ -94,7 +94,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 (is.mapping(model)) {
+  if (is_mapping(model)) {
     msg <- c(
       paste0(msg, ", not ", obj_type_friendly(model), "."),
       "i" = "Did you accidentally pass {.fn aes} to the {.arg data} argument?"

R/geom-.R

@@ -237,7 +237,7 @@ Geom <- ggproto("Geom",
 
 #' @export
 #' @rdname is_tests
-is.geom <- function(x) inherits(x, "Geom")
+is_geom <- function(x) inherits(x, "Geom")
 
 eval_from_theme <- function(aesthetics, theme, class = NULL) {
   themed <- is_themed_aes(aesthetics)

R/geom-defaults.R

@@ -93,13 +93,13 @@ update_stat_defaults <- function(stat, new) {
 #'
 #' # Changed theme
 #' get_geom_defaults("point", theme(geom = element_geom(ink = "purple")))
-get_geom_defaults <- function(geom, theme = theme_get()) {
+get_geom_defaults <- function(geom, theme = get_theme()) {
   theme <- theme %||% list(geom = .default_geom_element)
 
   if (is.function(geom)) {
     geom <- geom()
   }
-  if (is.layer(geom)) {
+  if (is_layer(geom)) {
     data <- data_frame0(.id = 1L)
     data <- geom$compute_geom_2(data = data, theme = theme)
     data$.id <- NULL
@@ -108,7 +108,7 @@ get_geom_defaults <- function(geom, theme = theme_get()) {
   if (is.character(geom)) {
     geom <- validate_subclass(geom, "Geom")
   }
-  if (is.geom(geom)) {
+  if (is_geom(geom)) {
     out <- geom$use_defaults(data = NULL, theme = theme)
     return(out)
   }