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

前端 未结 2 1877
深忆病人
深忆病人 2021-02-10 05:27

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

2条回答
  •  庸人自扰
    2021-02-10 06:00

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

提交回复
热议问题