#' venndiagram2()
#'
#' modified VennDiagram::venn.diagram() function (see \code{\link[VennDiagram]{venn.diagram}})
#'
#' @note
#' must load library("VennDiagram")
#' @return a venn diagram
#' @export
#
# modified so that it won't output log 2016-02-25
#
#
#
# The VennDiagram package is copyright (c) 2012 Ontario Institute for Cancer Research (OICR)
# This package and its accompanying libraries is free software; you can redistribute it and/or modify it under the terms of the GPL
# (either version 1, or at your option, any later version) or the Artistic License 2.0. Refer to LICENSE for the full license text.
# OICR makes no representations whatsoever as to the SOFTWARE contained herein. It is experimental in nature and is provided WITHOUT
# WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE OR ANY OTHER WARRANTY, EXPRESS OR IMPLIED. OICR MAKES NO REPRESENTATION
# OR WARRANTY THAT THE USE OF THIS SOFTWARE WILL NOT INFRINGE ANY PATENT OR OTHER PROPRIETARY RIGHT.
# By downloading this SOFTWARE, your Institution hereby indemnifies OICR against any loss, claim, damage or liability, of whatsoever kind or
# nature, which may arise from your Institution's respective use, handling or storage of the SOFTWARE.
# If publications result from research using this SOFTWARE, we ask that the Ontario Institute for Cancer Research be acknowledged and/or
# credit be given to OICR scientists, as scientifically appropriate.
### UMBRELLA FUNCTION TO DRAW VENN DIAGRAMS #######################################################
venn.diagram2 <- function(
x,
filename,
height = 3000,
width = 3000,
resolution = 500,
imagetype = 'png',
units = 'px',
compression = 'lzw',
na = 'stop',
main = NULL,
sub = NULL,
main.pos = c(0.5, 1.05),
main.fontface = 'plain',
main.fontfamily = 'Arial',
main.col = 'black',
main.cex = 1.5,
main.just = c(0.5, 1),
sub.pos = c(0.5, 1.05),
sub.fontface = 'plain',
sub.fontfamily = 'Arial',
sub.col = 'black',
sub.cex = 1,
sub.just = c(0.5, 1),
category.names = names(x),
force.unique = TRUE,
print.mode = "raw",
sigdigs = 3,
direct.area = FALSE,
area.vector = 0,
hyper.test = FALSE,
total.population = NULL,
...
) {
# #Create a string to capture the date and the time of day
# time.string = gsub(":", "-", gsub(" ", "_", as.character(Sys.time())))
#
# #Initialize the logger to output to file
# if(!is.null(filename)){
# flog.appender(appender.file(paste0(filename,".",time.string,".log")), name='VennDiagramLogger')
# }
# else{
# flog.appender(appender.file(paste0("VennDiagram",time.string,".log")), name='VennDiagramLogger')
# }
#
# #Log the parameters the function was called with
# out.list = as.list(sys.call())
# out.list[[1]] <- NULL
# out.string = capture.output(out.list)
# flog.info(out.string,name='VennDiagramLogger')
#If the input area.vector correspond directly to a1,a2, etc, then call the function and pass it through directly by a flag
if(direct.area){
if(1 == length(area.vector)){
list.names <- category.names;
if (is.null(list.names)) { list.names <- ''; }
grob.list <- VennDiagram::draw.single.venn(
area = area.vector[1],
category = list.names,
ind = FALSE,
...
);
}
if(3 == length(area.vector)){
grob.list <- VennDiagram::draw.pairwise.venn(
area1 = area.vector[1],
area2 = area.vector[2],
cross.area = area.vector[3],
category = category.names,
ind = FALSE,
print.mode=print.mode,
sigdigs=sigdigs,
...
);
}
if(7 == length(area.vector)){
grob.list <- VennDiagram::draw.triple.venn(
area1 = 0,
area2 = 0,
area3 = 0,
n12 = 0,
n23 = 0,
n13 = 0,
n123 = 0,
category = category.names,
ind = FALSE,
list.order = 1:3,
print.mode=print.mode,
sigdigs=sigdigs,
area.vector=area.vector,
direct.area=TRUE,
...
);
}
if(15 == length(area.vector)){
grob.list <- VennDiagram::draw.quad.venn(
area1 = 0,
area2 = 0,
area3 = 0,
area4 = 0,
n12 = 0,
n13 = 0,
n14 = 0,
n23 = 0,
n24 = 0,
n34 = 0,
n123 = 0,
n124 = 0,
n134 = 0,
n234 = 0,
n1234 = 0,
category = category.names,
ind = FALSE,
print.mode=print.mode,
sigdigs=sigdigs,
area.vector=area.vector,
direct.area=TRUE,
...
);
}
if(31 == length(area.vector)){
grob.list <- VennDiagram::draw.quintuple.venn(
area1 = 0,
area2 = 0,
area3 = 0,
area4 = 0,
area5 = 0,
n12 = 0,
n13 = 0,
n14 = 0,
n15 = 0,
n23 = 0,
n24 = 0,
n25 = 0,
n34 = 0,
n35 = 0,
n45 = 0,
n123 = 0,
n124 = 0,
n125 = 0,
n134 = 0,
n135 = 0,
n145 = 0,
n234 = 0,
n235 = 0,
n245 = 0,
n345 = 0,
n1234 = 0,
n1235 = 0,
n1245 = 0,
n1345 = 0,
n2345 = 0,
n12345 = 0,
category = category.names,
ind = FALSE,
print.mode=print.mode,
sigdigs=sigdigs,
area.vector=area.vector,
direct.area=TRUE,
...
);
}
}
#Use default processing behaviour of having individual elements in the list x
else{
if (force.unique) {
for (i in 1:length(x)) {
x[[i]] <- unique(x[[i]])
}
}
# check for the presence of NAs in the input list
if ('none' == na) {
x <- x;
}
else if ('stop' == na) {
for (i in 1:length(x)) {
# stop if there are any NAs in this vector
if (any(is.na(x[[i]]))) {
#flog.error('NAs in dataset', call. = FALSE,name="VennDiagramLogger")
stop('NAs in dataset', call. = FALSE);
}
}
}
else if ('remove' == na) {
for (i in 1:length(x)) { x[[i]] <- x[[i]][!is.na(x[[i]])]; }
}
else {
#flog.error('Invalid na option: valid options are "none", "stop", and "remove"',name="VennDiagramLogger")
stop('Invalid na option: valid options are "none", "stop", and "remove"');
}
# check the length of the given list
if (0 == length(x) | length(x) > 5) {
#flog.error('Incorrect number of elements.', call. = FALSE,name="VennDiagramLogger")
stop('Incorrect number of elements.', call. = FALSE);
}
# draw a single-set Venn diagram
if (1 == length(x)) {
list.names <- category.names;
if (is.null(list.names)) { list.names <- ''; }
grob.list <- VennDiagram::draw.single.venn(
area = length(x[[1]]),
category = list.names,
ind = FALSE,
...
);
}
# draw a pairwise Venn diagram
else if (2 == length(x)) {
grob.list <- VennDiagram::draw.pairwise.venn(
area1 = length(x[[1]]),
area2 = length(x[[2]]),
cross.area = length(intersect(x[[1]],x[[2]])),
category = category.names,
ind = FALSE,
print.mode=print.mode,
sigdigs=sigdigs,
...
);
}
# draw a three-set Venn diagram
else if (3 == length(x)) {
A <- x[[1]];
B <- x[[2]];
C <- x[[3]];
list.names <- category.names;
nab <- intersect(A, B);
nbc <- intersect(B, C);
nac <- intersect(A, C);
nabc <- intersect(nab, C);
grob.list <- VennDiagram::draw.triple.venn(
area1 = length(A),
area2 = length(B),
area3 = length(C),
n12 = length(nab),
n23 = length(nbc),
n13 = length(nac),
n123 = length(nabc),
category = list.names,
ind = FALSE,
list.order = 1:3,
print.mode=print.mode,
sigdigs=sigdigs,
...
);
}
# draw a four-set Venn diagram
else if (4 == length(x)) {
A <- x[[1]];
B <- x[[2]];
C <- x[[3]];
D <- x[[4]];
list.names <- category.names;
n12 <- intersect(A, B);
n13 <- intersect(A, C);
n14 <- intersect(A, D);
n23 <- intersect(B, C);
n24 <- intersect(B, D);
n34 <- intersect(C, D);
n123 <- intersect(n12, C);
n124 <- intersect(n12, D);
n134 <- intersect(n13, D);
n234 <- intersect(n23, D);
n1234 <- intersect(n123, D);
grob.list <- VennDiagram::draw.quad.venn(
area1 = length(A),
area2 = length(B),
area3 = length(C),
area4 = length(D),
n12 = length(n12),
n13 = length(n13),
n14 = length(n14),
n23 = length(n23),
n24 = length(n24),
n34 = length(n34),
n123 = length(n123),
n124 = length(n124),
n134 = length(n134),
n234 = length(n234),
n1234 = length(n1234),
category = list.names,
ind = FALSE,
print.mode=print.mode,
sigdigs=sigdigs,
...
);
}
# draw a five-set Venn diagram
else if (5 == length(x)) {
A <- x[[1]];
B <- x[[2]];
C <- x[[3]];
D <- x[[4]];
E <- x[[5]];
list.names <- category.names;
n12 <- intersect(A, B);
n13 <- intersect(A, C);
n14 <- intersect(A, D);
n15 <- intersect(A, E);
n23 <- intersect(B, C);
n24 <- intersect(B, D);
n25 <- intersect(B, E);
n34 <- intersect(C, D);
n35 <- intersect(C, E);
n45 <- intersect(D, E);
n123 <- intersect(n12, C);
n124 <- intersect(n12, D);
n125 <- intersect(n12, E);
n134 <- intersect(n13, D);
n135 <- intersect(n13, E);
n145 <- intersect(n14, E);
n234 <- intersect(n23, D);
n235 <- intersect(n23, E);
n245 <- intersect(n24, E);
n345 <- intersect(n34, E);
n1234 <- intersect(n123, D);
n1235 <- intersect(n123, E);
n1245 <- intersect(n124, E);
n1345 <- intersect(n134, E);
n2345 <- intersect(n234, E);
n12345 <- intersect(n1234, E);
grob.list <- VennDiagram::draw.quintuple.venn(
area1 = length(A),
area2 = length(B),
area3 = length(C),
area4 = length(D),
area5 = length(E),
n12 = length(n12),
n13 = length(n13),
n14 = length(n14),
n15 = length(n15),
n23 = length(n23),
n24 = length(n24),
n25 = length(n25),
n34 = length(n34),
n35 = length(n35),
n45 = length(n45),
n123 = length(n123),
n124 = length(n124),
n125 = length(n125),
n134 = length(n134),
n135 = length(n135),
n145 = length(n145),
n234 = length(n234),
n235 = length(n235),
n245 = length(n245),
n345 = length(n345),
n1234 = length(n1234),
n1235 = length(n1235),
n1245 = length(n1245),
n1345 = length(n1345),
n2345 = length(n2345),
n12345 = length(n12345),
category = list.names,
ind = FALSE,
print.mode=print.mode,
sigdigs=sigdigs,
...
);
}
# this should never happen because of the previous check
else {
#flog.error('Invalid size of input object',name="VennDiagramLogger")
stop('Invalid size of input object');
}
}
# if there are two sets in the VennDiagram and the hypergeometric test is requested then perform the test and add the pvalue to the subtitle
#p value always shown with 2 sig digs. Add another parameter for this later if you want to control the sig digs
if (length(x) == 2 & !is.null(total.population) & hyper.test){
val.p = calculate.overlap.and.pvalue(x[[1]],x[[2]],total.population)
if(is.null(sub)){
sub = paste0("p = ",signif(val.p[3],digits=2))
}else{
sub = paste0(sub,", p = ",signif(val.p[3],digits=2))
}
}
# if requested, add a sub-title
if (!is.null(sub)) {
grob.list <- add.title(
gList = grob.list,
x = sub,
pos = sub.pos,
fontface = sub.fontface,
fontfamily = sub.fontfamily,
col = sub.col,
cex = sub.cex
);
}
# if requested, add a main-title
if (!is.null(main)) {
grob.list <- add.title(
gList = grob.list,
x = main,
pos = main.pos,
fontface = main.fontface,
fontfamily = main.fontfamily,
col = main.col,
cex = main.cex
);
}
# if a filename is given, write a desired image type, TIFF default
if (!is.null(filename)) {
# set the graphics driver
current.type <- getOption('bitmapType');
if (length(grep('Darwin', Sys.info()['sysname']))) {
options(bitmapType = 'quartz');
}
else {
options(bitmapType = 'cairo');
}
# TIFF image type specified
if('tiff' == imagetype) {
tiff(
filename = filename,
height = height,
width = width,
units = units,
res = resolution,
compression = compression
);
}
# PNG image type specified
else if('png' == imagetype) {
png(
filename = filename,
height = height,
width = width,
units = units,
res = resolution
);
}
# SVG image type specified
else if('svg' == imagetype) {
svg(
filename = filename,
height = height,
width = width
);
}
# Invalid imagetype specified
else {
#flog.error("You have misspelled your 'imagetype', please try again",name="VennDiagramLogger")
stop("You have misspelled your 'imagetype', please try again");
}
grid.draw(grob.list);
dev.off();
options(bitmapType = current.type);
# return a success code
return(1);
}
# if file creation was not requested return the plotting object
return(grob.list);
}
calculate.overlap <- function(x) {
# draw a single-set Venn diagram
if (1 == length(x)) {
overlap <- x;
}
# draw a pairwise Venn diagram
else if (2 == length(x)) {
overlap <- list(
a1 = x[[1]],
a2 = x[[2]],
a3 = intersect(x[[1]],x[[2]])
);
}
# draw a three-set Venn diagram
else if (3 == length(x)) {
A <- x[[1]];
B <- x[[2]];
C <- x[[3]];
nab <- intersect(A, B);
nbc <- intersect(B, C);
nac <- intersect(A, C);
nabc <- intersect(nab, C);
# calculate overlaps
a5 = nabc;
a2 = nab[-which(nab %in% a5)];
a4 = nac[-which(nac %in% a5)];
a6 = nbc[-which(nbc %in% a5)];
a1 = A[-which(A %in% c(a2,a4,a5))];
a3 = B[-which(B %in% c(a2,a5,a6))];
a7 = C[-which(C %in% c(a4,a5,a6))];
overlap <- list(
a5 = a5,
a2 = a2,
a4 = a4,
a6 = a6,
a1 = a1,
a3 = a3,
a7 = a7
);
}
# draw a four-set Venn diagram
else if (4 == length(x)) {
A <- x[[1]];
B <- x[[2]];
C <- x[[3]];
D <- x[[4]];
n12 <- intersect(A, B);
n13 <- intersect(A, C);
n14 <- intersect(A, D);
n23 <- intersect(B, C);
n24 <- intersect(B, D);
n34 <- intersect(C, D);
n123 <- intersect(n12, C);
n124 <- intersect(n12, D);
n134 <- intersect(n13, D);
n234 <- intersect(n23, D);
n1234 <- intersect(n123, D);
# calculate overlaps
a6 = n1234;
a12 = n123[-which(n123 %in% a6)];
a11 = n124[-which(n124 %in% a6)];
a5 = n134[-which(n134 %in% a6)];
a7 = n234[-which(n234 %in% a6)];
a15 = n12[-which(n12 %in% c(a6,a11,a12))];
a4 = n13[-which(n13 %in% c(a6,a5,a12))];
a10 = n14[-which(n14 %in% c(a6,a5,a11))];
a13 = n23[-which(n23 %in% c(a6,a7,a12))];
a8 = n24[-which(n24 %in% c(a6,a7,a11))];
a2 = n34[-which(n34 %in% c(a6,a5,a7))];
a9 = A[-which(A %in% c(a4,a5,a6,a10,a11,a12,a15))];
a14 = B[-which(B %in% c(a6,a7,a8,a11,a12,a13,a15))];
a1 = C[-which(C %in% c(a2,a4,a5,a6,a7,a12,a13))];
a3 = D[-which(D %in% c(a2,a5,a6,a7,a8,a10,a11))];
overlap <- list(
a6 = a6,
a12 = a12,
a11 = a11,
a5 = a5,
a7 = a7,
a15 = a15,
a4 = a4,
a10 = a10,
a13 = a13,
a8 = a8,
a2 = a2,
a9 = a9,
a14 = a14,
a1 = a1,
a3 = a3
);
}
# draw a five-set Venn diagram
else if (5 == length(x)) {
A <- x[[1]];
B <- x[[2]];
C <- x[[3]];
D <- x[[4]];
E <- x[[5]];
n12 <- intersect(A, B);
n13 <- intersect(A, C);
n14 <- intersect(A, D);
n15 <- intersect(A, E);
n23 <- intersect(B, C);
n24 <- intersect(B, D);
n25 <- intersect(B, E);
n34 <- intersect(C, D);
n35 <- intersect(C, E);
n45 <- intersect(D, E);
n123 <- intersect(n12, C);
n124 <- intersect(n12, D);
n125 <- intersect(n12, E);
n134 <- intersect(n13, D);
n135 <- intersect(n13, E);
n145 <- intersect(n14, E);
n234 <- intersect(n23, D);
n235 <- intersect(n23, E);
n245 <- intersect(n24, E);
n345 <- intersect(n34, E);
n1234 <- intersect(n123, D);
n1235 <- intersect(n123, E);
n1245 <- intersect(n124, E);
n1345 <- intersect(n134, E);
n2345 <- intersect(n234, E);
n12345 <- intersect(n1234, E);
# calculate overlaps
a31 = n12345;
a30 = n1234[-which(n1234 %in% a31)];
a29 = n1235[-which(n1235 %in% a31)];
a28 = n1245[-which(n1245 %in% a31)];
a27 = n1345[-which(n1345 %in% a31)];
a26 = n2345[-which(n2345 %in% a31)];
a25 = n245[-which(n245 %in% c(a26,a28,a31))];
a24 = n234[-which(n234 %in% c(a26,a30,a31))];
a23 = n134[-which(n134 %in% c(a27,a30,a31))];
a22 = n123[-which(n123 %in% c(a29,a30,a31))];
a21 = n235[-which(n235 %in% c(a26,a29,a31))];
a20 = n125[-which(n125 %in% c(a28,a29,a31))];
a19 = n124[-which(n124 %in% c(a28,a30,a31))];
a18 = n145[-which(n145 %in% c(a27,a28,a31))];
a17 = n135[-which(n135 %in% c(a27,a29,a31))];
a16 = n345[-which(n345 %in% c(a26,a27,a31))];
a15 = n45[-which(n45 %in% c(a18,a25,a16,a28,a27,a26,a31))];
a14 = n24[-which(n24 %in% c(a19,a24,a25,a30,a28,a26,a31))];
a13 = n34[-which(n34 %in% c(a16,a23,a24,a26,a27,a30,a31))];
a12 = n13[-which(n13 %in% c(a17,a22,a23,a27,a29,a30,a31))];
a11 = n23[-which(n23 %in% c(a21,a22,a24,a26,a29,a30,a31))];
a10 = n25[-which(n25 %in% c(a20,a21,a25,a26,a28,a29,a31))];
a9 = n12[-which(n12 %in% c(a19,a20,a22,a28,a29,a30,a31))];
a8 = n14[-which(n14 %in% c(a18,a19,a23,a27,a28,a30,a31))];
a7 = n15[-which(n15 %in% c(a17,a18,a20,a27,a28,a29,a31))];
a6 = n35[-which(n35 %in% c(a16,a17,a21,a26,a27,a29,a31))];
a5 = E[-which(E %in% c(a6,a7,a15,a16,a17,a18,a25,a26,a27,a28,a31,a20,a29,a21,a10))];
a4 = D[-which(D %in% c(a13,a14,a15,a16,a23,a24,a25,a26,a27,a28,a31,a18,a19,a8,a30))];
a3 = C[-which(C %in% c(a21,a11,a12,a13,a29,a22,a23,a24,a30,a31,a26,a27,a16,a6,a17))];
a2 = B[-which(B %in% c(a9,a10,a19,a20,a21,a11,a28,a29,a31,a22,a30,a26,a25,a24,a14))];
a1 = A[-which(A %in% c(a7,a8,a18,a17,a19,a9,a27,a28,a31,a20,a30,a29,a22,a23,a12))];
overlap <- list(
a31 = a31,
a30 = a30,
a29 = a29,
a28 = a28,
a27 = a27,
a26 = a26,
a25 = a25,
a24 = a24,
a23 = a23,
a22 = a22,
a21 = a21,
a20 = a20,
a19 = a19,
a18 = a18,
a17 = a17,
a16 = a16,
a15 = a15,
a14 = a14,
a13 = a13,
a12 = a12,
a11 = a11,
a10 = a10,
a9 = a9,
a8 = a8,
a7 = a7,
a6 = a6,
a5 = a5,
a4 = a4,
a3 = a3,
a2 = a2,
a1 = a1
);
}
# this should never happen because of the previous check
else {
#flog.error('Invalid size of input object',name="VennDiagramLogger")
stop('Invalid size of input object');
}
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.