Clean up orphan functions and tiny one-off helpers

NAMESPACE

@@ -459,9 +459,20 @@ export(guide_transform)
 export(guides)
 export(has_flipped_aes)
 export(is.Coord)
+export(is.coord)
+export(is.element)
 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(label_both)
 export(label_bquote)

R/aes-evaluation.R

@@ -219,6 +219,8 @@ stage_scaled <- function(start = NULL, after_stat = NULL, after_scale = NULL) {
 }
 
 # Regex to determine if an identifier refers to a calculated aesthetic
+# The pattern includes ye olde '...var...' syntax, which was
+# deprecated in 3.4.0 in favour of `after_stat()`
 match_calculated_aes <- "^\\.\\.([a-zA-Z._]+)\\.\\.$"
 
 # Determine if aesthetic is calculated

R/axis-secondary.R

@@ -124,6 +124,10 @@ dup_axis <- function(transform = identity, name = derive(), breaks = derive(),
  sec_axis(transform, trans = trans, name, breaks, labels, guide)
 }
 
+is.sec_axis <- function(x) {
+ inherits(x, "AxisSecondary")
+}
+
 set_sec_axis <- function(sec.axis, scale) {
  if (!is.waive(sec.axis)) {
  if (scale$is_discrete()) {
@@ -132,7 +136,7 @@ set_sec_axis <- function(sec.axis, scale) {
  }
  }
  if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis)
- if (!inherits(sec.axis, "AxisSecondary")) {
+ if (!is.sec_axis(sec.axis)) {
  cli::cli_abort("Secondary axes must be specified using {.fn sec_axis}.")
  }
  scale$secondary.axis <- sec.axis

R/bin.R

@@ -25,6 +25,8 @@ bins <- function(breaks, closed = "right",
  )
 }
 
+is_bins <- function(x) inherits(x, "ggplot2_bins")
+
 #' @export
 print.ggplot2_bins <- function(x, ...) {
  n <- length(x$breaks)
@@ -131,7 +133,7 @@ bin_breaks_bins <- function(x_range, bins = 30, center = NULL,
 # Compute bins ------------------------------------------------------------
 
 bin_vector <- function(x, bins, weight = NULL, pad = FALSE) {
- check_inherits(bins, "ggplot2_bins", "a {.cls ggplot2_bins} object")
+ check_object(bins, is_bins, "a {.cls ggplot2_bins} object")
 
  if (all(is.na(x))) {
  return(bin_out(length(x), NA, NA, xmin = NA, xmax = NA))

R/coord-.R

@@ -225,12 +225,6 @@ Coord <- ggproto("Coord",
  }
 )
 
-#' Is this object a coordinate system?
-#'
-#' @export is.Coord
-#' @keywords internal
-is.Coord <- function(x) inherits(x, "Coord")
-
 # Renders an axis with the correct orientation or zeroGrob if no axis should be
 # generated
 render_axis <- function(panel_params, axis, scale, position, theme) {

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/coord-sf.R

@@ -580,12 +580,12 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE,
  )
 }
 
-parse_axes_labeling <- function(x) {
+parse_axes_labeling <- function(x, call = caller_env()) {
  if (is.character(x)) {
  x <- unlist(strsplit(x, ""))
  x <- list(top = x[1], right = x[2], bottom = x[3], left = x[4])
  } else if (!is.list(x)) {
- cli::cli_abort("Panel labeling format not recognized.")
+ cli::cli_abort("Panel labeling format not recognized.", call = call)
  }
  x
 }

R/facet-.R

@@ -353,13 +353,6 @@ get_strip_labels <- function(plot = get_last_plot()) {
  plot$plot$facet$format_strip_labels(layout, params)
 }
 
-#' Is this object a faceting specification?
-#'
-#' @param x object to test
-#' @keywords internal
-#' @export
-is.facet <- function(x) inherits(x, "Facet")
-
 # A "special" value, currently not used but could be used to determine
 # if faceting is active
 NO_PANEL <- -1L
@@ -444,7 +437,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

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

R/geom-defaults.R

@@ -98,7 +98,7 @@ get_geom_defaults <- function(geom, theme = theme_get()) {
  if (is.character(geom)) {
  geom <- check_subclass(geom, "Geom")
  }
- if (inherits(geom, "Geom")) {
+ if (is.geom(geom)) {
  out <- geom$use_defaults(data = NULL, theme = theme)
  return(out)
  }

R/geom-label.R

@@ -78,7 +78,7 @@ GeomLabel <- ggproto("GeomLabel", Geom,
  data <- coord$transform(data, panel_params)
  data$vjust <- compute_just(data$vjust, data$y, data$x, data$angle)
  data$hjust <- compute_just(data$hjust, data$x, data$y, data$angle)
- if (!inherits(label.padding, "margin")) {
+ if (!is.margin("margin")) {
  label.padding <- rep(label.padding, length.out = 4)
  }
 

R/ggproto.R

@@ -106,11 +106,6 @@ 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")
-
 fetch_ggproto <- function(x, name) {
  res <- NULL
 

R/guide-.R

@@ -377,7 +377,7 @@
  # Renders tickmarks
  build_ticks = function(key, elements, params, position = params$position,
  length = elements$ticks_length) {
- if (!inherits(elements, "element")) {
+ if (!is.element(elements)) {
  elements <- elements$ticks
  }
  if (!inherits(elements, "element_line")) {
@@ -520,7 +520,7 @@
  bottom = "top",
  left = "right",
  right = "left",
  position
  )
 }
 

R/guides-.R

@@ -69,7 +69,7 @@
 guides <- function(...) {
  args <- list2(...)
  if (length(args) > 0) {
- if (is.list(args[[1]]) && !inherits(args[[1]], "guide")) args <- args[[1]]
+ if (is.list(args[[1]]) && !is.guide(args[[1]])) args <- args[[1]]
  args <- rename_aes(args)
  }
 
@@ -138,7 +138,7 @@
  if (is.null(guides)) {
  return(invisible())
  }
- if (inherits(guides, "Guides")) {
+ if (is.guides(guides)) {
  guides <- guides$guides
  }
  self$guides <- defaults(guides, self$guides)
@@ -862,7 +862,7 @@
  guide <- fun()
  }
  }
- if (inherits(guide, "Guide")) {
+ if (is.guide(guide)) {
  return(guide)
  }
  if (inherits(guide, "guide") && is.list(guide)) {

R/labeller.R

@@ -228,6 +228,8 @@ label_wrap_gen <- function(width = 25, multi_line = TRUE) {
  structure(fun, class = "labeller")
 }
 
+is_labeller <- function(x) inherits(x, "labeller")
+
 resolve_labeller <- function(rows, cols, labels) {
  if (is.null(cols) && is.null(rows)) {
  cli::cli_abort("Supply one of {.arg rows} or {.arg cols}.")
@@ -289,7 +291,7 @@ as_labeller <- function(x, default = label_value, multi_line = TRUE) {
  # support it.
  default <- dispatch_args(default, multi_line = multi_line)
 
- if (inherits(x, "labeller")) {
+ if (is_labeller(x)) {
  x <- dispatch_args(x, multi_line = multi_line)
  x(labels)
  } else if (is.function(x)) {

R/layer.R

@@ -58,8 +58,8 @@
 #' `NA`, the default, includes if any aesthetics are mapped.
 #' `FALSE` never includes, and `TRUE` always includes.
 #' It can also be a named logical vector to finely select the aesthetics to
-#' display. To include legend keys for all levels, even 
-#' when no data exists, use `TRUE`. If `NA`, all levels are shown in legend, 
+#' display. To include legend keys for all levels, even
+#' when no data exists, use `TRUE`. If `NA`, all levels are shown in legend,
 #' but unobserved levels are omitted.
 #' @param inherit.aes If `FALSE`, overrides the default aesthetics,
 #' rather than combining with them. This is most useful for helper functions
@@ -203,7 +203,7 @@ layer <- function(geom = NULL, stat = NULL,
 }
 
 validate_mapping <- function(mapping, call = caller_env()) {
- if (!inherits(mapping, "uneval")) {
+ if (!is.mapping(mapping)) {
  msg <- "{.arg mapping} must be created by {.fn aes}."
  # Native pipe have higher precedence than + so any type of gg object can be
  # expected here, not just ggplot

R/plot-build.R

@@ -288,7 +288,7 @@ ggplot_gtable.ggplot_built <- function(data) {
  plot_margin <- calc_element("plot.margin", theme)
  plot_table <- gtable_add_padding(plot_table, plot_margin)
 
- if (inherits(theme$plot.background, "element")) {
+ if (is.element(theme$plot.background)) {
  plot_table <- gtable_add_grob(plot_table,
  element_render(theme, "plot.background"),
  t = 1, l = 1, b = -1, r = -1, name = "background", z = -Inf)

R/plot-construction.R

@@ -149,14 +149,14 @@
 }
 #' @export
 ggplot_add.Guides <- function(object, plot, object_name) {
- if (inherits(plot$guides, "Guides")) {
+ if (is.guides(plot$guides)) {
  # We clone the guides object to prevent modify-in-place of guides
  old <- plot$guides
  new <- ggproto(NULL, old)
  new$add(object)
  plot$guides <- new
  } else {
  plot$guides <- object
  }
  plot
 }

R/plot.R

@@ -111,7 +111,7 @@ ggplot <- function(data = NULL, mapping = aes(), ...,
 #' @export
 ggplot.default <- function(data = NULL, mapping = aes(), ...,
  environment = parent.frame()) {
- if (!missing(mapping) && !inherits(mapping, "uneval")) {
+ if (!missing(mapping) && !is.mapping(mapping)) {
  cli::cli_abort(c(
  "{.arg mapping} must be created with {.fn aes}.",
  "x" = "You've supplied {.obj_type_friendly {mapping}}."
@@ -154,12 +154,6 @@ plot_clone <- function(plot) {
  p
 }
 
-#' Reports whether x is a ggplot object
-#' @param x An object to test
-#' @keywords internal
-#' @export
-is.ggplot <- function(x) inherits(x, "ggplot")
-
 #' Explicitly draw plot
 #'
 #' Generally, you do not need to print or plot a ggplot2 plot explicitly: the

R/scale-colour.R

@@ -197,7 +197,7 @@ scale_fill_binned <- function(...,
 # helper function to make sure that the provided scale is of the correct
 # type (i.e., is continuous and works with the provided aesthetic)
 check_scale_type <- function(scale, name, aesthetic, scale_is_discrete = FALSE, call = caller_env()) {
- if (!is.ggproto(scale) || !inherits(scale, "Scale")) {
+ if (!is.ggproto(scale) || !is.scale(scale)) {
  cli::cli_abort(c(
  "The {.arg type} argument must return a continuous scale for the {.field {aesthetic}} aesthetic.",
  "x" = "The provided object is not a scale function."

R/theme.R

@@ -483,7 +483,7 @@ theme <- function(...,
  elements$panel.spacing.y <- elements$panel.margin.y
  elements$panel.margin.y <- NULL
  }
- if (is.unit(elements$legend.margin) && !inherits(elements$legend.margin, "margin")) {
+ if (is.unit(elements$legend.margin) && !is.margin(elements$legend.margin)) {
  cli::cli_warn(c(
  "{.var legend.margin} must be specified using {.fn margin}",
  "i" = "For the old behavior use {.var legend.spacing}"
@@ -529,7 +529,7 @@ theme <- function(...,
  # If complete theme set all non-blank elements to inherit from blanks
  if (complete) {
  elements <- lapply(elements, function(el) {
- if (inherits(el, "element") && !inherits(el, "element_blank")) {
+ if (is.element(el) && !inherits(el, "element_blank")) {
  el$inherit.blank <- TRUE
  }
  el
@@ -905,12 +905,6 @@ combine_elements <- function(e1, e2) {
  e1
 }
 
-#' Reports whether x is a theme object
-#' @param x An object to test
-#' @export
-#' @keywords internal
-is.theme <- function(x) inherits(x, "theme")
-
 #' @export
 `$.theme` <- function(x, ...) {
  .subset2(x, ...)