ggplot2：一行内多个图形，带有单个图例

Question

我希望能得到两个图表及其图例的组合图，格式如下：

library(ggplot2) 
library(grid)
library(gridExtra)
dsamp <- diamonds[sample(nrow(diamonds), 1000), ]    
p1 <- qplot(price, carat, data=dsamp, colour=clarity)
p2 <- qplot(price, depth, data=dsamp, colour=clarity)
g <- ggplotGrob(p1 + theme(legend.position="bottom"))$grobs
legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
grid.arrange(arrangeGrob(p1+theme(legend.position="right"),p2+theme(legend.position="none"),legend,ncol=3,widths=c(3/7,3/7,1/7)))

然而我不想猜测图形和图例的宽度（并指定ncol），而是希望从p1和p2中提取它们如此展示。

因此，我期待需要像这样的代码（从链接中调整的代码）：

grid_arrange_shared_legend_row <- function(...) {
  plots <- list(...)
  g <- ggplotGrob(plots[[1]] + theme(legend.position="right"))$grobs
  legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
  lwidth <- sum(legend$width)
  grid.arrange(
    do.call(arrangeGrob, lapply(plots, function(x)
      x + theme(legend.position="none"))),
    legend,
    ncol = length(plots)+1,
    widths = unit.c(rep(unit(1, "npc") - lwidth, length(plots)), lwidth))
}
grid_arrange_shared_legend_row(p1, p2)

但这并不是将两个图表排列在一行，而是一个列中：

这个问题类似于这个问题，但不同之处在于我也需要适应宽度。我同时使用了那个问题和答案以及github上的代码片段。

- mts

Answer 1

为什么不使用分面呢？

library(reshape2)
dmelt <- melt(dsamp, id.vars = c("price", "clarity"), measure.vars = c("carat", "depth"))
ggplot(dmelt, aes(x = price, y = value, color = clarity)) +
  geom_point() +
  facet_wrap(~ variable, scales = "free")

- Roland

---

谢谢，这个确实很好用。也许你应该用同样的代码回答另一个问题？它在我的谷歌搜索结果中排名相当靠前，对未来的用户来说将是一个很好的参考！ - mts

Answer 2

我通常使用facet_wrap或facet_grid，正如@Roland所建议的那样。

不久前，我不得不使用grid.arrange（我希望y轴上的标签按特定顺序着色），这是我想出来的函数：

ggplot_shared_info <- function(...) {
  plots <- list(...)
  g <- ggplotGrob(plots[[1]])$grobs
  legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
  title <- g[[grep("plot.title", sapply(g, function(x) x$name))]]
  xaxis <- g[[grep("axis.title.x", sapply(g, function(x) x$name))]]
  yaxis <- g[[grep("axis.title.y", sapply(g, function(x) x$name))]]

  lwidth <- sum(legend$width)
  theight <- sum(title$height)
  xheight <- sum(xaxis$height)
  ywidth <- sum(yaxis$width)

  grid.arrange(
     title,
     arrangeGrob(
       yaxis,
       do.call(arrangeGrob, c(lapply(plots, function(x)
         x + theme(legend.position="none", 
                   plot.title = element_blank(),
                   axis.title = element_blank())), 
         nrow = 1)),
       legend,
       nrow = 1,
       widths = grid::unit.c(ywidth, unit(1, "npc") - ywidth - lwidth, lwidth)
     ),
     xaxis, 
     heights = grid::unit.c(theight, unit(1, "npc") - theight - xheight, xheight),
     ncol = 1
  )
}

编辑：现在用户可以确定列表中应该“连接”哪些绘图元素。

ggplot_shared_info <- function(..., elements = c('legend', 'title', 'yaxis', 'xaxis')) {
  plots <- list(...)
  g <- ggplotGrob(plots[[1]])$grobs

  legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
  lwidth <- sum(legend$width)
  title <- g[[grep("plot.title", sapply(g, function(x) x$name))]]
  theight <- sum(title$height)  
  xaxis <- g[[grep("axis.title.x", sapply(g, function(x) x$name))]]
  xheight <- sum(xaxis$height)
  yaxis <- g[[grep("axis.title.y", sapply(g, function(x) x$name))]]
  ywidth <- sum(yaxis$width)

  plots <- lapply(plots, function(x, elements = elements){
    if('legend' %in% elements) x <- x + theme(legend.position="none")
    if('title' %in% elements) x <- x + theme(plot.title = element_blank())
    if('xaxis' %in% elements) x <- x + theme(axis.title.x = element_blank())
    if('yaxis' %in% elements) x <- x + theme(axis.title.y = element_blank())
    x
  }, elements = elements)
  plots <- do.call(arrangeGrob, c(plots, nrow = 1))

  if('legend' %in% elements) 
    plots <- arrangeGrob(plots, legend, nrow = 1, widths = grid::unit.c(unit(1, "npc") - lwidth, lwidth))
  if('yaxis' %in% elements)
    plots <- arrangeGrob(yaxis, plots, nrow = 1, widths = grid::unit.c(ywidth, unit(1, "npc") - ywidth))
  if('title' %in% elements) 
    plots <- arrangeGrob(title, plots, ncol = 1, heights = grid::unit.c(theight, unit(1, "npc") - theight))
  if('xaxis' %in% elements)     
    plots <- arrangeGrob(plots, xaxis, ncol = 1, heights = grid::unit.c(unit(1, "npc") - xheight, xheight))
  grid.arrange(plots)
}

- user5029763

---

这个很好用，而且应该更通用，谢谢！请注意，缺少标题会导致错误，即对于给定的示例应该被称为：ggplot_shared_info(p1+ggtitle("p1"), p2)。 - mts

没想到这个！我会尝试编辑我的代码，让用户可以确定他希望“共享”哪些图形元素。 - user5029763