Axis caps

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, 

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,14 +42,24 @@
 #' # 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,
 
     # customisations
     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)
 }
 

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"))