Rysowanie zagnieżdżonych diagramów żył

Question

Mam dane, które zawierają binarne wskaźniki dla dwóch grup i dla większej liczby grup, które są zagnieżdżone w jednej z dwóch pierwszych grup.

Na przykład

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 i b są dwie grupy i b.1 i b.2 są zagnieżdżone grupy b.

Co chciałbym zrobić, to narysować jeden diagram Venna dla wszystkich grup. Oznacza to, że b.1 i b.2 zostaną ograniczone w ramach b, które będą przecinać się z a.

Czy jest jakiś sposób, aby to osiągnąć? Korzystanie z rozwiązania ggplot byłoby świetne.

Próbując R's VennDiagram "tylko do grupy B, B.1, B.2 i nawet nie dla mnie:

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

Z pakietem Vennerable I zbliżyć tylko rysowanie "B" grupy:

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) 

Ale kiedy dodać grupę a robi pomieszane:

Bo to, co naprawdę potrzebne jest jeden okrąg dla grupy a o powierzchni przecinającej z grupy b lub w kręgu grupy b są kręgi grupy b.1 i b.2.

Answer 1

Główną ideą jest zwrócenie potrójną Venn z a, b1 i b2, a następnie ręcznie nakładki elipsę dla 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) 

Teraz narysujemy elipsę i dodajemy etykietę. Wymaga to sporo prób i błędów, aby uzyskać właściwą lokalizację, kąt i rozmiar. W rzeczywistości nie jest doskonały, ale już prawie jest.

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

W swoim założeniu, istnieje kilka wzorów miejscach okręgu. Myślę, że byłoby lepiej zrobić twój function().

Oto mój przykład (edycja, zmiana domyślnego 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) 
} 

przygotowanie listy danych:

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 

stosowanie wyżej funkcji i narysować wyjście:

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