two-way density plot combined with one way density plot with selected regions in r

后端 未结 3 1631
后悔当初
后悔当初 2020-12-02 07:02
# data 
set.seed (123)
xvar <- c(rnorm (1000, 50, 30), rnorm (1000, 40, 10), rnorm (1000, 70, 10))
yvar <-   xvar + rnorm (length (xvar), 0, 20)
myd <- data         


        
相关标签:
3条回答
  • 2020-12-02 07:10

    Building on Seth's answer (thank you Seth, and you deserve all credits), I improved some of issues raised by the questioner. As comments is too short to answer all issues I choose to use this as answer itself. A couple of issues are still there, need your help:

    # data
    set.seed (123)
    xvar <- c(rnorm (1000, 50, 30), rnorm (1000, 40, 10), rnorm (1000, 70, 10))
    yvar <-   xvar + rnorm (length (xvar), 0, 20)
    myd <- data.frame (xvar, yvar)
    
    require(ggplot2)
    
    # density plot for xvar
    upperp = 80   # upper cutoff
    lowerp = 30
    

    middle figure

     g=ggplot(myd,aes(x=xvar,y=yvar))+
        stat_density2d(aes(fill=..level..), geom="polygon") +
        scale_fill_gradient(low="blue", high="green") + 
      scale_x_continuous(limits = c(0, 110)) + 
       scale_y_continuous(limits = c(0, 110)) + theme_bw()
    

    geom_rect two regions

    gbig=g+ geom_rect(data=myd, aes(  NULL,  NULL, xmin=0,  
    xmax=lowerp,ymin=0, ymax=20), fill='red', alpha=.0051,inherit.aes=F)+ 
    geom_rect(aes(NULL,  NULL,   xmin=upperp,            xmax=110, 
     ymin=upperp,            ymax=110),            fill='green',            
      alpha=.0051,
                inherit.aes=F)+   
      opts(legend.position = "none", 
      plot.margin = unit(rep(0, 4), "lines"))
    

    Top histogram with shaded region

        x.dens <- density(myd$xvar)
        df.dens <- data.frame(x = x.dens$x, y = x.dens$y)
    
       dens_top <- ggplot()+geom_density(aes(myd$xvar, y = ..density..))
    + scale_x_continuous(limits = c(0, 110)) +
    geom_area(data = subset(df.dens, x <= lowerp), aes(x=x,y=y), fill = 'red') 
     +  geom_area(data = subset(df.dens, x >= upperp), aes(x=x,y=y), fill = 'green') 
     +    opts (axis.text.x=theme_blank(), axis.title.x=theme_blank(), 
      plot.margin = unit(rep(0, 4), "lines")) + xlab ("") + ylab ("") +  theme_bw()
    

    right histogram with shaded region

       y.dens <- density(myd$yvar)
        df.dens.y <- data.frame(x = y.dens$x, y = y.dens$y)
    
        dens_right <- ggplot()+geom_density(aes(myd$yvar, y = ..density..))
       + scale_x_continuous(limits = c(0, 110)) +
      geom_area(data = subset(df.dens.y, x <= lowerp), aes(x=x,y=y), 
      fill = 'red') 
      +  geom_area(data = subset(df.dens.y, x >= upperp), aes(x=x,y=y), 
      fill = 'green')
        +      coord_flip() + 
    
    
    opts (axis.text.x=theme_blank(), axis.title.x=theme_blank(), 
       plot.margin = unit(rep(0, 4), "lines")) + xlab ("") + ylab ("") 
       +  theme_bw()
    

    Make an empty graph to fill in the corner

           empty <- ggplot()+geom_point(aes(1,1), colour="white")+ 
           scale_x_continuous(breaks = NA) + scale_y_continuous(breaks = NA) +
                  opts(axis.ticks=theme_blank(),
                       panel.background=theme_blank(),
                       axis.text.x=theme_blank(),
                       axis.text.y=theme_blank(),
                       axis.title.x=theme_blank(),
                       axis.title.y=theme_blank())
    

    Then use the grid.arrange function:

    library(gridExtra)
     grid.arrange(dens_top, empty , gbig, dens_right, ncol=2,nrow=2,
     widths=c(2, 1), heights=c(1, 2))
    

    enter image description here

    PS: (1) Can somebody help to align the graphs perfectly ? (2) Can someone help to remove the additional space between plots, I tried adjust margins - but there is space between x and y density plot and central plot.

    0 讨论(0)
  • Here is the example for combining multiple plots with alignment:

    library(ggplot2)
    library(grid)
    
    set.seed (123)
    xvar <- c(rnorm (100, 50, 30), rnorm (100, 40, 10), rnorm (100, 70, 10))
    yvar <-   xvar + rnorm (length (xvar), 0, 20)
    myd <- data.frame (xvar, yvar)
    
    p1 <- ggplot(myd,aes(x=xvar,y=yvar))+
      stat_density2d(aes(fill=..level..), geom="polygon") +
      coord_cartesian(c(0, 150), c(0, 150)) +
      opts(legend.position = "none")
    
    p2 <- ggplot(myd, aes(x = xvar)) + stat_density() +
      coord_cartesian(c(0, 150))
    p3 <- ggplot(myd, aes(x = yvar)) + stat_density() + 
      coord_flip(c(0, 150))
    
    gt <- ggplot_gtable(ggplot_build(p1))
    gt2 <- ggplot_gtable(ggplot_build(p2))
    gt3 <- ggplot_gtable(ggplot_build(p3))
    
    gt1 <- ggplot2:::gtable_add_cols(gt, unit(0.3, "null"), pos = -1)
    gt1 <- ggplot2:::gtable_add_rows(gt1, unit(0.3, "null"), pos = 0)
    
    gt1 <- ggplot2:::gtable_add_grob(gt1, gt2$grobs[[which(gt2$layout$name == "panel")]],
                                      1, 4, 1, 4)
    gt1 <- ggplot2:::gtable_add_grob(gt1, gt2$grobs[[which(gt2$layout$name == "axis-l")]],
                                     1, 3, 1, 3, clip = "off")
    
    gt1 <- ggplot2:::gtable_add_grob(gt1, gt3$grobs[[which(gt3$layout$name == "panel")]],
                                     4, 6, 4, 6)
    gt1 <- ggplot2:::gtable_add_grob(gt1, gt3$grobs[[which(gt3$layout$name == "axis-b")]],
                                     5, 6, 5, 6, clip = "off")
    grid.newpage()
    grid.draw(gt1)
    

    enter image description here

    note that this works with gglot2 0.9.1, and in the future release you may do it more easily.

    And finally

    you can do that by:

    library(ggplot2)
    library(grid)
    
    set.seed (123)
    xvar <- c(rnorm (100, 50, 30), rnorm (100, 40, 10), rnorm (100, 70, 10))
    yvar <-   xvar + rnorm (length (xvar), 0, 20)
    myd <- data.frame (xvar, yvar)
    
    p1 <- ggplot(myd,aes(x=xvar,y=yvar))+
      stat_density2d(aes(fill=..level..), geom="polygon") +
      geom_polygon(aes(x, y), 
                   data.frame(x = c(-Inf, -Inf, 30, 30), y = c(-Inf, 30, 30, -Inf)),
                   alpha = 0.5, colour = NA, fill = "red") +
      geom_polygon(aes(x, y), 
                   data.frame(x = c(Inf, Inf, 80, 80), y = c(Inf, 80, 80, Inf)),
                   alpha = 0.5, colour = NA, fill = "green") +
      coord_cartesian(c(0, 120), c(0, 120)) +
      opts(legend.position = "none")
    
    xd <- data.frame(density(myd$xvar)[c("x", "y")])
    p2 <- ggplot(xd, aes(x, y)) + 
      geom_area(data = subset(xd, x < 30), fill = "red") +
      geom_area(data = subset(xd, x > 80), fill = "green") +
      geom_line() +
      coord_cartesian(c(0, 120))
    
    yd <- data.frame(density(myd$yvar)[c("x", "y")])
    p3 <- ggplot(yd, aes(x, y)) + 
      geom_area(data = subset(yd, x < 30), fill = "red") +
      geom_area(data = subset(yd, x > 80), fill = "green") +
      geom_line() +
      coord_flip(c(0, 120))
    
    gt <- ggplot_gtable(ggplot_build(p1))
    gt2 <- ggplot_gtable(ggplot_build(p2))
    gt3 <- ggplot_gtable(ggplot_build(p3))
    
    gt1 <- ggplot2:::gtable_add_cols(gt, unit(0.3, "null"), pos = -1)
    gt1 <- ggplot2:::gtable_add_rows(gt1, unit(0.3, "null"), pos = 0)
    
    gt1 <- ggplot2:::gtable_add_grob(gt1, gt2$grobs[[which(gt2$layout$name == "panel")]],
                                      1, 4, 1, 4)
    gt1 <- ggplot2:::gtable_add_grob(gt1, gt2$grobs[[which(gt2$layout$name == "axis-l")]],
                                     1, 3, 1, 3, clip = "off")
    
    gt1 <- ggplot2:::gtable_add_grob(gt1, gt3$grobs[[which(gt3$layout$name == "panel")]],
                                     4, 6, 4, 6)
    gt1 <- ggplot2:::gtable_add_grob(gt1, gt3$grobs[[which(gt3$layout$name == "axis-b")]],
                                     5, 6, 5, 6, clip = "off")
    grid.newpage()
    grid.draw(gt1)
    

    enter image description here

    0 讨论(0)
  • 2020-12-02 07:26

    As in the example I linked to above you need the gridExtra package. This is the g you gave.

    g=ggplot(myd,aes(x=xvar,y=yvar))+
        stat_density2d(aes(fill=..level..), geom="polygon") +
        scale_fill_gradient(low="blue", high="green") + theme_bw()
    

    use geom_rect to draw the two regions

    gbig=g+geom_rect(data=myd,
            aes(  NULL,
                NULL,
                xmin=0,
                xmax=lowerp,
                ymin=-10,
                ymax=20),
            fill='red',
            alpha=.0051,
            inherit.aes=F)+
      geom_rect(aes(    NULL,
                NULL,
                xmin=upperp,
                xmax=100,
                ymin=upperp,
                ymax=130),
                fill='green',
                alpha=.0051,
                inherit.aes=F)+
      opts(legend.position = "none") 
    

    This is a simple ggplot histogram; it lacks your colored regions, but they are pretty easy

      dens_top <- ggplot()+geom_density(aes(x))
      dens_right <- ggplot()+geom_density(aes(x))+coord_flip()
    

    Make an empty graph to fill in the corner

      empty <- ggplot()+geom_point(aes(1,1), colour="white")+
                  opts(axis.ticks=theme_blank(), 
                       panel.background=theme_blank(), 
                       axis.text.x=theme_blank(), 
                       axis.text.y=theme_blank(),           
                       axis.title.x=theme_blank(), 
                       axis.title.y=theme_blank())
    

    Then use the grid.arrange function:

    library(gridExtra)
    
    grid.arrange(dens_top,     empty     , 
                 gbig,         dens_right, 
                     ncol=2, 
                     nrow=2, 
                     widths=c(4, 1), 
                     heights=c(1, 4))
    

    enter image description here

    Not very pretty but the idea is there. You will have to make sure the scales match too!

    0 讨论(0)
提交回复
热议问题