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
|
histStack<-function(x,...) {
UseMethod("histStack")
}
histStack.formula<-function(x,data,breaks="Sturges",col="rainbow",right=TRUE,
main="",xlab=NULL,legend.pos=NULL,cex.legend=0.75,...) {
mf<-model.frame(x,data=data)
if(is.null(xlab)) xlab<-names(mf)[1]
histStack.default(mf[,1],mf[,2],breaks=breaks,col=col,right=right,
main=main,xlab=xlab,legend.pos=legend.pos,cex.legend=cex.legend,...)
}
histStack.default<-function(x,z,breaks="Sturges",col="rainbow",right=TRUE,
main="",xlab=NULL,legend.pos=NULL,cex.legend=0.75,...) {
if(!is.factor(z)) {
z<-factor(z)
warning("z was converted to a factor")
}
seps=levels(z)
numseps<-length(seps)
if(length(col) == 1) col<-do.call(col,list(n=numseps))
if(length(col) < numseps) col<-rep(col,length.out=numseps)
if(!is.numeric(x)) stop("x must be numeric",call.=FALSE)
# plot the histogram of all x
hS<-hist(x,breaks=breaks,col=col[1],right=right,main=main,xlab=xlab,...)
# plot the remaining
for(i in 1:(numseps-1))
hist(x[z %in% seps[-(1:i)]],breaks=hS$breaks,col=col[i+1],
right=right,add=TRUE)
if(!is.null(legend.pos)) {
if(length(legend.pos > 1))
legend(legend.pos[1],legend.pos[2],seps,fill=col,cex=cex.legend)
else legend(legend.pos,seps,fill=col,cex=cex.legend)
}
}
|
