Задание ширины в высоких таблицах рисунков в ggarrange () - возможная ошибка?(R, ggplot, яйцо) - PullRequest
0 голосов
/ 06 февраля 2019

Я работаю в R и Rstudio, организовывая набор довольно сложных графиков, используя, как правило, великолепный ggarrange (), но на этот раз я столкнулся с постоянной проблемой, которая кажется легко воспроизводимой и, возможно, является ошибкой?

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)
)

, что приводит к следующей ошибке:

Ошибка в файле unit.c (сумма (оставленные $ ширины), ширина, сумма (правильные $ ширины)): недопустимо объединять«единичные» объекты с другими типами

Это не произойдет, если вы удалите два графика (превратив график в матрицу 2x2).Кроме того, эта модель, кажется, расширяется;если я запускаю 9 графиков в матрице 3x3 (ncol = 3, widths = c (1,2,3)), это работает, но если я добавлю еще 3 графика (как в матрице 3x4), я снова получу то же сообщение об ошибке.

Это ошибка?Это имеет исправление?Есть ли обходной путь?

1 Ответ

0 голосов
/ 07 февраля 2019

Определенно ошибка.Попробуйте следующую замену, которая, кажется, работает,

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
}
...