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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
|
staircase.plot<-function(heights,totals=NA,labels=NULL,halfwidth=0.3,main="",
mar=NA,total.col="blue",inc.col=NA,bg.col=NA,direction="e",las=1,
display.height=TRUE,stagger=FALSE,cex=par("cex"),...) {
if(is.matrix(heights) | is.data.frame(heights)) {
dimheights<-dim(heights)
if(dimheights[2] > 1) totals<-heights[,2]
heights<-as.vector(heights)
}
if(!is.numeric(heights))
stop("heights must be a numeric vector or matrix/data frame with numeric first column")
nbars<-length(heights)
# if no marker for increments (FALSE | 0) and totals (TRUE | non-zero)
# consider the first and last values to be totals and all others increments
if(is.na(totals[1])) totals<-c(TRUE,rep(FALSE,nbars-2),TRUE)
# coerce totals to a logical vector if it isn't
if(!is.logical(totals)) totals<-totals != 0
oldmar<-par("mar")
if(!is.na(bg.col)) {
oldbg<-par("bg")
par(bg=bg.col)
}
maxht<-max(heights)
currht<-heights[1]
for(i in 2:nbars) {
if(!totals[i]) {
currht<-currht+heights[i]
if(currht > maxht) maxht<-currht
}
}
if(direction == "e" || direction == "w") {
if(is.na(mar[1])) mar<-c(10,2,3,2)
par(mar=mar,xaxs="i")
plot(0,xlim=c(0.5,nbars+0.5),ylim=c(0,maxht),type="n",axes=FALSE,
xlab="",ylab="",...)
}
else {
if(is.na(mar[1])) mar<-c(2,10,3,2)
par(mar=mar,yaxs="i")
plot(0,xlim=c(0,maxht),ylim=c(0.5,nbars+0.5),type="n",axes=FALSE,
xlab="",ylab="",...)
}
par(xpd=TRUE)
bar.col<-rep(NA,nbars)
if(length(inc.col) < sum(!totals))
inc.col=rep(inc.col,length.out=sum(!totals))
bar.col[!totals]<-inc.col
bar.col[totals]<-total.col
label_offset<-ifelse(direction == "e" || direction == "w",
strheight("M"),strwidth("M"))
if(direction == "s" || direction == "w") {
start<-nbars
finish<-1
dir<- -1
}
else {
start<-1
finish<-nbars
dir<-1
}
barend<-0
barpos<-start:finish
for(bar in 1:nbars) {
barstart<-ifelse(totals[bar],0,barend)
barend<-barstart+heights[bar]
if(direction == "e" || direction == "w") {
rect(barpos[bar]-halfwidth,barstart,barpos[bar]+halfwidth,barend,
col=bar.col[bar])
if(display.height)
text(barpos[bar],ifelse(heights[bar]<0,barstart,barend)+label_offset,
heights[bar],cex=cex)
if(direction == "e" && bar != nbars)
segments(barpos[bar]+halfwidth*dir,barend,barpos[bar]+dir-halfwidth*dir,
barend,lty=3)
if(direction == "w" && bar != nbars)
segments(barpos[bar]-halfwidth*dir,barend,barpos[bar]+dir+halfwidth*dir,
barend,lty=3)
if(!is.null(labels)) {
labelline<-0.5
if(stagger) labelline<-c(labelline,1.5)
mtext(labels,side=1,line=labelline,at=start:finish,adj=0.5,las=las,cex=cex)
}
}
else {
rect(barstart,barpos[bar]-halfwidth,barend,barpos[bar]+halfwidth,
col=bar.col[bar])
if(display.height)
text(ifelse(heights[bar]<0,barstart,barend)+label_offset,
barpos[bar],heights[bar],adj=0,cex=cex)
if(bar != nbars)
segments(barend,barpos[bar]+halfwidth*dir,barend,
barpos[bar]+dir-halfwidth*dir,lty=3)
if(!is.null(labels)) {
labelline<-0.5
if(stagger) labelline<-c(labelline,1.5)
mtext(labels,side=2,line=labelline,at=start:finish,adj=1,las=las,cex=cex)
}
}
}
if(nchar(main)) mtext(main,line=mar[3]/2,at=getFigCtr()[1],cex=1.5)
par(xpd=FALSE,mar=oldmar)
if(!is.na(bg.col)) par(bg=oldbg)
}
|
