将二级标题添加到facet_wraps

Question

我有一个数据框，由分布在两个位置（即和）的八个站点（即A、B、C... ）组成。我已经为每个站点制作了一个数字，但是，我想添加一个额外的列标题来表示该站点的位置。我怎样才能做到这一点？HNorthSouthfacet_wrap()

示例数据

library(ggplot2)
library(dplyr)

set.seed(123)

df <- data.frame(matrix(ncol = 4, nrow = 24))
colnames(df)[1:4] <- c('location','site','x','y')
df$location <- rep(c('North','North','North','South','South','South'),4)
df$site <- c('A','A','A','E','E','E','B','B','B','F','F','F',
             'C','C','C','G','G','G','D','D','D','H','H','H')
df$x <- rep(seq(0,12,4),6)
df$y <- rnorm(24,50,20)
df

示例图（缺少辅助标头）

df %>%
  mutate(across(site, factor, levels = c('A','B','E','F',
                                         'C','D','G','H'))) %>%
  ggplot(aes(x = x, y = y)) +
  geom_point() +
  geom_line() +
  scale_x_continuous(breaks = seq(0,12,3),
                     limits = c(0,12)) +
  scale_y_continuous(breaks = seq(0,max(df$y),5)) +
  theme_bw() +
  facet_wrap(~site, nrow = 2)

这是一个类似的问题（链接在这里），但是，当已经有一个函数被调用时，我无法让它工作scale_x_continuous()，并且不清楚该答案如何与同一轴上的多个标题一起工作。

这是我正在寻找的输出的示例。请注意，df$location是辅助 x 轴标题，左侧两列是North站点，右侧两列是South站点。

Answer 1

基于 akrun 的答案，您可以通过将 中的相应元素设置为空白来隐藏条带strip_nested()。不过，我还没有找到删除多余空间的方法。

library(ggh4x)
#> Loading required package: ggplot2
library(ggplot2)
library(dplyr)


set.seed(123)

df <- data.frame(matrix(ncol = 4, nrow = 24))
colnames(df)[1:4] <- c('location','site','x','y')
df$location <- rep(c('North','North','North','South','South','South'),4)
df$site <- c('A','A','A','E','E','E','B','B','B','F','F','F',
             'C','C','C','G','G','G','D','D','D','H','H','H')
df$x <- rep(seq(0,12,4),6)
df$y <- rnorm(24,50,20)
df %>%
  mutate(across(site, factor, levels = c('A','B','E','F',
                                         'C','D','G','H'))) %>%
  ggplot(aes(x = x, y = y)) +
  geom_point() +
  geom_line() +
  scale_x_continuous(breaks = seq(0,12,3),
                     limits = c(0,12)) +
  scale_y_continuous(breaks = seq(0,max(df$y),5)) +
  theme_bw() +
  facet_manual(
    vars(location, site), design = "ABEF\nCDGH",
    strip = strip_nested(
      text_x = list(element_text(), element_blank())[c(1,1,2,2,rep(1, 8))],
      background_x = list(element_rect(), element_blank())[c(1,1,2,2,rep(1, 8))]
    ))

^{由reprex 包于 2023 年 1 月 5 日创建(v2.0.1)}