Two column facet_grid with strip labels on top

Question

facet_grid and facet_wrap each have their own limitations.

facet_wrap does not have a space = "free" argument, leading to plots with unattractive y-axes (see Add space argument to facet_wrap for code)

facet_grid is limited by having labels on the side (see Add space argument to facet_wrap for code).

Solutions have been offered to move facet_grid labels to the top (see ggplot2: Using gtable to move strip labels to top of panel for facet_grid).

Is it possible to use the ggplot2: Using gtable to move strip labels to top of panel for facet_grid solution to make a 2 column figure, such as would be created using the ncol = 2 argument with facet_wrap, or can the solution be accomplished using facet_wrap itself? The solution should look like below with y-axis spacing similar to the facet_grid example above.

Requirements are; labels on top, proper spacing on y-axis, and both x-axes use the same scale.

Answer 1

Is this the output you're looking for?

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)

^{Created on 2021-12-16 by the reprex package (v2.0.1)}

If not, what changes need to be made?