Align gridArranged фасеточного 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

Это немного грязно, но вы можете массировать верстаки, чтобы иметь одинаковое количество строк и выровнять их. Дальнейшее уточнение выявило бы строки, соответствующие панелям сюжета, вместо того, чтобы предполагать, что все графики имеют одинаковую последовательность рядов панелей - и т. Д.

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)