Plotting a colorful Venn Diagram with R

Update: the CRAN package now includes routines to plot intersections for 2-item and 4-item sets in addition to the 3-items sets. The user specifies the values and colors for each of the 15 intersections in a 4-item plot.

To find our more about the methods used to customize the colors for regions within the Venn Plot see

http://elliotnoma.wordpress.com/2013/03/15/the-geometry-of-a-colorful-venn-plot/

Colorful Venn Plot is now a package in CRAN, the Comprehensive R Archive Network:

http://cran.r-project.org/web/packages/colorfulVennPlot/index.html

Here is what the output would look like:

plotVenn <-
function(x, labels, shrink=1, Colors = c("red","yellow","orange","lightblue","purple","green","grey"))
{ # last modified 11/25/2010 by Elliot, 6/8/2011 Aliona
  # plot a Venn diagram
  # arguments: a vector of values (names indicate the overlap in base 2), 3 labels, colors for the 7 sections
  # the value for "000" is not plotted
  # y <- c(37,29,6,232,121,77,25)
  # names(y) <- c("001","010","011","100","101","110","111")
  # labels <- c("A","B","C")
  # plotVenn(y, labels, Colors=rainbow(7))

  library(grid)

  getArcEnds <- function(center1, center2, radius)
  {
    calcdist <- function(x,y) sqrt((x[1] - y[1])^2 + (x[2] - y[2])^2)
    calcangle <- function(x,y) atan((y[2] - x[2]) / (y[1] - x[1]))

    centerDistance <- calcdist(center1, center2)
    connector <- ifelse(center1[1] > center2[1], pi, 0) + calcangle(center1, center2)

    intersection <- acos((centerDistance / 2) / radius)

    c(begin=connector - intersection, end=connector + intersection)
  }

  arcPoints <- function(beginpt, endpt, center, radius)
  {
    angles <- seq(beginpt, endpt, length=nfacets)
    x <- center[1] + radius * cos(angles)
    y <- center[2] + radius * sin(angles)

    list(x=x,y=y)
  }

  getArc <- function(center1, center2, radius)
  {
    ends <- getArcEnds(center1, center2, radius)
    arcPoints(ends["begin"], ends["end"], center1, radius)
  }

  twoWayOverlap <- function(center1, center2, radius, color)
  {
    points1 <- getArc(center1, center2, radius)
    points2 <- getArc(center2, center1, radius)

    points <- list()
    points$x <- c(points1$x,points2$x)
    points$y <- c(points1$y,points2$y)

    points <- points

    grid.polygon(x=points$x, y=points$y, gp=gpar(fill=color))
  }

  centralArcs <- function(centers, i, radius)
  {
    if (i == 1) { j <- 2; k <- 3}
    if (i == 2) { j <- 1; k <- 3}
    if (i == 3) { j <- 2; k <- 1}
    endsone <- getArcEnds(centers[[i]], centers[[j]], radius)
    endstwo <- getArcEnds(centers[[i]], centers[[k]], radius)
    if (endsone[2] < 0) endsone <- endsone + 2 * pi
    if (endstwo[2] < 0) endstwo <- endstwo + 2 * pi
    if (endstwo[1] < endsone[1] & endsone[1] < endstwo[2]) {
      return (arcPoints(endsone[1], endstwo[2], centers[[i]], radius))
    } else {
      return (arcPoints(endstwo[1], endsone[2], centers[[i]], radius))
    }
  }

  fromBase2 <- function(x) 4 * as.numeric(substr(x,1,1)) + 2 * as.numeric(substr(x,2,2)) + as.numeric(substr(x,3,3))

  values <- rep(0, length(x))
  if (is.null(names(x))) 
    names(x) <- c("101","110","010","001","011","100","111")[seq(length(x))]
  valptr <- unlist(lapply(names(x), fromBase2))

  for (i in seq_along(x))
    if (valptr[i] %in% 1:7) values[valptr[i]] <- values[valptr[i]] + x[i]

  nfacets <- 300
  radius <- 0.25
  r0 <- .18
  dy <- r0 * sin(pi/6)
  dx <- r0 * cos(pi/6)
  labx0 <- .3
  labx1 <- 1.5
  labx2 <- .75
  centers <- list(c(0.5, 0.5 + r0),c(0.5 - dx, 0.5 - dy),c(0.5 + dx, 0.5 - dy))

  angle <- seq(0, 2*pi, length=nfacets) [-nfacets]
  grid.polygon(x=centers[[1]][1] + radius*cos(angle), y=centers[[1]][2] + radius*sin(angle), gp=gpar(fill=Colors[4]))
  grid.text(labels[1], 0.5, 0.5 + r0 + labx0, gp = gpar(fontsize=20*shrink, fontface="bold"))
  grid.polygon(x=centers[[2]][1] + radius*cos(angle), y=centers[[2]][2] + radius*sin(angle), gp=gpar(fill=Colors[2]))
  grid.text(labels[2], 0.5 - dx, 0.5 - dy - labx0, gp = gpar(fontsize=20*shrink, fontface="bold"))
  grid.polygon(x=centers[[3]][1] + radius*cos(angle), y=centers[[3]][2] + radius*sin(angle), gp=gpar(fill=Colors[1]))
  grid.text(labels[3], 0.5 + dx, 0.5 - dy - labx0, gp = gpar(fontsize=20*shrink, fontface="bold"))
  grid.text(values[4], 0.5, 0.5 + r0 * labx1)
  grid.text(values[2], 0.5 - dx * labx1, 0.5 - dy * labx1)
  grid.text(values[1], 0.5 + dx * labx1, 0.5 - dy * labx1)

  twoWayOverlap(centers[[1]], centers[[2]], radius, Colors[6])
  grid.text(values[6], 0.5 - dx * labx2, 0.5 + dy * labx2)
  twoWayOverlap(centers[[2]], centers[[3]], radius, Colors[3])
  grid.text(values[3], 0.5, 0.5 - r0 * labx2)
  twoWayOverlap(centers[[1]], centers[[3]], radius, Colors[5])
  grid.text(values[5], 0.5 + dx * labx2, 0.5 + dy * labx2)

  points1 <- centralArcs(centers, 1, radius)
  points2 <- centralArcs(centers, 2, radius)
  points3 <- centralArcs(centers, 3, radius)

  points <- list()
  points$x <- c(points1$x, points2$x, points3$x)
  points$y <- c(points1$y, points2$y, points3$y)

  grid.polygon(x=points$x, y=points$y, gp=gpar(fill=Colors[7]))

  grid.text(values[7], 0.5, 0.5)

}

#### TEST:
labels <- c("A", "B", "C")
y <- y1 <- seq(7)
names(y) <- c("001","010","011","100","101","110","111")
names(y1) <- names(y)[c(4:7,1:3)]
while (!is.null(dev.list())) dev.off()
plotVenn(y, labels)
dev.new()
plotVenn(y1, paste(labels, 1))
print(y)
print(y1)

About these ads