双向密度图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") 

我需要绘制双向密度的情节，我不知道还有比下面的更好的办法：

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密度图。

编辑：上图（感谢赛斯和Jon非常接近的答案）：终极期望 （1）去除空间和轴刻度标签等，使其紧凑
（2）电网的比对，使中间地块蜱和栅格应该与侧蜱和标签对齐，并且情节的大小看起来相同。

Answer 1

这里是多条曲线与比对相结合的例子：

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) 

注意这与gglot2 0.9.1，并在未来的版本中，您可以更轻松地做到这一点。

最后

，你可以做到这一点：

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

正如在上面链接的例子中，您需要gridExtra包。 这是你给的g。

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

使用geom_rect绘制两个区域

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

这是一个简单ggplot直方图;它缺少你的颜色区域， 但他们很容易

dens_top <- ggplot()+geom_density(aes(x)) 
    dens_right <- ggplot()+geom_density(aes(x))+coord_flip() 

做一个空图，填补了角落

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

然后使用grid.arrange功能：

library(gridExtra) 

grid.arrange(dens_top,  empty  , 
      gbig,   dens_right, 
       ncol=2, 
       nrow=2, 
       widths=c(4, 1), 
       heights=c(1, 4)) 

不是很漂亮，但有想法。 你必须确保秤匹配！

Answer 3

基于塞思的回答（感谢塞思，你应得的所有学分），我改进了提问者提出的一些问题。由于意见太短，无法回答所有问题，所以我选择将其作为答案本身。一对夫妇的问题仍然存在，需要你的帮助：

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

geom_rect两个地区

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

然后使用grid.arrange功能：

library(gridExtra) 
grid.arrange(dens_top, empty , gbig, dens_right, ncol=2,nrow=2, 
widths=c(2, 1), heights=c(1, 2)) 

PS：（1）有人可以帮助完美对齐图表吗？ （2）有人可以帮助删除地块之间的额外空间，我尝试调整边距 - 但是x和y密度图和中心图之间存在空间。