[R] Gantt chart problem after upgrade to R 2.4.0
Jim Lemon
jim at bitwrit.com.au
Sat Nov 18 12:32:49 CET 2006
John Kane wrote:
> I am having a problem with a gantt chart since
> moving to R2.4.0. from 2.3.1
> ...
Okay, I think I have fixed the problem. I don't yet know why it worked
on Windows and not Linux, but this should work on both. I have added
another argument to the gantt.chart function and it seems to overcome
the problem. Haven't tested it extensively, so I would appreciate any
information about bugs that have sprung from the ichor of the one I
squashed. There will be another version of plotrix shortly and this will
be in it.
Jim
Watch out for the line breaks that have crept into the code.
gantt.chart<-function(x=NULL,format="%Y/%m/%d",xlim=NULL,taskcolors=NULL,
priority.legend=FALSE,vgridpos=NULL,vgridlab=NULL,vgrid.format="%Y/%m/%d",
half.height=0.25,hgrid=FALSE,main="",ylab="") {
oldpar<-par(no.readonly=TRUE)
if(is.null(x)) x<-get.gantt.info(format=format)
ntasks<-length(x$labels)
plot.new()
charheight<-strheight("M",units="inches")
maxwidth<-max(strwidth(x$labels,units="inches"))*1.5
if(is.null(xlim)) xlim=range(c(x$starts,x$ends))
npriorities<-max(x$priorities)
if(is.null(taskcolors))
taskcolors<-color.gradient(c(255,0),c(0,0),c(0,255),npriorities)
else {
if(length(taskcolors) < npriorities)
taskcolors<-rep(taskcolors,length.out=npriorities)
}
bottom.margin<-ifelse(priority.legend,0.5,0)
par(mai=c(bottom.margin,maxwidth,charheight*5,0.1))
par(omi=c(0.1,0.1,0.1,0.1),xaxs="i",yaxs="i")
plot(x$starts,1:ntasks,xlim=xlim,ylim=c(0.5,ntasks+0.5),
main="",xlab="",ylab=ylab,axes=FALSE,type="n")
box()
if(nchar(main)) mtext(main,3,2)
if(is.null(vgridpos)) tickpos<-axis.POSIXct(3,xlim,format=vgrid.format)
else tickpos<-vgridpos
# if no tick labels, use the grid positions if there
if(is.null(vgridlab) && !is.null(vgridpos))
vgridlab<-format.POSIXct(vgridpos,vgrid.format)
# if vgridpos wasn't specified, use default axis ticks
if(is.null(vgridlab)) axis.POSIXct(3,xlim,format=vgrid.format)
else axis(3,at=tickpos,labels=vgridlab)
topdown<-seq(ntasks,1)
axis(2,at=topdown,labels=x$labels,las=2)
abline(v=tickpos,col="darkgray",lty=3)
for(i in 1:ntasks) {
rect(x$starts[i],topdown[i]-half.height,
x$ends[i],topdown[i]+half.height,
col=taskcolors[x$priorities[i]],
border=FALSE)
}
if(hgrid)
abline(h=(topdown[1:(ntasks-1)]+topdown[2:ntasks])/2,col="darkgray",lty=3)
if(priority.legend) {
par(xpd=TRUE)
plim<-par("usr")
gradient.rect(plim[1],0,plim[1]+(plim[2]-plim[1])/4,0.3,col=taskcolors)
text(plim[1],0.2,"Priorities ",adj=c(1,0.5))
text(c(plim[1],plim[1]+(plim[2]-plim[1])/4),c(0.4,0.4),c("High","Low"))
}
par(oldpar)
invisible(x)
}
More information about the R-help
mailing list