From 9da2a7bd37c9132947bc222cb1e471b67633cf14 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 26 Apr 2023 20:03:15 +0200 Subject: [PATCH 1/5] Pass around cap argument --- R/guide-axis.R | 13 ++++++++++++- 1 file changed, 12 insertions(+), 1 deletion(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index 221157fb7f..7fcf134065 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -37,7 +37,16 @@ #' # 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, order = 0, position = waiver()) { + n.dodge = 1, cap = "none", order = 0, + position = waiver()) { + + if (is.logical(cap)) { + check_bool(cap) + cap <- if (cap) "both" else "none" + } + cap <- arg_match0(cap, c("none", "both", "upper", "lower")) + + new_guide( title = title, @@ -45,6 +54,7 @@ guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = NULL, check.overlap = check.overlap, angle = angle, n.dodge = n.dodge, + cap = cap, # parameter available_aes = c("x", "y"), @@ -72,6 +82,7 @@ GuideAxis <- ggproto( direction = NULL, angle = NULL, n.dodge = 1, + cap = "none", order = 0, check.overlap = FALSE ), From 8229f626b1a25e046e9e8ada1f94500e68ba2240 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 26 Apr 2023 20:03:38 +0200 Subject: [PATCH 2/5] Do capping --- R/guide-axis.R | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index 7fcf134065..458f36fb23 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -239,10 +239,17 @@ GuideAxis <- ggproto( # The decor in the axis guide is the axis line build_decor = function(decor, grobs, elements, params) { + x <- c(0, 1) + if (params$cap %in% c("both", "upper")) { + x[2] <- max(params$key[[params$aes]], na.rm = TRUE) + } + if (params$cap %in% c("both", "lower")) { + x[1] <- min(params$key[[params$aes]], na.rm = TRUE) + } exec( element_grob, element = elements$line, - !!params$aes := unit(c(0, 1), "npc"), + !!params$aes := unit(x, "npc"), !!params$orth_aes := unit(rep(params$orth_side, 2), "npc") ) }, From ec17fe4a359ba6fd7527545f0236d0315ea67845 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 26 Apr 2023 20:03:56 +0200 Subject: [PATCH 3/5] Document --- NEWS.md | 2 ++ R/guide-axis.R | 5 +++++ man/guide_axis.Rd | 7 +++++++ 3 files changed, 14 insertions(+) diff --git a/NEWS.md b/NEWS.md index 401083cb6d..0ca3c09b59 100644 --- a/NEWS.md +++ b/NEWS.md @@ -26,6 +26,8 @@ * More informative error for mismatched `direction`/`theme(legend.direction = ...)` arguments (#4364, #4930). * `guide_coloursteps()` and `guide_bins()` sort breaks (#5152). + * `guide_axis()` gains a `cap` argument that can be used to trim the + axis line to extreme breaks (#4907). * `geom_label()` now uses the `angle` aesthetic (@teunbrand, #2785) * 'lines' units in `geom_label()`, often used in the `label.padding` argument, diff --git a/R/guide-axis.R b/R/guide-axis.R index 458f36fb23..f30d1c1a59 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -14,6 +14,11 @@ #' @param 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. +#' @param cap A `character` to cut the axis line back to the last breaks. Can +#' be `"none"` (default) to draw the axis line along the whole panel, or +#' `"upper"` and `"lower"` to draw the axis to the upper or lower break, or +#' `"both"` to only draw the line in between the most extreme breaks. `TRUE` +#' and `FALSE` are shorthand for `"both"` and `"none"` respectively. #' @param order A positive `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), diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd index 34c358c671..086ba0b25a 100644 --- a/man/guide_axis.Rd +++ b/man/guide_axis.Rd @@ -9,6 +9,7 @@ guide_axis( check.overlap = FALSE, angle = NULL, n.dodge = 1, + cap = "none", order = 0, position = waiver() ) @@ -30,6 +31,12 @@ you probably want.} horizontal axes) that should be used to render the labels. This is useful for displaying labels that would otherwise overlap.} +\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{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), From 7e43b4d01d1d4ad76f74e67b4695b3da79cd070b Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 26 Apr 2023 20:05:02 +0200 Subject: [PATCH 4/5] Add test --- .../guides/axis-guides-with-capped-ends.svg | 114 ++++++++++++++++++ tests/testthat/test-guides.R | 13 ++ 2 files changed, 127 insertions(+) create mode 100644 tests/testthat/_snaps/guides/axis-guides-with-capped-ends.svg diff --git a/tests/testthat/_snaps/guides/axis-guides-with-capped-ends.svg b/tests/testthat/_snaps/guides/axis-guides-with-capped-ends.svg new file mode 100644 index 0000000000..393ffb017b --- /dev/null +++ b/tests/testthat/_snaps/guides/axis-guides-with-capped-ends.svg @@ -0,0 +1,114 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +100 +200 +300 + +100 +200 +300 +400 + + + + + + + + + +100 +200 +300 +400 + + + + +100 +200 +300 +hp +disp +axis guides with capped ends + + diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 71314e8cfb..4a3f7ed64d 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -462,6 +462,19 @@ test_that("Axis titles won't be blown away by coord_*()", { # expect_doppelganger("guide titles with coord_sf()", plot + coord_sf()) }) +test_that("axis guides can be capped", { + p <- ggplot(mtcars, aes(hp, disp)) + + geom_point() + + theme(axis.line = element_line()) + + guides( + x = guide_axis(cap = "both"), + y = guide_axis(cap = "upper"), + y.sec = guide_axis(cap = "lower"), + x.sec = guide_axis(cap = "none") + ) + expect_doppelganger("axis guides with capped ends", p) +}) + test_that("guides are positioned correctly", { df <- data_frame(x = 1, y = 1, z = factor("a")) From b39484b06df004a1c390a37ffa2bdba45323ef09 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Sun, 7 May 2023 11:52:24 +0200 Subject: [PATCH 5/5] Munch decor if appropriate --- R/guide-axis.R | 47 +++++++++++++++++++++++++++++++++++------------ 1 file changed, 35 insertions(+), 12 deletions(-) diff --git a/R/guide-axis.R b/R/guide-axis.R index f30d1c1a59..9fae5c670f 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -108,6 +108,25 @@ GuideAxis <- ggproto( Guide$extract_params(scale, params, hashables) }, + extract_decor = function(scale, aesthetic, position, key, cap = "none", ...) { + + value <- c(-Inf, Inf) + if (cap %in% c("both", "upper")) { + value[2] <- max(key[[aesthetic]]) + } + if (cap %in% c("both", "lower")) { + value[1] <- min(key[[aesthetic]]) + } + + opposite <- setdiff(c("x", "y"), aesthetic) + opposite_value <- if (position %in% c("top", "right")) -Inf else Inf + + data_frame( + !!aesthetic := value, + !!opposite := opposite_value + ) + }, + transform = function(self, params, coord, panel_params) { key <- params$key position <- params$position @@ -125,6 +144,8 @@ GuideAxis <- ggproto( key <- coord$transform(key, panel_params) params$key <- key + params$decor <- coord_munch(coord, params$decor, panel_params) + # Ported over from `warn_for_position_guide` # This is trying to catch when a user specifies a position perpendicular # to the direction of the axis (e.g., a "y" axis on "top"). @@ -244,18 +265,13 @@ GuideAxis <- ggproto( # The decor in the axis guide is the axis line build_decor = function(decor, grobs, elements, params) { - x <- c(0, 1) - if (params$cap %in% c("both", "upper")) { - x[2] <- max(params$key[[params$aes]], na.rm = TRUE) + if (empty(decor)) { + return(zeroGrob()) } - if (params$cap %in% c("both", "lower")) { - x[1] <- min(params$key[[params$aes]], na.rm = TRUE) - } - exec( - element_grob, - element = elements$line, - !!params$aes := unit(x, "npc"), - !!params$orth_aes := unit(rep(params$orth_side, 2), "npc") + element_grob( + elements$line, + x = unit(decor$x, "npc"), + y = unit(decor$y, "npc") ) }, @@ -370,7 +386,8 @@ GuideAxis <- ggproto( }, draw_early_exit = function(self, params, elements) { - line <- self$build_decor(elements = elements, params = params) + line <- self$build_decor(decor = params$decor, elements = elements, + params = params) absoluteGrob( gList(line), width = grobWidth(line), @@ -408,11 +425,17 @@ draw_axis <- function(break_positions, break_labels, axis_position, theme, position = axis_position) params <- guide$params aes <- if (axis_position %in% c("top", "bottom")) "x" else "y" + opp <- setdiff(c("x", "y"), aes) + opp_value <- if (axis_position %in% c("top", "right")) 0 else 1 key <- data_frame( break_positions, break_positions, break_labels, .name_repair = ~ c(aes, ".value", ".label") ) params$key <- key + params$decor <- data_frame0( + !!aes := c(0, 1), + !!opp := opp_value + ) guide$draw(theme, params) }