绘制嵌套维恩图答案

【问题标题】：Drawing nested venn diagrams绘制嵌套维恩图
【发布时间】：2016-07-31 00:26:27
【问题描述】：

我的数据包含两个组的二进制指标，以及嵌套在前两个组之一中的更多组。

例如：

set.seed(1)
df <- data.frame(a=rep(0,10),b=rep(0,10),b.1=rep(0,10),b.2=rep(0,10))
df$a[sample(10,5,replace=F)] <- 1
df$b[sample(10,5,replace=F)] <- 1
df$b.1[sample(which(df$b==1),3,replace=F)] <- 1
df$b.2[sample(which(df$b==1),3,replace=F)] <- 1
df <- df[which(rowSums(df)==0),]

a 和 b 是两个组，b.1 和 b.2 嵌套在组 b 中。

我想做的是绘制所有组的维恩图。这意味着b.1 和b.2 将被限制在b 内，这将与a 相交。

有什么方法可以实现吗？使用ggplot 解决方案会很棒。

仅对 b、b.1 和 b.2 组尝试 R's VennDiagram' 甚至对我都不起作用：

library(VennDiagram)
draw.triple.venn(area1=sum(df$b),area2=sum(df$b.1),area3=sum(df$b.2),
                   n12=sum(df$b*df$b.1),n23=sum(df$b.1*df$b.2),n13=sum(df$b*df$b.2),n123=sum(df$b*df$b.1*df$b.2),
                   category=c("b","b1","b2"))

使用Vennerable 包，我只画了“b”组：

library(Vennerable)
plot(Venn(Sets=list(b=which(df$b==1),b.1=which(df$b.1==1),b.2=which(df$b.2==1))),doEuler=T,doWeight=T)

但是当我添加 a 组时，它就搞砸了：

因为我真正需要的是a 组的一个圆圈，与b 组有一个相交区域，b 组的圆圈内是b.1 和b.2 组的圆圈。

【问题讨论】：

我发现代码有点小错误。我认为df <- df[-which(rowSums(df)==0),] 是您想要的（第一个代码块的最后一行）。

标签： r ggplot2 nested venn-diagram

【解决方案1】：

主要思想是用a、b1和b2绘制一个三元维恩，然后手动为b覆盖一个椭圆。

library(VennDiagram)
library(gridExtra)
polygons <- draw.triple.venn(
    area1=sum(df$a),
    area2=sum(df$b.1),
    area3=sum(df$b.2),
    n12=sum(df$a*df$b.1),
    n23=sum(df$b.1*df$b.2),
    n13=sum(df$a*df$b.2),
    n123=sum(df$a*df$b.1*df$b.2),
    category=c("a","b1","b2"),
    margin=.1)

现在我们绘制椭圆并添加标签。这需要大量的试验和错误才能获得正确的位置、角度和尺寸。事实上，它并不完美，但它几乎就在那里。

b <- ellipseGrob(
    x=unit(0.562,"npc"),
    y=unit(0.515,"npc"),
    angle=(1.996*pi)/3,
    size=65.5, ar=2, gp=gpar(lwd=2.2))
grid.draw(b)
grid.text("b", x=unit(.9,"npc"), y=unit(.9,"npc"), gp=gpar(fontfamily="serif"))

【讨论】：

【解决方案2】：

在您的假设中，圆圈位置的模式很少。我认为最好让你的function()。

这是我的示例（已编辑；更改默认 vp）：

nest_venn <- function(data_list, fill = c(2, 4, 5, 6), alpha = 0.15, 
                      vp = viewport(height=unit(1 ,"snpc"), width=unit(1,"snpc"))) {
  counts <- get.venn.partitions(data_list)$..count..      # calculation of each area's value
  if(any(counts[c(3, 4, 7, 8, 11, 12)]==!0)) warning("data_list[[3]] and/or data_list[[4]] isn't nested")
  grobs <- grobTree(
    circleGrob(x = 0.33, y = 0.5, r = 0.3, gp = gpar(fill = alpha(fill[1], alpha), col=8, lwd = 2)),  # a circle
    circleGrob(x = 0.67, y = 0.5, r = 0.3, gp = gpar(fill = alpha(fill[2], alpha), col=8, lwd = 2)),  # b circle
    circleGrob(x = 0.67, y = 0.6, r = 0.16, gp = gpar(fill = alpha(fill[3], alpha), col=8, lwd = 2)), # b.1 circle
    circleGrob(x = 0.67, y = 0.4, r = 0.16, gp = gpar(fill = alpha(fill[4], alpha), col=8, lwd = 2)), # b.2 circle
    textGrob(names(data_list)[1], x = 0.33, y = 0.82, gp = gpar(cex = 1, fontface = 4)), # a label
    textGrob(names(data_list)[2], x = 0.67, y = 0.82, gp = gpar(cex = 1, fontface = 4)), # b label
    textGrob(names(data_list)[3], x = 0.83, y = 0.7, gp = gpar(cex = 1, fontface = 4)),  # b.1 label
    textGrob(names(data_list)[4], x = 0.83, y = 0.3, gp = gpar(cex = 1, fontface = 4)),  # b.2 label
    textGrob(counts[15], x = 0.28, y = 0.5, gp = gpar(cex = 1.2)),  # a
    textGrob(counts[14], x = 0.9, y = 0.5, gp = gpar(cex = 1.2)),   #     b
    textGrob(counts[13], x = 0.47, y = 0.5, gp = gpar(cex = 1.2)),  # a & b
    textGrob(counts[10], x = 0.68, y = 0.65, gp = gpar(cex = 1.2)), #     b & b.1
    textGrob(counts[6], x = 0.68, y = 0.35, gp = gpar(cex = 1.2)),  #     b       & b.2
    textGrob(counts[9], x = 0.57, y = 0.6, gp = gpar(cex = 1.2)),   # a & b & b.1
    textGrob(counts[5], x = 0.57, y = 0.4, gp = gpar(cex = 1.2)),   # a & b       & b.2
    textGrob(counts[2], x = 0.69, y = 0.5, gp = gpar(cex = 1.2)),   #     b & b.1 & b.2
    textGrob(counts[1], x = 0.6, y = 0.5, gp = gpar(cex = 1.2)),    # a & b & b.1 & b.2
    vp = vp)
  return(grobs)
}

数据清单的准备：

set.seed(1)
df <- data.frame(a=rep(0,10),b=rep(0,10),b.1=rep(0,10),b.2=rep(0,10))
df$a[sample(10,5,replace=F)] <- 1
df$b[sample(10,5,replace=F)] <- 1
df$b.1[sample(which(df$b==1),3,replace=F)] <- 1
df$b.2[sample(which(df$b==1),3,replace=F)] <- 1
df <- df[-which(rowSums(df)==0),]            # the same as OP's example data

data_list <- list()
for(i in colnames(df)) data_list[[i]] <- which(df[,i]==1)
  # > data_list[1]
  # $a
  # [1] 2 3 4 5 7

使用上述函数并绘制输出：

library(VennDiagram); library(grid); library(ggplot2)

nestvenn.obj <- nest_venn(data_list)
grid.newpage()
grid.draw(nestvenn.obj)

# [ edited ]
# If you want a fixed size etc, please give an argument, vp.
vp1 <- viewport(height=unit(150 ,"mm"), width=unit(150, "mm")) # example
nestvenn.obj <- nest_venn(data_list, vp = vp1)
grid.newpage()

# an example with ggplot
library(gtable); library(dplyr)

grid.newpage()
ggplot(data.frame(x=1, y=1), aes(x, y)) %>% ggplotGrob() %>% 
  gtable_filter("panel") %>% gList(nestvenn.obj) %>% grid.draw()

【讨论】：