File: intersectDiagram.R

package info (click to toggle)
r-cran-plotrix 2.9-3-2
  • links: PTS, VCS
  • area: main
  • in suites: squeeze
  • size: 960 kB
  • sloc: makefile: 3
file content (66 lines) | stat: -rw-r--r-- 2,419 bytes parent folder | download
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)
}