add param to alter width of rug segments in geom_rug

R/geom-rug.r

@@ -1,12 +1,15 @@
 #' Marginal rug plots.
 #'
-#' @section Aesthetics: 
+#' @section Aesthetics:
 #' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("geom", "rug")}
 #'
 #' @inheritParams geom_point
 #' @param sides A string that controls which sides of the plot the rugs appear on.
 #'   It can be set to a string containing any of \code{"trbl"}, for top, right,
 #'   bottom, and left.
+#' @param rugwidth The width the rug segments. This should be a \code{\link{unit}}
+#' object.
+#'
 #' @export
 #' @examples
 #' p <- ggplot(mtcars, aes(x=wt, y=mpg))
@@ -15,55 +18,67 @@
 #' p + geom_point() + geom_rug(sides="b")    # Rug on bottom only
 #' p + geom_point() + geom_rug(sides="trbl") # All four sides
 #' p + geom_point() + geom_rug(position='jitter')
-geom_rug <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", sides = "bl", ...) {
-  GeomRug$new(mapping = mapping, data = data, stat = stat, position = position, sides = sides, ...)
+geom_rug <- function (mapping = NULL, data = NULL, stat = "identity", position = "identity", sides = "bl", rugwidth=unit(0.03, "npc"), ...) {
+
+  GeomRug$new(mapping = mapping, data = data, stat = stat, position = position, sides = sides, rugwidth=rugwidth, ...)
 }
 
 GeomRug <- proto(Geom, {
   objname <- "rug"
 
-  draw <- function(., data, scales, coordinates, sides, ...) {
+  draw <- function(., data, scales, coordinates, sides, rugwidth=units(0.03, "npc"), ...) {
+    if (!is(rugwidth, "unit")) {
+      stop("'rugwidth' must be a 'unit' object.")
+    }
     rugs <- list()
-    data <- coord_transform(coordinates, data, scales)    
+    data <- coord_transform(coordinates, data, scales)
     if (!is.null(data$x)) {
       if(grepl("b", sides)) {
+        y0b <- unit(0, "npc")
+        y1b <- y0b + rugwidth
         rugs$x_b <- segmentsGrob(
           x0 = unit(data$x, "native"), x1 = unit(data$x, "native"),
-          y0 = unit(0, "npc"), y1 = unit(0.03, "npc"),
+          y0 = y0b, y1 = y1b,
           gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt)
         )
       }
 
       if(grepl("t", sides)) {
+        y0t <- unit(1, "npc")
+        y1t <- y0t - rugwidth
         rugs$x_t <- segmentsGrob(
           x0 = unit(data$x, "native"), x1 = unit(data$x, "native"),
-          y0 = unit(1, "npc"), y1 = unit(0.97, "npc"),
+          y0 = y0t, y1 = y1t,
           gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt)
         )
       }
-    }  
+    }
 
     if (!is.null(data$y)) {
       if(grepl("l", sides)) {
+        x0l <- unit(0, "npc")
+        x1l <- x0l + rugwidth
         rugs$y_l <- segmentsGrob(
           y0 = unit(data$y, "native"), y1 = unit(data$y, "native"),
-          x0 = unit(0, "npc"), x1 = unit(0.03, "npc"),
+          x0 = x0l, x1 = x1l,
           gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt)
         )
       }
 
       if(grepl("r", sides)) {
+        x0r = unit(1, "npc")
+        x1r = x0r - rugwidth
         rugs$y_r <- segmentsGrob(
           y0 = unit(data$y, "native"), y1 = unit(data$y, "native"),
-          x0 = unit(1, "npc"), x1 = unit(0.97, "npc"),
+          x0 = x0r, x1 = x1r,
           gp = gpar(col = alpha(data$colour, data$alpha), lty = data$linetype, lwd = data$size * .pt)
         )
       }
-    }  
-    
+    }
+
     gTree(children = do.call("gList", rugs))
   }
-  
+
   default_stat <- function(.) StatIdentity
   default_aes <- function(.) aes(colour="black", size=0.5, linetype=1, alpha = NA)
   guide_geom <- function(.) "path"

inst/tests/test-rug.r

@@ -0,0 +1,7 @@
+context("Rug")
+
+test_that("Rugwidth needs unit object", {
+    p <- ggplot(mtcars, aes(x=mpg,y=hp))
+    expect_is(p + geom_rug(rugwidth=grid::unit(0.01, "npc")), "ggplot")
+    expect_error(print(p + geom_rug(rugwidth=0.01)))
+})

man/geom_rug.Rd

@@ -3,14 +3,18 @@
 \title{Marginal rug plots.}
 \usage{
   geom_rug(mapping = NULL, data = NULL, stat = "identity",
-    position = "identity", sides = "bl", ...)
+    position = "identity", sides = "bl",
+    rugwidth = unit(0.03, "npc"), ...)
 }
 \arguments{
   \item{sides}{A string that controls which sides of the
   plot the rugs appear on.  It can be set to a string
   containing any of \code{"trbl"}, for top, right, bottom,
   and left.}
 
+  \item{rugwidth}{The width the rug segments. This should
+  be a \code{\link{unit}} object.}
+
   \item{mapping}{The aesthetic mapping, usually constructed
   with \code{\link{aes}} or \code{\link{aes_string}}. Only
   needs to be set at the layer level if you are overriding