Two column facet_grid with strip labels on top-CodePudding

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

facet_grid is limited by having labels on the side (see

Solutions have been offered to move facet_grid labels to the top (see

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

CodePudding user response：

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?