/
ganttChart.R
151 lines (147 loc) · 4.24 KB
/
ganttChart.R
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
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
#' @title Gantt Chart
#'
#' @description A flexible Gantt Chart.
#'
#' @param df a data.frame (see details).
#' @param task_order a logical. Should the tasks be ordered? See below for
#' more details.
#' @param mstone_add Should milestones be added?
#' @param mstone_lwd lines width for the milestone.
#' @param mstone_spacing spacing between milestones (expressed as figure unit).
#' @param axes a logical. Should the axes be added?
#' @param mstone_font font of milestone (ignore of `axes` is `FALSE`).
#' @param lighten_done percentage use to lighten done task (see [lighten()]).
#' Default set to 0, so the completed task of a given milestone have the same
#' color as the pending ones.
#'
#' @author David Beauchesne, Kevin Cazelles
#'
#' @details
#' Argument `df` should be a data frame with the following columns (in any
#' order):
#' * `milestone`: milestones names,
#' * `due`: due date (will be converted into a date with [as.Date()]),
#' * `start`: start date (will be converted into a date with [as.Date()]),
#' * `task`: tasks names.
#' It might as well include any of the following optional columns:
#' * `done`: vector of logicals indicating whether the task if completed
#' * `col`: to custom the color of the tasks.
#'
#' @references
#' <https://insileco.github.io/2017/09/20/gantt-charts-in-r/>
#'
#' @export
#' @examples
#' ff <- ganttChart(dfGantt,
#' mstone_lwd = 3, mstone_spacing = 0.6,
#' lighten_done = 80
#' )
#'
ganttChart <- function(df, task_order = TRUE, mstone_add = task_order,
mstone_spacing = 1, mstone_lwd = 2, axes = TRUE, mstone_font = 2,
lighten_done = 0) {
##
opar <- par(no.readonly = TRUE)
on.exit(par(opar))
## checks
df$start <- as.Date(df$start)
df$due <- as.Date(df$due)
stopifnot(all(df$start <= df$due))
## order data frame
if (mstone_add) {
df <- mstone_add(df)
} else {
if ("done" %in% names(df)) {
df$done <- c("I", "C")[df$done + 1]
}
}
if (task_order) df <- order_dfgantt(df)
## y coordinates
tbm <- table(df$milestone)
nms <- length(tbm)
if (!task_order & mstone_add) {
warning("spacing set to 0")
mstone_spacing <- 0
}
df$y <- rev(
seq_len(nrow(df))) + mstone_spacing * (nms - mstone_tonum(df$milestone)
)
##
plot.new()
if (axes) {
# update margins with size of max character
opar$mai[2L] <- max(strwidth(c(df$task, df$milestone), "inches")) * 1.25
par(mai = opar$mai)
}
plot.window(xlim = range(c(df$due, df$start)), ylim = range(df$y))
##
if (axes) {
if (mstone_font != opar$font) {
id <- df$done == "M"
axis(2, at = df$y[!id], labels = df$task[!id], lwd = 0, las = 1)
axis(2,
at = df$y[id], labels = df$task[id], lwd = 0, las = 1,
font = mstone_font
)
} else {
axis(2, at = df$y, labels = df$task, lwd = 0, las = 1)
}
vald <- pretty(range(c(df$due, df$start)))
axis(1, at = vald, labels = vald)
}
##
if ("col" %in% names(df)) {
cols <- df$col
} else {
cols <- mstone_tonum(df$milestone)
id <- df$done == "C"
if (length(id) && lighten_done) {
cols[id] <- unlist(lapply(cols[id], lighten, lighten_done))
}
}
#
for (i in seq_len(nrow(df))) {
tl <- ifelse(df$done[i] == "M", mstone_lwd, opar$lwd)
lines(
c(df$start[i], df$due[i]), rep(df$y[i], 2),
col = cols[i],
lwd = tl
)
}
##
invisible(df)
}
order_dfgantt <- function(df) {
# use the minimum of the starting day among tasks of a milestone to sort
# them out properly
tmp <- merge(df,
aggregate(start ~ milestone, df, min),
by = "milestone", suffixes = c("", "_tmp")
)
print(tmp)
ord <- order(tmp$start_tmp, tmp$milestone, tmp$start, tmp$due,
decreasing = c(FALSE, FALSE, FALSE, TRUE), method = "radix"
)
tmp[ord, -ncol(tmp)]
}
mstone_add <- function(df) {
tmp <- merge(
aggregate(start ~ milestone, df, min),
aggregate(due ~ milestone, df, max),
by = "milestone"
)
tmp$task <- tmp$milestone
# convert to letter
if (!"done" %in% names(df)) {
df$done <- "I"
} else {
df$done <- c("I", "C")[df$done + 1]
}
tmp$done <- "M"
#
if ("col" %in% names(df)) {
tmp$col <- aggregate(col ~ milestone, df, blendColors)
}
rbind(df, tmp)
}
mstone_tonum <- function(x) as.numeric(factor(x, levels = unique(x)))