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
|
sizetree<-function(x,left=0,top,right=1,lastcenter=NA,showval=TRUE,showcount=TRUE,
firstcall=TRUE,col=NA,colorindex=1,base.cex=1,...) {
dimx<-dim(x)
if(firstcall) {
x<-x[do.call(order,x),]
oldmar<-par("mar")
par(mar=c(1,2,2,1))
top<-sum(!is.na(x[,1]))
if(top<dimx[1])
cat(dimx[1]-top,"NA values dropped from first stack.\n")
plot(0,xlim=c(0,dimx[2]),ylim=c(0,top),type="n",
axes=FALSE,xlab="",ylab="",...)
}
xfreq<-table(x[,1])
if(firstcall) names(col)<-names(xfreq)
lenxf<-length(xfreq)
if(lenxf) {
if(is.list(col)) {
barcol<-col[[colorindex]]
colorindex<-colorindex+1
}
else barcol<-col[names(col) %in% names(xfreq)]
if(length(barcol) < lenxf)
barcol<-rep(col,length.out=lenxf)
labels<-names(xfreq)
squeeze<-(right-left)/10
for(bar in 1:lenxf) {
if(length(xfreq[bar])) {
if(!is.na(xfreq[bar])) {
if(xfreq[bar] > 0) {
rect(left+squeeze,top-xfreq[bar],right-squeeze,top,
col=barcol[bar])
labelheight<-strheight(labels[bar])
cex<-ifelse((1.5*labelheight) > xfreq[bar],
base.cex*0.75*xfreq[bar]/labelheight,base.cex)
if(showval) {
textcol<-ifelse(colSums(col2rgb(unlist(barcol[bar])) *
c(1.4,1.4,0.5)) < 350,"white","black")
bartext<-ifelse(showcount,paste(labels[bar],
" (",xfreq[bar],")",sep=""),labels[bar])
text((left+right)/2,top-xfreq[bar]/2,
bartext,cex=cex,col=textcol)
}
if(!is.na(lastcenter))
segments(left+squeeze,top-xfreq[bar]/2,left-squeeze,
lastcenter)
}
}
}
xvalue<-ifelse(is.numeric(x[, 1]),as.numeric(labels[bar]),labels[bar])
if(dimx[2] > 1) {
prevcol<-ifelse(bar > 1,col[bar-1],NA)
nextcol<-ifelse(bar < lenxf,col[bar+1],NA)
nextx<-subset(x,x[,1]==xvalue,2:dimx[2])
sizetree(nextx,right,top,right+1,lastcenter=top-xfreq[bar]/2,
showval=showval,firstcall=FALSE,col=col,colorindex=colorindex,
base.cex=base.cex)
}
top<-top-xfreq[bar]
}
}
if(firstcall) par(mar=oldmar)
}
|
