将图例转换为ggplot2中多面图的空面 [英] Shift legend into empty facets of a faceted plot in ggplot2

问题描述

请考虑以下情节:

library(ggplot2)

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

facet_wrap函数将多面面板的序列包装成由nrow行和ncol列组成的大致矩形的显示.但是，根据数据，实际的面板数通常比nrow * ncol少几个面板，这在绘图中留下了一块浪费的空间.

The facet_wrap function wraps a sequence of faceted panels into a roughly rectangular display of nrow rows and ncol columns. However, depending on the data, the actual number of panels is often a few panels short of nrow * ncol, which leaves a chunk of wasted space in the plot.

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

If the plot includes legend(s), the situation is exacerbated, because now we have even more wasted space due to the legend, whether it's on the right (default legend position), or one of the other three directions.

为了节省空间，我想将图例移动到由未填充的构面创建的空间中.

To save space, I would like to shift the legend(s) into the space created by unfilled facets.

以下内容是一种节省空间的措施，但图例固定在绘图区域的一角，一侧可能留有很多空间，从而产生了不平衡的外观:

The following works as a space-saving measure, but the legend is anchored to a corner of the plot area, with potentially a lot of space left on one side, creating an imbalanced look:

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

通过手动调整legend.position/legend.justification值将图例移至空白区域的中心是一个反复试验的问题，并且如果要处理的面图很多，则很难缩放.

Shifting a legend towards the centre of the blank space area by manually adjusting the legend.position/legend.justification values is a matter of trial and error, and difficult to scale if one has many faceted plots to work on.

总而言之，我想要一种方法:

In summary, I want a method that:

1. 将多面图的图例移到由于空面而产生的空间中.
2. 得到一个外观漂亮的图.
3. 很容易自动化来处理很多图.

1. Shifts the legend(s) of a faceted plot into the space created due to empty facets.
2. Results in a reasonably nice-looking plot.
3. Is easily automated to handle many plots.

这对我来说是一个经常性的用例，我决定将它与我的工作解决方案一起发布在这里，以防其他人发现它有用.我没有在Stack Overflow上的其他地方询问/回答看到这种情况.如果有任何人，请发表评论，我将很乐意在此回答，或者将其标记为重复(视情况而定).

This is a recurring use case for me, and I've decided to post it along with my working solution here in case anyone else finds it useful. I haven't seen this scenario asked/answered elsewhere on Stack Overflow. If anyone has, please leave a comment and I'll be happy to answer there instead or have this marked as a duplicate, as the case may be.

推荐答案

以下是我为上一个问题<关于利用空面板上的空间，但我认为保证自己的空间足够不同.

The following is an extension to an answer I wrote for a previous question about utilising the space from empty facet panels, but I think it's sufficiently different to warrant its own space.

本质上，我编写了一个函数，该函数接受由ggplotGrob()转换的 ggplot/grob 对象，如果不是，则将其转换为grob，然后挖掘底层grob以移动图例摸索到与空白区域相对应的单元格.

Essentially, I wrote a function that takes a ggplot/grob object converted by ggplotGrob(), converts it to grob if it isn't one, and digs into the underlying grobs to move the legend grob into the cells that correspond to the empty space.

功能:

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))

如果我们利用空白区域的方向水平排列图例，则可以看到更细的结果:

Nicer looking result if we take advantage of the empty space's direction to arrange the legend horizontally:

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))

这篇关于将图例转换为ggplot2中多面图的空面的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！