双向密度图与r中选定区域的单向密度图相结合 [英] two-way density plot combined with one way density plot with selected regions in r
本文介绍了双向密度图与r中选定区域的单向密度图相结合的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！
问题描述
＃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）
＃xvar密度图
upperp = 80＃上限截止点
lowerp = 30＃下限截止点
x < - myd $ xvar
图（密度（x））
密度< - 密度（x）
x11 < - min（其中（密度（x）≤x≤p≤b） （dens $ x< lowerp））
x21< - min（其中（dens $ x> upperp））
x22< -max（其中（dens $ x> upperp））
with（dens，polygon（x = c（x [c（x11，x11：x12，x12）]），
y = c（0，y [x11：x12]，0），col = （x，c [x（x21，x21，x22，x22）]），
y = c（0，y [x21：x22]，green））
。 0），col =red））
abline（v = c（mean（x）），lwd = 2，l ty = 2，col =red）
＃yvar的密度图
upperp = 70＃上限值
lowerp = 30＃下限值
x< - myd $ yvar
plot（density（x））
dens < - density（x）
x11 < - min（其中（$ x <= lowerp））
x12< （其中（密码$ x <= lowerp））
x21 < - min（其中（密码$ x> （dens，polygon）（x = c（x [c（x11，x11：x12，x12）]）的
x22 < - max（其中（dens $ x> upperp））
），
y = c（0，y [x11：x12]，0），col =green））
with（dens，polygon（x = c（x [c（x21，x21： （x，x22，x22）]），
y = c（0，y [x21：x22]，0），col =red））
abline（v = c（mean（x）），lwd = 2，lty = 2，col =red）
我需要绘制双向密度图，我不确定是否有比以下更好的方法：
ggplot（myd，aes（x = xvar，y = yvar ））+
stat_density2d（aes（fill = .. level ..），geom =polygon）+
scale_fill_gradient（low =blue，high =green）+ theme_bw（）
我想将所有三种类型合并为一个（我不知道是否可以创建双向在ggplot中绘图），解决方案的绘图是以ggplot还是base还是混合绘制是没有意义的。我希望这是可行的项目，考虑R的鲁棒性。我个人比较喜欢ggplot2。
注意：此图中较低的阴影不正确，在xvar和yvar图中红色应始终低于和高于绿色，对应于xy密度图中的阴影区域。
编辑：对图表的最终期望（感谢seth和jon的非常接近的答案）
（1）删除空间和坐标轴剔标签等，使其紧凑
（2）网格的对齐，以便中间剧情蜱和网格应与边蜱和标签和标签的大小一致。
解决方案
下面是组合多个图和对齐的示例：
library（ggplot2）$ b （rnorm（100,50,30），rnorm（100,40,10），rnorm（rnorm（100，50，30）），
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 =（x，yvar））+ stat_density（）+
coord_cartesian coord_flip（c（0,150））
$ b $ gt gt <-ggplot_gtable（ggplot_build（p1））
gt2 < - ggplot_gtable（ggplot_build（p2））
gt3 < - ggplot_gtable（ggplot_build（p3） ）
gt1 < - ggplot2 ::: gtable_add_cols（gt，单元（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 [[其中（gt2 $ layout $ name ==axis- l）]]，
1，3，1，3，clip =off）
gt1 < - ggplot2 ::: gtable_add_grob（gt1，gt3 $ grobs [[ （gt3 $ layout $ name ==panel）]]，
4，6，4，6）
gt1 < - ggplot2 ::: gtable_add_grob（gt1，gt3 $ grobs [[ gt3 $ layout $ name ==axis-b）]]，
5，6，5，6，clip =off）
grid.newpage（）
grid.draw （gt1）
请注意，这适用于gglot2 0.9.1，并且在未来的版本可能会更简单。
最后
你可以通过以下方式实现：
库（ggplot2）
库（网格）
集合。种子（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，color = 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，color = NA，fill =green）+
coord_cartesian（c（0，120），c（0，120））+
opts（legend.position =无）
xd < - data.frame（密度（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> （g1），ggplot_build（p1）; 80），fill =green）+
geom_line（）+
coord_flip（c（0,120））
$ b $ gtggplot_gtable ）
gt2< - ggplot_gtable（ggplot_build（p2））
gt3< - ggplot_gtable（ggplot_build（p3））
gt1< - ggplot2 ::: gtable_add_cols（gt ，单位（0.3，null），pos = -1）
gt1 < - ggplot2 ::: gtable_add_rows（gt1，单位（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 [[其中（gt3 $ layout $ name ==axis- b））]]，
5，6，5，6，clip =off）
grid.newpage（）
grid.draw（gt1）
# 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.
解决方案
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)
这篇关于双向密度图与r中选定区域的单向密度图相结合的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
查看全文
