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
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
|
get.gantt.info<-function(format="%Y/%m/%d") {
cat("Enter the label, start and finish time for each task.\n")
cat("Default format for time is year/month/day e.g. 2005/2/22\n")
cat("Enter a blank label to end.\n")
nextlabel<-"dummy"
tasklabels<-NA
taskstarts<-NA
taskends<-NA
priorities<-NA
while(nchar(nextlabel)) {
nextlabel<-readline("Task label - ")
if(nchar(nextlabel)) {
if(is.na(tasklabels[1])) tasklabels<-nextlabel
else tasklabels<-c(tasklabels,nextlabel)
nextstart<-as.POSIXct(strptime(readline("Task begins - "),format=format))
if(is.na(taskstarts[1])) taskstarts<-nextstart
else taskstarts<-c(taskstarts,nextstart)
nextend<-nextstart-1
while(nextend < nextstart) {
nextend<-as.POSIXct(strptime(readline("Task ends - "),format=format))
if(nextend < nextstart) cat("Task cannot end before it starts!\n")
else {
if(is.na(taskends[1])) taskends<-nextend
else taskends<-c(taskends,nextend)
}
}
nextpriority<-0
while (nextpriority < 1 || nextpriority > 10) {
nextpriority <- as.numeric(readline("Task priority (1-10) - "))
if(is.na(nextpriority)) {
cat("Task priority must be a number between 1 and 10!\n")
next.priority<-0
}
}
if(is.na(priorities[1])) priorities<-nextpriority
else priorities<-c(priorities,nextpriority)
}
}
return(list(labels=tasklabels,starts=taskstarts,ends=taskends,
priorities=priorities))
}
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="",xlab="",cylindrical=FALSE,label.cex=1) {
oldpar <- par("mai","omi","xpd","xaxs","yaxs")
if(is.null(x)) x<-get.gantt.info(format=format)
if(any(x$starts > x$ends))
stop("Can't have a start date after an end date")
tasks<-unique(x$labels)
ntasks<-length(tasks)
# if no priorities are given, set all to 1
if(is.null(x$priorities)) x$priorities<-rep(1,ntasks)
if(is.null(dev.list())) plot.new()
charheight<-strheight("M",units="inches")
oldcex<-par(cex=label.cex)
maxwidth<-max(strwidth(x$labels,units="inches"))+0.3
par(oldcex)
if (is.null(xlim)) xlim=range(c(x$starts,x$ends))
npriorities<-max(x$priorities)
if(is.null(taskcolors)) taskcolors<-rainbow(npriorities)
if(length(taskcolors) < ntasks) taskcolors<-taskcolors[x$priorities]
nlabels<-length(x$labels)
# if the number of taskcolors is less than the number of labels,
# assign the first ntasks colors to the unique labels
if(length(taskcolors) < nlabels)
taskcolors<-taskcolors[as.numeric(factor(x$labels))]
# otherwise, the taskcolors will be assigned by order to the labels
bottom.margin<-ifelse(priority.legend || nchar(xlab),0.7,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(range(x$starts),c(1,ntasks),xlim=xlim,ylim=c(0.5,ntasks+0.5),
main="",xlab="",ylab="",axes=FALSE,type="n")
box()
if(nchar(main)) mtext(main,3,2,at=getFigCtr()[1])
if(nchar(xlab)) mtext(xlab,1,1)
if(is.na(vgrid.format)) {
if(is.null(vgridlab)) vgridlab=vgridpos
axis(3,at=vgridpos,labels=vgridlab)
tickpos<-vgridpos
}
else {
if(is.null(vgridpos)) tickpos<-axis.POSIXct(3,xlim,format=vgrid.format)
else tickpos<-vgridpos
# if no tick labels, use the grid positions if they exist
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=tasks,las=2,cex.axis=label.cex)
abline(v=tickpos,col="darkgray",lty = 3)
for(i in 1:ntasks) {
if(cylindrical)
cylindrect(x$starts[x$labels==tasks[i]],topdown[i]-half.height,
x$ends[x$labels==tasks[i]],topdown[i]+half.height,
col=taskcolors[i],gradient="y")
else
rect(x$starts[x$labels==tasks[i]],topdown[i]-half.height,
x$ends[x$labels==tasks[i]],topdown[i]+half.height,
col=taskcolors[x$labels==tasks[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],plim[3]-(plim[4]-plim[3])/10,
plim[1]+(plim[2]-plim[1])/4,
plim[3]-(plim[4]-plim[3])/20,col=taskcolors)
mtext("Priorities",side=1,line=1,at=plim[1]-(plim[2]-plim[1])/20,adj=1)
mtext(c("High","Low"),side=1,line=0,
at=c(plim[1],plim[1]+(plim[2]-plim[1])/4),
c(1-ntasks/10,1-ntasks/10))
}
par(oldpar)
invisible(x)
}
|
