Vẽ sơ đồ venn lồng nhau

Question

Tôi có dữ liệu chứa các chỉ số nhị phân cho hai nhóm và cho nhiều nhóm được lồng trong một trong hai nhóm đầu tiên.

Ví dụ:

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 và b là hai nhóm và b.1 và b.2 được lồng trong nhóm b.

Điều tôi muốn làm là vẽ một sơ đồ venn của tất cả các nhóm. Điều này có nghĩa là b.1 và b.2 sẽ bị ngắt trong phạm vi b, sẽ giao cắt a.

Có cách nào để đạt được điều này không? Sử dụng giải pháp ggplot sẽ tuyệt vời.

Cố R's VennDiagram 'chỉ dành cho nhóm b, b.1 và b.2 thậm chí không làm việc cho tôi:

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

Với Vennerable gói tôi nhận được gần chỉ vẽ "b" nhóm:

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) 

Nhưng khi tôi thêm nhóm a nó được điều sai lầm:

Bởi vì những gì tôi thực sự cần là một vòng tròn cho nhóm a với diện tích giao nhau với nhóm b, và trong vòng tròn của nhóm b là các vòng tròn của nhóm b.1 và b.2.

Answer 1

Ý tưởng chính là vẽ một Venn ba với a, b1 và b2 và sau đó phủ một hình elip theo cách thủ công cho 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ây giờ, chúng tôi vẽ hình elip và thêm nhãn. Điều này đòi hỏi một chút công bằng của thử nghiệm và lỗi để có được vị trí, góc độ và kích thước phù hợp. Vì nó là, nó không hoàn hảo, nhưng nó gần như ở đó.

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

Answer 2

Trong giả định của bạn, có vài mẫu các địa điểm vòng tròn. Tôi nghĩ sẽ tốt hơn nếu bạn làm function().

Dưới đây là ví dụ của tôi (thay đổi nội dung, thay đổi mặc định 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) 
} 

chuẩn bị danh sách dữ liệu:

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 

sử dụng trên chức năng và vẽ đầu ra:

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