Question

我正在尝试通过允许用户选择要绘制的面板数来在ggplot中使带有共享图例的多面板ShinyApp更加灵活。

目前，我的代码每次都这样写出面板对象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 ...

Answer 1

我的函数的自制版本通过添加plotlist参数并将plots <- c(list(...), plotlist)行作为第一行代码来获得该功能。这样，它既可以获取图列表，也可以获取单独的图对象。

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)

Answer 2

难看的文本字符串粘贴解决方案：

由于提供的答案似乎无效或不合适（与从大量代码中重建的绘图集列表相比，重建了一套完全不同的绘图集，因此我在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（plotlist [[1]]，plotlist [[2]]，plotlist [[3]]，plotlist [[4]]，ncol = 2，nrow = 2，position ='right'，top = grid :: textGrob（'My title'，gp = grid :: gpar（fontsize = 18）））“

Answer 3

您可以按以下方式列出具有单个图例的地块列表。以下代码将ggplot图的预制列表作为其参数：

library(tidyverse)
library(gridExtra)

从ggplot（source）中提取图例的功能：

get_legend = function(p) {
  tmp <- ggplot2::ggplot_gtable(ggplot2::ggplot_build(p))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  legend
}

使用单个图例布置图的功能：

layout_plots = function(plotlist) {

  leg = get_legend(plotlist[[1]] + theme(legend.position="bottom"))

  grid.arrange(
    arrangeGrob(grobs=map(plotlist, ~.x + theme(legend.position="none",
                                                axis.title.y=element_blank())), 
                nrow=1, left=ggplot_build(plotlist[[1]])$plot$labels$y),
    leg, ncol=1, heights=c(7, 1))
}

layout_plot(plotlist)

原始答案：

这是您自己选择的选项：

library(tidyverse)
library(gridExtra)

从ggplot（source）中提取图例的功能：

get_legend = function(p) {
  tmp <- ggplot2::ggplot_gtable(ggplot2::ggplot_build(p))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  legend
}

使用整齐的评估功能生成和绘制地块列表的功能：

# Arguments:
#  data A data frame
#  y The y-axis variable
#  colour The column to map to the colour aesthetic
#  ... Any number of column names that will become the x axis variable for each plot
my_plots = function(data, y, colour, ...) {

  x=enquos(...)
  y=enquo(y)
  colour=enquo(colour)

  # Generate one plot for each value of x and store in a list
  plotlist = map(x, ~ ggplot(data, aes(!!.x, !!y, colour=!!colour)) +
                   geom_point() +
                   theme(axis.title.y=element_blank()))

  # Extract legend from one of the plots as a separate grob
  leg = get_legend(plotlist[[1]])

  # Arrange the plots (after removing the legend from each plot and the extracted legend
  grid.arrange(
    arrangeGrob(grobs=map(plotlist, ~ .x + theme(legend.position="none")), ncol=1),
    leg,
    widths=c(7, 1), left=as_label(y)
  )
}

现在运行功能：

my_plots(dsamp, price, clarity, carat, cut, color, depth)

my_plots(mtcars, mpg, factor(cyl), hp, qsec, carb)

来自带有grid_arrange_shared_legend的列表的多面板ggplot

3 个答案: