Drawing nested venn diagrams

Question

I have data which contain binary indicators for two groups, and to more groups that are nested within one of the first two groups.

For example:

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 and b are the two groups and b.1 and b.2 are nested within group b.

What I'd like to do is draw one venn diagram of all groups. This means that b.1 and b.2 will be circumscribed within b, which will intersect a.

Is there any way to achieve this? Using a ggplot solution would be great.

Trying R's VennDiagram' only for groups b, b.1, and b.2 doesn't even work for me:

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

With the Vennerable package I get close only drawing the "b" groups:

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)

But when I add the a group it gets messed up:

Because what I really need is one circle for group a with an intersecting area with group b, and within the circle of group b are the circles of groups b.1 and b.2.

Answer 1

The main idea is to draw a triple Venn with a, b1, and b2, and then manually overlay an ellipse for 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)

Now we draw the ellipse and add the label. This requires a fair bit of trial and error to get the location, angle, and size right. As it is, it's not perfect, but it's almost there.

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

In your assumption, there are few patterns of circle locations. I think it would be better to make your function().

Here is my example (edited; change default 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)
}

preparation of data list:

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

use above function and draw the output:

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