将图例移动到ggplot2分面绘图中的空白区域

Question

考虑以下图表：

library(ggplot2)

p <- ggplot(diamonds, 
            aes(x = carat, fill = cut)) +
  geom_density(position = "stack") +
  facet_wrap(~ color)

facet_wrap函数将一系列分面面板包装成大致矩形的显示，其中有nrow行和ncol列。然而，根据数据的不同，实际面板数量通常比nrow * ncol少几个面板，这在绘图中留下了一大块浪费的空间。

如果图中包含图例，则情况会恶化，因为现在由于图例（无论是在右侧[默认图例位置]还是在其他三个方向之一），我们将有更多的浪费空间。

为了节省空间，我希望将图例移至未填充分面所创建的空间中。

以下方法可以作为节省空间的措施，但是图例锚定在绘图区域的一个角落，可能会在一侧留下很多空间，从而创建一个不平衡的外观：

p +
  theme(legend.position = c(1, 0),
        legend.justification = c(1, 0))

手动调整legend.position/legend.justification的值，将图例移至空白区域中心是一个试错过程，并且如果需要处理多个分面图时难以扩展。

总之，我想要一个方法：

1. 将分面图的图例移至由空分面创建的空间中。 2. 产生一个相当美观的图形。 3. 可以轻松自动化以处理许多图形。

这对我来说是一个经常使用的情况，我已经决定将其与我的工作解决方案一起发布在这里，以防其他人发现它有用。我还没有在Stack Overflow上看到这种情况的问答。如果有人知道，请留下评论，我很乐意在那里回答，或者将其标记为重复，视情况而定。

- Z.Lin

Answer 1

以下是我为关于利用空面板的空间的之前的问题撰写的答案的扩展，但我认为它足够不同，值得有自己的空间。

基本上，我编写了一个函数，该函数接受由ggplotGrob()转换的ggplot/grob对象，如果它不是grob，则将其转换为grob，并深入挖掘底层grob以将图例grob移动到对应于空白空间的单元格中。 函数:

library(gtable)
library(cowplot)

shift_legend <- function(p){

  # check if p is a valid object
  if(!"gtable" %in% class(p)){
    if("ggplot" %in% class(p)){
      gp <- ggplotGrob(p) # convert to grob
    } else {
      message("This is neither a ggplot object nor a grob generated from ggplotGrob. Returning original plot.")
      return(p)
    }
  } else {
    gp <- p
  }

  # check for unfilled facet panels
  facet.panels <- grep("^panel", gp[["layout"]][["name"]])
  empty.facet.panels <- sapply(facet.panels, function(i) "zeroGrob" %in% class(gp[["grobs"]][[i]]))
  empty.facet.panels <- facet.panels[empty.facet.panels]
  if(length(empty.facet.panels) == 0){
    message("There are no unfilled facet panels to shift legend into. Returning original plot.")
    return(p)
  }

  # establish extent of unfilled facet panels (including any axis cells in between)
  empty.facet.panels <- gp[["layout"]][empty.facet.panels, ]
  empty.facet.panels <- list(min(empty.facet.panels[["t"]]), min(empty.facet.panels[["l"]]),
                             max(empty.facet.panels[["b"]]), max(empty.facet.panels[["r"]]))
  names(empty.facet.panels) <- c("t", "l", "b", "r")

  # extract legend & copy over to location of unfilled facet panels
  guide.grob <- which(gp[["layout"]][["name"]] == "guide-box")
  if(length(guide.grob) == 0){
    message("There is no legend present. Returning original plot.")
    return(p)
  }
  gp <- gtable_add_grob(x = gp,
                        grobs = gp[["grobs"]][[guide.grob]],
                        t = empty.facet.panels[["t"]],
                        l = empty.facet.panels[["l"]],
                        b = empty.facet.panels[["b"]],
                        r = empty.facet.panels[["r"]],
                        name = "new-guide-box")

  # squash the original guide box's row / column (whichever applicable)
  # & empty its cell
  guide.grob <- gp[["layout"]][guide.grob, ]
  if(guide.grob[["l"]] == guide.grob[["r"]]){
    gp <- gtable_squash_cols(gp, cols = guide.grob[["l"]])
  }
  if(guide.grob[["t"]] == guide.grob[["b"]]){
    gp <- gtable_squash_rows(gp, rows = guide.grob[["t"]])
  }
  gp <- gtable_remove_grobs(gp, "guide-box")

  return(gp)
}

结果:

library(grid)

grid.draw(shift_legend(p))

如果我们利用空白空间的方向水平排列图例，结果看起来更加美观：

p.new <- p +
  guides(fill = guide_legend(title.position = "top",
                             label.position = "bottom",
                             nrow = 1)) +
  theme(legend.direction = "horizontal")
grid.draw(shift_legend(p.new))

其他一些例子：

# example 1: 1 empty panel, 1 vertical legend
p1 <- ggplot(economics_long, 
             aes(date, value, color = variable)) +
  geom_line() +
  facet_wrap(~ variable, 
             scales = "free_y", nrow = 2, 
             strip.position = "bottom") +
  theme(strip.background = element_blank(), 
        strip.placement = "outside")
grid.draw(shift_legend(p1))

# example 2: 2 empty panels (vertically aligned) & 2 vertical legends side by side
p2 <- ggplot(mpg,
             aes(x = displ, y = hwy, color = fl, shape = factor(cyl))) +
  geom_point(size = 3) +
  facet_wrap(~ class, dir = "v") +
  theme(legend.box = "horizontal")
grid.draw(shift_legend(p2))

# example 3: facets in polar coordinates
p3 <- ggplot(mtcars, 
             aes(x = factor(1), fill = factor(cyl))) +
  geom_bar(width = 1, position = "fill") + 
  facet_wrap(~ gear, nrow = 2) +
  coord_polar(theta = "y") +
  theme_void()
grid.draw(shift_legend(p3))

- Z.Lin

---

非常好的解决方案！你的继承测试（!"gtable" %in% class(p)等）应该通过inherits来编写：if (!inherits(p, 'gtable'))。由于你针对不同的对象类执行不同的操作，考虑使用S3方法代替if语句。 - Konrad Rudolph

很好的答案。那么shift.legend函数不在一个包中吗？ - Herman Toothrot

有没有办法将输出转换回 ggplot 对象？ - Eric Scott

Answer 2

好的问答！

我在这个链接中找到了类似的内容。因此，我想这将是你的函数不错的补充。

更准确地说，来自lemon的函数reposition_legend()似乎是你需要的东西，只是它没有寻找空白区域。

我从你的函数中汲取灵感，使用panel参数将空面板的名称传递给reposition_legend()。

示例数据和库：

library(ggplot2)
library(gtable)
library(lemon)

p <- ggplot(diamonds, 
            aes(x = carat, fill = cut)) +
  geom_density(position = "stack") +
  facet_wrap(~ color) +
  theme(legend.direction = "horizontal")

当然了，我删除了所有的检查（即相同的if语句），只是为了专注于重要的内容。

shift_legend2 <- function(p) {
  # ...
  # to grob
  gp <- ggplotGrob(p)
  facet.panels <- grep("^panel", gp[["layout"]][["name"]])
  empty.facet.panels <- sapply(facet.panels, function(i) "zeroGrob" %in% class(gp[["grobs"]][[i]]))
  empty.facet.panels <- facet.panels[empty.facet.panels]

  # establish name of empty panels
  empty.facet.panels <- gp[["layout"]][empty.facet.panels, ]
  names <- empty.facet.panels$name
  # example of names:
  #[1] "panel-3-2" "panel-3-3"

# now we just need a simple call to reposition the legend
  reposition_legend(p, 'center', panel=names)
}

shift_legend2(p)

请注意，这可能仍需要一些调整，我只是觉得这是值得分享的东西。

目前行为看起来不错，而且函数长度缩短了几行。

---

其他情况。

第一个例子：

p1 <- ggplot(economics_long, 
             aes(date, value, color = variable)) +
  geom_line() +
  facet_wrap(~ variable, 
             scales = "free_y", nrow = 2, 
             strip.position = "bottom") +
  theme(strip.background = element_blank(), 
        strip.placement = "outside")

shift_legend2(p1)

第二个例子：

p2 <- ggplot(mpg,
             aes(x = displ, y = hwy, color = fl, shape = factor(cyl))) +
  geom_point(size = 3) +
  facet_wrap(~ class, dir = "v") +
  theme(legend.box = "horizontal")

#[1] "panel-2-3" "panel-3-3" are the names of empty panels in this case
shift_legend2(p2) 

第三个例子：

p3 <- ggplot(mtcars, 
             aes(x = factor(1), fill = factor(cyl))) +
  geom_bar(width = 1, position = "fill") + 
  facet_wrap(~ gear, nrow = 2) +
  coord_polar(theta = "y") +
  theme_void()
shift_legend2(p3)

---

完成函数：

shift_legend2 <- function(p) {
  # check if p is a valid object
  if(!(inherits(p, "gtable"))){
    if(inherits(p, "ggplot")){
      gp <- ggplotGrob(p) # convert to grob
    } else {
      message("This is neither a ggplot object nor a grob generated from ggplotGrob. Returning original plot.")
      return(p)
    }
  } else {
    gp <- p
  }

  # check for unfilled facet panels
  facet.panels <- grep("^panel", gp[["layout"]][["name"]])
  empty.facet.panels <- sapply(facet.panels, function(i) "zeroGrob" %in% class(gp[["grobs"]][[i]]), 
                               USE.NAMES = F)
  empty.facet.panels <- facet.panels[empty.facet.panels]

  if(length(empty.facet.panels) == 0){
    message("There are no unfilled facet panels to shift legend into. Returning original plot.")
    return(p)
  }

  # establish name of empty panels
  empty.facet.panels <- gp[["layout"]][empty.facet.panels, ]
  names <- empty.facet.panels$name

  # return repositioned legend
  reposition_legend(p, 'center', panel=names)
}

- RLave

---

有没有一种方法可以在不重新绘制图形的情况下调用函数？ - Mohamed Ismaiel Ahmed

如果我理解你的问题正确，你可以使用 reposition_legend(p, 'center', panel=names, plot = F) 修改最后一行。然后你可以执行 grid::grid.draw(shift_legend2(p3))。 - RLave

谢谢，那个方法可行！我之所以问是因为我的图形比较复杂，在Rstudio中绘制需要一些时间。 - Mohamed Ismaiel Ahmed

Answer 3

我认为由@RLave标识的lemon::reposition_legend()是最优雅的解决方案。然而，它依赖于知道空facet的名称。我想分享一种简洁的方法来找到这些名称，因此提出了另一个版本的shift_legend():

shift_legend3 <- function(p) {
    pnls <- cowplot::plot_to_gtable(p) %>% gtable::gtable_filter("panel") %>%
      with(setNames(grobs, layout$name)) %>% purrr::keep(~identical(.x,zeroGrob()))

    if( length(pnls) == 0 ) stop( "No empty facets in the plot" )

    lemon::reposition_legend( p, "center", panel=names(pnls) )
}

- Artem Sokolov

---

刚刚找到了这个函数。我发现这是一个更好的解决方案，因此相应地点赞了。谢谢。 - Lee

Answer 4

R包patchwork提供了一种优雅的解决方案，用于组合多个图形（略微不同于单个分面ggplot）。如果有三个ggplot对象p1、p2、p3，则语法非常简单：

• 使用+操作符，在一个面中“添加”这些图形
• 使用guide_area()命令指定哪个面应该包含指南
• 如果所有三个图形都有相同的图例，请使用命令plot_layout(guides = 'collect')告诉patchwork将图例“收集”起来，以节省空间。

查看下面的代码以获取基本语法和下面链接中的完全可重现示例。

library(patchwork)

# guide_area() puts legend in empty fourth facet
p1 + p2 + p3 + guide_area() + 
  plot_layout(guides = 'collect')

https://patchwork.data-imaginist.com/articles/guides/layout.html#controlling-guides

- Omar Wasow