为组合的 ggplots 添加一个公共图例答案

【问题标题】：Add a common Legend for combined ggplots为组合的 ggplots 添加一个公共图例
【发布时间】：2012-11-30 16:48:32
【问题描述】：

我有两个与grid.arrange 水平对齐的ggplots。我浏览了很多论坛帖子，但我尝试的一切似乎都是现在更新并命名为别的命令。

我的数据是这样的；

# Data plot 1                                   
        axis1     axis2   
group1 -0.212201  0.358867
group2 -0.279756 -0.126194
group3  0.186860 -0.203273
group4  0.417117 -0.002592
group1 -0.212201  0.358867
group2 -0.279756 -0.126194
group3  0.186860 -0.203273
group4  0.186860 -0.203273

# Data plot 2   
        axis1     axis2
group1  0.211826 -0.306214
group2 -0.072626  0.104988
group3 -0.072626  0.104988
group4 -0.072626  0.104988
group1  0.211826 -0.306214
group2 -0.072626  0.104988
group3 -0.072626  0.104988
group4 -0.072626  0.104988

#And I run this:
library(ggplot2)
library(gridExtra)


groups=c('group1','group2','group3','group4','group1','group2','group3','group4')

x1=data1[,1]
y1=data1[,2]

x2=data2[,1]
y2=data2[,2]

p1=ggplot(data1, aes(x=x1, y=y1,colour=groups)) + geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8)

p2=ggplot(data2, aes(x=x2, y=y2,colour=groups)) + geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8)

#Combine plots
p3=grid.arrange(
p1 + theme(legend.position="none"), p2+ theme(legend.position="none"), nrow=1, widths = unit(c(10.,10), "cm"), heights = unit(rep(8, 1), "cm")))

如何从这些图中提取图例并将其添加到组合图的底部/中心？

【问题讨论】：

我偶尔会遇到这个问题。如果您不想刻画该图，我知道的最简单的解决方案就是保存一个带有图例的图，然后使用 Photoshop/Ilustrator 将其粘贴到空白图例图上。我知道不优雅——但实用又快又容易。
@StephenHenderson 这就是答案。使用 gfx 编辑器进行刻面或后期处理。

标签： r ggplot2 legend gridextra

【解决方案1】：

您也可以使用ggpubr 包中的ggarrange 并设置“common.legend = TRUE”：

library(ggpubr)

dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
p1 <- qplot(carat, price, data = dsamp, colour = clarity)
p2 <- qplot(cut, price, data = dsamp, colour = clarity)
p3 <- qplot(color, price, data = dsamp, colour = clarity)
p4 <- qplot(depth, price, data = dsamp, colour = clarity) 

ggarrange(p1, p2, p3, p4, ncol=2, nrow=2, common.legend = TRUE, legend="bottom")

【讨论】：

这是否可能在带有 renderPlot() 的闪亮应用程序（或 flexdashboard）中不起作用？它在具有正常绘图的正常 R 脚本中工作得非常好。但是，当我在我的 flexdashboard 中对使用 renderPlot() 制作的绘图执行完全相同的操作时，什么也没有出现。
谢谢你 - 我认为这是迄今为止我所寻找的最简单的解决方案
这太棒了！谢谢！
@Tingolfin 当我需要通过其他函数绘制 print(ggarrangeobject) 对象时，我有时不得不将它包裹在我的一个 ggarrange 对象周围，这可能类似于您的 @987654328 的解决方案@?
common.legend = TRUE 就是我所需要的！

【解决方案2】：

2021 年 3 月更新

这个答案仍有一些价值，但主要是历史价值。多年来，自此发布以来，通过软件包提供了更好的解决方案。您应该考虑下面发布的较新答案。

2015 年 2 月更新

见Steven's answer below

df1 <- read.table(text="group   x     y   
group1 -0.212201  0.358867
group2 -0.279756 -0.126194
group3  0.186860 -0.203273
group4  0.417117 -0.002592
group1 -0.212201  0.358867
group2 -0.279756 -0.126194
group3  0.186860 -0.203273
group4  0.186860 -0.203273",header=TRUE)

df2 <- read.table(text="group   x     y   
group1  0.211826 -0.306214
group2 -0.072626  0.104988
group3 -0.072626  0.104988
group4 -0.072626  0.104988
group1  0.211826 -0.306214
group2 -0.072626  0.104988
group3 -0.072626  0.104988
group4 -0.072626  0.104988",header=TRUE)


library(ggplot2)
library(gridExtra)

p1 <- ggplot(df1, aes(x=x, y=y,colour=group)) + geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8) + theme(legend.position="bottom")

p2 <- ggplot(df2, aes(x=x, y=y,colour=group)) + geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8)

#extract legend
#https://github.com/hadley/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs
g_legend<-function(a.gplot){
  tmp <- ggplot_gtable(ggplot_build(a.gplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == "guide-box")
  legend <- tmp$grobs[[leg]]
  return(legend)}

mylegend<-g_legend(p1)

p3 <- grid.arrange(arrangeGrob(p1 + theme(legend.position="none"),
                         p2 + theme(legend.position="none"),
                         nrow=1),
             mylegend, nrow=2,heights=c(10, 1))

这是结果图：

【讨论】：

两个答案都指向same wiki page，它可以随着新版本的 ggplot2 破坏代码而更新。
六年后，这个答案解决了我的问题。谢谢！
这对某些/大多数人来说可能很简单，但我没有马上明白，所以我想发表评论。如果您想在图的顶部（而不是在下方）显示常见的图例，您需要做的就是切换参数。在上面的示例中，mylegend 位于 arrangeGrob() 之前。您还需要反转高度（即heights=c(1,10)
有没有办法将底部图例居中或向右移动一点？
@wolfsatthedoor theme(legend.position="bottom", legend.justification = c(0.75, 0.5)) 值 0.5 为中心，较大的值向右/向下移动。

【解决方案3】：

一个新的、有吸引力的解决方案是使用patchwork。语法很简单：

library(ggplot2)
library(patchwork)

p1 <- ggplot(df1, aes(x = x, y = y, colour = group)) + 
  geom_point(position = position_jitter(w = 0.04, h = 0.02), size = 1.8)
p2 <- ggplot(df2, aes(x = x, y = y, colour = group)) + 
  geom_point(position = position_jitter(w = 0.04, h = 0.02), size = 1.8)

combined <- p1 + p2 & theme(legend.position = "bottom")
combined + plot_layout(guides = "collect")

^{由reprex package (v0.2.1) 于 2019 年 12 月 13 日创建}

【讨论】：

如果你稍微改变命令的顺序，你可以在一行中做到这一点：combined <- p1 + p2 + plot_layout(guides = "collect") & theme(legend.position = "bottom")
为什么现在不拼凑图例？这个例子似乎已经做到了，但是当我尝试使用拼凑的开发版本时，它一直将图例放在左边而不是中心。谢谢。
使用最新的 CRAN 版本的补丁（1.1.1），我仍然得到与此处答案相同的输出。至于开发版本，我不确定，但我想你可以在repo 中打开一个问题，并带有一个代表来询问你所得到的是否是预期的。我在 NEWS 文件中没有看到任何关于此的内容，所以我想可能不是。
可以在拼凑中将 x 轴实验室组合成一个共同的一对两个绘图吗？
@Nip：不像传说那样简单。见this issue。

【解决方案4】：

Roland 的回答需要更新。见：https://github.com/hadley/ggplot2/wiki/Share-a-legend-between-two-ggplot2-graphs

此方法已针对 ggplot2 v1.0.0 进行了更新。

library(ggplot2)
library(gridExtra)
library(grid)


grid_arrange_shared_legend <- function(...) {
    plots <- list(...)
    g <- ggplotGrob(plots[[1]] + theme(legend.position="bottom"))$grobs
    legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
    lheight <- sum(legend$height)
    grid.arrange(
        do.call(arrangeGrob, lapply(plots, function(x)
            x + theme(legend.position="none"))),
        legend,
        ncol = 1,
        heights = unit.c(unit(1, "npc") - lheight, lheight))
}

dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
p1 <- qplot(carat, price, data=dsamp, colour=clarity)
p2 <- qplot(cut, price, data=dsamp, colour=clarity)
p3 <- qplot(color, price, data=dsamp, colour=clarity)
p4 <- qplot(depth, price, data=dsamp, colour=clarity)
grid_arrange_shared_legend(p1, p2, p3, p4)

请注意缺少ggplot_gtable 和ggplot_build。而是使用ggplotGrob。这个例子比上面的解决方案有点复杂，但它仍然为我解决了。

【讨论】：

你好，我有6个地块，我想把这6个地块排列成2行×3列并在顶部绘制图例，那么如何更改函数grid_arrange_shared_legend？谢谢！
@just_rookie 你找到解决方案了吗？如何更改函数以便可以使用不同的 ncol 和 nrow 排列，而不仅仅是 ncol = 1？
嗨，我试过这个解决方案，效果很好，但是在打印时，我得到了 2 个 pdf 页而不是只有 1 个，第一个是空白的，而后者包含我的情节，为什么我会出现这种行为?谢谢，
对于任何与我有同样问题的人，这里有一个解决方法：stackoverflow.com/questions/12481267/…
这里有很棒的东西。知道如何为所有地块添加一个标题吗？

【解决方案5】：

我建议使用cowplot。来自他们的R vignette：

# load cowplot
library(cowplot)

# down-sampled diamonds data set
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]

# Make three plots.
# We set left and right margins to 0 to remove unnecessary spacing in the
# final plot arrangement.
p1 <- qplot(carat, price, data=dsamp, colour=clarity) +
   theme(plot.margin = unit(c(6,0,6,0), "pt"))
p2 <- qplot(depth, price, data=dsamp, colour=clarity) +
   theme(plot.margin = unit(c(6,0,6,0), "pt")) + ylab("")
p3 <- qplot(color, price, data=dsamp, colour=clarity) +
   theme(plot.margin = unit(c(6,0,6,0), "pt")) + ylab("")

# arrange the three plots in a single row
prow <- plot_grid( p1 + theme(legend.position="none"),
           p2 + theme(legend.position="none"),
           p3 + theme(legend.position="none"),
           align = 'vh',
           labels = c("A", "B", "C"),
           hjust = -1,
           nrow = 1
           )

# extract the legend from one of the plots
# (clearly the whole thing only makes sense if all plots
# have the same legend, so we can arbitrarily pick one.)
legend_b <- get_legend(p1 + theme(legend.position="bottom"))

# add the legend underneath the row we made earlier. Give it 10% of the height
# of one plot (via rel_heights).
p <- plot_grid( prow, legend_b, ncol = 1, rel_heights = c(1, .2))
p

【讨论】：

这是唯一的方法，它可以使用 legend_b() 在我的情节中使用 annotate_figure(ggarrange()) 放置手动图例。 非常感谢，上帝保佑你！

【解决方案6】：

@Giuseppe，您可能需要考虑这一点，以便灵活规范地块排列（修改自 here）：

library(ggplot2)
library(gridExtra)
library(grid)

grid_arrange_shared_legend <- function(..., nrow = 1, ncol = length(list(...)), position = c("bottom", "right")) {

  plots <- list(...)
  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, nrow = nrow, ncol = ncol)

  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)

}

额外的参数nrow 和ncol 控制排列图的布局：

dsamp <- diamonds[sample(nrow(diamonds), 1000), ]
p1 <- qplot(carat, price, data = dsamp, colour = clarity)
p2 <- qplot(cut, price, data = dsamp, colour = clarity)
p3 <- qplot(color, price, data = dsamp, colour = clarity)
p4 <- qplot(depth, price, data = dsamp, colour = clarity)
grid_arrange_shared_legend(p1, p2, p3, p4, nrow = 1, ncol = 4)
grid_arrange_shared_legend(p1, p2, p3, p4, nrow = 2, ncol = 2)

【讨论】：

与其他解决方案相同，我试过了，效果很好，但是在打印时，我得到了 2 个 pdf 页而不是只有 1 个，第一个是空白的，而后者包含我的情节，为什么我有这样的行为？谢谢，
对于任何与我有同样问题的人，这里有一个解决方法：stackoverflow.com/questions/12481267/…
有人可以解释一下解决方案吗？我怎样才能将图例放在顶部而不是底部？谢谢

【解决方案7】：

如果您在两个图中绘制相同的变量，最简单的方法是将数据框合并为一个，然后使用 facet_wrap。

你的例子：

big_df <- rbind(df1,df2)

big_df <- data.frame(big_df,Df = rep(c("df1","df2"),
times=c(nrow(df1),nrow(df2))))

ggplot(big_df,aes(x=x, y=y,colour=group)) 
+ geom_point(position=position_jitter(w=0.04,h=0.02),size=1.8) 
+ facet_wrap(~Df)

另一个使用菱形数据集的示例。这表明，如果您的绘图之间只有一个共同变量，您甚至可以使其工作。

diamonds_reshaped <- data.frame(price = diamonds$price,
independent.variable = c(diamonds$carat,diamonds$cut,diamonds$color,diamonds$depth),
Clarity = rep(diamonds$clarity,times=4),
Variable.name = rep(c("Carat","Cut","Color","Depth"),each=nrow(diamonds)))

ggplot(diamonds_reshaped,aes(independent.variable,price,colour=Clarity)) + 
geom_point(size=2) + facet_wrap(~Variable.name,scales="free_x") + 
xlab("")

第二个示例唯一棘手的是，当您将所有内容组合到一个数据框中时，因子变量会被强制转换为数字。因此，理想情况下，您将主要在所有感兴趣的变量都是同一类型时执行此操作。

【讨论】：

【解决方案8】：

@Guiseppe：

我对 Grobs 等一无所知，但我为两个图拼凑了一个解决方案，应该可以扩展到任意数字，但它不是一个性感的函数：

plots <- list(p1, p2)
g <- ggplotGrob(plots[[1]] + theme(legend.position="bottom"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
lheight <- sum(legend$height)
tmp <- arrangeGrob(p1 + theme(legend.position = "none"), p2 + theme(legend.position = "none"), layout_matrix = matrix(c(1, 2), nrow = 1))
grid.arrange(tmp, legend, ncol = 1, heights = unit.c(unit(1, "npc") - lheight, lheight))

【讨论】：

【解决方案9】：

如果两个图的图例相同，有一个使用grid.arrange 的简单解决方案（假设您希望图例与两个图垂直或水平对齐）。只需保留最底部或最右侧图的图例，同时省略另一个图例。但是，仅向一个绘图添加图例会改变一个绘图相对于另一个绘图的大小。为避免这种情况，请使用heights 命令手动调整并保持它们相同的大小。您甚至可以使用grid.arrange 来制作通用轴标题。请注意，除了library(gridExtra) 之外，这还需要library(grid)。对于垂直图：

y_title <- expression(paste(italic("E. coli"), " (CFU/100mL)"))

grid.arrange(arrangeGrob(p1, theme(legend.position="none"), ncol=1), 
   arrangeGrob(p2, theme(legend.position="bottom"), ncol=1), 
   heights=c(1,1.2), left=textGrob(y_title, rot=90, gp=gpar(fontsize=20)))

这是我正在从事的一个项目的类似图表的结果：

【讨论】：