在r中选择区域的双向密度图与单向密度图相结合
我想将所有三种类型合并为一种(我不知道是否可以在ggplot中创建双向绘图),对于解决方案be绘图是在ggplot中还是在base中或混合中没有优先权。考虑到R的健壮性,我希望这是一个可行的项目。我个人更喜欢ggplot2 注:此图中的下部阴影不正确,在xvar和yvar图中,红色应始终较低,绿色应始终较高,对应于xy密度图中的阴影区域 编辑:图表上的最终预期(感谢赛斯和乔恩给出了非常接近的答案) (1) 删除空间和轴刻度标签等以使其紧凑在r中选择区域的双向密度图与单向密度图相结合,r,graph,ggplot2,kernel-density,R,Graph,Ggplot2,Kernel Density,我想将所有三种类型合并为一种(我不知道是否可以在ggplot中创建双向绘图),对于解决方案be绘图是在ggplot中还是在base中或混合中没有优先权。考虑到R的健壮性,我希望这是一个可行的项目。我个人更喜欢ggplot2 注:此图中的下部阴影不正确,在xvar和yvar图中,红色应始终较低,绿色应始终较高,对应于xy密度图中的阴影区域 编辑:图表上的最终预期(感谢赛斯和乔恩给出了非常接近的答案) (1) 删除空间和轴刻度标签等以使其紧凑 (2) 对齐轴网,以便中间的打印记号和轴网应与侧面记号
(2) 对齐轴网,以便中间的打印记号和轴网应与侧面记号和标签对齐,并且打印的大小看起来相同。
如我上面链接的示例所示,您需要gridExtra包。 这是你给的g 使用geom_rect绘制两个区域
g=ggplot(myd,aes(x=xvar,y=yvar))+
stat_density2d(aes(fill=..level..), geom="polygon") +
scale_fill_gradient(low="blue", high="green") + theme_bw()
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()
这是一个简单的ggplot直方图;它缺少你的彩色区域,
但它们很简单
不是很漂亮,但想法是有的。
你必须确保天平也匹配 在赛斯回答的基础上(谢谢赛斯,你应该得到所有的学分),我改进了提问者提出的一些问题。由于评论太短,无法回答所有问题,我选择将其作为答案仍存在一些问题,需要您的帮助:
library(gridExtra)
grid.arrange(dens_top, empty ,
gbig, dens_right,
ncol=2,
nrow=2,
widths=c(4, 1),
heights=c(1, 4))
几何矩形两个区域
g=ggplot(myd,aes(x=xvar,y=yvar))+
stat_density2d(aes(fill=..level..), geom="polygon") +
scale_fill_gradient(low="blue", high="green") + theme_bw()
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()
带阴影区域的顶部直方图
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"))
PS:(1)有人能帮你把这些图表完美地对齐吗?(2) 有人能帮我去掉绘图之间的额外空间吗?我试过调整边距,但x和y密度绘图和中心绘图之间有空间。以下是将多个绘图与对齐组合的示例:
library(gridExtra)
grid.arrange(dens_top, empty , gbig, dens_right, ncol=2,nrow=2,
widths=c(2, 1), heights=c(1, 2))
库(ggplot2)
图书馆(网格)
种子集(123)
xvar这里的答案可能有助于通过ggplot获得密度。您的问题非常令人鼓舞,我想知道您是否可以在您的帖子中分享能够绘制该图的最终代码?非常感谢。感谢赛斯的回答,这确实是向前迈进了一步……我可能还需要在maringal密度图(红色和绿色)中对区域进行着色,并显示平均线。同时,删除密度图中的x轴lebel并使图紧凑。最重要的是所有图中的比例xvar和yvar需要匹配…这个问题是关于设置限制的。谢谢,填充区域和密度线之间似乎存在差距,是否有任何改进方法?
# 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
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()
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"))
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()
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()
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())
library(gridExtra)
grid.arrange(dens_top, empty , gbig, dens_right, ncol=2,nrow=2,
widths=c(2, 1), heights=c(1, 2))
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)
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)