How to align an ordinary ggplot with a faceted one in cowplot?

后端 未结 5 393
南方客
南方客 2020-12-24 13:40

I\'m trying to arrange plots for publication with the use of cowplot package.
I just want the panels to be equally sized and labelled.

Reproducibl

5条回答
  •  轻奢々
    轻奢々 (楼主)
    2020-12-24 14:41

    here's a solution based on this idea

    library(ggplot2)
    library(grid)
    library(gridExtra)
    library(gtable)
    
    gtable_frame <- function(g, width=unit(1,"null"), height=unit(1,"null")){
      panels <- g[["layout"]][grepl("panel", g[["layout"]][["name"]]), ]
      ll <- unique(panels$l)
      tt <- unique(panels$t)
    
      fixed_ar <- g$respect
      if(fixed_ar) { # there lies madness, want to align despite aspect ratio constraints
        ar <- as.numeric(g$heights[tt[1]]) / as.numeric(g$widths[ll[1]])
        height <- width * ar
        g$respect <- FALSE
      }
    
      core <- g[seq(min(tt), max(tt)), seq(min(ll), max(ll))]
      top <- g[seq(1, min(tt)-1), ]
      bottom <- g[seq(max(tt)+1, nrow(g)), ]
      left <- g[, seq(1, min(ll)-1)]
      right <- g[, seq(max(ll)+1, ncol(g))]
    
      fg <- nullGrob()
      lg <-  if(length(left))  g[seq(min(tt), max(tt)), seq(1, min(ll)-1)] else fg
      rg <- if(length(right)) g[seq(min(tt), max(tt)), seq(max(ll)+1,ncol(g))] else fg
      grobs = list(fg, g[seq(1, min(tt)-1), seq(min(ll), max(ll))], fg, 
                   lg, g[seq(min(tt), max(tt)), seq(min(ll), max(ll))], rg, 
                   fg, g[seq(max(tt)+1, nrow(g)), seq(min(ll), max(ll))], fg)
      widths <- unit.c(sum(left$widths), width, sum(right$widths))
      heights <- unit.c(sum(top$heights), height, sum(bottom$heights))
      all <- gtable_matrix("all", grobs = matrix(grobs, ncol=3, nrow=3, byrow = TRUE), 
                           widths = widths, heights = heights)
      all[["layout"]][5,"name"] <- "panel" # make sure knows where the panel is for nested calls
      if(fixed_ar)  all$respect <- TRUE
      all
    }
    
    
    p1 <- ggplot(mtcars)+
      geom_point(aes(x=mpg,y=hp))+
      theme_bw()+
      theme(aspect.ratio=1)
    
    p2 <- ggplot(mtcars)+
      geom_point(aes(x=mpg,y=hp,fill=cyl))+
      facet_wrap(~cyl,ncol=2)+
      theme_bw()+
      theme(aspect.ratio=1,
            legend.position='none')
    
    g1 <- ggplotGrob(p1)
    g2 <- ggplotGrob(p2)
    fg1 <- gtable_frame(g1)
    fg2 <- gtable_frame(g2)
    grid.newpage()
    grid.draw(cbind(fg1, fg2))
    

    Note that the gtable_frame function wraps plots based on their panels, but excluding the panel strips by design (I find it more pleasant).

提交回复
热议问题