Can you easily plot rugs/axes on the top/right in ggplot2?

Question

The following example has no inherent meaning... it\'s just meant to demonstrate particular placement of labels, rugs, etc. and is representative of [edited] (a) a significan

Answer 1

I'll echo @Gavin's question, but for the sake of fiddling, this should get you pretty close:

qplot(x,y) + 
    geom_segment(data = data.frame(x), aes(x = x, y = max(x) - .05, xend = x, yend = max(x))) +         #x-rug
    geom_segment(data = data.frame(x), aes(x = min(x), y = max(x), xend = max(x), yend = max(x))) +     #x-rug
    geom_segment(data = data.frame(y), aes(x = max(x) + .05, y = y, xend = max(x), yend = y)) +         #y-rug
    geom_segment(data = data.frame(y), aes(x = max(x) + .05, y = min(y), xend = max(x) + .05, yend = max(y) )) + #y-rug
    scale_x_continuous(breaks = NA) +   
    scale_y_continuous(breaks = NA) +
    xlab(NULL) +
    ylab(NULL) +
    geom_text(aes(label = round(mean(x),2), x = mean(x), y = min(y) - .2), size = 4) +
    geom_text(aes(label = round(mean(y),2), x = min(x) - .2, y = mean(y)), size = 4) + 
    geom_text(aes(label = round(max(x),2), x = max(x) + .2, y = max(y) + .2), size = 4)
    #...add other text labels to your heart's desire.

If you don't need to put the rugs on the top and on the right, you can take advantage of geom_rug(). I don't know of an easy way to "move" the x or y axis away from their predefined locations. Something like this may be easier to digest / work with:

df <- data.frame(x,y)
qplot(x,y, data = df, geom = c("point", "rug")) # + ...any additional geom's here

Answer 2

Accepted Solutions

---

Chase's Answer (Modified)

Chase's answer had a few Xs and Ys out of place, causing the top/right axes to float unexpectedly... Here's an updated version of it:

xxx <- function(x, y) {

 p <- qplot(x,y) + 
    geom_segment(data     = data.frame(x), 
                 aes(x    = x, 
                     y    = max(y) + .05, 
                     xend = x, 
                     yend = max(y) + .1  )) +     #top-ticks

    geom_segment(data     = data.frame(x), 
                 aes(x    = min(x), 
                     y    = max(y) + .1, 
                     xend = max(x), 
                     yend = max(y) + .1  )) +     #top-axis

    geom_segment(data     = data.frame(y), 
                 aes(x    = max(x) + .1, 
                     y    = y, 
                     xend = max(x) + .05, 
                     yend = y)) +                #right-ticks

    geom_segment(data     = data.frame(y), 
                 aes(x    = max(x) + .1, 
                     y    = min(y), 
                     xend = max(x) + .1, 
                     yend = max(y)     )) +      #right-axis

    scale_x_continuous(breaks = NA) +   
    scale_y_continuous(breaks = NA) +
    xlab(NULL) +
    ylab(NULL) +
    geom_text(aes(label = round(mean(x), 2), 
                  x     = mean(x), 
                  y     = min(y) - .2), 
              size = 4) +

    geom_text(aes(label = round(mean(y), 2), 
                  x     = min(x) - .2, 
                  y     = mean(y)), 
              size = 4) + 

    geom_text(aes(label = round(max(y), 2), 
                  x     = max(x) + .5, 
                  y     = max(y) + .0),        
              size = 4) +                   #right-max

    geom_text(aes(label = round(min(y), 2), 
                  x     = max(x) + .5, 
                  y     = min(y) - .0),         
              size = 4) +                    #right-min

    geom_text(aes(label = round(max(x), 2), 
                  x     = max(x) + .0, 
                  y     = max(y) + .2),        
              size = 4) +                   #top-max

    geom_text(aes(label = round(min(x), 2), 
                  x     = min(x) + .0, 
                  y     = max(y) + .2),         
              size = 4)                     #top-min

}

x <- rnorm(20)
y <- rnorm(20)

(xxx(x, y))

---

Solution Based on Hadley's Code

See: https://github.com/hadley/ggplot2/wiki/Creating-a-new-geom

Beginning with Hadley's geom-rug.r, essentially, I've changed only the location of the rugs by tweaking these two (partial) lines:

From

         y0 = unit(0, "npc"), y1 = unit(0.03, "npc"),

to

         y0 = unit(1.02, "npc"), y1 = unit(1.05, "npc"),

and from

         x0 = unit(0, "npc"), x1 = unit(0.03, "npc"),

to

         x0 = unit(1.02, "npc"), x1 = unit(1.05, "npc"),

---

 library(ggplot2)

 GeomRugAlt <- proto(Geom, {
   draw <- function(., data, scales, coordinates, ...) {  
     rugs <- list()
     data <- coordinates$transform(data, scales)    
     if (!is.null(data$x)) {
       rugs$x <- with(data, segmentsGrob(
         x0 = unit(x, "native"), x1 = unit(x, "native"), 
         y0 = unit(1.02, "npc"), y1 = unit(1.05, "npc"),
         gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt)
       ))
     }  

     if (!is.null(data$y)) {
       rugs$y <- with(data, segmentsGrob(
         y0 = unit(y, "native"), y1 = unit(y, "native"), 
         x0 = unit(1.02, "npc"), x1 = unit(1.05), "npc"),
         gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt)
       ))
     }  

     gTree(children = do.call("gList", rugs))
   }

   objname <- "rug_alt"

   desc <- "Marginal rug plots"

   default_stat <- function(.) StatIdentity
   default_aes <- function(.) aes(colour="black", size=0.5, linetype=1, alpha = 1)
   guide_geom <- function(.) "path"

   examples <- function(.) {
     p <- ggplot(mtcars, aes(x=wt, y=mpg))
     p + geom_point()
     p + geom_point() + geom_rug_alt()
     p + geom_point() + geom_rug_alt(position='jitter')
   }


 })

 geom_rug_alt <- GeomRugAlt$build_accessor()

 x <- rnorm(20)
 y <- rnorm(20)

 p <- qplot(x,y)
 p
 p + geom_rug() + geom_rug_alt()