diff --git a/R/scale-.R b/R/scale-.R index f345310e4b..15ad62a4a3 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -618,6 +618,12 @@ check_breaks_labels <- function(breaks, labels, call = NULL) { if (is.null(breaks)) { return(TRUE) } + if (identical(breaks, NA)) { + cli::cli_abort( + "Invalid {.arg breaks} specification. Use {.code NULL}, not {.code NA}.", + call = call + ) + } if (is.null(labels)) { return(TRUE) } @@ -728,6 +734,12 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, return(numeric()) } transformation <- self$get_transformation() + breaks <- self$breaks %|W|% transformation$breaks + + if (is.null(breaks)) { + return(NULL) + } + # Ensure limits don't exceed domain (#980) domain <- suppressWarnings(transformation$transform(transformation$domain)) domain <- sort(domain) @@ -735,41 +747,25 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (length(domain) == 2 && !zero_range(domain)) { limits <- oob_squish(limits, domain) } - - # Limits in transformed space need to be converted back to data space - limits <- transformation$inverse(limits) - - if (is.null(self$breaks)) { - return(NULL) - } - - if (identical(self$breaks, NA)) { - cli::cli_abort( - "Invalid {.arg breaks} specification. Use {.code NULL}, not {.code NA}.", - call = self$call - ) + if (zero_range(as.numeric(limits))) { + return(limits[1]) } - # Compute `zero_range()` in transformed space in case `limits` in data space - # don't support conversion to numeric (#5304) - if (zero_range(as.numeric(transformation$transform(limits)))) { - breaks <- limits[1] - } else if (is.waiver(self$breaks)) { - if (!is.null(self$n.breaks) && trans_support_nbreaks(transformation)) { - breaks <- transformation$breaks(limits, self$n.breaks) + if (is.function(breaks)) { + # Limits in transformed space need to be converted back to data space + limits <- transformation$inverse(limits) + if (!is.null(self$n.breaks) && support_nbreaks(breaks)) { + breaks <- breaks(limits, n = self$n.breaks) } else { + breaks <- breaks(limits) if (!is.null(self$n.breaks)) { cli::cli_warn( - "Ignoring {.arg n.breaks}. Use a {.cls transform} object that supports setting number of breaks.", + "Ignoring {.arg n.breaks}. Use a {.cls transform} object or \\ + {.arg breaks} function that supports setting number of breaks", call = self$call ) } - breaks <- transformation$breaks(limits) } - } else if (is.function(self$breaks)) { - breaks <- self$breaks(limits) - } else { - breaks <- self$breaks } # Breaks in data space need to be converted back to transformed space @@ -1013,13 +1009,6 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale, return(NULL) } - if (identical(self$breaks, NA)) { - cli::cli_abort( - "Invalid {.arg breaks} specification. Use {.code NULL}, not {.code NA}.", - call = self$call - ) - } - if (is.waiver(self$breaks)) { breaks <- limits } else if (is.function(self$breaks)) { @@ -1235,14 +1224,9 @@ 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 {.code NULL}, not {.code NA}.", - call = self$call - ) } else if (is.waiver(self$breaks)) { if (self$nice.breaks) { - if (!is.null(self$n.breaks) && trans_support_nbreaks(transformation)) { + if (!is.null(self$n.breaks) && support_nbreaks(transformation$breaks)) { breaks <- transformation$breaks(limits, n = self$n.breaks) } else { if (!is.null(self$n.breaks)) { @@ -1401,6 +1385,14 @@ check_transformation <- function(x, transformed, name, arg = NULL, call = NULL) cli::cli_warn(msg, call = call) } + +support_nbreaks <- function(fun) { + if (inherits(fun, "ggproto_method")) { + fun <- environment(fun)$f + } + "n" %in% fn_fmls_names(fun) +} + check_continuous_limits <- function(limits, ..., arg = caller_arg(limits), call = caller_env()) { @@ -1411,10 +1403,6 @@ check_continuous_limits <- function(limits, ..., check_length(limits, 2L, arg = arg, call = call) } -trans_support_nbreaks <- function(trans) { - "n" %in% names(formals(trans$breaks)) -} - allow_lambda <- function(x) { if (is_formula(x)) as_function(x) else x } diff --git a/tests/testthat/_snaps/scales-breaks-labels.md b/tests/testthat/_snaps/scales-breaks-labels.md index e3b5f28532..55ef686c68 100644 --- a/tests/testthat/_snaps/scales-breaks-labels.md +++ b/tests/testthat/_snaps/scales-breaks-labels.md @@ -67,67 +67,3 @@ Error in `scale_x_datetime()`: ! Invalid `minor_breaks` specification. Use `NULL`, not `NA`. -# scale_breaks with explicit NA options (deprecated) - - Code - sxc$get_breaks() - Condition - Error in `scale_x_continuous()`: - ! Invalid `breaks` specification. Use `NULL`, not `NA`. - ---- - - Code - sxc$get_breaks_minor() - Condition - Error in `scale_x_continuous()`: - ! Invalid `breaks` specification. Use `NULL`, not `NA`. - ---- - - Code - syc$get_breaks() - Condition - Error in `scale_y_continuous()`: - ! Invalid `breaks` specification. Use `NULL`, not `NA`. - ---- - - Code - syc$get_breaks_minor() - Condition - Error in `scale_y_continuous()`: - ! Invalid `breaks` specification. Use `NULL`, not `NA`. - ---- - - Code - sac$get_breaks() - Condition - Error in `scale_alpha_continuous()`: - ! Invalid `breaks` specification. Use `NULL`, not `NA`. - ---- - - Code - ssc$get_breaks() - Condition - Error in `scale_size_continuous()`: - ! Invalid `breaks` specification. Use `NULL`, not `NA`. - ---- - - Code - sfc$get_breaks() - Condition - Error in `scale_fill_continuous()`: - ! Invalid `breaks` specification. Use `NULL`, not `NA`. - ---- - - Code - scc$get_breaks() - Condition - Error in `scale_colour_continuous()`: - ! Invalid `breaks` specification. Use `NULL`, not `NA`. - diff --git a/tests/testthat/test-scales-breaks-labels.R b/tests/testthat/test-scales-breaks-labels.R index 42e3d67bb3..165f494bf7 100644 --- a/tests/testthat/test-scales-breaks-labels.R +++ b/tests/testthat/test-scales-breaks-labels.R @@ -186,38 +186,12 @@ test_that("suppressing breaks, minor_breask, and labels works", { test_that("scale_breaks with explicit NA options (deprecated)", { # NA is defunct, should throw error - - # X - sxc <- scale_x_continuous(breaks = NA) - sxc$train(1:3) - expect_snapshot(sxc$get_breaks(), error = TRUE) - expect_snapshot(sxc$get_breaks_minor(), error = TRUE) - - # Y - syc <- scale_y_continuous(breaks = NA) - syc$train(1:3) - expect_snapshot(syc$get_breaks(), error = TRUE) - expect_snapshot(syc$get_breaks_minor(), error = TRUE) - - # Alpha - sac <- scale_alpha_continuous(breaks = NA) - sac$train(1:3) - expect_snapshot(sac$get_breaks(), error = TRUE) - - # Size - ssc <- scale_size_continuous(breaks = NA) - ssc$train(1:3) - expect_snapshot(ssc$get_breaks(), error = TRUE) - - # Fill - sfc <- scale_fill_continuous(breaks = NA) - sfc$train(1:3) - expect_snapshot(sfc$get_breaks(), error = TRUE) - - # Colour - scc <- scale_colour_continuous(breaks = NA) - scc$train(1:3) - expect_snapshot(scc$get_breaks(), error = TRUE) + expect_error(scale_x_continuous(breaks = NA)) + expect_error(scale_y_continuous(breaks = NA)) + expect_error(scale_alpha_continuous(breaks = NA)) + expect_error(scale_size_continuous(breaks = NA)) + expect_error(scale_fill_continuous(breaks = NA)) + expect_error(scale_colour_continuous(breaks = NA)) }) test_that("breaks can be specified by names of labels", { diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R index 514cb392a3..d33ef0006a 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -430,21 +430,18 @@ test_that("scales accept lambda notation for function input", { test_that("breaks and labels are correctly checked", { expect_snapshot_error(check_breaks_labels(1:10, letters)) - p <- ggplot(mtcars) + geom_point(aes(mpg, disp)) + scale_x_continuous(breaks = NA) - expect_snapshot_error(ggplot_build(p)) + expect_snapshot_error(scale_x_continuous(breaks = NA)) p <- ggplot(mtcars) + geom_point(aes(mpg, disp)) + scale_x_continuous(minor_breaks = NA) expect_snapshot_error(ggplot_build(p)) p <- ggplot(mtcars) + geom_point(aes(mpg, disp)) + scale_x_continuous(labels = NA) expect_snapshot_error(ggplotGrob(p)) p <- ggplot(mtcars) + geom_point(aes(mpg, disp)) + scale_x_continuous(labels = function(x) 1:2) expect_snapshot_error(ggplotGrob(p)) - p <- ggplot(mtcars) + geom_bar(aes(factor(gear))) + scale_x_discrete(breaks = NA) - expect_snapshot_error(ggplot_build(p)) + expect_snapshot_error(scale_x_discrete(breaks = NA)) p <- ggplot(mtcars) + geom_bar(aes(factor(gear))) + scale_x_discrete(labels = NA) expect_snapshot_error(ggplotGrob(p)) - p <- ggplot(mtcars) + geom_bar(aes(mpg)) + scale_x_binned(breaks = NA) - expect_snapshot_error(ggplot_build(p)) + expect_snapshot_error(scale_x_binned(breaks = NA)) p <- ggplot(mtcars) + geom_bar(aes(mpg)) + scale_x_binned(labels = NA) expect_snapshot_error(ggplotGrob(p)) p <- ggplot(mtcars) + geom_bar(aes(mpg)) + scale_x_binned(labels = function(x) 1:2)