It is easy to the draw a Venn diagram with the following code:
library(VennDiagram)
set.seed(1) # For reproducibility of results
xx.1 <- list(A = sample(LETTERS, 15), B = sample(LETTERS, 15),
C = sample(LETTERS, 15), D = sample(LETTERS, 15))
venn.diagram(xx.1, filename ="1.tiff", height = 1000, width = 1000)
But how do I figure out the items in each field? For example, I would like to know what are the two letters only found in A?
EDIT:
Here is my solution, it is not perfect but could give all the intersections.
library(reshape)
library(R.utils)
## data
A <- data.frame(names = sample(LETTERS, 15), A = 1)
B <- data.frame(names = sample(LETTERS, 15), B = 1)
C <- data.frame(names = sample(LETTERS, 15), C = 1)
D <- data.frame(names = sample(LETTERS, 15), D = 1)
## a merged data frame.
xx.1 <- list(A = A, B= B, C= C, D = D)
xx.2 <- merge_recurse(xx.1)
## function
ff.vennFourItems <- function(X)
{
## get the items from venn diagram; for four sets, there are 15 fields;
vennItems <- list()
cate.n <- names(X)[2:5]
for (i in 1:15)
{
xx.b <- intToBin(i)
## make it four bits;
if (nchar(xx.b) != 4)
{
xx.b <- paste(paste(rep("0", 4 - nchar(xx.b)), collapse = ""), xx.b, sep ="")
}
xx.b.1 <- unlist(strsplit(xx.b, ""))
xx.1 <- X
if(xx.b.1[1] == "0") { xx.1 <- xx.1[is.na(xx.1[, 2]), ] }
else { xx.1 <- xx.1[!is.na(xx.1[, 2]), ] }
if(xx.b.1[2] == "0") { xx.1 <- xx.1[is.na(xx.1[, 3]), ] }
else { xx.1 <- xx.1[!is.na(xx.1[, 3]), ] }
if(xx.b.1[3] == "0") { xx.1 <- xx.1[is.na(xx.1[, 4]), ] }
else { xx.1 <- xx.1[!is.na(xx.1[, 4]), ] }
if(xx.b.1[4] == "0") { xx.1 <- xx.1[is.na(xx.1[, 5]), ] }
else { xx.1 <- xx.1[!is.na(xx.1[, 5]), ] }
chipC <- paste(paste(cate.n, collapse = "#"), xx.b, sep = "***")
if (dim(xx.1)[1] == 0)
{
xx.2 <- list(genes = dim(xx.1)[1], chipC = chipC, chipCN = i, detailChipS = xx.1, shortL = data.frame(genes = "noInteraction", cl = i, fullCl = chipC))
}
else
{
xx.2 <- list(genes = dim(xx.1)[1], chipC = chipC, chipCN = i, detailChipS = xx.1, shortL = data.frame(genes = as.character(xx.1[, 1]), cl = i, fullCl = chipC))
}
vennItems <- c(vennItems, list(xx.2))
}
vennItems
}
xx.3 <- ff.vennFourItems(xx.2)
str(xx.3)
List of 15
$ :List of 5
..$ genes : int 1
..$ chipC : chr "A#B#C#D***0001"
..$ chipCN : int 1
..$ detailChipS:'data.frame': 1 obs. of 5 variables:
.. ..$ names: Factor w/ 25 levels "A","B","E","F",..: 25
.. ..$ A : num NA
.. ..$ B : num NA
.. ..$ C : num NA
.. ..$ D : num 1
..$ shortL :'data.frame': 1 obs. of 3 variables:
.. ..$ genes : Factor w/ 1 level "Z": 1
.. ..$ cl : int 1
.. ..$ fullCl: Factor w/ 1 level "A#B#C#D***0001": 1
$ :List of 5
..$ genes : int 0
..$ chipC : chr "A#B#C#D***0010"
..$ chipCN : int 2
Take a look at ?intersect
, ?union
and ?setdiff
function to extract the different fields of the Venn diagram.
I have created some list
versions of the two functions to better get the elements in the different compartments:
Intersect <- function (x) {
# Multiple set version of intersect
# x is a list
if (length(x) == 1) {
unlist(x)
} else if (length(x) == 2) {
intersect(x[[1]], x[[2]])
} else if (length(x) > 2){
intersect(x[[1]], Intersect(x[-1]))
}
}
Union <- function (x) {
# Multiple set version of union
# x is a list
if (length(x) == 1) {
unlist(x)
} else if (length(x) == 2) {
union(x[[1]], x[[2]])
} else if (length(x) > 2) {
union(x[[1]], Union(x[-1]))
}
}
Setdiff <- function (x, y) {
# Remove the union of the y's from the common x's.
# x and y are lists of characters.
xx <- Intersect(x)
yy <- Union(y)
setdiff(xx, yy)
}
So, if we want to see the common elements (i.e. the union of A, B, C, and D) or the ones in C and D but not in A and B in your example we do something like the following.
set.seed(1)
xx.1 <- list(A = sample(LETTERS, 15),
B = sample(LETTERS, 15),
C = sample(LETTERS, 15),
D = sample(LETTERS, 15))
Intersect(xx.1)
#[1] "E" "L"
Setdiff(xx.1[c("C", "D")], xx.1[c("A", "B")])
#[1] "O" "P" "K" "H"
Hope this helps!
By some (I think) clever use of the combn
function, indexing, and a good understanding of lapply
we can all elements systematically:
# Create a list of all the combinations
combs <-
unlist(lapply(1:length(xx.1),
function(j) combn(names(xx.1), j, simplify = FALSE)),
recursive = FALSE)
names(combs) <- sapply(combs, function(i) paste0(i, collapse = ""))
str(combs)
#List of 15
# $ A : chr "A"
# $ B : chr "B"
# $ C : chr "C"
# $ D : chr "D"
# $ AB : chr [1:2] "A" "B"
# $ AC : chr [1:2] "A" "C"
# $ AD : chr [1:2] "A" "D"
# $ BC : chr [1:2] "B" "C"
# $ BD : chr [1:2] "B" "D"
# $ CD : chr [1:2] "C" "D"
# $ ABC : chr [1:3] "A" "B" "C"
# $ ABD : chr [1:3] "A" "B" "D"
# $ ACD : chr [1:3] "A" "C" "D"
# $ BCD : chr [1:3] "B" "C" "D"
# $ ABCD: chr [1:4] "A" "B" "C" "D"
# "A" means "everything in A minus all others"
# "A", "B" means "everything in "A" and "B" minus all others" and so on
elements <-
lapply(combs, function(i) Setdiff(xx.1[i], xx.1[setdiff(names(xx.1), i)]))
n.elements <- sapply(elements, length)
print(n.elements)
# A B C D AB AC AD BC BD CD ABC ABD ACD BCD ABCD
# 2 2 0 0 1 2 2 0 3 4 4 1 1 2 2