add length argument to geom_rug to allow different lengths

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 3.1.0.9000
 
+* `geom_rug()` gains a `length` option to allow for changing the length of the rug lines. (@daniel-wells, #3109)
+
 * `coord_sf()` graticule lines are now drawn in the same thickness as 
   panel grid lines in `coord_cartesian()`, and seting panel grid
   lines to `element_blank()` now also works in `coord_sf()` 

R/geom-rug.r

@@ -4,9 +4,10 @@
 #' with the two 1d marginal distributions. Rug plots display individual
 #' cases so are best used with smaller datasets.
 #'
-#' The rug lines are drawn with a fixed size (3\% of the total plot size) so
-#' are dependent on the overall scale expansion in order not to overplot
-#' existing data.
+#' By default, the rug lines are drawn with a length that corresponds to 3\%
+#' of the total plot size. Since the default scale expansion of for continuous
+#' variables is 5\% at both ends of the scale, the rug will not overlap with
+#' any data points under the default settings.
 #'
 #' @eval rd_aesthetics("geom", "rug")
 #' @inheritParams layer
@@ -15,6 +16,7 @@
 #'   It can be set to a string containing any of `"trbl"`, for top, right,
 #'   bottom, and left.
 #' @param outside logical that controls whether to move the rug tassels outside of the plot area. Default is off (FALSE). You will also need to use `coord_cartesian(clip = "off")`. When set to TRUE, also consider changing the sides argument to "tr". See examples.
+#' @param length A [grid::unit()] object that sets the length of the rug lines. Use scale expansion to avoid overplotting of data.
 #' @export
 #' @examples
 #' p <- ggplot(mtcars, aes(wt, mpg)) +
@@ -43,11 +45,17 @@
 #'    coord_cartesian(clip = "off") +
 #'    theme(plot.margin = margin(1, 1, 1, 1, "cm"))
 #'
+#' # increase the line length and
+#' # expand axis to avoid overplotting
+#' p + geom_rug(length = unit(0.05, "npc")) +
+#'    scale_y_continuous(expand = c(0.1, 0.1))
+#'
 geom_rug <- function(mapping = NULL, data = NULL,
                      stat = "identity", position = "identity",
                      ...,
                      outside = FALSE,
                      sides = "bl",
+                     length = unit(0.03, "npc"),
                      na.rm = FALSE,
                      show.legend = NA,
                      inherit.aes = TRUE) {
@@ -62,6 +70,7 @@ geom_rug <- function(mapping = NULL, data = NULL,
     params = list(
       outside = outside,
       sides = sides,
+      length = length,
       na.rm = na.rm,
       ...
     )
@@ -76,7 +85,10 @@ geom_rug <- function(mapping = NULL, data = NULL,
 GeomRug <- ggproto("GeomRug", Geom,
   optional_aes = c("x", "y"),
 
-  draw_panel = function(data, panel_params, coord, sides = "bl", outside) {
+  draw_panel = function(data, panel_params, coord, sides = "bl", outside = FALSE, length = unit(0.03, "npc")) {
+    if (!inherits(length, "unit")) {
+      stop("'length' must be a 'unit' object.", call. = FALSE)
+    }
     rugs <- list()
     data <- coord$transform(data, panel_params)
 
@@ -88,25 +100,25 @@ GeomRug <- ggproto("GeomRug", Geom,
 
     # move the rug to outside the main plot space
     rug_length <- if (!outside) {
-      list(min = 0.03, max = 0.97)
+      list(min = length, max = unit(1, "npc") - length)
     } else {
-      list(min = -0.03, max = 1.03)
+      list(min = -1 * length, max = unit(1, "npc") + length)
     }
 
     gp <- gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt)
     if (!is.null(data$x)) {
       if (grepl("b", sides)) {
         rugs$x_b <- segmentsGrob(
           x0 = unit(data$x, "native"), x1 = unit(data$x, "native"),
-          y0 = unit(0, "npc"), y1 = unit(rug_length$min, "npc"),
+          y0 = unit(0, "npc"), y1 = rug_length$min,
           gp = gp
         )
       }
 
       if (grepl("t", sides)) {
         rugs$x_t <- segmentsGrob(
           x0 = unit(data$x, "native"), x1 = unit(data$x, "native"),
-          y0 = unit(1, "npc"), y1 = unit(rug_length$max, "npc"),
+          y0 = unit(1, "npc"), y1 = rug_length$max,
           gp = gp
         )
       }
@@ -116,15 +128,15 @@ GeomRug <- ggproto("GeomRug", Geom,
       if (grepl("l", sides)) {
         rugs$y_l <- segmentsGrob(
           y0 = unit(data$y, "native"), y1 = unit(data$y, "native"),
-          x0 = unit(0, "npc"), x1 = unit(rug_length$min, "npc"),
+          x0 = unit(0, "npc"), x1 = rug_length$min,
           gp = gp
         )
       }
 
       if (grepl("r", sides)) {
         rugs$y_r <- segmentsGrob(
           y0 = unit(data$y, "native"), y1 = unit(data$y, "native"),
-          x0 = unit(1, "npc"), x1 = unit(rug_length$max, "npc"),
+          x0 = unit(1, "npc"), x1 = rug_length$max,
           gp = gp
         )
       }

tests/testthat/test-geom-rug.R

@@ -20,3 +20,25 @@ test_that("coord_flip flips the rugs", {
   expect_equal(length(b[[1]]$children[[1]]$y0), 1)
   expect_equal(length(b[[1]]$children[[1]]$y1), 1)
 })
+
+test_that("Rug length needs unit object", {
+  p <- ggplot(df, aes(x,y))
+  expect_error(print(p + geom_rug(length = 0.01)))
+})
+
+test_that("Rug lengths are correct", {
+  a <- layer_grob(p, 2)
+
+  # Check default lengths
+  expect_equal(a[[1]]$children[[1]]$x0, unit(0, "npc"))
+  expect_equal(a[[1]]$children[[1]]$x1, unit(0.03, "npc"))
+
+  p <- ggplot(df, aes(x, y)) + geom_point() + geom_rug(sides = 'l', length = unit(12, "pt"))
+  b <- layer_grob(p, 2)
+
+  # Check default length is changed
+  expect_equal(a[[1]]$children[[1]]$x0, unit(0, "npc"))
+  expect_equal(b[[1]]$children[[1]]$x1, unit(12, "pt"))
+
+})
+