对齐 gridArranged facetted ggplots

Question

我为我的数据中的三个不同组分别创建了一个分面图，如下所示：

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)

这给了我这个：

如您所见，三组之间的刻面数量不同，这意味着三列中的刻面具有不同的高度。有没有办法以一种非脆弱的方式协调这个高度（即，我不必手动确定第 2 列和第 3 列的高度，这让我的刻面看起来具有大致相同的高度）？

Answer 1

这是一个解决方案，来自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

这有点乱，但你可以按摩 gtables 以获得相同的行数，并对齐它们。进一步细化将定位与绘图面板对应的行，而不是假设所有绘图都具有相同的面板行序列 - 轴 - 等。

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)