两列 facet_grid，顶部有条形标签

Question

facet_grid 和 facet_wrap 各有其局限性。

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

facet_grid 受到侧面标签的限制（请参阅了解代码）。

已提供将 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 (v2.0.1)}

于 2021-12-16 创建

如果不是，需要做哪些改变？

两列 facet_grid，顶部有条形标签

Two column facet_grid with strip labels on top

r

ggplot2

facet-wrap

facet-grid