1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66
|
intersectDiagram<-function(x,pct=FALSE,show.nulls=FALSE,xnames=NULL,
namesep="-",mar=c(0,0,3,0),main="Intersection Diagram",col=NULL,
minspacing=0.1) {
if(is.matrix(x) || is.data.frame(x)) x<-makeIntersectList(x)
# check if this is going to screw up some other list that would work
if(!match(class(x),"intersectList",0))
stop("x must be a matrix, data frame or intersectList")
oldmar<-par("mar")
par(mar=mar)
# don't count the total of the last element of the list
lenx<-length(x)-1
xtotal<-x[[length(x)]]
if(is.null(xnames)) xnames<-names(x[[1]])
if(is.null(xnames)) xnames<-LETTERS[1:lenx]
if(is.null(col)) col<-c(rainbow(length(x)-1),NA)
if(length(col) < length(x)) col<-rep(col,length.out=length(x))
listsums<-sapply(x, sum)
horizmax<-max(listsums)
xsum<-0
plot(0,xlim=c(0,horizmax*(1+minspacing)),ylim=c(0,lenx+show.nulls),
main=main,xlab="",ylab="",type="n",axes=FALSE)
for(comb in 1:lenx) {
xsum<-xsum+sum(x[[comb]])
rowmat<-combn(xnames,comb)
blocknames<-pasteCols(rowmat,namesep)
lenxcomb<-length(x[[comb]])
gap<-(horizmax*(1+minspacing)-sum(x[[comb]]))/lenxcomb
startx<-gap/2
for(intersect in 1:lenxcomb) {
cellqnt<-ifelse(pct, paste(round(100*x[[comb]][intersect]/xtotal,1),"%",sep=""),
x[[comb]][intersect])
if(x[[comb]][intersect] > 0) {
if(!is.na(col[1])) {
lencol<-length(col)
xinc<-x[[comb]][intersect]/comb
slice<-1
leftx<-startx
for(bn in 1:lencol) {
if(length(grep(xnames[bn],blocknames[intersect],fixed=TRUE))) {
polygon(c(leftx,leftx,leftx+xinc,leftx+xinc),c(lenx+show.nulls-comb+0.1,
lenx+show.nulls-comb+0.9,lenx+show.nulls-comb+0.9,
lenx+show.nulls-comb+0.1),border=NA,col=col[bn])
slice<-slice+1
leftx <- leftx + xinc
}
}
}
rect(startx,lenx+show.nulls-comb+0.1,startx+x[[comb]][intersect],
lenx+show.nulls-comb+0.9)
}
boxed.labels(startx+x[[comb]][intersect]/2,lenx+show.nulls-comb+0.5,
paste(blocknames[intersect],cellqnt,sep="\n"))
startx<-startx+x[[comb]][intersect]+gap
}
}
if(show.nulls) {
nonset<-as.numeric(xtotal-xsum)
leftx<-sum(par("usr")[1:2])/2-nonset/2
polygon(c(leftx,leftx,leftx+nonset,leftx+nonset),c(0.1,0.9,0.9,0.1),col=NA)
if(pct) nonsetpc<-paste(round(100*nonset/xtotal,1),"%",sep="")
boxed.labels(leftx+nonset/2,0.5,paste("Non-members",nonsetpc,sep="\n"),
col=col[length(col)])
}
par(mar=oldmar)
}
|