From 7267f02b3c3c848473b4bc5b3f8ed49b98599693 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 27 Oct 2023 16:19:13 +0200 Subject: [PATCH 01/18] fix recycle bug --- R/guide-.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/guide-.R b/R/guide-.R index a3f449b9ed..4acbf855d2 100644 --- a/R/guide-.R +++ b/R/guide-.R @@ -381,7 +381,7 @@ Guide <- ggproto( pos <- unname(c(top = 1, bottom = 0, left = 0, right = 1)[position]) dir <- -2 * pos + 1 pos <- unit(rep(pos, 2 * n_breaks), "npc") - dir <- rep(vec_interleave(dir, 0), n_breaks) * tick_len + dir <- rep(vec_interleave(dir, 0), n_breaks) * rep(tick_len, each = 2) tick <- pos + dir # Build grob From 77d83ba208bf6cb1dceb2582d48a3d887ab37a90 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 27 Oct 2023 16:19:59 +0200 Subject: [PATCH 02/18] set default minor.ticks in axis --- R/guide-axis.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index 6f15c1f23e..dd7ca85cdc 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -108,7 +108,7 @@ GuideAxis <- ggproto( minor_length = "axis.minor.ticks.length" ), - extract_key = function(scale, aesthetic, minor.ticks, ...) { + extract_key = function(scale, aesthetic, minor.ticks = FALSE, ...) { major <- Guide$extract_key(scale, aesthetic, ...) if (!minor.ticks) { return(major) From 43964f7ffdb37e4e665fc2fdcc3f428e5ba1bbf0 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 27 Oct 2023 16:28:41 +0200 Subject: [PATCH 03/18] Draft guide --- R/guide-axis-logticks.R | 145 ++++++++++++++++++++++++++++++++++++++++ 1 file changed, 145 insertions(+) create mode 100644 R/guide-axis-logticks.R diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R new file mode 100644 index 0000000000..8d70fbcd12 --- /dev/null +++ b/R/guide-axis-logticks.R @@ -0,0 +1,145 @@ + +guide_axis_logticks <- function( + long = rel(2.25), + mid = rel(1.5), + short = rel(0.75), + prescale_base = NULL, + negative_small = 0.1, + cap = "none", + ... +) { + if (is.logical(cap)) { + check_bool(cap) + cap <- if (cap) "both" else "none" + } + cap <- arg_match0(cap, c("none", "both", "upper", "lower")) + + check_fun <- function(x) (is.rel(x) || is.unit(x)) && length(x) == 1 + what <- "a {.cls rel} or {.cls unit} object of length 1" + check_object(long, check_fun, what) + check_object(mid, check_fun, what) + check_object(short, check_fun, what) + + new_guide( + available_aes = c("x", "y"), + prescale_base = prescale_base, + negative_small = negative_small, + long = long, + mid = mid, + short = short, + minor.ticks = TRUE, + ..., + super = GuideAxisLogticks + ) +} + + +GuideAxisLogticks <- ggproto( + "GuideAxisLogticks", GuideAxis, + + params = defaults( + list( + prescale_base = NULL, + negative_small = 0.1, + minor.ticks = TRUE, # for spacing calculation + long = rel(2.25), + mid = rel(1.5), + short = rel(0.75) + ), + GuideAxis$params + ), + + # Here we calculate a 'shadow key' that only applies to the tickmarks. + extract_params = function(scale, params, ...) { + + if (scale$is_discrete()) { + cli::cli_abort("Cannot calculate logarithmic ticks for discrete scales.") + } + + aesthetic <- params$aesthetic + params$name <- paste0(params$name, "_", aesthetic) + params + + # Reconstruct a transformation if user has prescaled data + if (!is.null(params$prescale_base)) { + trans <- log_trans(base = params$prescale_base) + } else { + trans <- scale$scale$trans + } + + # Reconstruct original range + limits <- trans$inverse(scale$get_limits()) + has_negatives <- any(limits < 0) + + if (!has_negatives) { + start <- floor(log10(min(limits))) - 1L + end <- ceiling(log10(max(limits))) + 1L + } else { + start <- log10(abs(params$negative_small)) + end <- ceiling(log10(max(abs(limits)))) + 1L + } + + # Calculate tick marks + tens <- 10^seq(start, end, by = 1) + fives <- tens * 5 + ones <- as.vector(outer(tens, setdiff(2:9, 5))) + + # Set ticks back into transformed space + ticks <- trans$transform(c(tens, fives, ones)) + nticks <- c(length(tens), length(fives), length(ones)) + type <- 1:3 + + if (has_negatives) { + # Mirror ticks around 0 + ticks <- c(ticks, -ticks, 0) + nticks <- c(nticks, nticks, 1) + type <- c(type, type, 1) + } + + logkey <- data_frame0( + !!aesthetic := ticks, + .type = rep(type, times = nticks) + ) + + # Discard out-of-bounds ticks + range <- scale$continuous_range + logkey <- vec_slice(logkey, ticks > range[1] & ticks < range[2]) + + params$logkey <- logkey + params + }, + + transform = function(self, params, coord, panel_params) { + params <- GuideAxis$transform(params, coord, panel_params) + # Also transform the logkey + params$logkey <- coord$transform(params$logkey, panel_params) + params + }, + + override_elements = function(params, elements, theme) { + elements <- GuideAxis$override_elements(params, elements, theme) + length <- elements$major_length + + # Multiply rel units with theme's tick length + tick_length <- lapply(params[c("long", "mid", "short")], function(x) { + if (is.rel(x)) unclass(x) * length else x + }) + tick_length <- inject(unit.c(!!!tick_length)) + elements$tick_length <- tick_length + + # We replace the lengths so that spacing calculation works out as intended + elements$major_length <- max(tick_length) + elements$minor_length <- min(tick_length) + elements + }, + + build_ticks = function(key, elements, params, position = params$opposite) { + # Instead of passing regular key, we pass the logkey + # In addition, we pass tick lengths directly + Guide$build_ticks( + params$logkey, + elements$ticks, params, position, + elements$tick_length[params$logkey$.type] + ) + } +) From 59cca1060f722476ba7cf54a70ebecf5e09e26d3 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 27 Oct 2023 17:11:15 +0200 Subject: [PATCH 04/18] Better censoring in symmetric scales --- R/guide-axis-logticks.R | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index 8d70fbcd12..f7dd33fb8e 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -69,13 +69,13 @@ GuideAxisLogticks <- ggproto( # Reconstruct original range limits <- trans$inverse(scale$get_limits()) - has_negatives <- any(limits < 0) + has_negatives <- any(limits <= 0) if (!has_negatives) { start <- floor(log10(min(limits))) - 1L end <- ceiling(log10(max(limits))) + 1L } else { - start <- log10(abs(params$negative_small)) + start <- floor(log10(abs(params$negative_small))) end <- ceiling(log10(max(abs(limits)))) + 1L } @@ -87,19 +87,22 @@ GuideAxisLogticks <- ggproto( # Set ticks back into transformed space ticks <- trans$transform(c(tens, fives, ones)) nticks <- c(length(tens), length(fives), length(ones)) - type <- 1:3 + + logkey <- data_frame0( + !!aesthetic := ticks, + .type = rep(1:3, times = nticks) + ) if (has_negatives) { # Mirror ticks around 0 - ticks <- c(ticks, -ticks, 0) - nticks <- c(nticks, nticks, 1) - type <- c(type, type, 1) + logkey <- vec_slice(logkey, logkey[[aesthetic]] >= params$negative_small) + mirror <- logkey + mirror[[aesthetic]] <- 1 * mirror[[aesthetic]] + zero <- data_frame0(!!aesthetic := 0, .type = 1L) + logkey <- vec_rbind(logkey, mirror, zero) } - logkey <- data_frame0( - !!aesthetic := ticks, - .type = rep(type, times = nticks) - ) + # Discard out-of-bounds ticks range <- scale$continuous_range From 788138b55bad100ce1b62f2e19605a21139bdd78 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 27 Oct 2023 17:11:37 +0200 Subject: [PATCH 05/18] internally cast args to `rel()` --- R/guide-axis-logticks.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index f7dd33fb8e..db727417a6 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -1,8 +1,8 @@ guide_axis_logticks <- function( - long = rel(2.25), - mid = rel(1.5), - short = rel(0.75), + long = 2.25, + mid = 1.5, + short = 0.75, prescale_base = NULL, negative_small = 0.1, cap = "none", @@ -14,6 +14,10 @@ guide_axis_logticks <- function( } cap <- arg_match0(cap, c("none", "both", "upper", "lower")) + if (is_bare_numeric(long)) long <- rel(long) + if (is_bare_numeric(mid)) mid <- rel(mid) + if (is_bare_numeric(short)) short <- rel(short) + check_fun <- function(x) (is.rel(x) || is.unit(x)) && length(x) == 1 what <- "a {.cls rel} or {.cls unit} object of length 1" check_object(long, check_fun, what) From 47440a190965ca12cd22191b39a84101d8bbbe04 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Fri, 27 Oct 2023 17:23:39 +0200 Subject: [PATCH 06/18] change mirror strategy --- R/guide-axis-logticks.R | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index db727417a6..117df72c69 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -79,6 +79,7 @@ GuideAxisLogticks <- ggproto( start <- floor(log10(min(limits))) - 1L end <- ceiling(log10(max(limits))) + 1L } else { + params$negative_small <- params$negative_small %||% 0.1 start <- floor(log10(abs(params$negative_small))) end <- ceiling(log10(max(abs(limits)))) + 1L } @@ -88,6 +89,16 @@ GuideAxisLogticks <- ggproto( fives <- tens * 5 ones <- as.vector(outer(tens, setdiff(2:9, 5))) + if (has_negatives) { + # Filter and mirror ticks around 0 + tens <- tens[tens >= params$negative_small] + tens <- c(tens, -tens, 0) + fives <- fives[fives >= params$negative_small] + fives <- c(fives, -fives) + ones <- ones[ones >= params$negative_small] + ones <- c(ones, -ones) + } + # Set ticks back into transformed space ticks <- trans$transform(c(tens, fives, ones)) nticks <- c(length(tens), length(fives), length(ones)) @@ -97,17 +108,6 @@ GuideAxisLogticks <- ggproto( .type = rep(1:3, times = nticks) ) - if (has_negatives) { - # Mirror ticks around 0 - logkey <- vec_slice(logkey, logkey[[aesthetic]] >= params$negative_small) - mirror <- logkey - mirror[[aesthetic]] <- 1 * mirror[[aesthetic]] - zero <- data_frame0(!!aesthetic := 0, .type = 1L) - logkey <- vec_rbind(logkey, mirror, zero) - } - - - # Discard out-of-bounds ticks range <- scale$continuous_range logkey <- vec_slice(logkey, ticks > range[1] & ticks < range[2]) From 5777f6ebd3380e9d43f8c3b107a4b33c9b6aec80 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sat, 28 Oct 2023 09:36:16 +0200 Subject: [PATCH 07/18] interpret numeric as `rel()` --- R/guide-axis-logticks.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index 117df72c69..4993381b81 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -46,9 +46,9 @@ GuideAxisLogticks <- ggproto( prescale_base = NULL, negative_small = 0.1, minor.ticks = TRUE, # for spacing calculation - long = rel(2.25), - mid = rel(1.5), - short = rel(0.75) + long = 2.25, + mid = 1.5, + short = 0.75 ), GuideAxis$params ), @@ -129,7 +129,7 @@ GuideAxisLogticks <- ggproto( # Multiply rel units with theme's tick length tick_length <- lapply(params[c("long", "mid", "short")], function(x) { - if (is.rel(x)) unclass(x) * length else x + if (is.unit(x)) x else unclass(x) * length }) tick_length <- inject(unit.c(!!!tick_length)) elements$tick_length <- tick_length From e39ea607e3bd097242ae3fbf70c3163e72440146 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sat, 28 Oct 2023 10:37:08 +0200 Subject: [PATCH 08/18] warn when prescale_base and scale transform are set --- R/guide-axis-logticks.R | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index 4993381b81..084c9a9f1e 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -66,6 +66,13 @@ GuideAxisLogticks <- ggproto( # Reconstruct a transformation if user has prescaled data if (!is.null(params$prescale_base)) { + trans_name <- scale$scale$trans$name + if (trans_name != "identity") { + cli::cli_warn(paste0( + "The {.arg prescale_base} argument will override the scale's ", + "{.field {trans_name}} transformation in log-tick positioning." + )) + } trans <- log_trans(base = params$prescale_base) } else { trans <- scale$scale$trans @@ -87,7 +94,7 @@ GuideAxisLogticks <- ggproto( # Calculate tick marks tens <- 10^seq(start, end, by = 1) fives <- tens * 5 - ones <- as.vector(outer(tens, setdiff(2:9, 5))) + ones <- as.vector(outer(setdiff(2:9, 5), tens)) if (has_negatives) { # Filter and mirror ticks around 0 @@ -110,7 +117,7 @@ GuideAxisLogticks <- ggproto( # Discard out-of-bounds ticks range <- scale$continuous_range - logkey <- vec_slice(logkey, ticks > range[1] & ticks < range[2]) + logkey <- vec_slice(logkey, ticks >= range[1] & ticks <= range[2]) params$logkey <- logkey params From 02913a1d7bf2f71ee962cab469676585de345e93 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sat, 28 Oct 2023 10:49:09 +0200 Subject: [PATCH 09/18] add control over whether to use expanded range --- R/guide-axis-logticks.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index 084c9a9f1e..06145748e7 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -5,6 +5,7 @@ guide_axis_logticks <- function( short = 0.75, prescale_base = NULL, negative_small = 0.1, + expanded = TRUE, cap = "none", ... ) { @@ -23,11 +24,13 @@ guide_axis_logticks <- function( check_object(long, check_fun, what) check_object(mid, check_fun, what) check_object(short, check_fun, what) + check_bool(expanded) new_guide( available_aes = c("x", "y"), prescale_base = prescale_base, negative_small = negative_small, + expanded = expanded, long = long, mid = mid, short = short, @@ -48,7 +51,8 @@ GuideAxisLogticks <- ggproto( minor.ticks = TRUE, # for spacing calculation long = 2.25, mid = 1.5, - short = 0.75 + short = 0.75, + expanded = TRUE ), GuideAxis$params ), @@ -116,7 +120,7 @@ GuideAxisLogticks <- ggproto( ) # Discard out-of-bounds ticks - range <- scale$continuous_range + range <- if (params$expanded) scale$continuous_range else scale$get_limits() logkey <- vec_slice(logkey, ticks >= range[1] & ticks <= range[2]) params$logkey <- logkey From 732478a005a9bc06d4adc3c9663a0b37eb282424 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sat, 28 Oct 2023 10:49:41 +0200 Subject: [PATCH 10/18] negative_small cannot be 0 or negative --- R/guide-axis-logticks.R | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index 06145748e7..76ac071af2 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -24,6 +24,11 @@ guide_axis_logticks <- function( check_object(long, check_fun, what) check_object(mid, check_fun, what) check_object(short, check_fun, what) + check_number_decimal( + negative_small, min = 1e-100, # minimal domain of scales::log_trans + allow_infinite = FALSE, + allow_null = TRUE + ) check_bool(expanded) new_guide( From 94bcae9d1e4940fabfa03b44ef4a56c19dcff7a7 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sat, 28 Oct 2023 11:04:08 +0200 Subject: [PATCH 11/18] capping works with new ticks --- R/guide-axis-logticks.R | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index 76ac071af2..b0dd0acc16 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -39,6 +39,7 @@ guide_axis_logticks <- function( long = long, mid = mid, short = short, + cap = cap, minor.ticks = TRUE, ..., super = GuideAxisLogticks @@ -128,6 +129,14 @@ GuideAxisLogticks <- ggproto( range <- if (params$expanded) scale$continuous_range else scale$get_limits() logkey <- vec_slice(logkey, ticks >= range[1] & ticks <= range[2]) + # Adjust capping based on these ticks instead of regular ticks + if (params$cap %in% c("both", "upper")) { + params$decor[[aesthetic]][2] <- max(logkey[[aesthetic]]) + } + if (params$cap %in% c("both", "lower")) { + params$decor[[aesthetic]][1] <- min(logkey[[aesthetic]]) + } + params$logkey <- logkey params }, From adb00d03869113ceee12fdb9dbe038b69b962f0c Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sat, 28 Oct 2023 11:47:42 +0200 Subject: [PATCH 12/18] Add tests --- tests/testthat/_snaps/guides.md | 4 + .../logtick-axes-with-customisation.svg | 206 ++++++++++++++++++ tests/testthat/test-guides.R | 101 +++++++++ 3 files changed, 311 insertions(+) create mode 100644 tests/testthat/_snaps/guides/logtick-axes-with-customisation.svg diff --git a/tests/testthat/_snaps/guides.md b/tests/testthat/_snaps/guides.md index 6fb109ecbd..f9c0dddd45 100644 --- a/tests/testthat/_snaps/guides.md +++ b/tests/testthat/_snaps/guides.md @@ -65,6 +65,10 @@ Breaks are not formatted correctly for a bin legend. i Use `(, ]` format to indicate bins. +# guide_axis_logticks calculates appropriate ticks + + The `prescale_base` argument will override the scale's log-10 transformation in log-tick positioning. + # 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/_snaps/guides/logtick-axes-with-customisation.svg b/tests/testthat/_snaps/guides/logtick-axes-with-customisation.svg new file mode 100644 index 0000000000..8ad941b27d --- /dev/null +++ b/tests/testthat/_snaps/guides/logtick-axes-with-customisation.svg @@ -0,0 +1,206 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-100 +-10 +-1 +0 +1 +10 +100 + +10 +100 +1000 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +10 +100 +1000 + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +-100 +-10 +-1 +0 +1 +10 +100 +Negative length pseudo-logticks with 0.1 as smallest tick +Pseudo-logticks with 1 as smallest tick +Inverted logticks with swapped tick lengths +Capped and not-expanded inverted logticks +logtick axes with customisation + + diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 6f7e241c92..a2f0e59529 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -344,6 +344,71 @@ test_that("guide_colourbar warns about discrete scales", { }) +test_that("guide_axis_logticks calculates appropriate ticks", { + + test_scale <- function(trans = "identity", limits = c(NA, NA)) { + scale <- scale_x_continuous(trans = trans) + scale$train(scale$transform(limits)) + view_scale_primary(scale) + } + + train_guide <- function(guide, scale) { + params <- guide$params + params$position <- "bottom" + guide$train(params, scale, "x") + } + + guide <- guide_axis_logticks(negative_small = 10) + outcome <- c((1:10)*10, (2:10)*100) + + # Test the classic log10 transformation + scale <- test_scale("log10", c(10, 1000)) + key <- train_guide(guide, scale)$logkey + + expect_equal(sort(key$x), log10(outcome)) + expect_equal(key$.type, rep(c(1,2,3), c(3, 2, 14))) + + # Test compound transformation + scale <- test_scale(c("log10", "reverse"), c(10, 1000)) + key <- train_guide(guide, scale)$logkey + + expect_equal(sort(key$x), -log10(rev(outcome))) + + # Test transformation with negatives + scale <- test_scale("pseudo_log", c(-1000, 1000)) + key <- train_guide(guide, scale)$logkey + + unlog <- sort(pseudo_log_trans()$inverse(key$x)) + expect_equal(unlog, c(-rev(outcome), 0, outcome)) + expect_equal(key$.type, rep(c(1,2,3), c(7, 4, 28))) + + # Test expanded argument + scale <- test_scale("log10", c(20, 900)) + scale$continuous_range <- c(1, 3) + + guide <- guide_axis_logticks(expanded = TRUE) + key <- train_guide(guide, scale)$logkey + + expect_equal(sort(key$x), log10(outcome)) + + guide <- guide_axis_logticks(expanded = FALSE) + key <- train_guide(guide, scale)$logkey + + expect_equal(sort(key$x), log10(outcome[-c(1, length(outcome))])) + + # Test with prescaled input + guide <- guide_axis_logticks(prescale_base = 2) + scale <- test_scale(limits = log2(c(10, 1000))) + + key <- train_guide(guide, scale)$logkey + expect_equal(sort(key$x), log2(outcome)) + + # Should warn when scale also has transformation + scale <- test_scale("log10", limits = c(10, 1000)) + expect_snapshot_warning(train_guide(guide, scale)$logkey) + +}) + # Visual tests ------------------------------------------------------------ test_that("axis guides are drawn correctly", { @@ -549,6 +614,42 @@ test_that("axis guides can be capped", { expect_doppelganger("axis guides with capped ends", p) }) +test_that("logticks look as they should", { + + p <- ggplot(data.frame(x = c(-100, 100), y = c(10, 1000)), aes(x, y)) + + geom_point() + + scale_y_continuous(trans = c("log10", "reverse"), + expand = expansion(add = 0.5)) + + scale_x_continuous( + breaks = c(-100, -10, -1, 0, 1, 10, 100) + ) + + coord_trans(x = "pseudo_log") + + theme_test() + + theme(axis.line = element_line(colour = "black"), + panel.border = element_blank(), + axis.ticks.length.x.top = unit(-2.75, "pt")) + + guides( + x = guide_axis_logticks( + title = "Pseudo-logticks with 1 as smallest tick", + negative_small = 1 + ), + y = guide_axis_logticks( + title = "Inverted logticks with swapped tick lengths", + long = 0.75, short = 2.25 + ), + x.sec = guide_axis_logticks( + negative_small = 0.1, + title = "Negative length pseudo-logticks with 0.1 as smallest tick" + ), + y.sec = guide_axis_logticks( + expanded = FALSE, cap = "both", + title = "Capped and not-expanded inverted logticks" + ) + ) + expect_doppelganger("logtick axes with customisation", p) + +}) + test_that("guides are positioned correctly", { df <- data_frame(x = 1, y = 1, z = factor("a")) From 5b3271f03eb89d25b382f7c6a3e5c428dcd3952f Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sat, 28 Oct 2023 11:49:27 +0200 Subject: [PATCH 13/18] Document --- DESCRIPTION | 1 + NAMESPACE | 2 + R/guide-axis-logticks.R | 68 +++++++++++++++++++++++- man/ggplot2-ggproto.Rd | 44 ++++++++-------- man/guide_axis_logticks.Rd | 105 +++++++++++++++++++++++++++++++++++++ 5 files changed, 197 insertions(+), 23 deletions(-) create mode 100644 man/guide_axis_logticks.Rd diff --git a/DESCRIPTION b/DESCRIPTION index 0f931609d9..281656cb67 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -174,6 +174,7 @@ Collate: 'grouping.R' 'guide-.R' 'guide-axis.R' + 'guide-axis-logticks.R' 'guide-legend.R' 'guide-bins.R' 'guide-colorbar.R' diff --git a/NAMESPACE b/NAMESPACE index 717abb2e18..b0a5f61c82 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -211,6 +211,7 @@ export(GeomViolin) export(GeomVline) export(Guide) export(GuideAxis) +export(GuideAxisLogticks) export(GuideBins) export(GuideColourbar) export(GuideColoursteps) @@ -418,6 +419,7 @@ export(ggproto_parent) export(ggsave) export(ggtitle) export(guide_axis) +export(guide_axis_logticks) export(guide_bins) export(guide_colorbar) export(guide_colorsteps) diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index b0dd0acc16..2fe9ca5b35 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -1,4 +1,65 @@ - +#' @include guide-axis.R +NULL + +#' Axis with logarithmic tick marks +#' +#' This axis guide replaces the placement of ticks marks at intervals in +#' log10 space. +#' +#' @param long,mid,short A [grid::unit()] object or [rel()] object setting +#' the (relative) length of the long, middle and short ticks. Numeric values +#' are interpreted as [rel()] objects. The [rel()] values are used to multiply +#' values of the `axis.ticks.length` theme setting. +#' @param prescale_base Base of logarithm used to transform data manually. The +#' default, `NULL`, will use the scale transformation to calculate positions. +#' Only set `prescale_base` if the data has already been log-transformed. +#' When using a log-transform in the position scale or in `coord_trans()`, +#' keep the default `NULL` argument. +#' @param negative_small When the scale limits include 0 or negative numbers, +#' what should be the smallest absolute value that is marked with a tick? +#' @param expanded Whether the ticks should cover the range after scale +#' expansion (`TRUE`, default), or be restricted to the scale limits +#' (`FALSE`). +#' @inheritParams guide_axis +#' @inheritDotParams guide_axis -minor.ticks +#' +#' @export +#' +#' @examples +#' # A standard plot +#' p <- ggplot(msleep, aes(bodywt, brainwt)) + +#' geom_point(na.rm = TRUE) +#' +#' # The logticks axis works well with log scales +#' p + scale_x_log10(guide = "axis_logticks") + +#' scale_y_log10(guide = "axis_logticks") +#' +#' # Or with log-transformed coordinates +#' p + coord_trans(x = "log10", y = "log10") + +#' guides(x = "axis_logticks", y = "axis_logticks") +#' +#' # When data is transformed manually, one should provide `prescale_base` +#' # Keep in mind that this axis uses log10 space for placement, not log2 +#' p + aes(x = log2(bodywt), y = log10(brainwt)) + +#' guides( +#' x = guide_axis_logticks(prescale_base = 2), +#' y = guide_axis_logticks(prescale_base = 10) +#' ) +#' +#' # A plot with both positive and negative extremes, pseudo-log transformed +#' set.seed(42) +#' p2 <- ggplot(data.frame(x = rcauchy(1000)), aes(x = x)) + +#' geom_density() + +#' scale_x_continuous( +#' breaks = c(-10^(4:0), 0, 10^(0:4)), +#' trans = "pseudo_log" +#' ) +#' +#' # The log ticks are mirrored when 0 is included +#' p2 + guides(x = "axis_logticks") +#' +#' # To control the tick density around 0, one can set `negative_small` +#' p2 + guides(x = guide_axis_logticks(negative_small = 1)) guide_axis_logticks <- function( long = 2.25, mid = 1.5, @@ -46,7 +107,10 @@ guide_axis_logticks <- function( ) } - +#' @rdname ggplot2-ggproto +#' @format NULL +#' @usage NULL +#' @export GuideAxisLogticks <- ggproto( "GuideAxisLogticks", GuideAxis, diff --git a/man/ggplot2-ggproto.Rd b/man/ggplot2-ggproto.Rd index 37a042dd68..3bd6d924c6 100644 --- a/man/ggplot2-ggproto.Rd +++ b/man/ggplot2-ggproto.Rd @@ -4,27 +4,28 @@ % R/geom-raster.R, R/annotation-raster.R, R/axis-secondary.R, R/coord-.R, % R/coord-cartesian-.R, R/coord-fixed.R, R/coord-flip.R, R/coord-map.R, % R/coord-polar.R, R/coord-quickmap.R, R/coord-transform.R, R/facet-.R, -% R/facet-grid-.R, R/facet-null.R, R/facet-wrap.R, R/stat-.R, R/geom-abline.R, -% R/geom-rect.R, R/geom-bar.R, R/geom-blank.R, R/geom-boxplot.R, R/geom-col.R, -% R/geom-path.R, R/geom-contour.R, R/geom-crossbar.R, R/geom-segment.R, -% R/geom-curve.R, R/geom-ribbon.R, R/geom-density.R, R/geom-density2d.R, -% R/geom-dotplot.R, R/geom-errorbar.R, R/geom-errorbarh.R, R/geom-function.R, -% R/geom-hex.R, R/geom-hline.R, R/geom-label.R, R/geom-linerange.R, -% R/geom-point.R, R/geom-pointrange.R, R/geom-quantile.R, R/geom-rug.R, -% R/geom-smooth.R, R/geom-spoke.R, R/geom-text.R, R/geom-tile.R, -% R/geom-violin.R, R/geom-vline.R, R/guide-.R, R/guide-axis.R, -% R/guide-legend.R, R/guide-bins.R, R/guide-colorbar.R, R/guide-colorsteps.R, -% R/guide-none.R, R/guide-old.R, R/layout.R, R/position-.R, -% R/position-dodge.R, R/position-dodge2.R, R/position-identity.R, -% R/position-jitter.R, R/position-jitterdodge.R, R/position-nudge.R, -% R/position-stack.R, R/scale-.R, R/scale-binned.R, R/scale-continuous.R, -% R/scale-date.R, R/scale-discrete-.R, R/scale-identity.R, R/stat-align.R, -% R/stat-bin.R, R/stat-bin2d.R, R/stat-bindot.R, R/stat-binhex.R, -% R/stat-boxplot.R, R/stat-contour.R, R/stat-count.R, R/stat-density-2d.R, -% R/stat-density.R, R/stat-ecdf.R, R/stat-ellipse.R, R/stat-function.R, -% R/stat-identity.R, R/stat-qq-line.R, R/stat-qq.R, R/stat-quantilemethods.R, -% R/stat-smooth.R, R/stat-sum.R, R/stat-summary-2d.R, R/stat-summary-bin.R, -% R/stat-summary-hex.R, R/stat-summary.R, R/stat-unique.R, R/stat-ydensity.R +% R/facet-grid-.R, R/facet-null.R, R/facet-wrap.R, R/stat-.R, +% R/geom-abline.R, R/geom-rect.R, R/geom-bar.R, R/geom-blank.R, +% R/geom-boxplot.R, R/geom-col.R, R/geom-path.R, R/geom-contour.R, +% R/geom-crossbar.R, R/geom-segment.R, R/geom-curve.R, R/geom-ribbon.R, +% R/geom-density.R, R/geom-density2d.R, R/geom-dotplot.R, R/geom-errorbar.R, +% R/geom-errorbarh.R, R/geom-function.R, R/geom-hex.R, R/geom-hline.R, +% R/geom-label.R, R/geom-linerange.R, R/geom-point.R, R/geom-pointrange.R, +% R/geom-quantile.R, R/geom-rug.R, R/geom-smooth.R, R/geom-spoke.R, +% R/geom-text.R, R/geom-tile.R, R/geom-violin.R, R/geom-vline.R, R/guide-.R, +% R/guide-axis.R, R/guide-axis-logticks.R, R/guide-legend.R, R/guide-bins.R, +% R/guide-colorbar.R, R/guide-colorsteps.R, R/guide-none.R, R/guide-old.R, +% R/layout.R, R/position-.R, R/position-dodge.R, R/position-dodge2.R, +% R/position-identity.R, R/position-jitter.R, R/position-jitterdodge.R, +% R/position-nudge.R, R/position-stack.R, R/scale-.R, R/scale-binned.R, +% R/scale-continuous.R, R/scale-date.R, R/scale-discrete-.R, +% R/scale-identity.R, R/stat-align.R, R/stat-bin.R, R/stat-bin2d.R, +% R/stat-bindot.R, R/stat-binhex.R, R/stat-boxplot.R, R/stat-contour.R, +% R/stat-count.R, R/stat-density-2d.R, R/stat-density.R, R/stat-ecdf.R, +% R/stat-ellipse.R, R/stat-function.R, R/stat-identity.R, R/stat-qq-line.R, +% R/stat-qq.R, R/stat-quantilemethods.R, R/stat-smooth.R, R/stat-sum.R, +% R/stat-summary-2d.R, R/stat-summary-bin.R, R/stat-summary-hex.R, +% R/stat-summary.R, R/stat-unique.R, R/stat-ydensity.R \docType{data} \name{ggplot2-ggproto} \alias{ggplot2-ggproto} @@ -89,6 +90,7 @@ \alias{GeomVline} \alias{Guide} \alias{GuideAxis} +\alias{GuideAxisLogticks} \alias{GuideLegend} \alias{GuideBins} \alias{GuideColourbar} diff --git a/man/guide_axis_logticks.Rd b/man/guide_axis_logticks.Rd new file mode 100644 index 0000000000..23a5865f91 --- /dev/null +++ b/man/guide_axis_logticks.Rd @@ -0,0 +1,105 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/guide-axis-logticks.R +\name{guide_axis_logticks} +\alias{guide_axis_logticks} +\title{Axis with logarithmic tick marks} +\usage{ +guide_axis_logticks( + long = 2.25, + mid = 1.5, + short = 0.75, + prescale_base = NULL, + negative_small = 0.1, + expanded = TRUE, + cap = "none", + ... +) +} +\arguments{ +\item{long, mid, short}{A \code{\link[grid:unit]{grid::unit()}} object or \code{\link[=rel]{rel()}} object setting +the (relative) length of the long, middle and short ticks. Numeric values +are interpreted as \code{\link[=rel]{rel()}} objects. The \code{\link[=rel]{rel()}} values are used to multiply +values of the \code{axis.ticks.length} theme setting.} + +\item{prescale_base}{Base of logarithm used to transform data manually. The +default, \code{NULL}, will use the scale transformation to calculate positions. +Only set \code{prescale_base} if the data has already been log-transformed. +When using a log-transform in the position scale or in \code{coord_trans()}, +keep the default \code{NULL} argument.} + +\item{negative_small}{When the scale limits include 0 or negative numbers, +what should be the smallest absolute value that is marked with a tick?} + +\item{expanded}{Whether the ticks should cover the range after scale +expansion (\code{TRUE}, default), or be restricted to the scale limits +(\code{FALSE}).} + +\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 +\code{"both"} to only draw the line in between the most extreme breaks. \code{TRUE} +and \code{FALSE} are shorthand for \code{"both"} and \code{"none"} respectively.} + +\item{...}{ + Arguments passed on to \code{\link[=guide_axis]{guide_axis}} + \describe{ + \item{\code{check.overlap}}{silently remove overlapping labels, +(recursively) prioritizing the first, last, and middle labels.} + \item{\code{angle}}{Compared to setting the angle in \code{\link[=theme]{theme()}} / \code{\link[=element_text]{element_text()}}, +this also uses some heuristics to automatically pick the \code{hjust} and \code{vjust} that +you probably want.} + \item{\code{n.dodge}}{The number of rows (for vertical axes) or columns (for +horizontal axes) that should be used to render the labels. This is +useful for displaying labels that would otherwise overlap.} + \item{\code{order}}{A positive \code{integer} of length 1 that specifies the order of +this guide among multiple guides. This controls in which order guides are +merged if there are multiple guides for the same position. If 0 (default), +the order is determined by a secret algorithm.} + \item{\code{position}}{Where this guide should be drawn: one of top, bottom, +left, or right.} + \item{\code{title}}{A character string or expression indicating a title of guide. +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.} + }} +} +\description{ +This axis guide replaces the placement of ticks marks at intervals in +log10 space. +} +\examples{ +# A standard plot +p <- ggplot(msleep, aes(bodywt, brainwt)) + + geom_point(na.rm = TRUE) + +# The logticks axis works well with log scales +p + scale_x_log10(guide = "axis_logticks") + + scale_y_log10(guide = "axis_logticks") + +# Or with log-transformed coordinates +p + coord_trans(x = "log10", y = "log10") + + guides(x = "axis_logticks", y = "axis_logticks") + +# When data is transformed manually, one should provide `prescale_base` +# Keep in mind that this axis uses log10 space for placement, not log2 +p + aes(x = log2(bodywt), y = log10(brainwt)) + + guides( + x = guide_axis_logticks(prescale_base = 2), + y = guide_axis_logticks(prescale_base = 10) + ) + +# A plot with both positive and negative extremes, pseudo-log transformed +set.seed(42) +p2 <- ggplot(data.frame(x = rcauchy(1000)), aes(x = x)) + + geom_density() + + scale_x_continuous( + breaks = c(-10^(4:0), 0, 10^(0:4)), + trans = "pseudo_log" + ) + +# The log ticks are mirrored when 0 is included +p2 + guides(x = "axis_logticks") + +# To control the tick density around 0, one can set `negative_small` +p2 + guides(x = guide_axis_logticks(negative_small = 1)) +} From 665e718446342bea5fb30b733955fb417e646d19 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sat, 28 Oct 2023 13:42:47 +0200 Subject: [PATCH 14/18] declare trans as function rather than strings --- tests/testthat/test-guides.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index a2f0e59529..6e22ebc7a1 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -346,7 +346,7 @@ test_that("guide_colourbar warns about discrete scales", { test_that("guide_axis_logticks calculates appropriate ticks", { - test_scale <- function(trans = "identity", limits = c(NA, NA)) { + test_scale <- function(trans = identity_trans(), limits = c(NA, NA)) { scale <- scale_x_continuous(trans = trans) scale$train(scale$transform(limits)) view_scale_primary(scale) @@ -362,20 +362,20 @@ test_that("guide_axis_logticks calculates appropriate ticks", { outcome <- c((1:10)*10, (2:10)*100) # Test the classic log10 transformation - scale <- test_scale("log10", c(10, 1000)) + scale <- test_scale(log10_trans(), c(10, 1000)) key <- train_guide(guide, scale)$logkey expect_equal(sort(key$x), log10(outcome)) expect_equal(key$.type, rep(c(1,2,3), c(3, 2, 14))) # Test compound transformation - scale <- test_scale(c("log10", "reverse"), c(10, 1000)) + scale <- test_scale(compose_trans(log10_trans(), reverse_trans()), c(10, 1000)) key <- train_guide(guide, scale)$logkey expect_equal(sort(key$x), -log10(rev(outcome))) # Test transformation with negatives - scale <- test_scale("pseudo_log", c(-1000, 1000)) + scale <- test_scale(pseudo_log_trans(), c(-1000, 1000)) key <- train_guide(guide, scale)$logkey unlog <- sort(pseudo_log_trans()$inverse(key$x)) @@ -383,7 +383,7 @@ test_that("guide_axis_logticks calculates appropriate ticks", { expect_equal(key$.type, rep(c(1,2,3), c(7, 4, 28))) # Test expanded argument - scale <- test_scale("log10", c(20, 900)) + scale <- test_scale(log10_trans(), c(20, 900)) scale$continuous_range <- c(1, 3) guide <- guide_axis_logticks(expanded = TRUE) @@ -404,7 +404,7 @@ test_that("guide_axis_logticks calculates appropriate ticks", { expect_equal(sort(key$x), log2(outcome)) # Should warn when scale also has transformation - scale <- test_scale("log10", limits = c(10, 1000)) + scale <- test_scale(log10_trans(), limits = c(10, 1000)) expect_snapshot_warning(train_guide(guide, scale)$logkey) }) @@ -618,12 +618,12 @@ test_that("logticks look as they should", { p <- ggplot(data.frame(x = c(-100, 100), y = c(10, 1000)), aes(x, y)) + geom_point() + - scale_y_continuous(trans = c("log10", "reverse"), + scale_y_continuous(trans = compose_trans(log10_trans(), reverse_trans()), expand = expansion(add = 0.5)) + scale_x_continuous( breaks = c(-100, -10, -1, 0, 1, 10, 100) ) + - coord_trans(x = "pseudo_log") + + coord_trans(x = pseudo_log_trans()) + theme_test() + theme(axis.line = element_line(colour = "black"), panel.border = element_blank(), From c0c1176def57a4f910fa78c7f8ee5ed1b9110fc9 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 31 Oct 2023 12:20:13 +0100 Subject: [PATCH 15/18] Add pkgdown item --- _pkgdown.yml | 1 + 1 file changed, 1 insertion(+) diff --git a/_pkgdown.yml b/_pkgdown.yml index 7dbedc3062..44b6704dc7 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -126,6 +126,7 @@ reference: - guide_colourbar - guide_legend - guide_axis + - guide_axis_logticks - guide_bins - guide_coloursteps - guide_none From d205944bf2c5fd16f135b3ba3be35ad821eb0590 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 22 Nov 2023 14:25:59 +0100 Subject: [PATCH 16/18] Enable theming for short ticks --- R/guide-axis-logticks.R | 33 ++++++++++++++++++++++++++++----- man/guide_axis_logticks.Rd | 5 +++++ 2 files changed, 33 insertions(+), 5 deletions(-) diff --git a/R/guide-axis-logticks.R b/R/guide-axis-logticks.R index 2fe9ca5b35..5e97d3f193 100644 --- a/R/guide-axis-logticks.R +++ b/R/guide-axis-logticks.R @@ -17,6 +17,9 @@ NULL #' keep the default `NULL` argument. #' @param negative_small When the scale limits include 0 or negative numbers, #' what should be the smallest absolute value that is marked with a tick? +#' @param short_theme A theme [element][element_line()] for customising the +#' display of the shortest ticks. Must be a line or blank element, and +#' it inherits from the `axis.minor.ticks` setting for the relevant position. #' @param expanded Whether the ticks should cover the range after scale #' expansion (`TRUE`, default), or be restricted to the scale limits #' (`FALSE`). @@ -66,6 +69,7 @@ guide_axis_logticks <- function( short = 0.75, prescale_base = NULL, negative_small = 0.1, + short_theme = element_line(), expanded = TRUE, cap = "none", ... @@ -91,6 +95,7 @@ guide_axis_logticks <- function( allow_null = TRUE ) check_bool(expanded) + check_inherits(short_theme, c("element_blank", "element_line")) new_guide( available_aes = c("x", "y"), @@ -102,6 +107,7 @@ guide_axis_logticks <- function( short = short, cap = cap, minor.ticks = TRUE, + short_theme = short_theme, ..., super = GuideAxisLogticks ) @@ -122,7 +128,8 @@ GuideAxisLogticks <- ggproto( long = 2.25, mid = 1.5, short = 0.75, - expanded = TRUE + expanded = TRUE, + short_theme = NULL ), GuideAxis$params ), @@ -216,6 +223,9 @@ GuideAxisLogticks <- ggproto( elements <- GuideAxis$override_elements(params, elements, theme) length <- elements$major_length + # Inherit short ticks from minor ticks + elements$short <- combine_elements(params$short_theme, elements$minor) + # Multiply rel units with theme's tick length tick_length <- lapply(params[c("long", "mid", "short")], function(x) { if (is.unit(x)) x else unclass(x) * length @@ -231,11 +241,24 @@ GuideAxisLogticks <- ggproto( build_ticks = function(key, elements, params, position = params$opposite) { # Instead of passing regular key, we pass the logkey - # In addition, we pass tick lengths directly - Guide$build_ticks( - params$logkey, + key <- params$logkey + long <- Guide$build_ticks( + vec_slice(key, key$.type == 1L), elements$ticks, params, position, - elements$tick_length[params$logkey$.type] + elements$tick_length[1L] + ) + + mid <- Guide$build_ticks( + vec_slice(key, key$.type == 2L), + elements$minor, params, position, + elements$tick_length[2L] + ) + + short <- Guide$build_ticks( + vec_slice(key, key$.type == 3L), + elements$short, params, position, + elements$tick_length[3L] ) + grobTree(long, mid, short, name = "ticks") } ) diff --git a/man/guide_axis_logticks.Rd b/man/guide_axis_logticks.Rd index 23a5865f91..c2e4a0c904 100644 --- a/man/guide_axis_logticks.Rd +++ b/man/guide_axis_logticks.Rd @@ -10,6 +10,7 @@ guide_axis_logticks( short = 0.75, prescale_base = NULL, negative_small = 0.1, + short_theme = element_line(), expanded = TRUE, cap = "none", ... @@ -30,6 +31,10 @@ keep the default \code{NULL} argument.} \item{negative_small}{When the scale limits include 0 or negative numbers, what should be the smallest absolute value that is marked with a tick?} +\item{short_theme}{A theme \link[=element_line]{element} for customising the +display of the shortest ticks. Must be a line or blank element, and +it inherits from the \code{axis.minor.ticks} setting for the relevant position.} + \item{expanded}{Whether the ticks should cover the range after scale expansion (\code{TRUE}, default), or be restricted to the scale limits (\code{FALSE}).} From 93377d4e8825aa2f12dcec7fff3bd8b99d8778e8 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 22 Nov 2023 14:39:35 +0100 Subject: [PATCH 17/18] Mark `annotation_logticks()` as superseded --- R/annotation-logticks.R | 5 +++++ man/annotation_logticks.Rd | 4 ++++ 2 files changed, 9 insertions(+) diff --git a/R/annotation-logticks.R b/R/annotation-logticks.R index 1e7f60be65..8f3e8a63c2 100644 --- a/R/annotation-logticks.R +++ b/R/annotation-logticks.R @@ -1,5 +1,10 @@ #' Annotation: log tick marks #' +#' @description +#' `r lifecycle::badge("superseded")` +#' +#' This function is superseded by using [`guide_axis_logticks()`]. +#' #' This annotation adds log tick marks with diminishing spacing. #' These tick marks probably make sense only for base 10. #' diff --git a/man/annotation_logticks.Rd b/man/annotation_logticks.Rd index 92a587e708..490a7d3b17 100644 --- a/man/annotation_logticks.Rd +++ b/man/annotation_logticks.Rd @@ -61,6 +61,10 @@ long tick marks. In base 10, these are the "1" (or "10") ticks.} \item{size}{\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}}} } \description{ +\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#superseded}{\figure{lifecycle-superseded.svg}{options: alt='[Superseded]'}}}{\strong{[Superseded]}} + +This function is superseded by using \code{\link[=guide_axis_logticks]{guide_axis_logticks()}}. + This annotation adds log tick marks with diminishing spacing. These tick marks probably make sense only for base 10. } From c5bf54ec9d21c6ebe7ab4c82dcd6997f0766422b Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 22 Nov 2023 14:45:14 +0100 Subject: [PATCH 18/18] add news bullet --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index a7bd1b024e..bea2948661 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # ggplot2 (development version) +* New `guide_axis_logticks()` can be used to draw logarithmic tick marks as + an axis. It supersedes the `annotation_logticks()` function + (@teunbrand, #5325). + * Glyphs drawing functions of the `draw_key_*()` family can now set `"width"` and `"height"` attributes (in centimetres) to the produced keys to control their displayed size in the legend.