使用grid_arrange_shared_legend从列表中绘制多面板图形

gr8qqesn  于 2022-12-05  发布在  其他
关注(0)|答案(2)|浏览(275)

我试图通过允许用户选择绘制多少个面板,使我的带有共享图例的多面板ggplotShinyApp中更加灵活。
目前,我的代码每次写出面板对象1,就像这样。

grid_arrange_shared_legend(p1,p2,p3,p4, ncol = 4, nrow = 1)

我不完全理解为什么我找不到一种方法来告诉grid_arrange_shared_legend接受一个图列表(列表对象),而不是一个接一个地写出它们。它抛出以下错误:
UseMethod(“ggplot_build”)中的错误:没有适用于'ggplot_build'的方法应用于类“NULL”的对象

library(ggplot2)
library(lemon)
plotlist <- list()
dsamp <- diamonds[sample(nrow(diamonds), 300), ]
plotlist$p1 <- qplot(carat, price, data = dsamp, colour = clarity)
plotlist$p2 <- qplot(cut, price, data = dsamp, colour = clarity)
plotlist$p3 <- qplot(color, price, data = dsamp, colour = clarity)
plotlist$p4 <- qplot(depth, price, data = dsamp, colour = clarity)
grid_arrange_shared_legend(plotlist, ncol = 4, nrow = 1)

通过使用列表,列表中有多少个地块并不重要,我会根据列表的长度计算ncol或nrow ...

j9per5c4

j9per5c41#

我的自制版本的函数通过添加一个plotlist参数,并添加plots <- c(list(...), plotlist)行作为第一行代码来实现,这样它既可以接受一个plot列表,也可以接受单独的plot对象。

grid_arrange_shared_legend_plotlist <- function(..., 
                                                plotlist=NULL,
                                                ncol = length(list(...)),
                                                nrow = NULL,
                                                position = c("bottom", "right")) {

  plots <- c(list(...), plotlist)

  if (is.null(nrow)) nrow = ceiling(length(plots)/ncol)

  position <- match.arg(position)
  g <- ggplotGrob(plots[[1]] + theme(legend.position = position))$grobs
  legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
  lheight <- sum(legend$height)
  lwidth <- sum(legend$width)
  gl <- lapply(plots, function(x) x + theme(legend.position="none"))
  gl <- c(gl, ncol = ncol, nrow = nrow)

  combined <- switch(position,
                     "bottom" = arrangeGrob(do.call(arrangeGrob, gl),
                                            legend,
                                            ncol = 1,
                                            heights = unit.c(unit(1, "npc") - lheight, lheight)),
                     "right" = arrangeGrob(do.call(arrangeGrob, gl),
                                           legend,
                                           ncol = 2,
                                           widths = unit.c(unit(1, "npc") - lwidth, lwidth)))

  grid.newpage()
  grid.draw(combined)

  # return gtable invisibly
  invisible(combined)
}

以您的示例为例:

library(gridExtra)
library(grid)
library(ggplot2)
plots <- list()
dsamp <- diamonds[sample(nrow(diamonds), 300), ]
plots$p1 <- qplot(carat, price, data = dsamp, colour = clarity)
plots$p2 <- qplot(cut, price, data = dsamp, colour = clarity)
plots$p3 <- qplot(color, price, data = dsamp, colour = clarity)
plots$p4 <- qplot(depth, price, data = dsamp, colour = clarity)

grid_arrange_shared_legend_plotlist(plotlist = plots, ncol = 4)

qc6wkl3g

qc6wkl3g2#

丑陋的文本字符串粘贴解决方案:

由于提供的答案似乎不起作用,或者不适合(重建一组与我已经从大量代码中获得的绘图对象列表完全不同的绘图对象),我使用eval(parse(text = ....)paste0进行了一些尝试,以动态生成一个文本字符串,最终成为完全写出的代码(它起作用了),而没有实际写出它

nplots = 4
nrow = 2
ncol = ceiling(nplots/nrow)
eval(parse( text = paste0("grid_arrange_shared_legend(", paste0("plotlist", "[[", c(1:nplots), "]]", sep = '', collapse = ','), ",ncol =", ncol, ",nrow =", nrow, ", position = 'right',  top=grid::textGrob('My title', gp=grid::gpar(fontsize=18)))", sep = '')))

其产生:
[1]“grid_arrange_shared_legend(绘图列表1,绘图列表2,绘图列表3,绘图列表4,ncol =2,nrow =2,位置= '右',顶部=grid::文本Grob('My title ',gp=grid::gpar(fontsize=18))”

相关问题