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 221157fb7f..9fae5c670f 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), @@ -37,7 +42,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 +59,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 +87,7 @@ GuideAxis <- ggproto( direction = NULL, angle = NULL, n.dodge = 1, + cap = "none", order = 0, check.overlap = FALSE ), @@ -92,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 @@ -109,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"). @@ -228,11 +265,13 @@ GuideAxis <- ggproto( # The decor in the axis guide is the axis line build_decor = function(decor, grobs, elements, params) { - exec( - element_grob, - element = elements$line, - !!params$aes := unit(c(0, 1), "npc"), - !!params$orth_aes := unit(rep(params$orth_side, 2), "npc") + if (empty(decor)) { + return(zeroGrob()) + } + element_grob( + elements$line, + x = unit(decor$x, "npc"), + y = unit(decor$y, "npc") ) }, @@ -347,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), @@ -385,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) } 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), 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"))