On 04/28/2012 10:00 PM, Jim Lemon wrote:
On 04/28/2012 09:29 PM, Jim Lemon wrote:
>...
Oops, the function is attached to this email.
Arrrgh, forgot to put it inline...
Jim
kiteChart<-function(x,xlim=NA,ylim=NA,timex=TRUE,main="Kite chart",
xlab=ifelse(timex,"Time","Groups"),ylab=ifelse(timex,"Groups","Time"),
fill=NULL,border=par("fg"),varpos=NA,varlabels=NA,timepos=NA,timelabels=NA,
mar=c(5,4,4,4),axlab=c(1,2,3,4),normalize=TRUE,shownorm=TRUE,...) {
oldmar<-par(mar=mar)
dimx<-dim(x)
if(is.na(xlim[1])) {
if(timex) xlim<-c(1,dimx[2])
else xlim<-c(0.5,dimx[1]+0.5)
}
if(is.na(ylim[1])) {
if(timex) ylim<-c(0.5,dimx[1]+0.5)
else ylim<-c(1,dimx[2])
}
plot(0,xlim=xlim,ylim=ylim,main=main,xlab=xlab,ylab=ylab,type="n",axes=FALSE,...)
if(is.na(varlabels[1])) {
if(is.null(rownames(x))) varlabels<-1:dimx[1]
else varlabels<-rownames(x)
}
if(is.na(varpos[1])) varpos<-1:dimx[1]
axis(ifelse(timex,axlab[2],axlab[1]),at=varpos[1:dimx[1]],labels=varlabels)
if(is.na(timepos[1])) timepos<-1:dimx[2]
if(is.na(timelabels[1])) {
if(is.null(colnames(x))) timelabels<-timepos
else timelabels<-colnames(x)
}
axis(ifelse(timex,axlab[1],axlab[2]),at=timepos,labels=timelabels)
box()
if(is.null(fill)) fill<-rainbow(dimx[1])
if(length(fill) < dimx[1]) fill<-rep(fill,length.out=dimx[1])
for(krow in 1:dimx[1]) {
if(normalize) {
if(shownorm)
mtext(paste("*",signif(1/max(x[krow,]),digits=3)),
ifelse(timex,axlab[4],axlab[3]),at=varpos[krow],las=1)
x[krow,]<-x[krow,]/(max(x[krow,])*2)
}
xpos<-1:length(x[krow,])
if(timex)
polygon(c(xpos,rev(xpos)),c(varpos[krow]+x[krow,],varpos[krow]-rev(x[krow,])),
col=fill[krow],border=border)
else
polygon(c(varpos[krow]+x[krow,],varpos[krow]-rev(x[krow,])),c(xpos,rev(xpos)),
col=fill[krow],border=border)
}
invisible(oldmar)
}
______________________________________________
R-help@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
