为甘特图添加阴影以描绘周末

Posted 2023-05-08

【中文标题】为甘特图添加阴影以描绘周末

【英文标题】：Add shading to a gantt chart to delineate weekends

【发布时间】：2018-09-16 11:26:54

【问题描述】：

我已经使用ggplot创建了一个甘特图，代码如下：

# load packages
require("ggplot2")
require("reshape2")

###############################################################################

# Create list of tasks name strings.
tasks <- c("Write introduction", "Parse citation data",
           "Construct data timeline",
           "Write methods", "Model formulation", 
           "Model selection", "Write results", "Write discussion",
           "Write abstract and editing")

# Compile dataframe of task names, and respective start and end dates.
dfr <- data.frame(
  name = factor(tasks, levels = tasks),
  start.date = as.Date(c("2018-04-09", "2018-04-09", "2018-04-16",
                         "2018-04-30", "2018-04-16", "2018-05-21",
                         "2018-06-04", "2018-07-02", "2018-07-30")),
  end.date = as.Date(c("2018-04-30", "2018-04-20", "2018-05-18",
                       "2018-06-01", "2018-05-18", "2018-06-01",
                       "2018-06-29", "2018-07-27", "2018-08-31"))
)

# Merge start and end dates into durations.
mdfr <- melt(dfr, measure.vars = c("start.date", "end.date"))

###############################################################################

# Create gantt chart.

ggplot(mdfr, aes(value, name)) +
  geom_line(size=4) +
  xlab(NULL) +
  ylab(NULL) +
  ggtitle("Project gantt chart") +
  theme_minimal() +
  theme(aspect.ratio = 0.3, axis.text = element_text(size = 10)) 

如何对图表进行格式化，以便周末在背景上加阴影或在背景网格上划定？

【参考方案1】：

首先您需要获取工作日信息：

foo <- as.Date(mdfr$value)
# Generate days from first to last day
allDays <- seq(min(foo), max(foo), by = "days")
# Extract weekday
days <- data.frame(day = weekdays(allDays), date = allDays)

周末加geom_vline（竖线）：

library(ggplot2)

ggplot(mdfr) +
    geom_vline(data = subset(days, day %in% c("Saturday", "Sunday")),
              aes(xintercept = date), color = "grey80", size = 2) +
    geom_line(aes(value, name), size = 4) +
    labs(title = "Project gantt chart",
         x = NULL,
         y = NULL) +
    theme_minimal() +
    theme(aspect.ratio = 0.3, 
          axis.text = element_text(size = 10))

【讨论】：

完美运行！谢谢！

【参考方案2】：

你可以试试

library(tidyverse)
mdfr %>% 
  as.tibble() %>% 
  mutate(date=as.POSIXct(value)) %>% 
  ggplot(aes(date, name)) +
  geom_line(size=4) +
  xlab(NULL) +
  ylab(NULL) +
  ggtitle("Project gantt chart") +
  theme_minimal() +
  theme(aspect.ratio = 0.3, axis.text = element_text(size = 10)) +
  scale_x_datetime(date_minor_breaks = "7 day") + 
  theme(panel.grid.minor.x = element_line(size=2, color = "pink"))

想法是将value 转换成POSIXct 格式（我这里使用tidyverse。但这不是必需的），然后您可以在scale_x_datetime 中指定与"7 days 的小中断。他们每周六开始。使用更大的尺寸也可以覆盖星期天。

【讨论】：

非常好的解决方案！

@PoGibas 问题是当次要击中主要网格线时。然后没有显示未成年人。至今无解。但必须是可能的。 ;)

也许删除次要行？