diff --git a/NAMESPACE b/NAMESPACE index 852cb97600..63bee440fc 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -475,6 +475,7 @@ 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) diff --git a/NEWS.md b/NEWS.md index 3b4926b206..38376bded8 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* The helper function `is.waiver()` is now exported to help extensions to work + with `waiver()` objects (@arcresu, #6173). * Date(time) scales now throw appropriate errors when `date_breaks`, `date_minor_breaks` or `date_labels` are not strings (@RodDalBen, #5880) * `geom_errorbarh()` is deprecated in favour of diff --git a/R/axis-secondary.R b/R/axis-secondary.R index 2999bd79b5..401dd5a663 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -129,7 +129,7 @@ is.sec_axis <- function(x) { } set_sec_axis <- function(sec.axis, scale) { - if (!is.waive(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.") @@ -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.waive(scale$name)) self$name <- scale$name + if (is.derived(self$name) && !is.waiver(scale$name)) self$name <- scale$name if (is.derived(self$breaks)) self$breaks <- scale$breaks - if (is.waive(self$breaks)) { + if (is.waiver(self$breaks)) { if (scale$is_discrete()) { self$breaks <- scale$get_breaks() } else { diff --git a/R/coord-sf.R b/R/coord-sf.R index c31af6d393..7d9d2dc2e7 100644 --- a/R/coord-sf.R +++ b/R/coord-sf.R @@ -108,7 +108,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.waive(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 { @@ -133,7 +133,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.waive(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 { @@ -534,7 +534,7 @@ coord_sf <- function(xlim = NULL, ylim = NULL, expand = TRUE, label_axes = waiver(), lims_method = "cross", ndiscr = 100, default = FALSE, clip = "on") { - if (is.waive(label_graticule) && is.waive(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 <- "" @@ -620,13 +620,13 @@ sf_breaks <- function(scale_x, scale_y, bbox, crs) { bbox[is.na(bbox)] <- c(-180, -90, 180, 90)[is.na(bbox)] } - if (!(is.waive(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.waive(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 diff --git a/R/facet-null.R b/R/facet-null.R index c66f39fa03..e263bf0453 100644 --- a/R/facet-null.R +++ b/R/facet-null.R @@ -27,9 +27,9 @@ FacetNull <- ggproto("FacetNull", Facet, layout_null() }, map_data = function(data, layout, params) { - # Need the is.waive 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.waive(data)) + if (is.waiver(data)) return(data_frame0(PANEL = factor())) if (empty(data)) diff --git a/R/guide-axis-theta.R b/R/guide-axis-theta.R index 2e4f7a6cef..7c7b62a9d0 100644 --- a/R/guide-axis-theta.R +++ b/R/guide-axis-theta.R @@ -200,7 +200,7 @@ GuideAxisTheta <- ggproto( } # Resolve text angle - if (is.waive(params$angle) || is.null(params$angle)) { + if (is.waiver(params$angle) || is.null(params$angle)) { angle <- elements$text$angle } else { angle <- flip_text_angle(params$angle - rad2deg(key$theta)) @@ -276,7 +276,7 @@ GuideAxisTheta <- ggproto( } # Resolve text angle - if (is.waive(params$angle %||% waiver())) { + if (is.waiver(params$angle %||% waiver())) { angle <- elements$text$angle } else { angle <- flip_text_angle(params$angle - rad2deg(key$theta)) diff --git a/R/guide-custom.R b/R/guide-custom.R index 990712b36b..f602bfc843 100644 --- a/R/guide-custom.R +++ b/R/guide-custom.R @@ -96,7 +96,7 @@ GuideCustom <- ggproto( # Render title params <- replace_null(params, position = position, direction = direction) elems <- GuideLegend$setup_elements(params, self$elements, theme) - if (!is.waive(params$title) && !is.null(params$title)) { + if (!is.waiver(params$title) && !is.null(params$title)) { title <- self$build_title(params$title, elems, params) } else { title <- zeroGrob() diff --git a/R/labels.R b/R/labels.R index 50e3776555..050d42829e 100644 --- a/R/labels.R +++ b/R/labels.R @@ -152,7 +152,7 @@ labs <- function(..., title = waiver(), subtitle = waiver(), caption = waiver(), tag = tag, alt = allow_lambda(alt), alt_insight = alt_insight, .ignore_empty = "all") - is_waive <- vapply(args, is.waive, logical(1)) + is_waive <- vapply(args, is.waiver, logical(1)) args <- args[!is_waive] # remove duplicated arguments args <- args[!duplicated(names(args))] diff --git a/R/layer.R b/R/layer.R index b10c230e1d..639fece4af 100644 --- a/R/layer.R +++ b/R/layer.R @@ -253,7 +253,7 @@ Layer <- ggproto("Layer", NULL, }, layer_data = function(self, plot_data) { - if (is.waive(self$data)) { + if (is.waiver(self$data)) { data <- plot_data } else if (is.function(self$data)) { data <- self$data(plot_data) @@ -263,7 +263,7 @@ Layer <- ggproto("Layer", NULL, } else { data <- self$data } - if (is.null(data) || is.waive(data)) data else unrowname(data) + if (is.null(data) || is.waiver(data)) data else unrowname(data) }, # hook to allow a layer access to the final layer data diff --git a/R/layout.R b/R/layout.R index 1b578111b2..25088798b1 100644 --- a/R/layout.R +++ b/R/layout.R @@ -283,7 +283,7 @@ Layout <- ggproto("Layout", NULL, } else { switch(label, x = ".bottom", y = ".right") } - if (is.null(labels[[label]][[i]]) || is.waive(labels[[label]][[i]])) + if (is.null(labels[[label]][[i]]) || is.waiver(labels[[label]][[i]])) return(zeroGrob()) element_render( diff --git a/R/scale-.R b/R/scale-.R index d7c0f42252..94887df365 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -753,7 +753,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, # don't support conversion to numeric (#5304) if (zero_range(as.numeric(transformation$transform(limits)))) { breaks <- limits[1] - } else if (is.waive(self$breaks)) { + } else if (is.waiver(self$breaks)) { if (!is.null(self$n.breaks) && trans_support_nbreaks(transformation)) { breaks <- transformation$breaks(limits, self$n.breaks) } else { @@ -795,7 +795,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, b <- b[is.finite(b)] transformation <- self$get_transformation() - if (is.waive(self$minor_breaks)) { + if (is.waiver(self$minor_breaks)) { if (is.null(b)) { breaks <- NULL } else { @@ -842,7 +842,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, ) } - if (is.waive(self$labels)) { + if (is.waiver(self$labels)) { labels <- transformation$format(breaks) } else if (is.function(self$labels)) { labels <- self$labels(breaks) @@ -1022,7 +1022,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, ) } - if (is.waive(self$breaks)) { + if (is.waiver(self$breaks)) { breaks <- limits } else if (is.function(self$breaks)) { breaks <- self$breaks(limits) @@ -1084,7 +1084,7 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, ) } - if (is.waive(self$labels)) { + if (is.waiver(self$labels)) { if (is.numeric(breaks)) { # Only format numbers, because on Windows, format messes up encoding format(breaks, justify = "none") @@ -1244,7 +1244,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, "Invalid {.arg breaks} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) - } else if (is.waive(self$breaks)) { + } else if (is.waiver(self$breaks)) { if (self$nice.breaks) { if (!is.null(self$n.breaks) && trans_support_nbreaks(transformation)) { breaks <- transformation$breaks(limits, n = self$n.breaks) @@ -1334,7 +1334,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, "Invalid {.arg labels} specification. Use {.code NULL}, not {.code NA}.", call = self$call ) - } else if (is.waive(self$labels)) { + } else if (is.waiver(self$labels)) { labels <- transformation$format(breaks) } else if (is.function(self$labels)) { labels <- self$labels(breaks) diff --git a/R/scale-continuous.R b/R/scale-continuous.R index 9d6eee9ca9..39b5203565 100644 --- a/R/scale-continuous.R +++ b/R/scale-continuous.R @@ -146,21 +146,21 @@ ScaleContinuousPosition <- ggproto("ScaleContinuousPosition", ScaleContinuous, }, break_info = function(self, range = NULL) { breaks <- ggproto_parent(ScaleContinuous, self)$break_info(range) - if (!(is.waive(self$secondary.axis) || self$secondary.axis$empty())) { + if (!(is.waiver(self$secondary.axis) || self$secondary.axis$empty())) { self$secondary.axis$init(self) breaks <- c(breaks, self$secondary.axis$break_info(breaks$range, self)) } breaks }, sec_name = function(self) { - if (is.waive(self$secondary.axis)) { + if (is.waiver(self$secondary.axis)) { waiver() } else { self$secondary.axis$name } }, make_sec_title = function(self, title) { - if (!is.waive(self$secondary.axis)) { + if (!is.waiver(self$secondary.axis)) { self$secondary.axis$make_title(title) } else { ggproto_parent(ScaleContinuous, self)$make_sec_title(title) diff --git a/R/scale-date.R b/R/scale-date.R index 0decaa4174..436b9b129d 100644 --- a/R/scale-date.R +++ b/R/scale-date.R @@ -302,15 +302,15 @@ datetime_scale <- function(aesthetics, transform, trans = deprecated(), if (is.character(breaks)) breaks <- breaks_width(breaks) if (is.character(minor_breaks)) minor_breaks <- breaks_width(minor_breaks) - if (!is.waive(date_breaks)) { + if (!is.waiver(date_breaks)) { check_string(date_breaks) breaks <- breaks_width(date_breaks) } - if (!is.waive(date_minor_breaks)) { + if (!is.waiver(date_minor_breaks)) { check_string(date_minor_breaks) minor_breaks <- breaks_width(date_minor_breaks) } - if (!is.waive(date_labels)) { + if (!is.waiver(date_labels)) { check_string(date_labels) labels <- function(self, x) { tz <- self$timezone %||% "UTC" @@ -379,21 +379,21 @@ ScaleContinuousDatetime <- ggproto("ScaleContinuousDatetime", ScaleContinuous, }, break_info = function(self, range = NULL) { breaks <- ggproto_parent(ScaleContinuous, self)$break_info(range) - if (!(is.waive(self$secondary.axis) || self$secondary.axis$empty())) { + if (!(is.waiver(self$secondary.axis) || self$secondary.axis$empty())) { self$secondary.axis$init(self) breaks <- c(breaks, self$secondary.axis$break_info(breaks$range, self)) } breaks }, sec_name = function(self) { - if (is.waive(self$secondary.axis)) { + if (is.waiver(self$secondary.axis)) { waiver() } else { self$secondary.axis$name } }, make_sec_title = function(self, title) { - if (!is.waive(self$secondary.axis)) { + if (!is.waiver(self$secondary.axis)) { self$secondary.axis$make_title(title) } else { ggproto_parent(ScaleContinuous, self)$make_sec_title(title) @@ -430,21 +430,21 @@ ScaleContinuousDate <- ggproto("ScaleContinuousDate", ScaleContinuous, }, break_info = function(self, range = NULL) { breaks <- ggproto_parent(ScaleContinuous, self)$break_info(range) - if (!(is.waive(self$secondary.axis) || self$secondary.axis$empty())) { + if (!(is.waiver(self$secondary.axis) || self$secondary.axis$empty())) { self$secondary.axis$init(self) breaks <- c(breaks, self$secondary.axis$break_info(breaks$range, self)) } breaks }, sec_name = function(self) { - if (is.waive(self$secondary.axis)) { + if (is.waiver(self$secondary.axis)) { waiver() } else { self$secondary.axis$name } }, make_sec_title = function(self, title) { - if (!is.waive(self$secondary.axis)) { + if (!is.waiver(self$secondary.axis)) { self$secondary.axis$make_title(title) } else { ggproto_parent(ScaleContinuous, self)$make_sec_title(title) diff --git a/R/scale-discrete-.R b/R/scale-discrete-.R index 8fea10caf2..f6fc512f9c 100644 --- a/R/scale-discrete-.R +++ b/R/scale-discrete-.R @@ -170,7 +170,7 @@ ScaleDiscretePosition <- ggproto("ScaleDiscretePosition", ScaleDiscrete, }, sec_name = function(self) { - if (is.waive(self$secondary.axis)) { + if (is.waiver(self$secondary.axis)) { waiver() } else { self$secondary.axis$name diff --git a/R/scale-manual.R b/R/scale-manual.R index 7fc9094070..47c647fc02 100644 --- a/R/scale-manual.R +++ b/R/scale-manual.R @@ -171,7 +171,7 @@ manual_scale <- function(aesthetic, values = NULL, breaks = waiver(), } # order values according to breaks - if (is.vector(values) && is.null(names(values)) && !is.waive(breaks) && + if (is.vector(values) && is.null(names(values)) && !is.waiver(breaks) && !is.null(breaks) && !is.function(breaks)) { if (length(breaks) <= length(values)) { names(values) <- breaks diff --git a/R/scale-view.R b/R/scale-view.R index 3cf18147ec..510f99f837 100644 --- a/R/scale-view.R +++ b/R/scale-view.R @@ -45,7 +45,7 @@ view_scale_primary <- function(scale, limits = scale$get_limits(), view_scale_secondary <- function(scale, limits = scale$get_limits(), continuous_range = scale$dimension(limits = limits)) { - if (is.null(scale$secondary.axis) || is.waive(scale$secondary.axis) || scale$secondary.axis$empty()) { + if (is.null(scale$secondary.axis) || is.waiver(scale$secondary.axis) || scale$secondary.axis$empty()) { # if there is no second axis, return the primary scale with no guide # this guide can be overridden using guides() primary_scale <- view_scale_primary(scale, limits, continuous_range) diff --git a/R/utilities.R b/R/utilities.R index 8772ed771b..039376f4df 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -12,7 +12,7 @@ scales::alpha } "%|W|%" <- function(a, b) { - if (!is.waive(a)) a else b + if (!is.waiver(a)) a else b } # Check required aesthetics are present @@ -182,13 +182,17 @@ should_stop <- function(expr) { #' A waiver is a "flag" object, similar to `NULL`, that indicates the #' calling function should just use the default value. It is used in certain #' functions to distinguish between displaying nothing (`NULL`) and -#' displaying a default value calculated elsewhere (`waiver()`) +#' displaying a default value calculated elsewhere (`waiver()`). +#' `is.waiver()` reports whether an object is a waiver. #' #' @export #' @keywords internal waiver <- function() structure(list(), class = "waiver") -is.waive <- function(x) inherits(x, "waiver") +#' @param x An object to test +#' @export +#' @rdname waiver +is.waiver <- function(x) inherits(x, "waiver") pal_binned <- function(palette) { function(x) { @@ -266,7 +270,7 @@ snake_class <- function(x) { } empty <- function(df) { - is.null(df) || nrow(df) == 0 || ncol(df) == 0 || is.waive(df) + is.null(df) || nrow(df) == 0 || ncol(df) == 0 || is.waiver(df) } is.discrete <- function(x) { diff --git a/man/waiver.Rd b/man/waiver.Rd index aeb97bf082..88fa06ba57 100644 --- a/man/waiver.Rd +++ b/man/waiver.Rd @@ -2,14 +2,21 @@ % Please edit documentation in R/utilities.R \name{waiver} \alias{waiver} +\alias{is.waiver} \title{A waiver object.} \usage{ waiver() + +is.waiver(x) +} +\arguments{ +\item{x}{An object to test} } \description{ A waiver is a "flag" object, similar to \code{NULL}, that indicates the calling function should just use the default value. It is used in certain functions to distinguish between displaying nothing (\code{NULL}) and -displaying a default value calculated elsewhere (\code{waiver()}) +displaying a default value calculated elsewhere (\code{waiver()}). +\code{is.waiver()} reports whether an object is a waiver. } \keyword{internal}