From 5872bae2a2f143ae969ca21e9bb93b060e6a741b Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 3 Jul 2024 15:07:33 +0200 Subject: [PATCH 1/6] deal with NA/NULL breaks earlier --- R/scale-.R | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) diff --git a/R/scale-.R b/R/scale-.R index 9eaa153590..b746787671 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -717,6 +717,18 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, return(numeric()) } transformation <- self$get_transformation() + breaks <- self$breaks %|W|% transformation$breaks + + if (is.null(breaks)) { + return(NULL) + } + if (identical(breaks, NA)) { + cli::cli_abort( + "Invalid {.arg breaks} specification. Use {.code NULL}, not {.code NA}.", + call = self$call + ) + } + # Ensure limits don't exceed domain (#980) domain <- suppressWarnings(transformation$transform(transformation$domain)) domain <- sort(domain) @@ -728,17 +740,6 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, # 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 - ) - } - # 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)))) { From 2799a8626651c9afd2913c103ebc18f564650b79 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 3 Jul 2024 17:27:13 +0200 Subject: [PATCH 2/6] generalise `trans_support_nbreaks()` --> `support_nbreaks()` --- R/scale-.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/scale-.R b/R/scale-.R index b746787671..b8fa0b9283 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -745,7 +745,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (zero_range(as.numeric(transformation$transform(limits)))) { breaks <- limits[1] } else if (is.waive(self$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, self$n.breaks) } else { if (!is.null(self$n.breaks)) { @@ -1237,7 +1237,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale, ) } else if (is.waive(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)) { @@ -1399,8 +1399,11 @@ check_transformation <- function(x, transformed, name, arg = NULL, call = NULL) cli::cli_warn(msg, call = call) } -trans_support_nbreaks <- function(trans) { - "n" %in% names(formals(trans$breaks)) +support_nbreaks <- function(fun) { + if (inherits(fun, "ggproto_method")) { + fun <- environment(fun)$f + } + "n" %in% fn_fmls_names(fun) } allow_lambda <- function(x) { From 78ecf628f31cdc09e95d4efe02044fd5bdbbd53f Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 3 Jul 2024 19:32:22 +0200 Subject: [PATCH 3/6] early exit on zero-range limits --- R/scale-.R | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/R/scale-.R b/R/scale-.R index b8fa0b9283..f00a28b452 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -737,14 +737,16 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, limits <- oob_squish(limits, domain) } + # Compute `zero_range()` in transformed space in case `limits` in data space + # don't support conversion to numeric (#5304) + if (zero_range(as.numeric(limits))) { + return(limits[1]) + } + # Limits in transformed space need to be converted back to data space limits <- transformation$inverse(limits) - # 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.waive(self$breaks)) { + if (is.waive(self$breaks)) { if (!is.null(self$n.breaks) && support_nbreaks(transformation$breaks)) { breaks <- transformation$breaks(limits, self$n.breaks) } else { From 151b4b158c89fe0ebdeb1a9201a59ab002fe5e9e Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 3 Jul 2024 19:36:26 +0200 Subject: [PATCH 4/6] apply `n.breaks` regarless or whence breaks-function came --- R/scale-.R | 20 ++++++++------------ 1 file changed, 8 insertions(+), 12 deletions(-) diff --git a/R/scale-.R b/R/scale-.R index f00a28b452..6675235690 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -743,25 +743,21 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, return(limits[1]) } - # Limits in transformed space need to be converted back to data space - limits <- transformation$inverse(limits) - - if (is.waive(self$breaks)) { - if (!is.null(self$n.breaks) && support_nbreaks(transformation$breaks)) { - 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 From 4d0ed0972611af050fd7d919b56c78050c091301 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 3 Jul 2024 19:52:54 +0200 Subject: [PATCH 5/6] Throw `NA` breaks error in 1 place --- R/scale-.R | 24 ++++---------- tests/testthat/test-scales-breaks-labels.R | 38 ++++------------------ tests/testthat/test-scales.R | 9 ++--- 3 files changed, 15 insertions(+), 56 deletions(-) diff --git a/R/scale-.R b/R/scale-.R index 6675235690..c509318130 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -607,6 +607,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) } @@ -722,12 +728,6 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (is.null(breaks)) { return(NULL) } - if (identical(breaks, NA)) { - cli::cli_abort( - "Invalid {.arg breaks} specification. Use {.code NULL}, not {.code NA}.", - call = self$call - ) - } # Ensure limits don't exceed domain (#980) domain <- suppressWarnings(transformation$transform(transformation$domain)) @@ -1004,13 +1004,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.waive(self$breaks)) { breaks <- limits } else if (is.function(self$breaks)) { @@ -1228,11 +1221,6 @@ 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.waive(self$breaks)) { if (self$nice.breaks) { if (!is.null(self$n.breaks) && support_nbreaks(transformation$breaks)) { diff --git a/tests/testthat/test-scales-breaks-labels.R b/tests/testthat/test-scales-breaks-labels.R index d24e0ab638..13f84880ab 100644 --- a/tests/testthat/test-scales-breaks-labels.R +++ b/tests/testthat/test-scales-breaks-labels.R @@ -170,38 +170,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_error(sxc$get_breaks()) - expect_error(sxc$get_breaks_minor()) - - # Y - syc <- scale_y_continuous(breaks = NA) - syc$train(1:3) - expect_error(syc$get_breaks()) - expect_error(syc$get_breaks_minor()) - - # Alpha - sac <- scale_alpha_continuous(breaks = NA) - sac$train(1:3) - expect_error(sac$get_breaks()) - - # Size - ssc <- scale_size_continuous(breaks = NA) - ssc$train(1:3) - expect_error(ssc$get_breaks()) - - # Fill - sfc <- scale_fill_continuous(breaks = NA) - sfc$train(1:3) - expect_error(sfc$get_breaks()) - - # Colour - scc <- scale_colour_continuous(breaks = NA) - scc$train(1:3) - expect_error(scc$get_breaks()) + 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 4e104f9024..2e52703b9f 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -432,21 +432,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) From b4c5eb5adcab6df99ace46bd4de6202c898321e1 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 2 Dec 2024 11:23:31 +0100 Subject: [PATCH 6/6] omit outdated comment --- R/scale-.R | 3 --- 1 file changed, 3 deletions(-) diff --git a/R/scale-.R b/R/scale-.R index c509318130..fe0c6c9ee3 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -736,9 +736,6 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, if (length(domain) == 2 && !zero_range(domain)) { limits <- oob_squish(limits, domain) } - - # Compute `zero_range()` in transformed space in case `limits` in data space - # don't support conversion to numeric (#5304) if (zero_range(as.numeric(limits))) { return(limits[1]) }