垂直facet_grid中固定刻度的动态aes()标签设置

问题说明 #

我制作了一个带棒棒糖图的垂直网格，图的上方显示Model名称。现在想为指定的Y轴刻度（breaks = c(2, 6, 10, 14)）显示对应的Similar标签。

原始数据与绘图代码 #

生成数据的代码：

db0 =
  tibble(
    S1 = rep(c("BIO","MAT","MED","PHY","SOC"),12),
    Model = rep(c("A","B","C"),20),
    Unaltered = runif(60),
    Altered = runif(60)
  ) %>%
  arrange(S1,Model) |>
  mutate(
    Similar =
      c(rep(c("MED","MAT","PHY","SOC"),3),
        rep(c("MED","BIO","PHY","SOC"),3),
        rep(c("BIO","MAT","PHY","SOC"),3),
        rep(c("MED","BIO","MAT","SOC"),3),
        rep(c("MED","BIO","MAT","PHY"),3)
        )) |>
  arrange(S1,Similar,Model) |>
  group_by(S1) |>
  mutate(
    Similar = factor(Similar),
    Model = factor(Model),
    y_position = row_number(),
    y_position = ifelse(y_position > 3,
                        y_position + 1,
                        y_position),
    y_position = ifelse(y_position > 7,
                        y_position + 1,
                        y_position),
        y_position = ifelse(y_position > 11,
                        y_position + 1,
                        y_position),
    Increase = ifelse(Altered > Unaltered, TRUE, FALSE)
  )

原始绘图代码：

db0 |> 
  ggplot(aes(y = y_position, group = interaction(Similar, Model))) + 
  geom_segment(aes(x = Unaltered, xend = Altered, color = Increase)) + 
  geom_point(aes(x = Unaltered), color = "black") + 
  geom_point(aes(x = Altered, color = Increase)) + 
  scale_color_manual(values = c("purple", "gold")) +
  scale_x_continuous(name = "Value", limits = c(0, 1)) + 
  theme_test() +
  theme(
    axis.text.y = element_text(size = 10),
    panel.grid.major.y = element_line(color = "grey90"),
    panel.grid.minor.y = element_blank(),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    legend.position = "none"
  ) +
  scale_y_continuous(
    breaks = c(2, 6, 10, 14),
    #labels = aes(Similar)
    ) +
  geom_text(aes(x = (Altered + Unaltered) / 2,
                y = y_position + .5,
                label = Model), size = 4,
            check_overlap = TRUE) +
  facet_grid(S1 ~ ., scales = "free_y")

修改方案 #

因为每个S1分组的Y轴刻度对应唯一的Similar值，我们可以先从数据中提取对应关系，再传给scale_y_continuous的labels参数：

# 提取每个S1分组下，目标y_position对应的Similar标签
label_map <- db0 |>
  filter(y_position %in% c(2,6,10,14)) |>
  distinct(S1, y_position, Similar) |>
  tidyr::pivot_wider(names_from = y_position, values_from = Similar)

# 修改后的绘图代码
db0 |> 
  ggplot(aes(y = y_position, group = interaction(Similar, Model))) + 
  geom_segment(aes(x = Unaltered, xend = Altered, color = Increase)) + 
  geom_point(aes(x = Unaltered), color = "black") + 
  geom_point(aes(x = Altered, color = Increase)) + 
  scale_color_manual(values = c("purple", "gold")) +
  scale_x_continuous(name = "Value", limits = c(0, 1)) + 
  theme_test() +
  theme(
    axis.text.y = element_text(size = 10),
    panel.grid.major.y = element_line(color = "grey90"),
    panel.grid.minor.y = element_blank(),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    legend.position = "none"
  ) +
  scale_y_continuous(
    breaks = c(2, 6, 10, 14),
    # 根据当前面板的S1分组匹配对应标签
    labels = function(breaks) {
      current_panel <- ggplot2::current_panel_params()$facets$S1
      label_map |> filter(S1 == current_panel) |> dplyr::pull(all_of(as.character(breaks)))
    }
  ) +
  geom_text(aes(x = (Altered + Unaltered) / 2,
                y = y_position + .5,
                label = Model), size = 4,
            check_overlap = TRUE) +
  facet_grid(S1 ~ ., scales = "free_y")

关键解释 #

1. 生成标签映射表：通过filter筛选出目标y刻度对应的行，再用pivot_wider把每个S1分组的刻度与标签对应起来，方便后续匹配。
2. 动态标签函数：在labels中使用自定义函数，通过current_panel_params()获取当前面板的S1分组，然后从映射表中提取对应刻度的Similar标签，实现分面板的动态标签显示。

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