From 509aecd02f6bd990d990497750ac5c8db7ed96de Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 2 Jan 2024 12:09:23 +0100 Subject: [PATCH 01/11] set secondary axes --- R/scale-discrete-.R | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/R/scale-discrete-.R b/R/scale-discrete-.R index b5f2f53df3..b2127e9103 100644 --- a/R/scale-discrete-.R +++ b/R/scale-discrete-.R @@ -62,7 +62,8 @@ #' scale_x_discrete(labels = abbreviate) #' } scale_x_discrete <- function(name = waiver(), ..., expand = waiver(), - guide = waiver(), position = "bottom") { + guide = waiver(), position = "bottom", + sec.axis = waiver()) { sc <- discrete_scale( aesthetics = c("x", "xmin", "xmax", "xend"), name = name, palette = identity, ..., @@ -71,12 +72,13 @@ scale_x_discrete <- function(name = waiver(), ..., expand = waiver(), ) sc$range_c <- ContinuousRange$new() - sc + set_sec_axis(sec.axis, sc) } #' @rdname scale_discrete #' @export scale_y_discrete <- function(name = waiver(), ..., expand = waiver(), - guide = waiver(), position = "left") { + guide = waiver(), position = "left", + sec.axis = waiver()) { sc <- discrete_scale( aesthetics = c("y", "ymin", "ymax", "yend"), name = name, palette = identity, ..., @@ -85,7 +87,7 @@ scale_y_discrete <- function(name = waiver(), ..., expand = waiver(), ) sc$range_c <- ContinuousRange$new() - sc + set_sec_axis(sec.axis, sc) } # The discrete position scale maintains two separate ranges - one for From 4730effae1a3a80a8d5d1cc5281c9168fc3e2fa5 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 2 Jan 2024 12:09:39 +0100 Subject: [PATCH 02/11] add missing `sec_name` method --- R/scale-discrete-.R | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/R/scale-discrete-.R b/R/scale-discrete-.R index b2127e9103..0fa437cdae 100644 --- a/R/scale-discrete-.R +++ b/R/scale-discrete-.R @@ -147,6 +147,14 @@ ScaleDiscretePosition <- ggproto("ScaleDiscretePosition", ScaleDiscrete, expand_limits_scale(self, expand, limits) }, + sec_name = function(self) { + if (is.waive(self$secondary.axis)) { + waiver() + } else { + self$secondary.axis$name + } + }, + clone = function(self) { new <- ggproto(NULL, self) new$range <- DiscreteRange$new() From 48a39ade8eb046b34d1dbf820c216c5af772cba8 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 2 Jan 2024 12:10:04 +0100 Subject: [PATCH 03/11] only allow identity transforms --- R/axis-secondary.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/axis-secondary.R b/R/axis-secondary.R index 673cc0ef5b..acba430a6d 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -119,7 +119,7 @@ sec_axis <- function(transform = NULL, #' @rdname sec_axis #' #' @export -dup_axis <- function(transform = ~., trans = deprecated(), +dup_axis <- function(transform = identity, trans = deprecated(), name = derive(), breaks = derive(), labels = derive(), guide = derive()) { sec_axis(transform, trans = trans, name, breaks, labels, guide) } @@ -129,6 +129,11 @@ is.sec_axis <- function(x) { } set_sec_axis <- function(sec.axis, scale) { + if (scale$is_discrete()) { + if (!identical(.subset2(sec.axis, "transform"), identity)) { + cli::cli_abort("Discrete secondary axes must have the {.fn identity} transformation.") + } + } if (!is.waive(sec.axis)) { if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis) if (!is.sec_axis(sec.axis)) { From e2ac5cf1fae2ed66787fb67a00e05b2e93517d70 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 2 Jan 2024 12:10:53 +0100 Subject: [PATCH 04/11] map discrete breaks --- R/axis-secondary.R | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/R/axis-secondary.R b/R/axis-secondary.R index acba430a6d..f2a999fa92 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -217,7 +217,12 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, if (self$empty()) return() # Test for monotonicity on unexpanded range - self$mono_test(scale) + if (!scale$is_discrete()) { + self$mono_test(scale) + breaks <- self$breaks + } else { + breaks <- scale$map(self$breaks) + } # Get scale's original range before transformation transformation <- scale$get_transformation() From 51fab96dc6888c8241b2422c911a6eb24c6fdb42 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 2 Jan 2024 12:11:08 +0100 Subject: [PATCH 05/11] breaks plumbing --- R/axis-secondary.R | 7 ++++--- 1 file changed, 4 insertions(+), 3 deletions(-) diff --git a/R/axis-secondary.R b/R/axis-secondary.R index f2a999fa92..3a6d6258d1 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -253,7 +253,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, old_val_trans <- rescale(range_info$major, from = c(0, 1), to = range) old_val_minor_trans <- rescale(range_info$minor, from = c(0, 1), to = range) } else { - temp_scale <- self$create_scale(new_range) + temp_scale <- self$create_scale(new_range, breaks = breaks) range_info <- temp_scale$break_info() # Map the break values back to their correct position on the primary scale @@ -302,10 +302,11 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, }, # Temporary scale for the purpose of calling break_info() - create_scale = function(self, range, transformation = transform_identity()) { + create_scale = function(self, range, transformation = transform_identity(), + breaks = self$breaks) { scale <- ggproto(NULL, ScaleContinuousPosition, name = self$name, - breaks = self$breaks, + breaks = breaks, labels = self$labels, limits = range, expand = c(0, 0), From 622ccd9d8b0599c173da8da036b77f03aaff0a0d Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 2 Jan 2024 12:11:19 +0100 Subject: [PATCH 06/11] default to identity transform --- R/axis-secondary.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/axis-secondary.R b/R/axis-secondary.R index 3a6d6258d1..da5070f858 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -225,7 +225,7 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, } # Get scale's original range before transformation - transformation <- scale$get_transformation() + transformation <- scale$get_transformation() %||% transform_identity() along_range <- seq(range[1], range[2], length.out = self$detail) old_range <- transformation$inverse(along_range) From e39b95e70aa569e236bb92e2f9ef6b9ddd5419e4 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 2 Jan 2024 12:13:28 +0100 Subject: [PATCH 07/11] document `sec.axis` argument --- R/scale-discrete-.R | 1 + man/scale_discrete.Rd | 8 ++++++-- man/sec_axis.Rd | 2 +- 3 files changed, 8 insertions(+), 3 deletions(-) diff --git a/R/scale-discrete-.R b/R/scale-discrete-.R index 0fa437cdae..4330cf3e71 100644 --- a/R/scale-discrete-.R +++ b/R/scale-discrete-.R @@ -12,6 +12,7 @@ #' #' @inheritDotParams discrete_scale #' @inheritParams discrete_scale +#' @param sec.axis [dup_axis()] is used to specify a secondary axis. #' @rdname scale_discrete #' @family position scales #' @seealso diff --git a/man/scale_discrete.Rd b/man/scale_discrete.Rd index 8cefee4c04..338691b547 100644 --- a/man/scale_discrete.Rd +++ b/man/scale_discrete.Rd @@ -10,7 +10,8 @@ scale_x_discrete( ..., expand = waiver(), guide = waiver(), - position = "bottom" + position = "bottom", + sec.axis = waiver() ) scale_y_discrete( @@ -18,7 +19,8 @@ scale_y_discrete( ..., expand = waiver(), guide = waiver(), - position = "left" + position = "left", + sec.axis = waiver() ) } \arguments{ @@ -90,6 +92,8 @@ expand the scale by 5\% on each side for continuous variables, and by \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{sec.axis}{\code{\link[=dup_axis]{dup_axis()}} is used to specify a secondary axis.} } \description{ \code{scale_x_discrete()} and \code{scale_y_discrete()} are used to set the values for diff --git a/man/sec_axis.Rd b/man/sec_axis.Rd index bca906a079..da957da1b4 100644 --- a/man/sec_axis.Rd +++ b/man/sec_axis.Rd @@ -16,7 +16,7 @@ sec_axis( ) dup_axis( - transform = ~., + transform = identity, trans = deprecated(), name = derive(), breaks = derive(), From 0a395b636ae0230c7e513c167d6d90957ceba30c Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 2 Jan 2024 12:16:54 +0100 Subject: [PATCH 08/11] only test when non-waiver --- R/axis-secondary.R | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/R/axis-secondary.R b/R/axis-secondary.R index da5070f858..c2ce2900df 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -129,12 +129,12 @@ is.sec_axis <- function(x) { } set_sec_axis <- function(sec.axis, scale) { - if (scale$is_discrete()) { - if (!identical(.subset2(sec.axis, "transform"), identity)) { - cli::cli_abort("Discrete secondary axes must have the {.fn identity} transformation.") - } - } if (!is.waive(sec.axis)) { + if (scale$is_discrete()) { + if (!identical(.subset2(sec.axis, "transform"), identity)) { + cli::cli_abort("Discrete secondary axes must have the {.fn identity} transformation.") + } + } if (is.formula(sec.axis)) sec.axis <- sec_axis(sec.axis) if (!is.sec_axis(sec.axis)) { cli::cli_abort("Secondary axes must be specified using {.fn sec_axis}.") From e30108245b1598ebe4a5025d68887cd61a7656f2 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 2 Jan 2024 12:24:46 +0100 Subject: [PATCH 09/11] Don't derive discrete breaks from transformation --- R/axis-secondary.R | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/R/axis-secondary.R b/R/axis-secondary.R index c2ce2900df..00139fe961 100644 --- a/R/axis-secondary.R +++ b/R/axis-secondary.R @@ -184,7 +184,13 @@ AxisSecondary <- ggproto("AxisSecondary", NULL, } if (is.derived(self$name) && !is.waive(scale$name)) self$name <- scale$name if (is.derived(self$breaks)) self$breaks <- scale$breaks - if (is.waive(self$breaks)) self$breaks <- scale$transformation$breaks + if (is.waive(self$breaks)) { + if (scale$is_discrete()) { + self$breaks <- scale$get_breaks() + } else { + self$breaks <- scale$transformation$breaks + } + } if (is.derived(self$labels)) self$labels <- scale$labels if (is.derived(self$guide)) self$guide <- scale$guide }, From ae0cbc7cf2996943d4ad32bf41fc60602fd6e4de Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 2 Jan 2024 12:30:36 +0100 Subject: [PATCH 10/11] add test --- tests/testthat/test-sec-axis.R | 20 ++++++++++++++++++++ 1 file changed, 20 insertions(+) diff --git a/tests/testthat/test-sec-axis.R b/tests/testthat/test-sec-axis.R index bcef0ae7aa..cd02fe5459 100644 --- a/tests/testthat/test-sec-axis.R +++ b/tests/testthat/test-sec-axis.R @@ -380,3 +380,23 @@ test_that("sec_axis() works for power transformations (monotonicity test doesn't breaks <- scale$break_info() expect_equal(breaks$major, breaks$sec.major, tolerance = .001) }) + +test_that("discrete scales can have secondary axes", { + + data <- data.frame(x = c("A", "B", "C"), y = c("D", "E", "F")) + p <- ggplot(data, aes(x, y)) + + geom_point() + + scale_x_discrete(sec.axis = dup_axis(labels = c("foo", "bar", "baz"))) + + scale_y_discrete(sec.axis = dup_axis( + breaks = c(1.5, 2.5), labels = c("grault", "garply") + )) + b <- ggplot_build(p) + + x <- get_guide_data(b, "x.sec") + expect_equal(x$.value, 1:3, ignore_attr = TRUE) + expect_equal(x$.label, c("foo", "bar", "baz")) + + y <- get_guide_data(b, "y.sec") + expect_equal(y$.value, c(1.5, 2.5), ignore_attr = TRUE) + expect_equal(y$.label, c("grault", "garply")) +}) From 7c4bb1e8139f046d970ee1935b4e5770969144d6 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Mon, 20 May 2024 09:25:20 +0200 Subject: [PATCH 11/11] add news bullet --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 070c74dd40..462cc692f3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -22,6 +22,9 @@ (@teunbrand, #5856). * New helper function `ggpar()` to translate ggplot2's interpretation of graphical parameters to {grid}'s interpretation (@teunbrand, #5866). +* `scale_{x/y}_discrete()` can now accept a `sec.axis`. It is recommended to + only use `dup_axis()` to set custom breaks or labels, as discrete variables + cannot be transformed (@teunbrand, #3171). # ggplot2 3.5.1