From 5da2d3004953ce7beab0a287618dd39023a5f75c Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 12 Sep 2023 15:19:20 +0200 Subject: [PATCH] Better scale messages (#5343) * More informative calls in constructors * Add test for scale calls * Fix call for feed-forward scales * Fix calls for gnarly default scales * Fix calls for transformation scales * Reoxygenate * Supply `call` to messages * Accept periods at ends of messages * Forward calls to checkers * Fix #4258 * `find_scale()` generates call * `xlim`/`ylim` have appropriate calls * `check_transformation()` throws more informative warning * Remove orphaned code * Deprecate `scale_name` argument * Purge `scale_name` * Test deprecation messages * Add NEWS bullet * conditionally test time scales --- NEWS.md | 5 + R/limits.R | 25 +-- R/scale-.R | 184 ++++++++++++------ R/scale-alpha.R | 11 +- R/scale-binned.R | 9 +- R/scale-brewer.R | 28 +-- R/scale-colour.R | 44 +++-- R/scale-continuous.R | 18 +- R/scale-date.R | 11 +- R/scale-discrete-.R | 4 +- R/scale-gradient.R | 36 ++-- R/scale-grey.R | 4 +- R/scale-hue.R | 28 ++- R/scale-identity.R | 18 +- R/scale-linetype.R | 4 +- R/scale-linewidth.R | 11 +- R/scale-manual.R | 6 +- R/scale-shape.R | 8 +- R/scale-size.R | 17 +- R/scale-steps.R | 16 +- R/scale-type.R | 7 +- R/scale-viridis.R | 18 +- R/zxx.R | 29 ++- man/binned_scale.Rd | 9 +- man/continuous_scale.Rd | 9 +- man/datetime_scale.Rd | 7 +- man/discrete_scale.Rd | 9 +- man/scale_discrete.Rd | 5 +- man/scale_gradient.Rd | 5 +- man/scale_grey.Rd | 5 +- man/scale_hue.Rd | 5 +- man/scale_linetype.Rd | 5 +- man/scale_manual.Rd | 5 +- man/scale_shape.Rd | 5 +- man/scale_size.Rd | 1 + man/scale_steps.Rd | 1 + tests/testthat/_snaps/scale-binned.md | 4 +- tests/testthat/_snaps/scales.md | 40 +++- tests/testthat/test-geom-dotplot.R | 2 +- tests/testthat/test-scale-colour-continuous.R | 2 +- tests/testthat/test-scale-type.R | 12 ++ tests/testthat/test-scales.R | 165 +++++++++++++++- 42 files changed, 604 insertions(+), 233 deletions(-) diff --git a/NEWS.md b/NEWS.md index 478ee5b36a..747eebf6bb 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # ggplot2 (development version) +* Scales throw more informative messages (@teunbrand, #4185, #4258) + +* The `scale_name` argument in `continuous_scale()`, `discrete_scale()` and + `binned_scale()` is soft-deprecated (@teunbrand, #1312). + * In `theme()`, some elements can be specified with `rel()` to inherit from `unit`-class objects in a relative fashion (@teunbrand, #3951). diff --git a/R/limits.R b/R/limits.R index daf6bd4003..727df98326 100644 --- a/R/limits.R +++ b/R/limits.R @@ -90,13 +90,13 @@ lims <- function(...) { #' @export #' @rdname lims xlim <- function(...) { - limits(c(...), "x") + limits(c(...), "x", call = current_call()) } #' @export #' @rdname lims ylim <- function(...) { - limits(c(...), "y") + limits(c(...), "y", call = current_call()) } #' Generate correct scale type for specified limits @@ -122,42 +122,45 @@ limits.numeric <- function(lims, var, call = caller_env()) { trans <- "identity" } - make_scale("continuous", var, limits = lims, trans = trans) + make_scale("continuous", var, limits = lims, trans = trans, call = call) } -make_scale <- function(type, var, ...) { - scale <- match.fun(paste("scale_", var, "_", type, sep = "")) - scale(...) +make_scale <- function(type, var, ..., call = NULL) { + name <- paste("scale_", var, "_", type, sep = "") + scale <- match.fun(name) + sc <- scale(...) + sc$call <- call %||% parse_expr(paste0(name, "()")) + sc } #' @export limits.character <- function(lims, var, call = caller_env()) { - make_scale("discrete", var, limits = lims) + make_scale("discrete", var, limits = lims, call = call) } #' @export limits.factor <- function(lims, var, call = caller_env()) { - make_scale("discrete", var, limits = as.character(lims)) + make_scale("discrete", var, limits = as.character(lims), call = call) } #' @export limits.Date <- function(lims, var, call = caller_env()) { if (length(lims) != 2) { cli::cli_abort("{.arg {var}} must be a two-element vector", call = call) } - make_scale("date", var, limits = lims) + make_scale("date", var, limits = lims, call = call) } #' @export limits.POSIXct <- function(lims, var, call = caller_env()) { if (length(lims) != 2) { cli::cli_abort("{.arg {var}} must be a two-element vector", call = call) } - make_scale("datetime", var, limits = lims) + make_scale("datetime", var, limits = lims, call = call) } #' @export limits.POSIXlt <- function(lims, var, call = caller_env()) { if (length(lims) != 2) { cli::cli_abort("{.arg {var}} must be a two-element vector", call = call) } - make_scale("datetime", var, limits = as.POSIXct(lims)) + make_scale("datetime", var, limits = as.POSIXct(lims), call = call) } #' Expand the plot limits, using data diff --git a/R/scale-.R b/R/scale-.R index 6c6fbb1c78..9a9ef4f4c9 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -3,8 +3,8 @@ #' #' @export #' @param aesthetics The names of the aesthetics that this scale works with. -#' @param scale_name The name of the scale that should be used for error messages -#' associated with this scale. +#' @param scale_name `r lifecycle::badge("deprecated")` The name of the scale +#' that should be used for error messages associated with this scale. #' @param palette A palette function that when called with a numeric vector with #' values between 0 and 1 returns the corresponding output values #' (e.g., [scales::area_pal()]). @@ -87,18 +87,24 @@ #' 0.6 units on each side for discrete variables. #' @param position For position scales, The position of the axis. #' `left` or `right` for y axes, `top` or `bottom` for x axes. +#' @param call The `call` used to construct the scale for reporting messages. #' @param super The super class to use for the constructed scale #' @keywords internal -continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(), +continuous_scale <- function(aesthetics, scale_name = deprecated(), palette, name = waiver(), breaks = waiver(), minor_breaks = waiver(), n.breaks = NULL, labels = waiver(), limits = NULL, rescaler = rescale, oob = censor, expand = waiver(), na.value = NA_real_, trans = "identity", guide = "legend", position = "left", + call = caller_call(), super = ScaleContinuous) { + call <- call %||% current_call() + if (lifecycle::is_present(scale_name)) { + deprecate_soft0("3.5.0", "continuous_scale(scale_name)") + } aesthetics <- standardise_aes_names(aesthetics) - check_breaks_labels(breaks, labels) + check_breaks_labels(breaks, labels, call = call) position <- arg_match0(position, c("left", "right", "top", "bottom")) @@ -121,10 +127,9 @@ continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(), minor_breaks <- allow_lambda(minor_breaks) ggproto(NULL, super, - call = match.call(), + call = call, aesthetics = aesthetics, - scale_name = scale_name, palette = palette, range = ContinuousRange$new(), @@ -177,14 +182,20 @@ continuous_scale <- function(aesthetics, scale_name, palette, name = waiver(), #' missing values be displayed as? Does not apply to position scales #' where `NA` is always placed at the far right. #' @keywords internal -discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), +discrete_scale <- function(aesthetics, scale_name = deprecated(), palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, expand = waiver(), na.translate = TRUE, na.value = NA, drop = TRUE, - guide = "legend", position = "left", super = ScaleDiscrete) { + guide = "legend", position = "left", + call = caller_call(), + super = ScaleDiscrete) { + call <- call %||% current_call() + if (lifecycle::is_present(scale_name)) { + deprecate_soft0("3.5.0", "discrete_scale(scale_name)") + } aesthetics <- standardise_aes_names(aesthetics) - check_breaks_labels(breaks, labels) + check_breaks_labels(breaks, labels, call = call) # Convert formula input to function if appropriate limits <- allow_lambda(limits) @@ -195,7 +206,7 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), cli::cli_warn(c( "Continuous limits supplied to discrete scale.", "i" = "Did you mean {.code limits = factor(...)} or {.fn scale_*_continuous}?" - )) + ), call = call) } position <- arg_match0(position, c("left", "right", "top", "bottom")) @@ -206,10 +217,9 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), } ggproto(NULL, super, - call = match.call(), + call = call, aesthetics = aesthetics, - scale_name = scale_name, palette = palette, range = DiscreteRange$new(), @@ -245,16 +255,22 @@ discrete_scale <- function(aesthetics, scale_name, palette, name = waiver(), #' the left (open on the right). #' @param show.limits should the limits of the scale appear as ticks #' @keywords internal -binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), +binned_scale <- function(aesthetics, scale_name = deprecated(), palette, name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, rescaler = rescale, oob = squish, expand = waiver(), na.value = NA_real_, n.breaks = NULL, nice.breaks = TRUE, right = TRUE, trans = "identity", show.limits = FALSE, - guide = "bins", position = "left", super = ScaleBinned) { + guide = "bins", position = "left", + call = caller_call(), + super = ScaleBinned) { + if (lifecycle::is_present(scale_name)) { + deprecate_soft0("3.5.0", "binned_scale(scale_name)") + } + call <- call %||% current_call() aesthetics <- standardise_aes_names(aesthetics) - check_breaks_labels(breaks, labels) + check_breaks_labels(breaks, labels, call = call) position <- arg_match0(position, c("left", "right", "top", "bottom")) @@ -275,10 +291,9 @@ binned_scale <- function(aesthetics, scale_name, palette, name = waiver(), oob <- allow_lambda(oob) ggproto(NULL, super, - call = match.call(), + call = call, aesthetics = aesthetics, - scale_name = scale_name, palette = palette, range = ContinuousRange$new(), @@ -402,9 +417,8 @@ Scale <- ggproto("Scale", NULL, call = NULL, aesthetics = aes(), - scale_name = NULL, palette = function() { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.") }, range = Range$new(), @@ -420,7 +434,7 @@ Scale <- ggproto("Scale", NULL, is_discrete = function() { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.") }, train_df = function(self, df) { @@ -434,7 +448,7 @@ Scale <- ggproto("Scale", NULL, }, train = function(self, x) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.", call = self$call) }, reset = function(self) { @@ -459,7 +473,7 @@ Scale <- ggproto("Scale", NULL, }, transform = function(self, x) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.", call = self$call) }, map_df = function(self, df, i = NULL) { @@ -481,11 +495,11 @@ Scale <- ggproto("Scale", NULL, }, map = function(self, x, limits = self$get_limits()) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.", call = self$call) }, rescale = function(self, x, limits = self$get_limits(), range = self$dimension()) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.", call = self$call) }, get_limits = function(self) { @@ -503,11 +517,11 @@ Scale <- ggproto("Scale", NULL, }, dimension = function(self, expand = expansion(0, 0), limits = self$get_limits()) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.", call = self$call) }, get_breaks = function(self, limits = self$get_limits()) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.", call = self$call) }, break_positions = function(self, range = self$get_limits()) { @@ -515,19 +529,19 @@ Scale <- ggproto("Scale", NULL, }, get_breaks_minor = function(self, n = 2, b = self$break_positions(), limits = self$get_limits()) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.", call = self$call) }, get_labels = function(self, breaks = self$get_breaks()) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.", call = self$call) }, clone = function(self) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.", call = self$call) }, break_info = function(self, range = NULL) { - cli::cli_abort("Not implemented") + cli::cli_abort("Not implemented.", call = self$call) }, axis_order = function(self) { @@ -547,7 +561,7 @@ Scale <- ggproto("Scale", NULL, } ) -check_breaks_labels <- function(breaks, labels) { +check_breaks_labels <- function(breaks, labels, call = NULL) { if (is.null(breaks)) { return(TRUE) } @@ -558,7 +572,10 @@ check_breaks_labels <- function(breaks, labels) { bad_labels <- is.atomic(breaks) && is.atomic(labels) && length(breaks) != length(labels) if (bad_labels) { - cli::cli_abort("{.arg breaks} and {.arg labels} must have the same length") + cli::cli_abort( + "{.arg breaks} and {.arg labels} must have the same length", + call = call + ) } TRUE @@ -566,8 +583,7 @@ check_breaks_labels <- function(breaks, labels) { default_transform <- function(self, x) { new_x <- self$trans$transform(x) - axis <- if ("x" %in% self$aesthetics) "x" else "y" - check_transformation(x, new_x, self$scale_name, axis) + check_transformation(x, new_x, self$trans$name, self$call) new_x } @@ -595,6 +611,14 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (length(x) == 0) { return() } + # Intercept error here to give examples and mention scale in call + if (is.factor(x) || !typeof(x) %in% c("integer", "double")) { + cli::cli_abort( + c("Discrete values supplied to continuous scale", + i = "Example values: {.and {.val {head(x, 5)}}}"), + call = self$call + ) + } self$range$train(x) }, @@ -661,7 +685,10 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, } if (identical(self$breaks, NA)) { - cli::cli_abort("Invalid {.arg breaks} specification. Use {.val NULL}, not {.val NA}") + cli::cli_abort( + "Invalid {.arg breaks} specification. Use {.val NULL}, not {.val NA}.", + call = self$call + ) } if (zero_range(as.numeric(limits))) { @@ -671,7 +698,10 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, breaks <- self$trans$breaks(limits, self$n.breaks) } else { if (!is.null(self$n.breaks)) { - cli::cli_warn("Ignoring {.arg n.breaks}. Use a {.cls trans} object that supports setting number of breaks") + cli::cli_warn( + "Ignoring {.arg n.breaks}. Use a {.cls trans} object that supports setting number of breaks.", + call = self$call + ) } breaks <- self$trans$breaks(limits) } @@ -699,7 +729,10 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, } if (identical(self$minor_breaks, NA)) { - cli::cli_abort("Invalid {.arg minor_breaks} specification. Use {.val NULL}, not {.val NA}") + cli::cli_abort( + "Invalid {.arg minor_breaks} specification. Use {.val NULL}, not {.val NA}.", + call = self$call + ) } if (is.waive(self$minor_breaks)) { @@ -732,7 +765,10 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, } if (identical(self$labels, NA)) { - cli::cli_abort("Invalid {.arg labels} specification. Use {.val NULL}, not {.val NA}") + cli::cli_abort( + "Invalid {.arg labels} specification. Use {.val NULL}, not {.val NA}.", + call = self$call + ) } if (is.waive(self$labels)) { @@ -744,7 +780,10 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, } if (length(labels) != length(breaks)) { - cli::cli_abort("{.arg breaks} and {.arg labels} are different lengths") + cli::cli_abort( + "{.arg breaks} and {.arg labels} are different lengths.", + call = self$call + ) } if (is.list(labels)) { # Guard against list with empty elements @@ -830,6 +869,14 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, if (length(x) == 0) { return() } + # Intercept error here to give examples and mention scale in call + if (!is.discrete(x)) { + cli::cli_abort( + c("Continuous values supplied to discrete scale", + i = "Example values: {.and {.val {head(x, 5)}}}"), + call = self$call + ) + } self$range$train(x, drop = self$drop, na.rm = !self$na.translate) }, @@ -841,7 +888,10 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, pal <- self$palette.cache } else { if (!is.null(self$n.breaks.cache)) { - cli::cli_warn("Cached palette does not match requested") + cli::cli_warn( + "Cached palette does not match requested.", + call = self$call + ) } pal <- self$palette(n) self$palette.cache <- pal @@ -885,7 +935,10 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, } if (identical(self$breaks, NA)) { - cli::cli_abort("Invalid {.arg breaks} specification. Use {.val NULL}, not {.val NA}") + cli::cli_abort( + "Invalid {.arg breaks} specification. Use {.val NULL}, not {.val NA}.", + call = self$call + ) } if (is.waive(self$breaks)) { @@ -917,7 +970,10 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, } if (identical(self$labels, NA)) { - cli::cli_abort("Invalid {.arg labels} specification. Use {.val NULL}, not {.val NA}") + cli::cli_abort( + "Invalid {.arg labels} specification. Use {.val NULL}, not {.val NA}.", + call = self$call + ) } if (is.waive(self$labels)) { @@ -1004,7 +1060,10 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, train = function(self, x) { if (!is.numeric(x)) { - cli::cli_abort("Binned scales only support continuous data") + cli::cli_abort( + "Binned scales only support continuous data.", + call = self$call + ) } if (length(x) == 0) { @@ -1071,14 +1130,20 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, if (is.null(self$breaks)) { return(NULL) } else if (identical(self$breaks, NA)) { - cli::cli_abort("Invalid {.arg breaks} specification. Use {.val NULL}, not {.val NA}") + cli::cli_abort( + "Invalid {.arg breaks} specification. Use {.val NULL}, not {.val NA}.", + call = self$call + ) } else if (is.waive(self$breaks)) { if (self$nice.breaks) { if (!is.null(self$n.breaks) && trans_support_nbreaks(self$trans)) { breaks <- self$trans$breaks(limits, n = self$n.breaks) } else { if (!is.null(self$n.breaks)) { - cli::cli_warn("Ignoring {.arg n.breaks}. Use a {.cls trans} object that supports setting number of breaks") + cli::cli_warn( + "Ignoring {.arg n.breaks}. Use a {.cls trans} object that supports setting number of breaks.", + call = self$call + ) } breaks <- self$trans$breaks(limits) } @@ -1125,7 +1190,10 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, breaks <- self$breaks(limits, n.breaks = n.breaks) } else { if (!is.null(self$n.breaks)) { - cli::cli_warn("Ignoring {.arg n.breaks}. Use a breaks function that supports setting number of breaks") + cli::cli_warn( + "Ignoring {.arg n.breaks}. Use a breaks function that supports setting number of breaks.", + call = self$call + ) } breaks <- self$breaks(limits) } @@ -1151,7 +1219,10 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, if (is.null(self$labels)) { return(NULL) } else if (identical(self$labels, NA)) { - cli::cli_abort("Invalid {.arg labels} specification. Use {.val NULL}, not {.val NA}") + cli::cli_abort( + "Invalid {.arg labels} specification. Use {.val NULL}, not {.val NA}.", + call = self$call + ) } else if (is.waive(self$labels)) { labels <- self$trans$format(breaks) } else if (is.function(self$labels)) { @@ -1160,7 +1231,10 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, labels <- self$labels } if (length(labels) != length(breaks)) { - cli::cli_abort("{.arg breaks} and {.arg labels} are different lengths") + cli::cli_abort( + "{.arg breaks} and {.arg labels} are different lengths.", + call = self$call + ) } labels }, @@ -1210,16 +1284,12 @@ scale_flip_position <- function(scale) { invisible() } -check_transformation <- function(x, transformed, name, axis) { +check_transformation <- function(x, transformed, name, call = NULL) { if (any(is.finite(x) != is.finite(transformed))) { - type <- if (name == "position_b") { - "binned" - } else if (name == "position_c") { - "continuous" - } else { - "discrete" - } - cli::cli_warn("Transformation introduced infinite values in {type} {axis}-axis") + cli::cli_warn( + "{.field {name}} transformation introduced infinite values.", + call = call + ) } } diff --git a/R/scale-alpha.R b/R/scale-alpha.R index d44eb40c9f..8be2925c58 100644 --- a/R/scale-alpha.R +++ b/R/scale-alpha.R @@ -24,7 +24,7 @@ #' p + scale_alpha("cylinders") #' p + scale_alpha(range = c(0.4, 0.8)) scale_alpha <- function(..., range = c(0.1, 1)) { - continuous_scale("alpha", "alpha_c", rescale_pal(range), ...) + continuous_scale("alpha", palette = rescale_pal(range), ...) } #' @rdname scale_alpha @@ -34,14 +34,16 @@ scale_alpha_continuous <- scale_alpha #' @rdname scale_alpha #' @export scale_alpha_binned <- function(..., range = c(0.1, 1)) { - binned_scale("alpha", "alpha_b", rescale_pal(range), ...) + binned_scale("alpha", palette = rescale_pal(range), ...) } #' @rdname scale_alpha #' @export scale_alpha_discrete <- function(...) { cli::cli_warn("Using alpha for a discrete variable is not advised.") - scale_alpha_ordinal(...) + args <- list2(...) + args$call <- args$call %||% current_call() + exec(scale_alpha_ordinal, !!!args) } #' @rdname scale_alpha @@ -49,8 +51,7 @@ scale_alpha_discrete <- function(...) { scale_alpha_ordinal <- function(..., range = c(0.1, 1)) { discrete_scale( "alpha", - "alpha_d", - function(n) seq(range[1], range[2], length.out = n), + palette = function(n) seq(range[1], range[2], length.out = n), ... ) } diff --git a/R/scale-binned.R b/R/scale-binned.R index 161691c3c0..1fb5444696 100644 --- a/R/scale-binned.R +++ b/R/scale-binned.R @@ -30,7 +30,7 @@ scale_x_binned <- function(name = waiver(), n.breaks = 10, nice.breaks = TRUE, guide = waiver(), position = "bottom") { binned_scale( ggplot_global$x_aes, - scale_name = "position_b", palette = identity, name = name, breaks = breaks, + palette = identity, name = name, breaks = breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, n.breaks = n.breaks, nice.breaks = nice.breaks, right = right, trans = trans, show.limits = show.limits, guide = guide, position = position, super = ScaleBinnedPosition @@ -47,7 +47,7 @@ scale_y_binned <- function(name = waiver(), n.breaks = 10, nice.breaks = TRUE, guide = waiver(), position = "left") { binned_scale( ggplot_global$y_aes, - scale_name = "position_b", palette = identity, name = name, breaks = breaks, + palette = identity, name = name, breaks = breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, n.breaks = n.breaks, nice.breaks = nice.breaks, right = right, trans = trans, show.limits = show.limits, guide = guide, position = position, super = ScaleBinnedPosition @@ -63,7 +63,10 @@ ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, train = function(self, x) { if (!is.numeric(x)) { - cli::cli_abort("Binned scales only support continuous data") + cli::cli_abort( + "Binned scales only support continuous data.", + call = self$call + ) } if (length(x) == 0 || self$after.stat) return() diff --git a/R/scale-brewer.R b/R/scale-brewer.R index 2bf583961a..b3d48ab820 100644 --- a/R/scale-brewer.R +++ b/R/scale-brewer.R @@ -83,13 +83,13 @@ #' v + scale_fill_fermenter() #' scale_colour_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "colour") { - discrete_scale(aesthetics, "brewer", brewer_pal(type, palette, direction), ...) + discrete_scale(aesthetics, palette = brewer_pal(type, palette, direction), ...) } #' @export #' @rdname scale_brewer scale_fill_brewer <- function(..., type = "seq", palette = 1, direction = 1, aesthetics = "fill") { - discrete_scale(aesthetics, "brewer", brewer_pal(type, palette, direction), ...) + discrete_scale(aesthetics, palette = brewer_pal(type, palette, direction), ...) } #' @export @@ -103,8 +103,11 @@ scale_colour_distiller <- function(..., type = "seq", palette = 1, direction = - "i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead" )) } - continuous_scale(aesthetics, "distiller", - gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space), na.value = na.value, guide = guide, ...) + continuous_scale( + aesthetics, + palette = gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space), + na.value = na.value, guide = guide, ... + ) # NB: 6-7 colours per palette gives nice gradients; more results in more saturated colours which do not look as good # For diverging scales, you need an odd number to make sure the mid-point is in the center } @@ -119,8 +122,11 @@ scale_fill_distiller <- function(..., type = "seq", palette = 1, direction = -1, "i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead" )) } - continuous_scale(aesthetics, "distiller", - gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space), na.value = na.value, guide = guide, ...) + continuous_scale( + aesthetics, + palette = gradient_n_pal(brewer_pal(type, palette, direction)(7), values, space), + na.value = na.value, guide = guide, ... + ) } #' @export @@ -134,7 +140,7 @@ scale_colour_fermenter <- function(..., type = "seq", palette = 1, direction = - "i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead" )) } - binned_scale(aesthetics, "fermenter", binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) + binned_scale(aesthetics, palette = binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) } #' @export @@ -147,11 +153,5 @@ scale_fill_fermenter <- function(..., type = "seq", palette = 1, direction = -1, "i" = "Consider using {.code type = \"seq\"} or {.code type = \"div\"} instead" )) } - binned_scale(aesthetics, "fermenter", binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) + binned_scale(aesthetics, palette = binned_pal(brewer_pal(type, palette, direction)), na.value = na.value, guide = guide, ...) } - -# icon.brewer <- function() { -# rectGrob(c(0.1, 0.3, 0.5, 0.7, 0.9), width = 0.21, -# gp = gpar(fill = RColorBrewer::brewer.pal(5, "PuOr"), col = NA) -# ) -# } diff --git a/R/scale-colour.R b/R/scale-colour.R index c063f9efa9..a3084ec7df 100644 --- a/R/scale-colour.R +++ b/R/scale-colour.R @@ -78,13 +78,18 @@ scale_colour_continuous <- function(..., type = getOption("ggplot2.continuous.colour")) { type <- type %||% "gradient" + args <- list2(...) + args$call <- args$call %||% current_call() if (is.function(type)) { - check_scale_type(type(...), "scale_colour_continuous", "colour") + if (!any(c("...", "call") %in% fn_fmls_names(type))) { + args$call <- NULL + } + check_scale_type(exec(type, !!!args), "scale_colour_continuous", "colour") } else if (identical(type, "gradient")) { - scale_colour_gradient(...) + exec(scale_colour_gradient, !!!args) } else if (identical(type, "viridis")) { - scale_colour_viridis_c(...) + exec(scale_colour_viridis_c, !!!args) } else { cli::cli_abort(c( "Unknown scale type: {.val {type}}", @@ -98,13 +103,18 @@ scale_colour_continuous <- function(..., scale_fill_continuous <- function(..., type = getOption("ggplot2.continuous.fill")) { type <- type %||% "gradient" + args <- list2(...) + args$call <- args$call %||% current_call() if (is.function(type)) { - check_scale_type(type(...), "scale_fill_continuous", "fill") + if (!any(c("...", "call") %in% fn_fmls_names(type))) { + args$call <- NULL + } + check_scale_type(exec(type, !!!args), "scale_fill_continuous", "fill") } else if (identical(type, "gradient")) { - scale_fill_gradient(...) + exec(scale_fill_gradient, !!!args) } else if (identical(type, "viridis")) { - scale_fill_viridis_c(...) + exec(scale_fill_viridis_c, !!!args) } else { cli::cli_abort(c( "Unknown scale type: {.val {type}}", @@ -117,8 +127,13 @@ scale_fill_continuous <- function(..., #' @rdname scale_colour_continuous scale_colour_binned <- function(..., type = getOption("ggplot2.binned.colour")) { + args <- list2(...) + args$call <- args$call %||% current_call() if (is.function(type)) { - check_scale_type(type(...), "scale_colour_binned", "colour") + if (!any(c("...", "call") %in% fn_fmls_names(type))) { + args$call <- NULL + } + check_scale_type(exec(type, !!!args), "scale_colour_binned", "colour") } else { type_fallback <- getOption("ggplot2.continuous.colour", default = "gradient") # don't use fallback from scale_colour_continuous() if it is @@ -130,9 +145,9 @@ scale_colour_binned <- function(..., type <- type %||% type_fallback if (identical(type, "gradient")) { - scale_colour_steps(...) + exec(scale_colour_steps, !!!args) } else if (identical(type, "viridis")) { - scale_colour_viridis_b(...) + exec(scale_colour_viridis_b, !!!args) } else { cli::cli_abort(c( "Unknown scale type: {.val {type}}", @@ -146,8 +161,13 @@ scale_colour_binned <- function(..., #' @rdname scale_colour_continuous scale_fill_binned <- function(..., type = getOption("ggplot2.binned.fill")) { + args <- list2(...) + args$call <- args$call %||% current_call() if (is.function(type)) { - check_scale_type(type(...), "scale_fill_binned", "fill") + if (!any(c("...", "call") %in% fn_fmls_names(type))) { + args$call <- NULL + } + check_scale_type(exec(type, !!!args), "scale_fill_binned", "fill") } else { type_fallback <- getOption("ggplot2.continuous.fill", default = "gradient") # don't use fallback from scale_colour_continuous() if it is @@ -159,9 +179,9 @@ scale_fill_binned <- function(..., type <- type %||% type_fallback if (identical(type, "gradient")) { - scale_fill_steps(...) + exec(scale_fill_steps, !!!args) } else if (identical(type, "viridis")) { - scale_fill_viridis_b(...) + exec(scale_fill_viridis_b, !!!args) } else { cli::cli_abort(c( "Unknown scale type: {.val {type}}", diff --git a/R/scale-continuous.R b/R/scale-continuous.R index 79939d1ee1..73b026a678 100644 --- a/R/scale-continuous.R +++ b/R/scale-continuous.R @@ -84,12 +84,17 @@ scale_x_continuous <- function(name = waiver(), breaks = waiver(), na.value = NA_real_, trans = "identity", guide = waiver(), position = "bottom", sec.axis = waiver()) { + call <- caller_call() + if (is.null(call) || !startsWith(as.character(call[[1]]), "scale_")) { + call <- current_call() + } sc <- continuous_scale( ggplot_global$x_aes, - "position_c", identity, name = name, breaks = breaks, n.breaks = n.breaks, + palette = identity, name = name, breaks = breaks, n.breaks = n.breaks, minor_breaks = minor_breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, trans = trans, - guide = guide, position = position, super = ScaleContinuousPosition + guide = guide, position = position, call = call, + super = ScaleContinuousPosition ) set_sec_axis(sec.axis, sc) @@ -105,12 +110,17 @@ scale_y_continuous <- function(name = waiver(), breaks = waiver(), na.value = NA_real_, trans = "identity", guide = waiver(), position = "left", sec.axis = waiver()) { + call <- caller_call() + if (is.null(call) || !startsWith(as.character(call[[1]]), "scale_")) { + call <- current_call() + } sc <- continuous_scale( ggplot_global$y_aes, - "position_c", identity, name = name, breaks = breaks, n.breaks = n.breaks, + palette = identity, name = name, breaks = breaks, n.breaks = n.breaks, minor_breaks = minor_breaks, labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, trans = trans, - guide = guide, position = position, super = ScaleContinuousPosition + guide = guide, position = position, call = call, + super = ScaleContinuousPosition ) set_sec_axis(sec.axis, sc) diff --git a/R/scale-date.R b/R/scale-date.R index 5d3dcb4de0..8c20532599 100644 --- a/R/scale-date.R +++ b/R/scale-date.R @@ -293,8 +293,8 @@ datetime_scale <- function(aesthetics, trans, palette, labels = waiver(), date_breaks = waiver(), date_labels = waiver(), date_minor_breaks = waiver(), timezone = NULL, - guide = "legend", ...) { - + guide = "legend", call = caller_call(), ...) { + call <- call %||% current_call() # Backward compatibility if (is.character(breaks)) breaks <- breaks_width(breaks) @@ -313,11 +313,6 @@ datetime_scale <- function(aesthetics, trans, palette, } } - name <- switch(trans, - date = "date", - time = "datetime" - ) - # x/y position aesthetics should use ScaleContinuousDate or # ScaleContinuousDatetime; others use ScaleContinuous if (all(aesthetics %in% c("x", "xmin", "xmax", "xend", "y", "ymin", "ymax", "yend"))) { @@ -337,13 +332,13 @@ datetime_scale <- function(aesthetics, trans, palette, sc <- continuous_scale( aesthetics, - name, palette = palette, breaks = breaks, minor_breaks = minor_breaks, labels = labels, guide = guide, trans = trans, + call = call, ..., super = scale_class ) diff --git a/R/scale-discrete-.R b/R/scale-discrete-.R index 25931f3d7e..339df10122 100644 --- a/R/scale-discrete-.R +++ b/R/scale-discrete-.R @@ -62,7 +62,7 @@ #' scale_x_discrete(labels = abbreviate) #' } scale_x_discrete <- function(..., expand = waiver(), guide = waiver(), position = "bottom") { - sc <- discrete_scale(c("x", "xmin", "xmax", "xend"), "position_d", identity, ..., + sc <- discrete_scale(c("x", "xmin", "xmax", "xend"), palette = identity, ..., expand = expand, guide = guide, position = position, super = ScaleDiscretePosition) sc$range_c <- ContinuousRange$new() @@ -71,7 +71,7 @@ scale_x_discrete <- function(..., expand = waiver(), guide = waiver(), position #' @rdname scale_discrete #' @export scale_y_discrete <- function(..., expand = waiver(), guide = waiver(), position = "left") { - sc <- discrete_scale(c("y", "ymin", "ymax", "yend"), "position_d", identity, ..., + sc <- discrete_scale(c("y", "ymin", "ymax", "yend"), palette = identity, ..., expand = expand, guide = guide, position = position, super = ScaleDiscretePosition) sc$range_c <- ContinuousRange$new() diff --git a/R/scale-gradient.R b/R/scale-gradient.R index a2cce5b8a3..95ee2824b2 100644 --- a/R/scale-gradient.R +++ b/R/scale-gradient.R @@ -77,7 +77,7 @@ #' scale_colour_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "colour") { - continuous_scale(aesthetics, "gradient", seq_gradient_pal(low, high, space), + continuous_scale(aesthetics, palette = seq_gradient_pal(low, high, space), na.value = na.value, guide = guide, ...) } @@ -85,7 +85,7 @@ scale_colour_gradient <- function(..., low = "#132B43", high = "#56B1F7", space #' @export scale_fill_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") { - continuous_scale(aesthetics, "gradient", seq_gradient_pal(low, high, space), + continuous_scale(aesthetics, palette = seq_gradient_pal(low, high, space), na.value = na.value, guide = guide, ...) } @@ -97,9 +97,12 @@ scale_fill_gradient <- function(..., low = "#132B43", high = "#56B1F7", space = scale_colour_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), midpoint = 0, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "colour") { - continuous_scale(aesthetics, "gradient2", - div_gradient_pal(low, mid, high, space), na.value = na.value, guide = guide, ..., - rescaler = mid_rescaler(mid = midpoint)) + continuous_scale( + aesthetics, + palette = div_gradient_pal(low, mid, high, space), + na.value = na.value, guide = guide, ..., + rescaler = mid_rescaler(mid = midpoint) + ) } #' @rdname scale_gradient @@ -107,9 +110,12 @@ scale_colour_gradient2 <- function(..., low = muted("red"), mid = "white", high scale_fill_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), midpoint = 0, space = "Lab", na.value = "grey50", guide = "colourbar", aesthetics = "fill") { - continuous_scale(aesthetics, "gradient2", - div_gradient_pal(low, mid, high, space), na.value = na.value, guide = guide, ..., - rescaler = mid_rescaler(mid = midpoint)) + continuous_scale( + aesthetics, + palette = div_gradient_pal(low, mid, high, space), + na.value = na.value, guide = guide, ..., + rescaler = mid_rescaler(mid = midpoint) + ) } mid_rescaler <- function(mid) { @@ -126,8 +132,11 @@ scale_colour_gradientn <- function(..., colours, values = NULL, space = "Lab", n guide = "colourbar", aesthetics = "colour", colors) { colours <- if (missing(colours)) colors else colours - continuous_scale(aesthetics, "gradientn", - gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...) + continuous_scale( + aesthetics, + palette = gradient_n_pal(colours, values, space), + na.value = na.value, guide = guide, ... + ) } #' @rdname scale_gradient #' @export @@ -135,6 +144,9 @@ scale_fill_gradientn <- function(..., colours, values = NULL, space = "Lab", na. guide = "colourbar", aesthetics = "fill", colors) { colours <- if (missing(colours)) colors else colours - continuous_scale(aesthetics, "gradientn", - gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...) + continuous_scale( + aesthetics, + palette = gradient_n_pal(colours, values, space), + na.value = na.value, guide = guide, ... + ) } diff --git a/R/scale-grey.R b/R/scale-grey.R index 4289d3690f..c71dd444ef 100644 --- a/R/scale-grey.R +++ b/R/scale-grey.R @@ -28,13 +28,13 @@ #' geom_point(aes(colour = miss)) + #' scale_colour_grey(na.value = "green") scale_colour_grey <- function(..., start = 0.2, end = 0.8, na.value = "red", aesthetics = "colour") { - discrete_scale(aesthetics, "grey", grey_pal(start, end), + discrete_scale(aesthetics, palette = grey_pal(start, end), na.value = na.value, ...) } #' @rdname scale_grey #' @export scale_fill_grey <- function(..., start = 0.2, end = 0.8, na.value = "red", aesthetics = "fill") { - discrete_scale(aesthetics, "grey", grey_pal(start, end), + discrete_scale(aesthetics, palette = grey_pal(start, end), na.value = na.value, ...) } diff --git a/R/scale-hue.R b/R/scale-hue.R index 1bcda70773..0e0d796537 100644 --- a/R/scale-hue.R +++ b/R/scale-hue.R @@ -55,7 +55,7 @@ #' } scale_colour_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50", aesthetics = "colour") { - discrete_scale(aesthetics, "hue", hue_pal(h, c, l, h.start, direction), + discrete_scale(aesthetics, palette = hue_pal(h, c, l, h.start, direction), na.value = na.value, ...) } @@ -63,7 +63,7 @@ scale_colour_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = #' @export scale_fill_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50", aesthetics = "fill") { - discrete_scale(aesthetics, "hue", hue_pal(h, c, l, h.start, direction), + discrete_scale(aesthetics, palette = hue_pal(h, c, l, h.start, direction), na.value = na.value, ...) } @@ -124,15 +124,21 @@ scale_fill_hue <- function(..., h = c(0, 360) + 15, c = 100, l = 65, h.start = 0 scale_colour_discrete <- function(..., type = getOption("ggplot2.discrete.colour")) { # TODO: eventually `type` should default to a set of colour-blind safe color codes (e.g. Okabe-Ito) type <- type %||% scale_colour_hue + args <- list2(...) + args$call <- args$call %||% current_call() + if (is.function(type)) { + if (!any(c("...", "call") %in% fn_fmls_names(type))) { + args$call <- NULL + } check_scale_type( - type(...), + exec(type, !!!args), "scale_colour_discrete", "colour", scale_is_discrete = TRUE ) } else { - scale_colour_qualitative(..., type = type) + exec(scale_colour_qualitative, !!!args, type = type) } } @@ -141,22 +147,28 @@ scale_colour_discrete <- function(..., type = getOption("ggplot2.discrete.colour scale_fill_discrete <- function(..., type = getOption("ggplot2.discrete.fill")) { # TODO: eventually `type` should default to a set of colour-blind safe color codes (e.g. Okabe-Ito) type <- type %||% scale_fill_hue + args <- list2(...) + args$call <- args$call %||% current_call() + if (is.function(type)) { + if (!any(c("...", "call") %in% fn_fmls_names(type))) { + args$call <- NULL + } check_scale_type( - type(...), + exec(type, !!!args), "scale_fill_discrete", "fill", scale_is_discrete = TRUE ) } else { - scale_fill_qualitative(..., type = type) + exec(scale_fill_qualitative, !!!args, type = type) } } scale_colour_qualitative <- function(..., type = NULL, h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50", aesthetics = "colour") { discrete_scale( - aesthetics, "qualitative", qualitative_pal(type, h, c, l, h.start, direction), + aesthetics, palette = qualitative_pal(type, h, c, l, h.start, direction), na.value = na.value, ... ) } @@ -164,7 +176,7 @@ scale_colour_qualitative <- function(..., type = NULL, h = c(0, 360) + 15, c = 1 scale_fill_qualitative <- function(..., type = NULL, h = c(0, 360) + 15, c = 100, l = 65, h.start = 0, direction = 1, na.value = "grey50", aesthetics = "fill") { discrete_scale( - aesthetics, "qualitative", qualitative_pal(type, h, c, l, h.start, direction), + aesthetics, palette = qualitative_pal(type, h, c, l, h.start, direction), na.value = na.value, ... ) } diff --git a/R/scale-identity.R b/R/scale-identity.R index 336083a6a2..9a3ace41a0 100644 --- a/R/scale-identity.R +++ b/R/scale-identity.R @@ -63,7 +63,7 @@ NULL #' @rdname scale_identity #' @export scale_colour_identity <- function(..., guide = "none", aesthetics = "colour") { - sc <- discrete_scale(aesthetics, "identity", identity_pal(), ..., guide = guide, + sc <- discrete_scale(aesthetics, palette = identity_pal(), ..., guide = guide, super = ScaleDiscreteIdentity) sc @@ -72,7 +72,7 @@ scale_colour_identity <- function(..., guide = "none", aesthetics = "colour") { #' @rdname scale_identity #' @export scale_fill_identity <- function(..., guide = "none", aesthetics = "fill") { - sc <- discrete_scale(aesthetics, "identity", identity_pal(), ..., guide = guide, + sc <- discrete_scale(aesthetics, palette = identity_pal(), ..., guide = guide, super = ScaleDiscreteIdentity) sc @@ -83,7 +83,7 @@ scale_fill_identity <- function(..., guide = "none", aesthetics = "fill") { #' Other shape scales: [scale_shape()], [scale_shape_manual()]. #' @export scale_shape_identity <- function(..., guide = "none") { - sc <- continuous_scale("shape", "identity", identity_pal(), ..., guide = guide, + sc <- continuous_scale("shape", palette = identity_pal(), ..., guide = guide, super = ScaleContinuousIdentity) sc @@ -94,7 +94,7 @@ scale_shape_identity <- function(..., guide = "none") { #' Other linetype scales: [scale_linetype()], [scale_linetype_manual()]. #' @export scale_linetype_identity <- function(..., guide = "none") { - sc <- discrete_scale("linetype", "identity", identity_pal(), ..., guide = guide, + sc <- discrete_scale("linetype", palette = identity_pal(), ..., guide = guide, super = ScaleDiscreteIdentity) sc @@ -105,7 +105,7 @@ scale_linetype_identity <- function(..., guide = "none") { #' Other alpha scales: [scale_alpha()], [scale_alpha_manual()]. #' @export scale_linewidth_identity <- function(..., guide = "none") { - sc <- continuous_scale("linewidth", "identity", identity_pal(), ..., + sc <- continuous_scale("linewidth", palette = identity_pal(), ..., guide = guide, super = ScaleContinuousIdentity) sc @@ -114,7 +114,7 @@ scale_linewidth_identity <- function(..., guide = "none") { #' @rdname scale_identity #' @export scale_alpha_identity <- function(..., guide = "none") { - sc <- continuous_scale("alpha", "identity", identity_pal(), ..., guide = guide, + sc <- continuous_scale("alpha", palette = identity_pal(), ..., guide = guide, super = ScaleContinuousIdentity) sc @@ -125,7 +125,7 @@ scale_alpha_identity <- function(..., guide = "none") { #' Other size scales: [scale_size()], [scale_size_manual()]. #' @export scale_size_identity <- function(..., guide = "none") { - sc <- continuous_scale("size", "identity", identity_pal(), ..., guide = guide, + sc <- continuous_scale("size", palette = identity_pal(), ..., guide = guide, super = ScaleContinuousIdentity) sc @@ -134,7 +134,7 @@ scale_size_identity <- function(..., guide = "none") { #' @rdname scale_identity #' @export scale_discrete_identity <- function(aesthetics, ..., guide = "none") { - sc <- discrete_scale(aesthetics, "identity", identity_pal(), ..., guide = guide, + sc <- discrete_scale(aesthetics, palette = identity_pal(), ..., guide = guide, super = ScaleDiscreteIdentity) sc @@ -143,7 +143,7 @@ scale_discrete_identity <- function(aesthetics, ..., guide = "none") { #' @rdname scale_identity #' @export scale_continuous_identity <- function(aesthetics, ..., guide = "none") { - sc <- continuous_scale(aesthetics, "identity", identity_pal(), ..., guide = guide, + sc <- continuous_scale(aesthetics, palette = identity_pal(), ..., guide = guide, super = ScaleContinuousIdentity) sc diff --git a/R/scale-linetype.R b/R/scale-linetype.R index 54d0eb1360..494abc5d55 100644 --- a/R/scale-linetype.R +++ b/R/scale-linetype.R @@ -34,14 +34,14 @@ #' facet_grid(linetype ~ .) + #' theme_void(20) scale_linetype <- function(..., na.value = "blank") { - discrete_scale("linetype", "linetype_d", linetype_pal(), + discrete_scale("linetype", palette = linetype_pal(), na.value = na.value, ...) } #' @rdname scale_linetype #' @export scale_linetype_binned <- function(..., na.value = "blank") { - binned_scale("linetype", "linetype_b", binned_pal(linetype_pal()), ...) + binned_scale("linetype", palette = binned_pal(linetype_pal()), ...) } #' @rdname scale_linetype diff --git a/R/scale-linewidth.R b/R/scale-linewidth.R index 9a550439a7..61f4dc1c0c 100644 --- a/R/scale-linewidth.R +++ b/R/scale-linewidth.R @@ -31,7 +31,7 @@ scale_linewidth_continuous <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") { - continuous_scale("linewidth", "linewidth_c", rescale_pal(range), name = name, + continuous_scale("linewidth", palette = rescale_pal(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, guide = guide) } @@ -45,7 +45,7 @@ scale_linewidth <- scale_linewidth_continuous scale_linewidth_binned <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), n.breaks = NULL, nice.breaks = TRUE, trans = "identity", guide = "bins") { - binned_scale("linewidth", "linewidth_b", rescale_pal(range), name = name, + binned_scale("linewidth", palette = rescale_pal(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, n.breaks = n.breaks, nice.breaks = nice.breaks, guide = guide) } @@ -55,7 +55,9 @@ scale_linewidth_binned <- function(name = waiver(), breaks = waiver(), labels = #' @usage NULL scale_linewidth_discrete <- function(...) { cli::cli_warn("Using {.field linewidth} for a discrete variable is not advised.") - scale_linewidth_ordinal(...) + args <- list2(...) + args$call <- args$call %||% current_call() + exec(scale_linewidth_ordinal, !!!args) } #' @rdname scale_linewidth @@ -66,8 +68,7 @@ scale_linewidth_ordinal <- function(..., range = c(2, 6)) { discrete_scale( "linewidth", - "linewidth_d", - function(n) seq(range[1], range[2], length.out = n), + palette = function(n) seq(range[1], range[2], length.out = n), ... ) } diff --git a/R/scale-manual.R b/R/scale-manual.R index 6d86c5f42c..380d64d64f 100644 --- a/R/scale-manual.R +++ b/R/scale-manual.R @@ -142,7 +142,8 @@ scale_discrete_manual <- function(aesthetics, ..., values, breaks = waiver()) { } manual_scale <- function(aesthetic, values = NULL, breaks = waiver(), ..., - limits = NULL) { + limits = NULL, call = caller_call()) { + call <- call %||% current_call() # check for missing `values` parameter, in lieu of providing # a default to all the different scale_*_manual() functions if (is_missing(values)) { @@ -182,5 +183,6 @@ manual_scale <- function(aesthetic, values = NULL, breaks = waiver(), ..., } values } - discrete_scale(aesthetic, "manual", pal, breaks = breaks, limits = limits, ...) + discrete_scale(aesthetic, palette = pal, breaks = breaks, limits = limits, + call = call, ...) } diff --git a/R/scale-shape.R b/R/scale-shape.R index daccdbbb98..cc293174ef 100644 --- a/R/scale-shape.R +++ b/R/scale-shape.R @@ -41,13 +41,13 @@ #' facet_wrap(~shape) + #' theme_void() scale_shape <- function(..., solid = TRUE) { - discrete_scale("shape", "shape_d", shape_pal(solid), ...) + discrete_scale("shape", palette = shape_pal(solid), ...) } #' @rdname scale_shape #' @export scale_shape_binned <- function(..., solid = TRUE) { - binned_scale("shape", "shape_b", binned_pal(shape_pal(solid)), ...) + binned_scale("shape", palette = binned_pal(shape_pal(solid)), ...) } #' @rdname scale_shape @@ -60,7 +60,9 @@ scale_shape_discrete <- scale_shape #' @usage NULL scale_shape_ordinal <- function(...) { cli::cli_warn("Using shapes for an ordinal variable is not advised") - scale_shape(...) + args <- list2(...) + args$call <- args$call %||% current_call() + exec(scale_shape, !!!args) } #' @rdname scale_shape diff --git a/R/scale-size.R b/R/scale-size.R index 0259dfd767..c75a22fa3e 100644 --- a/R/scale-size.R +++ b/R/scale-size.R @@ -52,7 +52,7 @@ NULL scale_size_continuous <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") { - continuous_scale("size", "area", area_pal(range), name = name, + continuous_scale("size", palette = area_pal(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, guide = guide) } @@ -66,7 +66,7 @@ scale_size <- scale_size_continuous scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), trans = "identity", guide = "legend") { - continuous_scale("size", "radius", rescale_pal(range), name = name, + continuous_scale("size", palette = rescale_pal(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, guide = guide) } @@ -76,7 +76,7 @@ scale_radius <- function(name = waiver(), breaks = waiver(), labels = waiver(), scale_size_binned <- function(name = waiver(), breaks = waiver(), labels = waiver(), limits = NULL, range = c(1, 6), n.breaks = NULL, nice.breaks = TRUE, trans = "identity", guide = "bins") { - binned_scale("size", "area_b", area_pal(range), name = name, + binned_scale("size", palette = area_pal(range), name = name, breaks = breaks, labels = labels, limits = limits, trans = trans, n.breaks = n.breaks, nice.breaks = nice.breaks, guide = guide) } @@ -86,7 +86,9 @@ scale_size_binned <- function(name = waiver(), breaks = waiver(), labels = waive #' @usage NULL scale_size_discrete <- function(...) { cli::cli_warn("Using {.field size} for a discrete variable is not advised.") - scale_size_ordinal(...) + args <- list2(...) + args$call <- args$call %||% current_call() + exec(scale_size_ordinal, !!!args) } #' @rdname scale_size @@ -97,8 +99,7 @@ scale_size_ordinal <- function(..., range = c(2, 6)) { discrete_scale( "size", - "size_d", - function(n) { + palette = function(n) { area <- seq(range[1] ^ 2, range[2] ^ 2, length.out = n) sqrt(area) }, @@ -111,7 +112,7 @@ scale_size_ordinal <- function(..., range = c(2, 6)) { #' @export #' @rdname scale_size scale_size_area <- function(..., max_size = 6) { - continuous_scale("size", "area", + continuous_scale("size", palette = abs_area(max_size), rescaler = rescale_max, ...) } @@ -119,7 +120,7 @@ scale_size_area <- function(..., max_size = 6) { #' @export #' @rdname scale_size scale_size_binned_area <- function(..., max_size = 6) { - binned_scale("size", "area_b", + binned_scale("size", palette = abs_area(max_size), rescaler = rescale_max, ...) } diff --git a/R/scale-steps.R b/R/scale-steps.R index 193fa6ddcb..5bbba07cb9 100644 --- a/R/scale-steps.R +++ b/R/scale-steps.R @@ -46,7 +46,7 @@ #' @rdname scale_steps scale_colour_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "coloursteps", aesthetics = "colour") { - binned_scale(aesthetics, "steps", seq_gradient_pal(low, high, space), + binned_scale(aesthetics, palette = seq_gradient_pal(low, high, space), na.value = na.value, guide = guide, ...) } #' @rdname scale_steps @@ -54,7 +54,7 @@ scale_colour_steps <- function(..., low = "#132B43", high = "#56B1F7", space = " scale_colour_steps2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), midpoint = 0, space = "Lab", na.value = "grey50", guide = "coloursteps", aesthetics = "colour") { - binned_scale(aesthetics, "steps2", div_gradient_pal(low, mid, high, space), + binned_scale(aesthetics, palette = div_gradient_pal(low, mid, high, space), na.value = na.value, guide = guide, rescaler = mid_rescaler(mid = midpoint), ...) } #' @rdname scale_steps @@ -62,14 +62,14 @@ scale_colour_steps2 <- function(..., low = muted("red"), mid = "white", high = m scale_colour_stepsn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", guide = "coloursteps", aesthetics = "colour", colors) { colours <- if (missing(colours)) colors else colours - binned_scale(aesthetics, "stepsn", - gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...) + binned_scale(aesthetics, palette = gradient_n_pal(colours, values, space), + na.value = na.value, guide = guide, ...) } #' @rdname scale_steps #' @export scale_fill_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "Lab", na.value = "grey50", guide = "coloursteps", aesthetics = "fill") { - binned_scale(aesthetics, "steps", seq_gradient_pal(low, high, space), + binned_scale(aesthetics, palette = seq_gradient_pal(low, high, space), na.value = na.value, guide = guide, ...) } #' @rdname scale_steps @@ -77,7 +77,7 @@ scale_fill_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "La scale_fill_steps2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"), midpoint = 0, space = "Lab", na.value = "grey50", guide = "coloursteps", aesthetics = "fill") { - binned_scale(aesthetics, "steps2", div_gradient_pal(low, mid, high, space), + binned_scale(aesthetics, palette = div_gradient_pal(low, mid, high, space), na.value = na.value, guide = guide, rescaler = mid_rescaler(mid = midpoint), ...) } #' @rdname scale_steps @@ -85,6 +85,6 @@ scale_fill_steps2 <- function(..., low = muted("red"), mid = "white", high = mut scale_fill_stepsn <- function(..., colours, values = NULL, space = "Lab", na.value = "grey50", guide = "coloursteps", aesthetics = "fill", colors) { colours <- if (missing(colours)) colors else colours - binned_scale(aesthetics, "stepsn", - gradient_n_pal(colours, values, space), na.value = na.value, guide = guide, ...) + binned_scale(aesthetics, palette = gradient_n_pal(colours, values, space), + na.value = na.value, guide = guide, ...) } diff --git a/R/scale-type.R b/R/scale-type.R index d8d4a70b6f..2feaa69c82 100644 --- a/R/scale-type.R +++ b/R/scale-type.R @@ -11,8 +11,11 @@ find_scale <- function(aes, x, env = parent.frame()) { for (scale in candidates) { scale_f <- find_global(scale, env, mode = "function") - if (!is.null(scale_f)) - return(scale_f()) + if (!is.null(scale_f)) { + sc <- scale_f() + sc$call <- parse_expr(paste0(scale, "()")) + return(sc) + } } # Failure to find a scale is not an error because some "aesthetics" don't diff --git a/R/scale-viridis.R b/R/scale-viridis.R index 6460d435b9..72ecd4a491 100644 --- a/R/scale-viridis.R +++ b/R/scale-viridis.R @@ -62,8 +62,7 @@ scale_colour_viridis_d <- function(..., alpha = 1, begin = 0, end = 1, direction = 1, option = "D", aesthetics = "colour") { discrete_scale( aesthetics, - "viridis_d", - viridis_pal(alpha, begin, end, direction, option), + palette = viridis_pal(alpha, begin, end, direction, option), ... ) } @@ -74,8 +73,7 @@ scale_fill_viridis_d <- function(..., alpha = 1, begin = 0, end = 1, direction = 1, option = "D", aesthetics = "fill") { discrete_scale( aesthetics, - "viridis_d", - viridis_pal(alpha, begin, end, direction, option), + palette = viridis_pal(alpha, begin, end, direction, option), ... ) } @@ -88,8 +86,7 @@ scale_colour_viridis_c <- function(..., alpha = 1, begin = 0, end = 1, guide = "colourbar", aesthetics = "colour") { continuous_scale( aesthetics, - "viridis_c", - gradient_n_pal( + palette = gradient_n_pal( viridis_pal(alpha, begin, end, direction, option)(6), values, space @@ -108,8 +105,7 @@ scale_fill_viridis_c <- function(..., alpha = 1, begin = 0, end = 1, guide = "colourbar", aesthetics = "fill") { continuous_scale( aesthetics, - "viridis_c", - gradient_n_pal( + palette = gradient_n_pal( viridis_pal(alpha, begin, end, direction, option)(6), values, space @@ -132,8 +128,7 @@ scale_colour_viridis_b <- function(..., alpha = 1, begin = 0, end = 1, binned_scale( aesthetics, - "viridis_b", - pal, + palette = pal, na.value = na.value, guide = guide, ... @@ -152,8 +147,7 @@ scale_fill_viridis_b <- function(..., alpha = 1, begin = 0, end = 1, binned_scale( aesthetics, - "viridis_b", - pal, + palette = pal, na.value = na.value, guide = guide, ... diff --git a/R/zxx.R b/R/zxx.R index 222238abc4..369f7c532c 100644 --- a/R/zxx.R +++ b/R/zxx.R @@ -5,10 +5,20 @@ #' @usage NULL scale_colour_ordinal <- function(..., type = getOption("ggplot2.ordinal.colour", getOption("ggplot2.ordinal.fill"))) { type <- type %||% scale_colour_viridis_d + args <- list2(...) + args$call <- args$call %||% current_call() if (is.function(type)) { - type(...) + if (any(c("...", "call") %in% fn_fmls_names(type))) { + args$call <- args$call %||% current_call() + } + exec(type, !!!args) } else { - discrete_scale("colour", "ordinal", ordinal_pal(type), ...) + exec( + discrete_scale, + aesthetics = "colour", + palette = ordinal_pal(type), + !!!args + ) } } @@ -72,10 +82,21 @@ scale_color_date <- scale_colour_date #' @usage NULL scale_fill_ordinal <- function(..., type = getOption("ggplot2.ordinal.fill", getOption("ggplot2.ordinal.colour"))) { type <- type %||% scale_fill_viridis_d + args <- list2(...) + args$call <- args$call %||% current_call() + if (is.function(type)) { - type(...) + if (any(c("...", "call") %in% fn_fmls_names(type))) { + args$call <- args$call %||% current_call() + } + exec(type, !!!args) } else { - discrete_scale("fill", "ordinal", ordinal_pal(type), ...) + exec( + discrete_scale, + aesthetics = "fill", + palette = ordinal_pal(type), + !!!args + ) } } diff --git a/man/binned_scale.Rd b/man/binned_scale.Rd index 6a64eb36d7..e242ee7a6b 100644 --- a/man/binned_scale.Rd +++ b/man/binned_scale.Rd @@ -6,7 +6,7 @@ \usage{ binned_scale( aesthetics, - scale_name, + scale_name = deprecated(), palette, name = waiver(), breaks = waiver(), @@ -23,14 +23,15 @@ binned_scale( show.limits = FALSE, guide = "bins", position = "left", + call = caller_call(), super = ScaleBinned ) } \arguments{ \item{aesthetics}{The names of the aesthetics that this scale works with.} -\item{scale_name}{The name of the scale that should be used for error messages -associated with this scale.} +\item{scale_name}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale +that should be used for error messages associated with this scale.} \item{palette}{A palette function that when called with a numeric vector with values between 0 and 1 returns the corresponding output values @@ -140,6 +141,8 @@ You can create your own transformation with \code{\link[scales:trans_new]{scales \item{position}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} +\item{call}{The \code{call} used to construct the scale for reporting messages.} + \item{super}{The super class to use for the constructed scale} } \description{ diff --git a/man/continuous_scale.Rd b/man/continuous_scale.Rd index 677091357e..530d96e525 100644 --- a/man/continuous_scale.Rd +++ b/man/continuous_scale.Rd @@ -6,7 +6,7 @@ \usage{ continuous_scale( aesthetics, - scale_name, + scale_name = deprecated(), palette, name = waiver(), breaks = waiver(), @@ -21,14 +21,15 @@ continuous_scale( trans = "identity", guide = "legend", position = "left", + call = caller_call(), super = ScaleContinuous ) } \arguments{ \item{aesthetics}{The names of the aesthetics that this scale works with.} -\item{scale_name}{The name of the scale that should be used for error messages -associated with this scale.} +\item{scale_name}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale +that should be used for error messages associated with this scale.} \item{palette}{A palette function that when called with a numeric vector with values between 0 and 1 returns the corresponding output values @@ -136,6 +137,8 @@ You can create your own transformation with \code{\link[scales:trans_new]{scales \item{position}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} +\item{call}{The \code{call} used to construct the scale for reporting messages.} + \item{super}{The super class to use for the constructed scale} } \description{ diff --git a/man/datetime_scale.Rd b/man/datetime_scale.Rd index 41193c86c8..c3a2f778a1 100644 --- a/man/datetime_scale.Rd +++ b/man/datetime_scale.Rd @@ -16,6 +16,7 @@ datetime_scale( date_minor_breaks = waiver(), timezone = NULL, guide = "legend", + call = caller_call(), ... ) } @@ -79,11 +80,13 @@ optionally followed by 's'.} \item{guide}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} +\item{call}{The \code{call} used to construct the scale for reporting messages.} + \item{...}{ Arguments passed on to \code{\link[=continuous_scale]{continuous_scale}} \describe{ - \item{\code{scale_name}}{The name of the scale that should be used for error messages -associated with this scale.} + \item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale +that should be used for error messages associated with this scale.} \item{\code{name}}{The name of the scale. Used as the axis or legend title. If \code{waiver()}, the default, the name of the scale is taken from the first mapping used for that aesthetic. If \code{NULL}, the legend title will be diff --git a/man/discrete_scale.Rd b/man/discrete_scale.Rd index e879c4e5f4..b2047dcbde 100644 --- a/man/discrete_scale.Rd +++ b/man/discrete_scale.Rd @@ -6,7 +6,7 @@ \usage{ discrete_scale( aesthetics, - scale_name, + scale_name = deprecated(), palette, name = waiver(), breaks = waiver(), @@ -18,14 +18,15 @@ discrete_scale( drop = TRUE, guide = "legend", position = "left", + call = caller_call(), super = ScaleDiscrete ) } \arguments{ \item{aesthetics}{The names of the aesthetics that this scale works with.} -\item{scale_name}{The name of the scale that should be used for error messages -associated with this scale.} +\item{scale_name}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale +that should be used for error messages associated with this scale.} \item{palette}{A palette function that when called with a single integer argument (the number of levels in the scale) returns the values that @@ -93,6 +94,8 @@ The default, \code{TRUE}, uses the levels that appear in the data; \item{position}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} +\item{call}{The \code{call} used to construct the scale for reporting messages.} + \item{super}{The super class to use for the constructed scale} } \description{ diff --git a/man/scale_discrete.Rd b/man/scale_discrete.Rd index 156c1b1f0d..af686fe8a8 100644 --- a/man/scale_discrete.Rd +++ b/man/scale_discrete.Rd @@ -44,8 +44,8 @@ from a discrete scale, specify \code{na.translate = FALSE}.} missing values be displayed as? Does not apply to position scales where \code{NA} is always placed at the far right.} \item{\code{aesthetics}}{The names of the aesthetics that this scale works with.} - \item{\code{scale_name}}{The name of the scale that should be used for error messages -associated with this scale.} + \item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale +that should be used for error messages associated with this scale.} \item{\code{name}}{The name of the scale. Used as the axis or legend title. If \code{waiver()}, the default, the name of the scale is taken from the first mapping used for that aesthetic. If \code{NULL}, the legend title will be @@ -61,6 +61,7 @@ transformation object as output. Also accepts rlang \link[rlang:as_function]{lambda} function notation. }} + \item{\code{call}}{The \code{call} used to construct the scale for reporting messages.} \item{\code{super}}{The super class to use for the constructed scale} }} diff --git a/man/scale_gradient.Rd b/man/scale_gradient.Rd index 53dfc30a16..35d57f2b68 100644 --- a/man/scale_gradient.Rd +++ b/man/scale_gradient.Rd @@ -88,8 +88,8 @@ scale_fill_gradientn( \item{...}{ Arguments passed on to \code{\link[=continuous_scale]{continuous_scale}} \describe{ - \item{\code{scale_name}}{The name of the scale that should be used for error messages -associated with this scale.} + \item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale +that should be used for error messages associated with this scale.} \item{\code{palette}}{A palette function that when called with a numeric vector with values between 0 and 1 returns the corresponding output values (e.g., \code{\link[scales:area_pal]{scales::area_pal()}}).} @@ -179,6 +179,7 @@ expand the scale by 5\% on each side for continuous variables, and by 0.6 units on each side for discrete variables.} \item{\code{position}}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} + \item{\code{call}}{The \code{call} used to construct the scale for reporting messages.} \item{\code{super}}{The super class to use for the constructed scale} }} diff --git a/man/scale_grey.Rd b/man/scale_grey.Rd index 75175e9b87..b25989858c 100644 --- a/man/scale_grey.Rd +++ b/man/scale_grey.Rd @@ -53,8 +53,8 @@ The default, \code{TRUE}, uses the levels that appear in the data; \item{\code{na.translate}}{Unlike continuous scales, discrete scales can easily show missing values, and do so by default. If you want to remove missing values from a discrete scale, specify \code{na.translate = FALSE}.} - \item{\code{scale_name}}{The name of the scale that should be used for error messages -associated with this scale.} + \item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale +that should be used for error messages associated with this scale.} \item{\code{name}}{The name of the scale. Used as the axis or legend title. If \code{waiver()}, the default, the name of the scale is taken from the first mapping used for that aesthetic. If \code{NULL}, the legend title will be @@ -80,6 +80,7 @@ expand the scale by 5\% on each side for continuous variables, and by 0.6 units on each side for discrete variables.} \item{\code{position}}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} + \item{\code{call}}{The \code{call} used to construct the scale for reporting messages.} \item{\code{super}}{The super class to use for the constructed scale} }} diff --git a/man/scale_hue.Rd b/man/scale_hue.Rd index cacdff69eb..73c1fe0ade 100644 --- a/man/scale_hue.Rd +++ b/man/scale_hue.Rd @@ -59,8 +59,8 @@ The default, \code{TRUE}, uses the levels that appear in the data; \item{\code{na.translate}}{Unlike continuous scales, discrete scales can easily show missing values, and do so by default. If you want to remove missing values from a discrete scale, specify \code{na.translate = FALSE}.} - \item{\code{scale_name}}{The name of the scale that should be used for error messages -associated with this scale.} + \item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale +that should be used for error messages associated with this scale.} \item{\code{name}}{The name of the scale. Used as the axis or legend title. If \code{waiver()}, the default, the name of the scale is taken from the first mapping used for that aesthetic. If \code{NULL}, the legend title will be @@ -86,6 +86,7 @@ expand the scale by 5\% on each side for continuous variables, and by 0.6 units on each side for discrete variables.} \item{\code{position}}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} + \item{\code{call}}{The \code{call} used to construct the scale for reporting messages.} \item{\code{super}}{The super class to use for the constructed scale} }} diff --git a/man/scale_linetype.Rd b/man/scale_linetype.Rd index 88ace88fb7..961064ea4d 100644 --- a/man/scale_linetype.Rd +++ b/man/scale_linetype.Rd @@ -47,8 +47,8 @@ The default, \code{TRUE}, uses the levels that appear in the data; missing values, and do so by default. If you want to remove missing values from a discrete scale, specify \code{na.translate = FALSE}.} \item{\code{aesthetics}}{The names of the aesthetics that this scale works with.} - \item{\code{scale_name}}{The name of the scale that should be used for error messages -associated with this scale.} + \item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale +that should be used for error messages associated with this scale.} \item{\code{name}}{The name of the scale. Used as the axis or legend title. If \code{waiver()}, the default, the name of the scale is taken from the first mapping used for that aesthetic. If \code{NULL}, the legend title will be @@ -66,6 +66,7 @@ notation. }} \item{\code{guide}}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} + \item{\code{call}}{The \code{call} used to construct the scale for reporting messages.} \item{\code{super}}{The super class to use for the constructed scale} }} diff --git a/man/scale_manual.Rd b/man/scale_manual.Rd index d8dbdfcfe7..7a3f7402cf 100644 --- a/man/scale_manual.Rd +++ b/man/scale_manual.Rd @@ -62,8 +62,8 @@ The default, \code{TRUE}, uses the levels that appear in the data; \item{\code{na.translate}}{Unlike continuous scales, discrete scales can easily show missing values, and do so by default. If you want to remove missing values from a discrete scale, specify \code{na.translate = FALSE}.} - \item{\code{scale_name}}{The name of the scale that should be used for error messages -associated with this scale.} + \item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale +that should be used for error messages associated with this scale.} \item{\code{name}}{The name of the scale. Used as the axis or legend title. If \code{waiver()}, the default, the name of the scale is taken from the first mapping used for that aesthetic. If \code{NULL}, the legend title will be @@ -81,6 +81,7 @@ notation. }} \item{\code{guide}}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} + \item{\code{call}}{The \code{call} used to construct the scale for reporting messages.} \item{\code{super}}{The super class to use for the constructed scale} }} diff --git a/man/scale_shape.Rd b/man/scale_shape.Rd index de53364c09..367aef2238 100644 --- a/man/scale_shape.Rd +++ b/man/scale_shape.Rd @@ -47,8 +47,8 @@ from a discrete scale, specify \code{na.translate = FALSE}.} missing values be displayed as? Does not apply to position scales where \code{NA} is always placed at the far right.} \item{\code{aesthetics}}{The names of the aesthetics that this scale works with.} - \item{\code{scale_name}}{The name of the scale that should be used for error messages -associated with this scale.} + \item{\code{scale_name}}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} The name of the scale +that should be used for error messages associated with this scale.} \item{\code{name}}{The name of the scale. Used as the axis or legend title. If \code{waiver()}, the default, the name of the scale is taken from the first mapping used for that aesthetic. If \code{NULL}, the legend title will be @@ -66,6 +66,7 @@ notation. }} \item{\code{guide}}{A function used to create a guide or its name. See \code{\link[=guides]{guides()}} for more information.} + \item{\code{call}}{The \code{call} used to construct the scale for reporting messages.} \item{\code{super}}{The super class to use for the constructed scale} }} diff --git a/man/scale_size.Rd b/man/scale_size.Rd index 304ceafa56..ac7d79021f 100644 --- a/man/scale_size.Rd +++ b/man/scale_size.Rd @@ -152,6 +152,7 @@ expand the scale by 5\% on each side for continuous variables, and by 0.6 units on each side for discrete variables.} \item{\code{position}}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} + \item{\code{call}}{The \code{call} used to construct the scale for reporting messages.} \item{\code{super}}{The super class to use for the constructed scale} }} diff --git a/man/scale_steps.Rd b/man/scale_steps.Rd index 3dcad65e49..4ce18b6839 100644 --- a/man/scale_steps.Rd +++ b/man/scale_steps.Rd @@ -162,6 +162,7 @@ expand the scale by 5\% on each side for continuous variables, and by 0.6 units on each side for discrete variables.} \item{\code{position}}{For position scales, The position of the axis. \code{left} or \code{right} for y axes, \code{top} or \code{bottom} for x axes.} + \item{\code{call}}{The \code{call} used to construct the scale for reporting messages.} \item{\code{super}}{The super class to use for the constructed scale} }} diff --git a/tests/testthat/_snaps/scale-binned.md b/tests/testthat/_snaps/scale-binned.md index 4be45dd8e9..661952c611 100644 --- a/tests/testthat/_snaps/scale-binned.md +++ b/tests/testthat/_snaps/scale-binned.md @@ -1,8 +1,8 @@ # binned scales only support continuous data - Binned scales only support continuous data + Binned scales only support continuous data. --- - Binned scales only support continuous data + Binned scales only support continuous data. diff --git a/tests/testthat/_snaps/scales.md b/tests/testthat/_snaps/scales.md index b9adefae05..0f83d92c63 100644 --- a/tests/testthat/_snaps/scales.md +++ b/tests/testthat/_snaps/scales.md @@ -8,39 +8,39 @@ --- - Invalid `breaks` specification. Use "NULL", not "NA" + Invalid `breaks` specification. Use "NULL", not "NA". --- - Invalid `minor_breaks` specification. Use "NULL", not "NA" + Invalid `minor_breaks` specification. Use "NULL", not "NA". --- - Invalid `labels` specification. Use "NULL", not "NA" + Invalid `labels` specification. Use "NULL", not "NA". --- - `breaks` and `labels` are different lengths + `breaks` and `labels` are different lengths. --- - Invalid `breaks` specification. Use "NULL", not "NA" + Invalid `breaks` specification. Use "NULL", not "NA". --- - Invalid `labels` specification. Use "NULL", not "NA" + Invalid `labels` specification. Use "NULL", not "NA". --- - Invalid `breaks` specification. Use "NULL", not "NA" + Invalid `breaks` specification. Use "NULL", not "NA". --- - Invalid `labels` specification. Use "NULL", not "NA" + Invalid `labels` specification. Use "NULL", not "NA". --- - `breaks` and `labels` are different lengths + `breaks` and `labels` are different lengths. # numeric scale transforms can produce breaks @@ -49,3 +49,25 @@ Output [1] NA 1.00000 20.08554 403.42879 +# training incorrectly appropriately communicates the offenders + + Continuous values supplied to discrete scale + i Example values: 1, 2, 3, 4, and 5 + +--- + + Discrete values supplied to continuous scale + i Example values: "A", "B", "C", "D", and "E" + +# Using `scale_name` prompts deprecation message + + The `scale_name` argument of `continuous_scale()` is deprecated as of ggplot2 3.5.0. + +--- + + The `scale_name` argument of `discrete_scale()` is deprecated as of ggplot2 3.5.0. + +--- + + The `scale_name` argument of `binned_scale()` is deprecated as of ggplot2 3.5.0. + diff --git a/tests/testthat/test-geom-dotplot.R b/tests/testthat/test-geom-dotplot.R index 6eda6bb8ed..eedd4ba4e3 100644 --- a/tests/testthat/test-geom-dotplot.R +++ b/tests/testthat/test-geom-dotplot.R @@ -196,7 +196,7 @@ test_that("geom_dotplot draws correctly", { ) ) + geom_dotplot(binwidth = .4, fill = "red", col = "blue") + - continuous_scale("stroke", "scaleName", function(x) scales::rescale(x, to = c(1, 6))) + continuous_scale("stroke", palette = function(x) scales::rescale(x, to = c(1, 6))) ) # Stacking groups diff --git a/tests/testthat/test-scale-colour-continuous.R b/tests/testthat/test-scale-colour-continuous.R index 10e3ae4dd5..e97e3d5b01 100644 --- a/tests/testthat/test-scale-colour-continuous.R +++ b/tests/testthat/test-scale-colour-continuous.R @@ -3,7 +3,7 @@ test_that("type argument is checked for proper input", { scale_colour_continuous(type = function() "abc") ) expect_snapshot_error( - scale_fill_continuous(type = geom_point) + suppressWarnings(scale_fill_continuous(type = geom_point)) ) expect_snapshot_error( scale_colour_binned(type = function(...) scale_colour_binned(aesthetics = c("fill", "point_colour"))) diff --git a/tests/testthat/test-scale-type.R b/tests/testthat/test-scale-type.R index ccefcee95b..4be2fe9ebf 100644 --- a/tests/testthat/test-scale-type.R +++ b/tests/testthat/test-scale-type.R @@ -12,3 +12,15 @@ test_that("message + continuous for unknown type", { expect_message(scale <- find_scale("colour", x), "ggplot2_foo") expect_s3_class(scale, "ScaleContinuous") }) + +test_that("find_scale gives sensible calls to scales", { + expect_equal( + find_scale("x", 1)$call, + quote(scale_x_continuous()) + ) + + expect_equal( + find_scale("colour", "A")$call, + quote(scale_colour_discrete()) + ) +}) diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R index 639f65674b..bedf7fb94b 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -197,7 +197,7 @@ test_that("scales warn when transforms introduces non-finite values", { geom_point(size = 5) + scale_y_log10() - expect_warning(ggplot_build(p), "Transformation introduced infinite values") + expect_warning(ggplot_build(p), "log-10 transformation introduced infinite values.") }) test_that("size and alpha scales throw appropriate warnings for factors", { @@ -288,7 +288,7 @@ test_that("multiple aesthetics can be set with one function call", { test_that("limits with NA are replaced with the min/max of the data for continuous scales", { make_scale <- function(limits = NULL, data = NULL) { - scale <- continuous_scale("aesthetic", scale_name = "test", palette = identity, limits = limits) + scale <- continuous_scale("aesthetic", palette = identity, limits = limits) if (!is.null(data)) { scale$train(data) } @@ -521,3 +521,164 @@ test_that("numeric scale transforms can produce breaks", { expect_equal(test_breaks("sqrt", limits = c(0, 10)), seq(0, 10, by = 2.5)) }) + +test_that("scale functions accurately report their calls", { + + construct <- exprs( + scale_alpha(), + scale_alpha_binned(), + scale_alpha_continuous(), + scale_alpha_date(), + scale_alpha_datetime(), + scale_alpha_discrete(), + scale_alpha_identity(), + scale_alpha_manual(), + scale_alpha_ordinal(), + # Skipping American spelling of 'color' scales here + scale_colour_binned(), + scale_colour_brewer(), + scale_colour_continuous(), + scale_colour_date(), + scale_colour_datetime(), + scale_colour_discrete(), + scale_colour_distiller(), + scale_colour_fermenter(), + scale_colour_gradient(), + scale_colour_gradient2(), + # Some scales have required arguments + scale_colour_gradientn(colours = c("firebrick", "limegreen")), + scale_colour_grey(), + scale_colour_hue(), + scale_colour_identity(), + scale_colour_manual(), + scale_colour_ordinal(), + scale_colour_steps(), + scale_colour_steps2(), + scale_colour_stepsn(colours = c("orchid", "tomato")), + scale_colour_viridis_b(), + scale_colour_viridis_c(), + scale_colour_viridis_d(), + scale_continuous_identity(aesthetics = "foo"), + scale_discrete_identity(aesthetics = "bar"), + scale_discrete_manual(aesthetics = "baz"), + scale_fill_binned(), + scale_fill_brewer(), + scale_fill_continuous(), + scale_fill_date(), + scale_fill_datetime(), + scale_fill_discrete(), + scale_fill_distiller(), + scale_fill_fermenter(), + scale_fill_gradient(), + scale_fill_gradient2(), + scale_fill_gradientn(colours = c("yellow", "green")), + scale_fill_grey(), + scale_fill_hue(), + scale_fill_identity(), + scale_fill_manual(), + scale_fill_ordinal(), + scale_fill_steps(), + scale_fill_steps2(), + scale_fill_stepsn(colours = c("steelblue", "pink")), + scale_fill_viridis_b(), + scale_fill_viridis_c(), + scale_fill_viridis_d(), + scale_linetype(), + scale_linetype_binned(), + # scale_linetype_continuous(), # designed to throw error + scale_linetype_discrete(), + scale_linetype_identity(), + scale_linetype_manual(), + scale_linewidth(), + scale_linewidth_binned(), + scale_linewidth_continuous(), + scale_linewidth_date(), + scale_linewidth_datetime(), + scale_linewidth_discrete(), + scale_linewidth_identity(), + scale_linewidth_manual(), + scale_linewidth_ordinal(), + scale_radius(), + scale_shape(), + scale_shape_binned(), + # scale_shape_continuous(), # designed to throw error + scale_shape_discrete(), + scale_shape_identity(), + scale_shape_manual(), + scale_shape_ordinal(), + scale_size(), + scale_size_area(), + scale_size_binned(), + scale_size_binned_area(), + scale_size_continuous(), + scale_size_date(), + scale_size_datetime(), + scale_size_discrete(), + scale_size_identity(), + scale_size_manual(), + scale_size_ordinal(), + scale_x_binned(), + scale_x_continuous(), + scale_x_date(), + scale_x_datetime(), + scale_x_discrete(), + scale_x_log10(), + scale_x_reverse(), + scale_x_sqrt(), + # scale_x_time(), + scale_y_binned(), + scale_y_continuous(), + scale_y_date(), + scale_y_datetime(), + scale_y_discrete(), + scale_y_log10(), + scale_y_reverse(), + scale_y_sqrt(), + # scale_y_time(), + xlim(10, 20), + ylim("A", "B") + ) + if (is_installed("hms")) { + construct <- c(construct, exprs(scale_x_time(), scale_y_time())) + } + + suppressWarnings( + calls <- lapply(construct, function(x) eval(x)$call) + ) + expect_equal(calls, construct) +}) + +test_that("training incorrectly appropriately communicates the offenders", { + + sc <- scale_colour_viridis_d() + expect_snapshot_error( + sc$train(1:5) + ) + + sc <- scale_colour_viridis_c() + expect_snapshot_error( + sc$train(LETTERS[1:5]) + ) +}) + +test_that("find_scale appends appropriate calls", { + + expect_equal( + find_scale("x", 1)$call, + quote(scale_x_continuous()) + ) + + expect_equal( + find_scale("colour", "A")$call, + quote(scale_colour_discrete()) + ) + +}) + +test_that("Using `scale_name` prompts deprecation message", { + + expect_snapshot_warning(continuous_scale("x", "foobar", identity_pal())) + expect_snapshot_warning(discrete_scale("x", "foobar", identity_pal())) + expect_snapshot_warning(binned_scale("x", "foobar", identity_pal())) + +})