使用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密度图中的阴影区域。

编辑：图表的最终期望（感谢seth和jon提供非常接近的答案） （1）去除空格和轴刻度标签等，使其紧凑 （2）网格的对齐，使中间图的刻度和网格与侧面的刻度和标签对齐，并且图形的大小看起来相同。

- SHRram

---

这里的回答可能有助于使用ggplot绘制密度图和散点图：https://dev59.com/J2oy5IYBdhLWcg3wcNvh - Seth

你的问题非常启发人，我想知道你是否能分享一下最终的代码，以便能够在你的帖子中绘制出图形？非常感谢。 - Yang Yang

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)

- kohske

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

虽然不太美观，但思路已经在那里。 你需要确保比例尺也匹配！

- Seth

---

感谢您的回答，Seth。这确实是一个进步...我可能仍然需要在边缘密度图中阴影区域（红色和绿色）和显示平均线方面进行改进。此外，删除密度图中的x轴标签并使图形紧凑。 - SHRram

最重要的是所有图表中的xvar和yvar比例尺需要匹配。 - SHRram

这个问题是关于设置限制的。https://dev59.com/mXA65IYBdhLWcg3w1SXU - Seth

Answer 3

在Seth的回答基础上（感谢Seth，你应该得到所有的荣誉），我改进了一些问题。由于评论太短无法回答所有问题，所以我选择将其作为答案。 还有一些问题需要你的帮助：

# 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密度图以及中央图之间存在空间。

- jon

---

谢谢，似乎填充区域和密度线之间存在一些差距，是否有改进的方法？ - SHRram