r - 在ggplot2 facet_wrap中跨列组合多个方面条

Question

我试图在两个相邻面板上组合刻面条(总是有两个相邻面板具有相同的第一个 ID 变量，但有两种不同的场景，我们称它们为“A”和“B”)。我不是特别喜欢 gtable + grid我试过的解决方案，但遗憾的是我不能使用 facet_nested()来自 ggh4x包(由于存在各种限制和所需的依赖项，我无法将其安装在我公司的服务器上 - 我只考虑使用相关代码，但由于依赖项，这又不容易)。
我希望通过组合顶部刻面条来指示哪些面板“属于一起”，从而使我更易于阅读的基本图的最小可行示例如下所示:

library(tidyverse)
library(gtable)
library(grid)

idx = 1:16

p1 = expand_grid(id=idx, id2=c("A", "B"), x=1:10) %>%
  mutate(y=rnorm(n=n())) %>%
  ggplot(aes(x=x,y=y)) +
  geom_jitter() +
  facet_wrap(~id + id2, nrow = 4, ncol=8)

带有“1”的 strip 、带有“2”的 strip 等应该组合起来(实际上它是一个稍长的文本，但这只是为了说明)。我试图为类似的情况调整答案( https://stackoverflow.com/a/40316170/7744356 - 谢谢@markus 再次找到它)，但这是我尝试过的。正如你在下面看到的，我生产的高度似乎是错误的。我认为这一定是我忽略/不理解的一些微不足道的事情。

# Combine strips for a ID
g <- ggplot_gtable(ggplot_build(p1))
strip <- gtable_filter(g, "strip-t", trim = FALSE)
stript <- which(grepl('strip-t', g$layout$name))
  
stript2 = stript[idx*2-1]
top <- strip$layout$t[idx*2-1]
# # Using the $b below instead of b = top[i]+1, also seems  not to work
#bot <- strip$layout$b[idx*2-1] 
l   <- strip$layout$l[idx*2-1]
r   <- strip$layout$r[idx*2]
  
mat   <- matrix(vector("list",
                       length = length(idx)*3),
                nrow = length(idx))
mat[] <- list(zeroGrob())

res <- gtable_matrix("toprow", mat,
                     unit(c(1, 0, 1), "null"),
                     unit( rep(1, length(idx)),
                           "null"))

for (i in 1:length(stript2)){
  if (i==1){
    zz <- res %>% 
      gtable_add_grob(g$grobs[[stript2[i]]]$grobs[[1]], 1, 1, 1, 3) %>%
      gtable_add_grob(g, ., 
                      t = top[i],  
                      l = l[i],  
                      b = top[i]+1,  
                      r = r[i], 
                      name = c("add-strip")) 
  } else {
    zz <- res %>% 
      gtable_add_grob(g$grobs[[stript2[i]]]$grobs[[1]], 1, 1, 1, 3) %>%
      gtable_add_grob(zz, ., 
                      t = top[i],  
                      l = l[i],  
                      b = top[i]+1,  
                      r = r[i], 
                      name = c("add-strip"))
  } 
}

grid::grid.draw(zz)

------------ 使用 ggh4x 实现更新 -----------------
这可能会为许多人解决此类问题，但也有其缺点(例如，跨行的轴对齐有点手动，可能需要手动删除 x 轴并确保限制相同，添加统一的 y 轴标签，需要从 github 安装一个包: devtools::install_github("teunbrand/ggh4x@v0.1") 对于特定版本，加上 cowplot 与例如 ggtern 的交互很差)。所以我会喜欢它，如果有人仍然设法做一个纯粹的 gtable + grid版本。

library(tidyverse)
library(ggh4x)
library(cowplot)

plots = expand_grid(id=idx, id2=c("A", "B"), x=1:10) %>%
  mutate(y=rnorm(n=n()),
         plotrow=(id-1)%/%4+1) %>%
  group_by(plotrow) %>%
  group_map( ~ ggplot(data=.,
                      aes(x=x,y=y)) +
               geom_jitter() +
               facet_nested( ~ id + id2, ))
            
plot_grid(plotlist = plots, nrow = 4, ncol=1)

Answer 1

我玩这个游戏有点晚了，但是 ggh4x 现在有 facet_nested_wrap()应该大大简化这个问题的实现(免责声明:我写了 ggh4x)。

library(tidyverse)
library(ggh4x)

idx = 1:16

p1 = expand_grid(id=idx, id2=c("A", "B"), x=1:10) %>%
    mutate(y=rnorm(n=n())) %>%
    ggplot(aes(x=x,y=y)) +
    geom_jitter() +
    facet_nested_wrap(~id + id2, nrow = 4, ncol=8)
p1

创建于 2020-08-12 由 reprex package (v0.3.0)
请记住，这可能仍然存在一些错误。另外，我知道这对 OP 没有帮助，因为他的软件包版本受到限制，但我想我还是在这里提到了这一点。