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)