顶部带有条形标签的两列 facet_grid

Question

facet_grid 和 facet_wrap 各有其局限性。

facet_wrap 没有 space = "free" 参数，导致绘图的 y 轴没有吸引力（代码见 Add space argument to facet_wrap）

facet_grid 受到侧面标签的限制（有关代码，请参阅Add space argument to facet_wrap）。

已提供将facet_grid 标签移至顶部的解决方案（请参阅ggplot2: Using gtable to move strip labels to top of panel for facet_grid）。

是否可以使用ggplot2: Using gtable to move strip labels to top of panel for facet_grid 解决方案来制作 2 列图形，例如使用带有 facet_wrap 的 ncol = 2 参数创建的，或者可以使用 facet_wrap 本身来完成解决方案？解决方案应如下所示，y 轴间距类似于上面的 facet_grid 示例。

要求是；顶部的标签，y 轴上的适当间距，两个 x 轴使用相同的比例。

Answer 1

这是您要查找的输出吗？

library(tidyverse)
library(gtable)
library(grid)
library(gridExtra)
#> 
#> Attaching package: 'gridExtra'
#> The following object is masked from 'package:dplyr':
#> 
#>     combine

p1 <- mtcars %>%
  rownames_to_column() %>%
  filter(carb %in% c(1, 3, 6)) %>%
  ggplot(aes(x = disp, y = rowname)) +
  geom_point() +
  xlim(c(0, 450)) +
  facet_grid(carb ~ ., scales = "free_y", space = "free_y") +
  theme(panel.spacing = unit(1, 'lines'),
        strip.text.y = element_text(angle = 0))

gt1 <- ggplotGrob(p1)
panels <-c(subset(gt1$layout, grepl("panel", gt1$layout$name), se=t:r))
for(i in rev(panels$t-1)) {
  gt1 = gtable_add_rows(gt1, unit(0.5, "lines"), i)
}
panels <-c(subset(gt1$layout, grepl("panel", gt1$layout$name), se=t:r))
strips <- c(subset(gt1$layout, grepl("strip-r", gt1$layout$name), se=t:r))
stripText = gtable_filter(gt1, "strip-r")
for(i in 1:length(strips$t)) {
  gt1 = gtable_add_grob(gt1, stripText$grobs[[i]]$grobs[[1]], t=panels$t[i]-1, l=5)
}
gt1 = gt1[,-6]
for(i in panels$t) {
  gt1$heights[i-1] = unit(0.8, "lines")
  gt1$heights[i-2] = unit(0.2, "lines")
}

p2 <- mtcars %>%
  rownames_to_column() %>%
  filter(carb %in% c(2, 4, 8)) %>%
  ggplot(aes(x = disp, y = rowname)) +
  geom_point() +
  xlim(c(0, 450)) +
  facet_grid(carb ~ ., scales = "free_y", space = "free_y") +
  theme(panel.spacing = unit(1, 'lines'),
        strip.text.y = element_text(angle = 0))

gt2 <- ggplotGrob(p2)
#> Warning: Removed 2 rows containing missing values (geom_point).
panels <-c(subset(gt2$layout, grepl("panel", gt2$layout$name), se=t:r))
for(i in rev(panels$t-1)) {
  gt2 = gtable_add_rows(gt2, unit(0.5, "lines"), i)
}
panels <-c(subset(gt2$layout, grepl("panel", gt2$layout$name), se=t:r))
strips <- c(subset(gt2$layout, grepl("strip-r", gt2$layout$name), se=t:r))
stripText = gtable_filter(gt2, "strip-r")
for(i in 1:length(strips$t)) {
  gt2 = gtable_add_grob(gt2, stripText$grobs[[i]]$grobs[[1]], t=panels$t[i]-1, l=5)
}
gt2 = gt2[,-6]
for(i in panels$t) {
  gt2$heights[i-1] = unit(0.8, "lines")
  gt2$heights[i-2] = unit(0.2, "lines")
}

grid.arrange(gt1, gt2, ncol = 2)

^{由reprex package 创建于 2021-12-16 (v2.0.1)}

如果没有，需要进行哪些更改？