From b70ac7079afa78301d297e6d1f41e28b3614c2a7 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 7 Sep 2023 13:39:54 +0200 Subject: [PATCH 01/13] Capture axis transforms as an actual transform --- R/guide-axis.R | 48 ++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 48 insertions(+) diff --git a/R/guide-axis.R b/R/guide-axis.R index eac32b2b98..3bd8666c89 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -540,3 +540,51 @@ axis_label_element_overrides <- function(axis_position, angle = NULL) { )) } } + +function_as_trans <- function(fun, limits, scale_trans, detail = 1000) { + if (is.character(fun)) { + fun <- as.trans(fun) + } + if (is.trans(fun)) { + if (fun$name == "identity") { + return(NULL) + } + return(fun) + } + if (is.null(fun) || is.null(limits) || zero_range(limits)) { + return(NULL) + } + if (!is.function(fun)) { + cli::cli_abort(paste0( + "The {.arg trans} argument must be a {.cls trans} object, ", + "a {.field formula} or {.field function}, not {obj_type_friendly(fun)}." + )) + } + + # Translation between primary and secondary ranges + limits_seq <- seq(limits[1], limits[2], length.out = detail) + origin_seq <- scale_trans$inverse(limits_seq) + trans_seq <- fun(origin_seq) + + # Test for monotonicity + if (!is_unique(sign(diff(trans_seq)))) { + cli::cli_abort("The {.arg trans} transformation must be monotonic.") + } + + # Deduplicate in the expanded area of the range that can occur if the + # transformation is non-monotonic in the expansion. The split ensures + # that the middle duplicates are kept. + duplicates <- c( + !duplicated(trans_seq[seq_len(detail / 2)], fromLast = TRUE), + !duplicated(trans_seq[-seq_len(detail / 2)]) + ) + origin_seq <- origin_seq[duplicates] + trans_seq <- trans_seq[duplicates] + + trans_new( + "secondary_transformation", + transform = function(x) approx(trans_seq, origin_seq, x)$y, + inverse = fun, + format = format_format(digits = 3) + ) +} From 3850af4e6dbc1f30b4e7de6b51947b8a1bc4dac4 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 7 Sep 2023 13:40:43 +0200 Subject: [PATCH 02/13] Plumbing for extra parameters --- R/guide-axis.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/R/guide-axis.R b/R/guide-axis.R index 3bd8666c89..fbf8a91d36 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -55,6 +55,12 @@ guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = NULL, new_guide( title = title, + # Override settings + breaks = breaks, + labels = labels, + minor.breaks = minor.breaks, + trans = allow_lambda(trans), + # customisations check.overlap = check.overlap, angle = angle, @@ -81,6 +87,10 @@ GuideAxis <- ggproto( params = list( title = waiver(), + breaks = derive(), + labels = derive(), + minor.breaks = NULL, + trans = NULL, name = "axis", hash = character(), position = waiver(), From b0a80dad14544a44eeb7d746cce662a7673a958f Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 7 Sep 2023 13:41:06 +0200 Subject: [PATCH 03/13] Extended `extract_key` method --- R/guide-axis.R | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 56 insertions(+) diff --git a/R/guide-axis.R b/R/guide-axis.R index fbf8a91d36..862e21cb96 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -113,6 +113,61 @@ GuideAxis <- ggproto( ticks_length = "axis.ticks.length" ), + extract_key = function(scale, aesthetic, breaks, labels, trans, ...) { + limits <- scale$continuous_range + + # Resolve transformation + trans <- function_as_trans(trans, limits, scale$scale$trans) + if (!is.null(trans) && scale$is_discrete()) { + cli::cli_warn("Cannot use axis transformation with discrete scales.") + trans <- NULL + } + + if (!is.null(trans) || !is.derived(breaks) || !is.derived(labels)) { + # If anything needs to be computed that is not included in the viewscale, + # a temporary scale computes the necessary components + temp_scale <- ggproto( + NULL, scale$scale, + trans = trans %||% scale$scale$trans, + limits = if (scale$is_discrete()) scale$get_limits() else limits, + breaks = if (is.derived(breaks)) scale$scale$breaks else breaks, + labels = if (is.derived(labels)) scale$scale$labels else labels + ) + # Allow plain numeric breaks for discrete scales + if (!(scale$is_discrete() && is.numeric(breaks))) { + breaks <- temp_scale$get_breaks() + } + } else { + temp_scale <- NULL + breaks <- scale$get_breaks() + } + + if (length(breaks) == 0) { + return(NULL) + } + + mapped <- scale$map(breaks) + + if (!is.null(temp_scale)) { + labels <- temp_scale$get_labels(breaks) + } else { + labels <- scale$get_labels(breaks) + } + if (is.expression(labels)) { + labels <- as.list(labels) + } + + key <- data_frame(!!aesthetic := mapped) + key$.value <- breaks + key$.label <- labels + + if (is.numeric(breaks)) { + vec_slice(key, is.finite(breaks)) + } else { + key + } + }, + extract_params = function(scale, params, ...) { params$name <- paste0(params$name, "_", params$aesthetic) params @@ -598,3 +653,4 @@ function_as_trans <- function(fun, limits, scale_trans, detail = 1000) { format = format_format(digits = 3) ) } + From df8e93c344a00bbfdde03018902cce88a44012e0 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 7 Sep 2023 13:57:22 +0200 Subject: [PATCH 04/13] Set and document new arguments --- R/guide-axis.R | 24 +++++++++++++++++++++--- man/guide_axis.Rd | 14 ++++++++++++++ 2 files changed, 35 insertions(+), 3 deletions(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index 862e21cb96..e5393dde13 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -6,6 +6,14 @@ #' [scale_(x|y)_discrete()][scale_x_discrete()]. #' #' @inheritParams guide_legend +#' @param breaks,labels,minor.breaks Either `derive()` to indicate that the +#' breaks, labels or minor breaks should be taken from the scale, or valid +#' input to the scale's synonymous arguments to override the scale's settings. +#' By default, `breaks` and `labels` are derived from the scale, whereas +#' `minor.breaks` are omitted. +#' @param trans A `function`, `formula` or `` object that can perform +#' the transformation for secondary axes. Note that discrete scales cannot +#' be transformed. The default, `NULL`, will perform no transformation. #' @param check.overlap silently remove overlapping labels, #' (recursively) prioritizing the first, last, and middle labels. #' @param angle Compared to setting the angle in [theme()] / [element_text()], @@ -41,9 +49,19 @@ #' #' # can also be used to add a duplicate guide #' p + guides(x = guide_axis(n.dodge = 2), y.sec = guide_axis()) -guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = NULL, - n.dodge = 1, cap = "none", order = 0, - position = waiver()) { +guide_axis <- function( + title = waiver(), + breaks = derive(), + labels = derive(), + minor.breaks = NULL, + trans = NULL, + check.overlap = FALSE, + angle = NULL, + n.dodge = 1, + cap = "none", + order = 0, + position = waiver() +) { if (is.logical(cap)) { check_bool(cap) diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd index 086ba0b25a..cf90988581 100644 --- a/man/guide_axis.Rd +++ b/man/guide_axis.Rd @@ -6,6 +6,10 @@ \usage{ guide_axis( title = waiver(), + breaks = derive(), + labels = derive(), + minor.breaks = NULL, + trans = NULL, check.overlap = FALSE, angle = NULL, n.dodge = 1, @@ -20,6 +24,16 @@ If \code{NULL}, the title is not shown. By default (\code{\link[=waiver]{waiver()}}), the name of the scale object or the name specified in \code{\link[=labs]{labs()}} is used for the title.} +\item{breaks, labels, minor.breaks}{Either \code{derive()} to indicate that the +breaks, labels or minor breaks should be taken from the scale, or valid +input to the scale's synonymous arguments to override the scale's settings. +By default, \code{breaks} and \code{labels} are derived from the scale, whereas +\code{minor.breaks} are omitted.} + +\item{trans}{A \code{function}, \code{formula} or \verb{} object that can perform +the transformation for secondary axes. Note that discrete scales cannot +be transformed. The default, \code{NULL}, will perform no transformation.} + \item{check.overlap}{silently remove overlapping labels, (recursively) prioritizing the first, last, and middle labels.} From db6647885e020d3ba45a513a1b55d553990577c6 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 22 Sep 2023 15:00:58 +0200 Subject: [PATCH 05/13] Move discrete scale warning --- R/guide-axis.R | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index e5393dde13..d40b62c5d0 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -136,10 +136,6 @@ GuideAxis <- ggproto( # Resolve transformation trans <- function_as_trans(trans, limits, scale$scale$trans) - if (!is.null(trans) && scale$is_discrete()) { - cli::cli_warn("Cannot use axis transformation with discrete scales.") - trans <- NULL - } if (!is.null(trans) || !is.derived(breaks) || !is.derived(labels)) { # If anything needs to be computed that is not included in the viewscale, @@ -625,9 +621,16 @@ axis_label_element_overrides <- function(axis_position, angle = NULL) { } function_as_trans <- function(fun, limits, scale_trans, detail = 1000) { + if (is.null(fun)) { + return(NULL) + } if (is.character(fun)) { fun <- as.trans(fun) } + if (!is.null(fun) && !is.numeric(limits)) { + cli::cli_warn("Cannot use axis transformation with discrete scales.") + return(NULL) + } if (is.trans(fun)) { if (fun$name == "identity") { return(NULL) From bf8b85740cb17ba1a4385d85272b6aa5a5d60e2f Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 22 Sep 2023 15:29:58 +0200 Subject: [PATCH 06/13] More transformation error-handling --- R/guide-axis.R | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index d40b62c5d0..1f4339aaf8 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -68,7 +68,7 @@ guide_axis <- function( cap <- if (cap) "both" else "none" } cap <- arg_match0(cap, c("none", "both", "upper", "lower")) - + check_breaks_labels(breaks, labels) new_guide( title = title, @@ -652,6 +652,23 @@ function_as_trans <- function(fun, limits, scale_trans, detail = 1000) { origin_seq <- scale_trans$inverse(limits_seq) trans_seq <- fun(origin_seq) + if (length(trans_seq) != detail) { + cli::cli_abort( + "The {.arg trans} transformation must preserve the length of input." + ) + } + + finite <- is.finite(trans_seq) + origin_seq <- origin_seq[finite] + trans_seq <- trans_seq[finite] + + if (length(trans_seq) < detail / 100) { + cli::cli_abort(paste0( + "The {.arg trans} transformation could not transform the range ", + "{.field [{limits[1]}, {limits[2]}]}." + )) + } + # Test for monotonicity if (!is_unique(sign(diff(trans_seq)))) { cli::cli_abort("The {.arg trans} transformation must be monotonic.") From 97b4b2f80b4c1a805e122f4fc3a07dd030672557 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 22 Sep 2023 15:48:44 +0200 Subject: [PATCH 07/13] Tweaks to limits --- R/guide-axis.R | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index 1f4339aaf8..665697db29 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -132,24 +132,28 @@ GuideAxis <- ggproto( ), extract_key = function(scale, aesthetic, breaks, labels, trans, ...) { - limits <- scale$continuous_range - # Resolve transformation - trans <- function_as_trans(trans, limits, scale$scale$trans) + # Retrieve limits information + limits <- scale$get_limits() + range <- scale$continuous_range + + # Resolve transformations + scale_trans <- scale$scale$trans %||% identity_trans() + trans <- function_as_trans(trans, range, scale_trans) if (!is.null(trans) || !is.derived(breaks) || !is.derived(labels)) { # If anything needs to be computed that is not included in the viewscale, # a temporary scale computes the necessary components temp_scale <- ggproto( NULL, scale$scale, - trans = trans %||% scale$scale$trans, - limits = if (scale$is_discrete()) scale$get_limits() else limits, breaks = if (is.derived(breaks)) scale$scale$breaks else breaks, labels = if (is.derived(labels)) scale$scale$labels else labels + trans = trans %||% scale_trans, + limits = scale_trans$inverse(limits), ) # Allow plain numeric breaks for discrete scales if (!(scale$is_discrete() && is.numeric(breaks))) { - breaks <- temp_scale$get_breaks() + breaks <- temp_scale$get_breaks(scale_trans$inverse(range)) } } else { temp_scale <- NULL From 0ab0732d9ee4d1dce92cd9a96bc71a6b20f72d4c Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 22 Sep 2023 15:49:07 +0200 Subject: [PATCH 08/13] Tweak to breaks --- R/guide-axis.R | 20 +++++++++++++++----- 1 file changed, 15 insertions(+), 5 deletions(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index 665697db29..7301c96660 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -142,14 +142,20 @@ GuideAxis <- ggproto( trans <- function_as_trans(trans, range, scale_trans) if (!is.null(trans) || !is.derived(breaks) || !is.derived(labels)) { + if (is.derived(breaks)) { + breaks <- scale$scale$breaks + if (is.waive(breaks)) { + breaks <- scale_trans$breaks + } + } # If anything needs to be computed that is not included in the viewscale, # a temporary scale computes the necessary components temp_scale <- ggproto( NULL, scale$scale, - breaks = if (is.derived(breaks)) scale$scale$breaks else breaks, - labels = if (is.derived(labels)) scale$scale$labels else labels trans = trans %||% scale_trans, limits = scale_trans$inverse(limits), + breaks = breaks, + labels = if (is.derived(labels)) scale$scale$labels else labels ) # Allow plain numeric breaks for discrete scales if (!(scale$is_discrete() && is.numeric(breaks))) { @@ -163,8 +169,11 @@ GuideAxis <- ggproto( if (length(breaks) == 0) { return(NULL) } - - mapped <- scale$map(breaks) + if (is.null(trans)) { + mapped <- scale$map(breaks) + } else { + mapped <- scale$map(scale_trans$transform(breaks)) + } if (!is.null(temp_scale)) { labels <- temp_scale$get_labels(breaks) @@ -692,7 +701,8 @@ function_as_trans <- function(fun, limits, scale_trans, detail = 1000) { "secondary_transformation", transform = function(x) approx(trans_seq, origin_seq, x)$y, inverse = fun, - format = format_format(digits = 3) + format = format_format(digits = 3), + domain = range(trans_seq) ) } From 20d490e94825fe46594e746362e9817254a709aa Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 22 Sep 2023 16:08:35 +0200 Subject: [PATCH 09/13] More nuance for discrete scales --- R/guide-axis.R | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index 7301c96660..5914690368 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -148,21 +148,28 @@ GuideAxis <- ggproto( breaks <- scale_trans$breaks } } + if (!scale$is_discrete()) { + limits <- scale_trans$inverse(limits) + } # If anything needs to be computed that is not included in the viewscale, # a temporary scale computes the necessary components temp_scale <- ggproto( NULL, scale$scale, trans = trans %||% scale_trans, - limits = scale_trans$inverse(limits), + limits = limits, breaks = breaks, labels = if (is.derived(labels)) scale$scale$labels else labels ) # Allow plain numeric breaks for discrete scales - if (!(scale$is_discrete() && is.numeric(breaks))) { + if (scale$is_discrete()) { + if (!is.numeric(breaks)) { + breaks <- temp_scale$get_breaks(limits) + } + } else { breaks <- temp_scale$get_breaks(scale_trans$inverse(range)) } } else { - temp_scale <- NULL + temp_scale <- scale breaks <- scale$get_breaks() } @@ -175,11 +182,7 @@ GuideAxis <- ggproto( mapped <- scale$map(scale_trans$transform(breaks)) } - if (!is.null(temp_scale)) { - labels <- temp_scale$get_labels(breaks) - } else { - labels <- scale$get_labels(breaks) - } + labels <- temp_scale$get_labels(breaks) if (is.expression(labels)) { labels <- as.list(labels) } From e510407034a6c6626017b8cc42c596461c9abaa5 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 22 Sep 2023 16:08:55 +0200 Subject: [PATCH 10/13] Add tests --- tests/testthat/_snaps/guides.md | 20 ++++++++ tests/testthat/test-guides.R | 89 +++++++++++++++++++++++++++++++++ 2 files changed, 109 insertions(+) diff --git a/tests/testthat/_snaps/guides.md b/tests/testthat/_snaps/guides.md index 6fb109ecbd..c2c932f9d1 100644 --- a/tests/testthat/_snaps/guides.md +++ b/tests/testthat/_snaps/guides.md @@ -65,6 +65,26 @@ Breaks are not formatted correctly for a bin legend. i Use `(, ]` format to indicate bins. +# guide_axis(trans) works as expected. + + The `trans` argument must be a object, a formula or function, not the number 10. + +--- + + The `trans` transformation must be monotonic. + +--- + + The `trans` transformation could not transform the range [0, 10]. + +--- + + The `trans` transformation must preserve the length of input. + +--- + + `breaks` and `labels` must have the same length + # binning scales understand the different combinations of limits, breaks, labels, and show.limits `show.limits` is ignored when `labels` are given as a character vector. diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index ac704fdf79..58fce5b7e0 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -339,6 +339,95 @@ test_that("guide_colourbar warns about discrete scales", { }) +test_that("guide_axis(trans) works as expected.", { + + axis_key <- function(limits = c(0, 10), ..., scale = scale_x_continuous()) { + scale <- scale$clone() + scale$train(limits) + vs <- view_scale_primary(scale) + + guide <- guide_axis(...) + params <- guide$params + params$position <- "bottom" + guide$train(params, vs, "x")$key + } + + # Input checking + expect_snapshot_error(axis_key(trans = 10)) + expect_snapshot_error(axis_key(trans = sin)) + expect_snapshot_error(axis_key(trans = function(x) rep(Inf, length(x)))) + expect_snapshot_error(axis_key(trans = ~ 1)) + expect_snapshot_error(axis_key(breaks = 1:2, labels = "A")) + expect_silent(axis_key(trans = ~ sin(.x / 100))) + + fmt <- format_format(digits = 3) + + # Identity transformation + scale <- scale_x_continuous() + key <- axis_key(trans = ~., breaks = waiver(), scale = scale) + expect_equal(key$.label, fmt(seq(0, 10, by = 2.5))) + expect_equal(key$x, seq(0, 10, by = 2.5), tolerance = 1e-3) + + # Works with subtraction + key <- axis_key(trans = ~1-., breaks = waiver(), scale = scale) + expect_equal(key$.label, fmt(seq(-7.5, 0, by = 2.5))) + expect_equal(key$x, seq(8.5, 1, by = -2.5), tolerance = 1e-3) + + # Works with division + key <- axis_key(limits = c(1, 9), trans = ~ 10/., breaks = waiver(), scale = scale) + expect_equal(key$.label, fmt(10 / c(4, 2, 4/3, 1))) + expect_equal(key$x, c(4, 2, 4/3, 1), tolerance = 1e-3) + + # Works with log transformed scales + ## Identity transformation + key <- axis_key(trans = ~.x, scale = scale_x_log10()) + expect_equal(key$.label, fmt(10^c(0, 3, 6, 9))) + expect_equal(key$x, c(0, 3, 6, 9), tolerance = 1e-3) + + ## Proper transformation + key <- axis_key(trans = ~ . * 100, scale = scale_x_log10()) + expect_equal(key$.label, fmt(10^c(2, 5, 8, 11))) + expect_equal(key$x, c(0, 3, 6, 9), tolerance = 1e-3) + + # Custom breaks/labels + key <- axis_key( + trans = ~ . * 100, + breaks = 10^seq(2, 10, by = 2), + labels = math_format(format = log10), + scale = scale_x_log10() + ) + expect_equal(as.character(key$.label), paste0("10^", seq(2, 10, by = 2))) + expect_equal(key$x, seq(0, 8, by = 2)) + + # Plain discrete scale + key <- axis_key( + c("A", "B", "C"), + scale = scale_x_discrete() + ) + expect_equal(key$.label, c("A", "B", "C")) + expect_equal(unclass(key$x), c(1, 2, 3)) + + # Discrete custom breaks/labels + key <- axis_key( + c("A", "B", "C"), + breaks = c("A", "C"), + labels = c("X", "Y"), + scale = scale_x_discrete() + ) + expect_equal(key$.label, c("X", "Y")) + expect_equal(unclass(key$x), c(1, 3)) + + # Discrete numeric breaks + key <- axis_key( + c("A", "B", "C"), + breaks = c(1.5, 2.5), + labels = c("foo", "bar"), + scale = scale_x_discrete() + ) + expect_equal(key$.label, c("foo", "bar")) + expect_equal(unclass(key$x), c(1.5, 2.5)) +}) + # Visual tests ------------------------------------------------------------ test_that("axis guides are drawn correctly", { From bee49dea423d1fe0fe777871e6751d35b7496e17 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 26 Oct 2023 09:38:52 +0200 Subject: [PATCH 11/13] Change test minor.ticks syntax --- tests/testthat/test-guides.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index d3984903c0..5f03d2ea12 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -598,13 +598,13 @@ test_that("guide_axis() draws minor ticks correctly", { scale_x_continuous(labels = math_format()) + guides( # Test for styling and style inheritance - x = guide_axis(minor.ticks = TRUE), + x = guide_axis(minor.breaks = TRUE), # # Test for opposed lengths - y = guide_axis(minor.ticks = TRUE), + y = guide_axis(minor.breaks = TRUE), # # Test for flipped lenghts - x.sec = guide_axis(minor.ticks = TRUE), + x.sec = guide_axis(minor.breaks = TRUE), # # Test that minor.length doesn't influence spacing when no minor ticks are drawn - y.sec = guide_axis(minor.ticks = FALSE) + y.sec = guide_axis(minor.breaks = FALSE) ) expect_doppelganger("guides with minor ticks", p) }) From 862f1c0c3c8270e592496bcd396d0b4b4af34be9 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 26 Oct 2023 10:11:22 +0200 Subject: [PATCH 12/13] Additional tweaks --- R/guide-axis.R | 62 +++++++++++++++++++++++++++----------------------- 1 file changed, 34 insertions(+), 28 deletions(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index 7643374b25..55208b520c 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -154,16 +154,14 @@ GuideAxis <- ggproto( is.custom(minor_breaks)) { if (is.derived(breaks)) { breaks <- scale$scale$breaks - if (is.waive(breaks)) { + if (is.waive(breaks) && !scale$is_discrete()) { breaks <- scale_trans$breaks } } if (is.derived(minor_breaks)) { minor_breaks <- scale$scale$minor_breaks } - if (!scale$is_discrete()) { - limits <- scale_trans$inverse(limits) - } + limits <- scale_trans$inverse(limits) # If anything needs to be computed that is not included in the viewscale, # a temporary scale computes the necessary components temp_scale <- ggproto( @@ -174,59 +172,64 @@ GuideAxis <- ggproto( minor_breaks = minor_breaks, labels = if (is.derived(labels)) scale$scale$labels else labels ) - # Allow plain numeric breaks for discrete scales if (scale$is_discrete()) { + # Allow plain numeric breaks for discrete scales if (!is.numeric(breaks)) { breaks <- temp_scale$get_breaks(limits) } + # Allow minor breaks to be a function + if (is.function(minor_breaks)) { + minor_breaks <- minor_breaks(limits) + } } else { breaks <- temp_scale$get_breaks(limits) minor_breaks <- temp_scale$get_breaks_minor(b = breaks, limits = limits) } } else { temp_scale <- scale - breaks <- scale$get_breaks() + if (!is.null(breaks)) { + breaks <- scale$get_breaks() + } if (!is.null(minor_breaks)) { minor_breaks <- scale$get_breaks_minor() } } - if (length(breaks) == 0) { - return(NULL) - } if (is.null(trans)) { - mapped <- scale$map(breaks) + map <- function(x) scale$map(x) } else { - mapped <- scale$map(scale_trans$transform(breaks)) + map <- function(x) scale$map(scale_trans$transform(x)) } - labels <- temp_scale$get_labels(breaks) - if (is.expression(labels)) { - labels <- as.list(labels) + if (!is.null(breaks)) { + if (!is.null(labels)) { + labels <- temp_scale$get_labels(breaks) + } + if (is.expression(labels)) { + labels <- as.list(labels) + } + key <- data_frame(!!aesthetic := map(breaks)) + key$.value <- breaks + key$.label <- labels + key <- vec_slice(key, is_finite(breaks)) + } else { + key <- data_frame0() } - key <- data_frame(!!aesthetic := mapped) - key$.value <- breaks - key$.label <- labels - - if (is.numeric(breaks)) { - key <- vec_slice(key, is.finite(breaks)) - } if (!is.null(minor_breaks)) { minor_breaks <- setdiff(minor_breaks, key$.value) - minor_breaks <- minor_breaks[is.finite(minor_breaks)] + minor_breaks <- minor_breaks[is_finite(minor_breaks)] if (length(minor_breaks) < 1) { return(key) } - if (is.null(trans)) { - minor <- scale$map(minor_breaks) - } else { - minor <- scale$map(scale_trans$transform(minor_breaks)) + minor <- data_frame0(!!aesthetic := map(minor_breaks)) + + if (!scale$is_discrete()) { + minor$.value <- minor_breaks } - minor <- data_frame0(!!aesthetic := minor) - minor$.value <- minor_breaks + minor$.type <- "minor" if (nrow(key) > 0) { @@ -236,6 +239,9 @@ GuideAxis <- ggproto( return(minor) } } + if (nrow(key) == 0) { + return(NULL) + } key }, From b0fb67b8347be3ad889fde36390c862fb5cbb35d Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 27 Oct 2023 11:20:39 +0200 Subject: [PATCH 13/13] Resolve mismatch --- R/guide-axis.R | 2 +- man/guide_axis.Rd | 4 ---- 2 files changed, 1 insertion(+), 5 deletions(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index 55208b520c..a749abae6f 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -771,7 +771,7 @@ function_as_trans <- function(fun, limits, scale_trans, detail = 1000) { trans_new( "secondary_transformation", - transform = function(x) approx(trans_seq, origin_seq, x)$y, + transform = function(x) stats::approx(trans_seq, origin_seq, x)$y, inverse = fun, format = format_format(digits = 3), domain = range(trans_seq) diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd index 21c7b43a53..cf90988581 100644 --- a/man/guide_axis.Rd +++ b/man/guide_axis.Rd @@ -13,7 +13,6 @@ guide_axis( check.overlap = FALSE, angle = NULL, n.dodge = 1, - minor.ticks = FALSE, cap = "none", order = 0, position = waiver() @@ -46,9 +45,6 @@ you probably want.} horizontal axes) that should be used to render the labels. This is useful for displaying labels that would otherwise overlap.} -\item{minor.ticks}{Whether to draw the minor ticks (\code{TRUE}) or not draw -minor ticks (\code{FALSE}, default).} - \item{cap}{A \code{character} to cut the axis line back to the last breaks. Can be \code{"none"} (default) to draw the axis line along the whole panel, or \code{"upper"} and \code{"lower"} to draw the axis to the upper or lower break, or