如何在ggplot2的facet_grid密度图中为x≥2阈值区域着色

我需要在双因子分面的密度图中，为x≥2的区域添加红色填充。已知单分面因子的实现方法，但不知道如何处理mode.f和task.f两个分面因子的情况，请问用ggplot_build时怎么指定这两个因子的水平，或者有没有其他方法？

数据集示例（共750行） #

mode.f task.f      mgds
1        1      A 1.1413636
2        1      A 0.9105000
3        2      A 1.0320000
4        2      A 1.1811429
14       1      C 1.4646000
15       1      C 1.7505000
16       2      C 1.3968000
17       1      D 1.0668333
18       1      D 1.0084000
19       1      D 1.1622500
20       2      D 1.3452500
21       2      D 1.0132000
22       3      C 0.6960000
23       3      C 0.9180000
24       3      D 1.0128000
25       3      D 0.6670000
26       2      E 2.9190000
27       2      E 1.3755000
28       2      E 1.4080000
29       1      E 1.3878000
30       1      E 1.4816667

单分面因子的可行代码 #

mp <- ggplot(df,aes(x=mgds))+
  geom_density(color=NA,fill="gray30",alpha=.4)+
  facet_wrap(~mode.f)+
  theme_bw()+
  theme(strip.background = 
        element_rect(fill="gray95",color="gray60"),
        strip.text = element_text(colour="black",size=10),
        panel.border = element_rect(color="gray60"))+
  labs(x="MGD (s)",y="Density")

to_fill <- data_frame(
  x = ggplot_build(mp)$data[[1]]$x,
  y = ggplot_build(mp)$data[[1]]$y,
  mode.f = factor(ggplot_build(mp)$data[[1]]$PANEL, levels = 
  c(1,2,3), labels = c("1","2","3")))

mp + geom_area(data = to_fill[to_fill$x >= 2, ], 
               aes(x=x, y=y), fill = "red")

目标双因子分面代码 #

ggplot(df,aes(x=mgds))+
  geom_density(color=NA,fill="gray30",alpha=.4)+
  facet_grid(mode.f~task.f)+
  theme_bw()+
  theme(strip.background = element_rect(fill="gray95",color="gray60"),
        strip.text = element_text(colour="black",size=10),
        panel.border = element_rect(color="gray60"))+
  geom_vline(xintercept=2,linetype="longdash",color="gray50")+
  labs(x="Measure",y="Density")

针对双因子分面场景，核心是从ggplot_build的布局信息中提取每个面板对应的mode.f和task.f水平，建立面板与双因子的映射关系，具体步骤如下：

步骤1：构建基础绘图对象 #

# 先创建基础的双因子分面密度图
mp <- ggplot(df,aes(x=mgds))+
  geom_density(color=NA,fill="gray30",alpha=.4)+
  facet_grid(mode.f~task.f)+
  theme_bw()+
  theme(strip.background = element_rect(fill="gray95",color="gray60"),
        strip.text = element_text(colour="black",size=10),
        panel.border = element_rect(color="gray60"))+
  geom_vline(xintercept=2,linetype="longdash",color="gray50")+
  labs(x="Measure",y="Density")

步骤2：提取面板与双因子的映射关系 #

从ggplot_build的布局数据中，直接获取每个面板对应的两个因子水平，避免手动指定：

# 获取绘图的构建数据
build_info <- ggplot_build(mp)

# 提取面板与mode.f、task.f的映射
panel_map <- build_info$layout$layout_df %>%
  select(PANEL, mode.f, task.f)

# 整理需要填充的数据：关联双因子，筛选x≥2的区域
to_fill <- build_info$data[[1]] %>%
  left_join(panel_map, by = "PANEL") %>%
  filter(x >= 2)

步骤3：添加红色填充区域 #

将筛选后的填充数据添加到基础图中：

# 为x≥2区域添加红色填充
mp + geom_area(data = to_fill, aes(x=x, y=y), fill = "red", alpha = 0.4)

替代方案（兼容旧版tidyverse） #

如果你的dplyr版本较低，也可以用如下方式提取映射：

panel_map <- data.frame(
  PANEL = 1:nrow(build_info$layout$panel_params),
  mode.f = sapply(build_info$layout$panel_params, function(p) p$facet$rows[[1]]),
  task.f = sapply(build_info$layout$panel_params, function(p) p$facet$cols[[1]])
)

to_fill <- build_info$data[[1]] %>%
  left_join(panel_map, by = "PANEL") %>%
  filter(x >= 2)

内容的提问来源于stack exchange，提问作者Chris Monk