#' @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)))
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.