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

Question

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


# density plot for xvar
            upperp = 80   # upper cutoff
            lowerp = 30   # lower cutoff
            x <- myd$xvar
            plot(density(x))
            dens <- density(x)
            x11 <- min(which(dens$x <= lowerp))
            x12 <- max(which(dens$x <= lowerp))
            x21 <- min(which(dens$x > upperp))
            x22 <- max(which(dens$x > upperp))
            with(dens, polygon(x = c(x[c(x11, x11:x12, x12)]),
                y = c(0, y[x11:x12], 0), col = "green"))
             with(dens, polygon(x = c(x[c(x21, x21:x22, x22)]),
                y = c(0, y[x21:x22], 0), col = "red"))
            abline(v = c(mean(x)), lwd = 2, lty = 2, col = "red")
# density plot with yvar
    upperp = 70  # upper cutoff
    lowerp = 30   # lower cutoff
    x <- myd$yvar
    plot(density(x))
    dens <- density(x)
    x11 <- min(which(dens$x <= lowerp))
    x12 <- max(which(dens$x <= lowerp))
    x21 <- min(which(dens$x > upperp))
    x22 <- max(which(dens$x > upperp))
    with(dens, polygon(x = c(x[c(x11, x11:x12, x12)]),
        y = c(0, y[x11:x12], 0), col = "green"))
     with(dens, polygon(x = c(x[c(x21, x21:x22, x22)]),
        y = c(0, y[x21:x22], 0), col = "red"))
    abline(v = c(mean(x)), lwd = 2, lty = 2, col = "red")

I need to plot two way density plot, I am not sure there is better way than the following:

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

I want to combine all three types in to one (I did not know if I can create two-way plot in ggplot), there is not prefrence on whether the solution be plots are in ggplot or base or mixed. I hope this is doable project, considering robustness of R. I personally prefer ggplot2.

Note: the lower shading in this plot is not right, red should be always lower and green upper in xvar and yvar graphs, corresponding to shaded region in xy density plot.

Edit: Ultimate expectation on the graph (thanks seth and jon for very close answer) (1) removing space and axis tick labels etc to make it compact
(2) alignments of grids so that middle plot ticks and grids should align with side ticks and labels and size of plots look the same.

Answer 1

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)

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)

Answer 2

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

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

Answer 3

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

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.