Search code examples
rggplot2egg

Setting widths on tall figure tables in ggarrange() - possible bug? (R, ggplot, egg)


I'm working in R and Rstudio arranging a set of rather complicated plots using the usually magnificent ggarrange(), but this time I've run into a persistent issue which seems easy to reproduce and possibly is a bug?

library(ggplot2)
library(egg)
datar <- data.frame(cbind(xxx = c(1,4,6,7,9,7,6,5,4,3,2,4,5,6), 
                          yyy = c(6,8,9,0,6,5,4,3,6,7,5,9,6,2)))
ggarrange(
    ggplot(datar, aes(xxx, yyy))+geom_point(),
    ggplot(datar, aes(xxx, yyy))+geom_point(),
    ggplot(datar, aes(xxx, yyy))+geom_point(),
    ggplot(datar, aes(xxx, yyy))+geom_point(),
    ggplot(datar, aes(xxx, yyy))+geom_point(),
    ggplot(datar, aes(xxx, yyy))+geom_point(),
    ncol = 2,
    widths = c(1,2)
)

Which produces the following error:

Error in unit.c(sum(left$widths), width, sum(right$widths)) : it is invalid to combine 'unit' objects with other types

This does not happen of you remove two of the plots (turning the plot into a 2x2 matrix). Furthermore, this pattern seems to scale up; if I run 9 plots in a 3x3 matrix (ncol = 3, widths = c(1,2,3)) it works, but if I add 3 more plots (as in a 3x4 matrix), I again get the same error message.

Is this a bug? Does it have a fix? Is there a work-around?


Solution

  • Definitely a bug. Try the following replacement which seems to work,

    ggarrange <- function(..., plots = list(...), nrow = NULL, ncol = NULL, widths = NULL, 
                          heights = NULL, byrow = TRUE, top = NULL, bottom = NULL, left = NULL, right = NULL, 
                          padding = unit(0.5, "line"), clip = "on", draw = TRUE, newpage = TRUE, debug = FALSE, 
                          labels = NULL, label.args = list(gp = grid::gpar(font = 4, cex = 1.2))) {
      n <- length(plots)
      grobs <- lapply(plots, ggplot2::ggplotGrob)
    
    
      ## logic for the layout if nrow/ncol supplied, honour this if not, use length of
      ## widths/heights, if supplied if nothing supplied, work out sensible defaults
    
      ## nothing to be done but check inconsistency
      if (!is.null(ncol) && !is.null(widths)) {
        stopifnot(length(widths) == ncol)
      }
      if (!is.null(nrow) && !is.null(heights)) {
        stopifnot(length(heights) == nrow)
      }
      ## use widths/heights if supplied
      if (is.null(ncol) && !is.null(widths)) {
        ncol <- length(widths)
      }
      if (is.null(nrow) && !is.null(heights)) {
        nrow <- length(heights)
      }
      ## work out the missing one
      if (is.null(nrow) && !is.null(ncol)) {
        nrow <- ceiling(n/ncol)
      }
      if (is.null(ncol) && !is.null(nrow)) {
        ncol <- ceiling(n/nrow)
      }
    
      ## it may happen that sufficient info was passed, but incompatible with number of grobs
      ## (fewer cells)
      stopifnot(nrow * ncol >= n)
    
      ## last case: nothing exists
      if (is.null(nrow) && is.null(ncol) && is.null(widths) && is.null(heights)) {
        nm <- grDevices::n2mfrow(n)
        nrow <- nm[1]
        ncol <- nm[2]
      }
    
      if (n%/%nrow) {
        # trouble, we need to add dummy grobs to fill the layout
        grobs <- c(grobs, rep(list(.dummy_gtable), nrow * ncol - n))
    
        # add dummy labels if needed
        if ((!is.null(labels)) && (length(labels) != nrow * ncol)) {
          labels <- c(labels, rep("", nrow * ncol - length(labels)))
        }
      }
    
      ## case numeric
      if (is.numeric(widths) && !inherits(widths, "unit")) {
        widths <- lapply(widths, unit, "null")
      }
      if (is.numeric(heights) && !inherits(heights, "unit")) {
        heights <- lapply(heights, unit, "null")
      }
    
      ## sizes
      if (is.null(widths)) 
        widths <- lapply(rep(1, n), unit, "null")
      if (is.null(heights)) 
        heights <- lapply(rep(1, n), unit, "null")
    
      # user may naively have passed grid units, but only unit.list units work well with `[`
      # so convert to this class
      if (grid::is.unit(widths)) 
        widths <- as.unit.list(widths)
      if (grid::is.unit(heights)) 
        widths <- as.unit.list(heights)
    
      # indexing is problematic, wrap in list
      if (grid::is.unit(widths) && length(widths) == 1) {
        widths <- list(widths)
      }
      if (grid::is.unit(heights) && length(heights) == 1) {
        heights <- list(heights)
      }
    
      ## split the list into rows/cols
      nrc <- if (byrow) 
        nrow else ncol
      if (nrc == 1) {
        splits <- rep(1, n)
      } else {
        seqgrobs <- seq_along(grobs)
        splits <- cut(seqgrobs, nrc, labels = seq_len(nrc))
        ## widths and heights refer to the layout repeat for corresponding grobs
    
        repw <- rep_len(seq_along(widths), length.out=n)
        reph <- rep_len(seq_along(heights), length.out=n)
        widths <- c(matrix(widths[repw], ncol = nrc, byrow = !byrow))
        heights <- c(matrix(heights[reph], ncol = nrc, byrow = byrow))
    
      }
    
      fg <- mapply(gtable_frame, g = grobs, width = widths, height = heights, MoreArgs = list(debug = debug), 
                   SIMPLIFY = FALSE)
    
    
      if (!is.null(labels)) {
        stopifnot(length(labels) == length(fg))
        # make grobs
        labels <- do.call(label_grid, c(list(labels), label.args))
        # add each grob to the whole gtable
        fg <- mapply(function(g, l) {
          gtable::gtable_add_grob(g, l, t = 1, l = 1, b = nrow(g), r = ncol(g), z = Inf, 
                                  clip = "off", name = "label")
        }, g = fg, l = labels, SIMPLIFY = FALSE)
      }
    
      spl <- split(fg, splits)
      if (byrow) {
        rows <- lapply(spl, function(.r) do.call(gridExtra::gtable_cbind, .r))
        gt <- do.call(gridExtra::gtable_rbind, rows)
      } else {
        # fill colwise
        cols <- lapply(spl, function(.c) do.call(gridExtra::gtable_rbind, .c))
        gt <- do.call(gridExtra::gtable_cbind, cols)
      }
    
    
      ## titles given as strings are converted to text grobs
      if (is.character(top)) {
        top <- textGrob(top)
      }
      if (is.grob(top)) {
        h <- grobHeight(top) + padding
        gt <- gtable_add_rows(gt, heights = h, 0)
        gt <- gtable_add_grob(gt, top, t = 1, l = 1, r = ncol(gt), z = Inf, clip = clip)
      }
      if (is.character(bottom)) {
        bottom <- textGrob(bottom)
      }
      if (is.grob(bottom)) {
        h <- grobHeight(bottom) + padding
        gt <- gtable_add_rows(gt, heights = h, -1)
        gt <- gtable_add_grob(gt, bottom, t = nrow(gt), l = 1, r = ncol(gt), z = Inf, clip = clip)
      }
      if (is.character(left)) {
        left <- textGrob(left, rot = 90)
      }
      if (is.grob(left)) {
        w <- grobWidth(left) + padding
        gt <- gtable_add_cols(gt, widths = w, 0)
        gt <- gtable_add_grob(gt, left, t = 1, b = nrow(gt), l = 1, r = 1, z = Inf, clip = clip)
      }
      if (is.character(right)) {
        right <- textGrob(right, rot = -90)
      }
      if (is.grob(right)) {
        w <- grobWidth(right) + padding
        gt <- gtable_add_cols(gt, widths = w, -1)
        gt <- gtable_add_grob(gt, right, t = 1, b = nrow(gt), l = ncol(gt), r = ncol(gt), 
                              z = Inf, clip = clip)
      }
    
      if (draw) {
        if (newpage) 
          grid.newpage()
        grid.draw(gt)
      }
      class(gt) <- c("egg", class(gt))
      invisible(gt)  # return the full gtable
    }