# TODO: Add comment
# 
# Author: E.Korsching Mar 6, 2012
###############################################################################


###  Venn diagram  - working example see: Troschel_Sicking/02diff_a_12data.R

# install.packages("BiocManager"); BiocManager::install(c("RBGL","graph"));
# install.packages("devtools"); library(devtools);
# install_github("js229/Vennerable")
#library(Vennerable)
#vignette("Venn")		# doc


# Venn Diagrams - package limma
# Description -  Compute classification counts and draw a Venn diagram.
# functions
# vennCounts(x, include="both")  # to object
# vennDiagram(object, include="both", names=NULL, mar=rep(1,4), cex=c(1.5,1,0.7), lwd=1, circle.col=NULL, counts.col=NULL, show.include=NULL, ...)

# adjusted for a different input data structure

vennDiagram.ek <- function(set1=NULL, set2=NULL, set3=NULL, names, cex=0.7){
	# wrapper for limma vennDiagram which is based on test results in a matrix  -  see limma package description
	# takes vectors (! no data frame with one col) of ids and calculates the overlap
	# length of names must match number of sets or default values will be used
	# order of names counts !
	
	#ini
	require("limma")
	i1<-0; i2<-0; i3<-0
	if( !is.null(set1) ){ i1 <- 1 }
	if( !is.null(set2) ){ i2 <- 10 }
	if( !is.null(set3) ){ i3 <- 100 }
	i.sum <- sum(i1,i2,i3)
	
	if( i.sum==1 ){ set1 <- set1 }
	if( i.sum==10 ){ set1 <- set2 }
	if( i.sum==100 ){ set1 <- set3 }
	if( i.sum==11 ){ set1 <- set1; set2 <- set2 }
	if( i.sum==101 ){ set1 <- set1; set2 <- set3 }
	if( i.sum==110 ){ set1 <- set2; set2 <- set3 }
	if( i.sum==0 ){ cat("\n 1, 2 or 3 sets must be provided"); break }
	
	names.len <- length(names)
	if( names.len!=1 & ( i.sum==1 | i.sum==10 | i.sum==100 ) ){ names <- "A" }
	if( names.len!=2 & ( i.sum==11 | i.sum==101 | i.sum==110 ) ){ names <- c("A","B") }
	if( names.len!=3 & i.sum==111 ){ names <- c("A","B","C") }
	
	if( i.sum==1 | i.sum==10 | i.sum==100 ){ counts.col="blue"; circle.col="black" }		# color
	if( i.sum==11 | i.sum==101 | i.sum==110 ){ counts.col=c("blue","blue"); circle.col=c("black","black") }
	if( i.sum==111 ){ counts.col=c("blue","blue","blue"); circle.col=c("black","black","black") }
	
	#work
	if(i.sum==1 | i.sum==10 | i.sum==100){		#one set
		universe <- sort( unique( set1 ) )		# form universe
		
		Counts <- matrix(0, nrow=length(universe), ncol=1)
		colnames(Counts) <- names
		
		Counts[ ,1] <- T	# all T
	}
	if(i.sum==11 | i.sum==101 | i.sum==110){		#two sets
		universe <- sort( unique( c(set1, set2) ) )		# form universe as unique union of two sets; inspired by Earl F. Glynn
		
		Counts <- matrix(0, nrow=length(universe), ncol=2)
		colnames(Counts) <- names
		
		Counts[ ,1] <- universe %in% set1		# create logical vector
		Counts[ ,2] <- universe %in% set2
	}
	if(i.sum==111){									#three sets
		universe <- sort( unique( c(set1, set2, set3) ) )		# form universe as unique union of three sets
		
		Counts <- matrix(0, nrow=length(universe), ncol=3)
		colnames(Counts) <- names
		
		Counts[ ,1] <- universe %in% set1
		Counts[ ,2] <- universe %in% set2
		Counts[ ,3] <- universe %in% set3
	}
	
	vennDiagram.var( vennCounts(Counts), counts.col=counts.col, circle.col=circle.col, lwd=2, cex=cex, mar=rep(1,4), show.include=F )
}


#example
#c("abc","abd","abe","abf","abg","abh","abi") %in% c("abg","abj","abh","abi","abk","abi")
#vennDiagram.ek(set1=c("abc","abd","abe","abf","abg","abh","abi"),set2=c("abg","abj","abh","abi","abk","abl","abm"), names=c("Bb", "Cc"))


# subfunction
vennDiagram.var <- function(object, include="both", names, mar=rep(1,4), cex=1, lwd=1, circle.col, counts.col, show.include, ...)
#	Plot Venn diagram
#	Gordon Smyth, James Wettenhall - Capabilities for multiple counts and colors by Francois Pepin.
#	4 July 2003.  Last modified 12 March 2010  --  adjusted by Eberhard Korsching, 6.3.2012, 9.6.2016
{
	if (!is(object, "VennCounts")){
		if (length(include)>2) stop("Cannot plot Venn diagram for more than 2 sets of counts")
		if (length(include)==2) object.2 <- vennCounts(object, include = include[2])
		object <- vennCounts(object, include = include[1])
	}else if(length(include==2)){
		include <- include[1]
	}
	nsets <- ncol(object)-1
	if(nsets > 3) stop("Can't plot Venn diagram for more than 3 sets")
	if(missing(names)) names <- colnames(object)[1:nsets]
	counts <- object[,"Counts"]
	if(length(include)==2) counts.2 <- object.2[, "Counts"]
	if(missing(circle.col)) circle.col <- par('col')
	if(length(circle.col)<nsets) circle.col <- rep(circle.col,length.out=nsets)
	if(missing(counts.col)) counts.col <- par('col')
	if(length(counts.col)<length(include)) counts.col <- rep(counts.col,length.out=length(include))
	if(missing(show.include)) show.include <- as.logical(length(include)-1)
	theta <- 2*pi*(0:360)/360
	xcentres <- list(0,c(-1,1),c(-1,1,0))[[nsets]]
	ycentres <- list(0,c(0,0),c(1/sqrt(3),1/sqrt(3),-2/sqrt(3)))[[nsets]]
	r <- c(1.5,1.5,1.5)[nsets]
	xtext <- list(-1.2,c(-1.2,1.2),c(-1.2,1.2,0))[[nsets]]
	ytext <- list(1.8,c(1.8,1.8),c(2.4,2.4,-3))[[nsets]]
	old.par <- par(mar=mar)
	on.exit(par(old.par))
	plot(x=0,y=0,type="n",xlim=c(-4,4),ylim=c(-4,4),xlab="",ylab="",axes=FALSE,...)
	for(circle in 1:nsets) {
#		lines() better than symbols() to make circles follow aspect ratio of plot
		lines(xcentres[circle]+r*cos(theta),ycentres[circle]+r*sin(theta),lwd=lwd,col=circle.col[circle])
		text(xtext[circle],ytext[circle],names[circle],cex=cex)
	}
	switch(nsets,
			{
#				rect(-3,-2.5,3,2.5)
				printing <- function(counts, cex, adj,col,leg){
					text(2.3,-2.1,counts[1],cex=cex,col=col,adj=adj)
					text(0,0,counts[2],cex=cex,col=col,adj=adj)
					if(show.include) text(-2.3,-2.1,leg,cex=cex,col=col,adj=adj)
				}
			}, {
#				rect(-3,-2.5,3,2.5)
				printing <- function(counts, cex, adj,col,leg){
					text(2.3,-2.1,counts[1],cex=cex,col=col,adj=adj)
					text(1.5,0.1,counts[2],cex=cex,col=col,adj=adj)
					text(-1.5,0.1,counts[3],cex=cex,col=col,adj=adj)
					text(0,0.1,counts[4],cex=cex,col=col,adj=adj)
					if(show.include) text(-2.3,-2.1,leg,cex=cex,col=col,adj=adj)
				}
			}, {
#				rect(-3,-3.5,3,3.3)
				printing <- function(counts, cex, adj,col,leg){
					text(2.5,-3,counts[1],cex=cex,col=col,adj=adj)
					text(0,-1.7,counts[2],cex=cex,col=col,adj=adj)
					text(1.5,1,counts[3],cex=cex,col=col,adj=adj)
					text(.75,-.35,counts[4],cex=cex,col=col,adj=adj)
					text(-1.5,1,counts[5],cex=cex,col=col,adj=adj)
					text(-.75,-.35,counts[6],cex=cex,col=col,adj=adj)
					text(0,.9,counts[7],cex=cex,col=col,adj=adj)
					text(0,0,counts[8],cex=cex,col=col,adj=adj)
					if(show.include) text(-2.5,-3,leg,cex=cex,col=col,adj=adj)
				}
			}
	)
	adj <- c(0.5,0.5)
	if (length(include)==2)
		adj <- c(0.5,0)
	printing(counts,cex,adj,counts.col[1],include[1])
	if (length(include)==2) printing(counts.2,cex,c(0.5,1),counts.col[2],include[2])
	invisible()
}