如何在使用ggplot2创建甘特图时，有条件地加粗y轴文本？

Question

我正在尝试使用主题根据属性 ActivitySort 条件设置元素文本。如果值为0，我希望将文本加粗，否则保持普通。

require("tidyverse")

task0 <- c('Strategy 1', 'Strategy 1', '2017-04-01', '2020-04-01',0, "Strategy")
task1 <- c('Strategy 1', 'Collect data', '2017-04-01', '2018-04-01',1, "In Progress")
task2 <- c('Strategy 1', 'Clean data', '2018-04-01', '2018-06-01', 1, "Completed")
task3 <- c('Strategy 1', 'Analyse data', '2018-06-01', '2019-04-01',1, "Discontinued")
task10 <- c('Strategy 2', 'Strategy 2', '2017-04-01', '2020-04-01',0, "Strategy")
task11 <- c('Strategy 2', 'Collect data again', '2017-04-01', '2018-04-01',1, "In Progress")
task12 <- c('Strategy 2', 'Clean data again', '2018-04-01', '2018-06-01', 1, "Completed")
task13 <- c('Strategy 2', 'Analyse data again', '2018-06-01', '2019-04-01',1, "Discontinued")
task14 <- c('Strategy 2', 'Write report again', '2019-04-01', '2020-04-01', 1, "Planned")

dataset <- as.data.frame(rbind(task0, task1, task2, task3,task10, task11, task12, task13, task14))
names(dataset) <- c('StrategyName', 'Activity', 'Start', 'End', 'ActivitySort', "Status")


dataset <-  as_tibble(dataset)
dataset <-  dataset  %>% mutate(StartSort = as.Date(Start, "%Y-%m-%d" ))
dataset <-  dataset %>% arrange(desc(StrategyName), desc(ActivitySort), desc(StartSort),Activity,  End)

acts <- c("Strategy", "Completed","In Progress", "Discontinued","Planned")
actcols <- c("#000000","#548235", "#2E75B6", "#BF9000", "#7030A0")
els <-unique(dataset$Activity)

g.gantt <- gather(dataset, "state", "date", 3:4) %>% mutate(date = as.Date(date, "%Y-%m-%d" ), Status=factor(Status, acts[length(acts):1]), Activity=factor(Activity, els))

plot <- ggplot(g.gantt, aes(x = date, y = Activity, color = Status, group=Activity)) +
  geom_line(size = 5) +
  scale_color_manual(values=actcols, name="Status",  breaks = acts, limits = acts) +
  labs(x="Project year", y=NULL, title="Activity timeline")

plot <- plot + facet_grid(rows = vars(StrategyName),  scales="free")


plot <- plot + theme(axis.text.y=  element_text(face=ifelse((dataset$ActivitySort == 0),"bold","plain")))

plot

目前的代码使用ifelse加粗文本，但结果与预期不符。我希望只有黑线所示的策略、项目和策略状态才能被加粗。请注意，目前只有第二个策略被加粗，而预期是两个策略都应该被加粗。

- John Bowyer

Answer 1

你的问题在于将数据分成了两个分面，并将y轴设置为自由。这意味着它们不相同。通过ifelse语句，你只是传递了9个TRUE或FALSE值，这些值与外部数据集相关，即你的上图得到了9个值（其中前4个是FALSE，因此没有加粗显示的内容），而下部的图也得到了相同的9个值，因为第5个是TRUE，所以Strategy 2加粗显示。
你可以通过从facet_grid中删除scales="free"部分来轻松检查这一点。你应该会得到像这样的结果:

因此，你需要使用自定义函数，根据其内容加粗每个标签。我修改了这里的代码。

bold_labels <- function(breaks) {
  strategy <- filter(dataset, Activity %in% breaks) %>% 
    mutate(check = str_detect(Activity, "Strategy")) %>% 
    pull(check)
  labels <- purrr::map2(
    breaks, strategy,
    ~ if (.y) bquote(bold(.(.x))) else bquote(plain(.(.x)))
  )
  parse(text = labels)
}
plot <- ggplot(g.gantt, aes(x = date, y = Activity, color = Status, group=Activity)) +
  geom_line(size = 5) +
  scale_color_manual(values=actcols, name="Status",  breaks = acts, limits = acts) +
  labs(x="Project year", y=NULL, title="Activity timeline") +
  scale_y_discrete(labels = bold_labels) +
  facet_grid(rows = vars(StrategyName), scales="free_y")
plot

结果为：

- Arienrhod