two-way density plot combined with one way density plot with selected regions in r
ggplot2, graph, kernel-density, r
Solution
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)
Problem
``` # 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.