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 significantly larger project I'm working on that I can't discuss in detail, (b) which requires the use of ggplot, and (c) needs visual features of graphics similar to those reflected in the plot given, below.

Is it possible to recreate the following using ggplot2 either directly or with some fiddling with grid?

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

plot(x, y, axes=F, xlab="", ylab="")

axis(side = 1, at = round(mean(x), 2))
axis(side = 2, at = round(mean(y), 2))

axis(side = 3, at = round( range(x), 2 ))
axis(side = 4, at = round( range(y), 2 ))

rug(x, side=3)
rug(y, side=4)

---

Please see the solutions (Chase's, modified, and one based on Hadley's Geom code) posted below

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