Align gridArranged facetted ggplots

Question

I've created a faceted plot, separately for three different groups in my data, like so:

df <- data.frame(x=rep(seq(0.05,1,by=0.05),times=40),
                 y=sample(c('A','B'),20*40,replace=TRUE),
                 id=rep(1:40,each=20),
                 group=c(rep(1,20*12),rep(2,20*12),rep(3,20*16)))

g1 <- ggplot(df[df$group==1,],aes(x,y,group=id))
g1 <- g1 + geom_line()
g1 <- g1 + facet_wrap(~id,ncol=3)

g2 <- ggplot(df[df$group==2,],aes(x,y,group=id))
g2 <- g2 + geom_line()
g2 <- g2 + facet_wrap(~id,ncol=3)

g3 <- ggplot(df[df$group==3,],aes(x,y,group=id))
g3 <- g3 + geom_line()
g3 <- g3 + facet_wrap(~id,ncol=3)

grid.arrange(g1,g2,g3,nrow=1)

which gives me this:

As you can see, the number of facets differs between the three groups which means that the facets in the three columns have different heights. Is there any way to harmonize this height in a non-fragile way (i.e. without me having to manually determine the heights of columns 2 and 3 that gives me facets that look like they have roughly the same height)?

Answer 1

Here's a solution with some guidance from this question.

library(ggplot2)
library(gridExtra)


ncol = 3 
df <- data.frame(x=rep(seq(0.05,1,by=0.05),times=40),
                 y=factor(sample(c('A','B'),20*40,replace=TRUE), levels = c("A", "B")),
                 id=rep(1:40,each=20),
                 group=c(rep(1,20*12),rep(2,20*12),rep(3,20*16)))

max_cases <- max(table(unique(df[,c("id", "group")])$group))

# create phantom plots for everything in the containing rectangle to standardize labels
rect_dim <- ceiling(max_cases / ncol) * ncol

plots <- lapply(X=unique(df$group), FUN= function(i){

  df_case <- subset(df, subset= group == i)
  tot_case <- nrow(unique(df_case[,c("id", "group")]))
  # create fill levels to pad the plots
  fill_levels <- unlist(lapply(X=1:(rect_dim - tot_case), function(y){paste0(rep(x=" ", times=y), collapse="")}))
  df_case$id.label <- ordered(df_case$id, levels = c(unique(df_case$id), fill_levels))

  g_case <- ggplot(df_case,aes(x,y,group=id.label)) + 
    geom_line() +
    facet_wrap(~id.label, ncol = ncol, drop=FALSE)

  # whiteout the inner y axis elements to clean it up a bit
  if(i != 1){
    g_case <- g_case + theme(axis.text.y = element_text(color = "white"), 
                             axis.title.y = element_text(color = "white"),
                             axis.ticks.y = element_line(color = "white"))
  }

  g_case <- ggplotGrob(g_case)
  rm_me <- (tot_case:rect_dim)[-1]
  # remove empty panels and layout
  g_case$grobs[names(g_case$grobs) %in% c(paste0("panel", rm_me), paste0("strip_t.", rm_me))] <- NULL
  g_case$layout <- g_case$layout[!(g_case$layout$name %in% c(paste0("panel-", rm_me), paste0("strip_t-", rm_me))),]
  g_case
})

plots$nrow = 1
do.call("grid.arrange", plots)

Answer 2

It's a bit messy, but you can massage the gtables to have the same number of rows, and align them. Further refinement would locate the rows corresponding to plot panels, rather than assume that all plots have the same row sequence of panel - axes - etc.

library(gtable)

cbind_top = function(...){
  pl <- list(...)
  ## test that only passing plots
  stopifnot(do.call(all, lapply(pl, inherits, "gg")))
  gl <- lapply(pl, ggplotGrob)
  nrows <- sapply(gl, function(x) length(x$heights))
  tallest <- max(nrows)
  add_dummy <- function(x, n){
    if(n == 0) return(x)
    gtable_add_rows(x, rep(unit(0, "mm"), n), nrow(x)-2)
  }
  gl <- mapply(add_dummy, x=gl, n=tallest - nrows)

  compare_unit <- function(u1,u2){
    n <- length(u1)
    stopifnot(length(u2) == n)
    null1 <- sapply(u1, attr, "unit")
    null2 <- sapply(u2, attr, "unit")
    null12 <- null1 == "null" | null2 == "null"
    both <- grid::unit.pmax(u1, u2)
    both[null12] <- rep(list(unit(1,"null")), sum(null12))
    both
  }

  bind2 <- function(x,y){
    y$layout$l <- y$layout$l + ncol(x)
    y$layout$r <- y$layout$r + ncol(x)
    x$layout <- rbind(x$layout, y$layout)
    x$widths <- gtable:::insert.unit(x$widths, y$widths)
    x$colnames <- c(x$colnames, y$colnames)
    x$heights <- compare_unit(x$heights, y$heights)
    x$grobs <- append(x$grobs, y$grobs)
    x
  }
  combined <- Reduce(bind2, gl[-1], gl[[1]])

  grid::grid.newpage()
  grid::grid.draw(combined)
}

cbind_top(g1,g2,g3)