组合具有不同图例的图时添加组合图例

Question

我有三个不同的次要情节，每个都有自己的传说。我想将这 3 个传说中的每一个组合成情节底部的一个共同传说。当所有子图都有相同的图例时，我发现了许多类似的问题，将不同子图的图例组合成一个共同的图例。然而，当传说不同时。更改代码的尝试没有成功。

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

data = read.table("fermentation_run.csv", header=TRUE, sep=",", fileEncoding="UTF-8-BOM") 
p1 <- ggplot(data, aes(x = time)) + 
  geom_line(aes(y = cdw*5, colour = "CDW"), size=1) + 
  geom_line(aes(y = glucose, colour = "glucose"), size=1) + 
  geom_step(aes(y = substrate, colour = "substrate"), size=1) + 
  theme_classic() + ylab("Concentration (g/l)") + 
  xlab("Time (h)") + 
  scale_colour_manual(values = c("grey", "red", "black"))
  theme(legend.position="bottom", legend.title=element_blank())

p2 <- ggplot(data, aes(x=time)) + 
  geom_line(aes(y = alkyl, colour = "alkyl SS"), size=1) + 
  geom_line(aes(y = oleyl, colour = "oleyl alcohol"), size=1) + 
  theme_classic() + 
  xlab("Time (h)") + 
  ylab("Concentration (g/l)") + 
  scale_colour_manual(values = c("green", "blue"))
  theme(legend.position="bottom", legend.title=element_blank())

p3 <- ggplot(data, aes(x=time)) + 
  geom_step(aes(y = aeration, colour="aeration"), size=1) + 
  geom_line(aes(y = do/2, colour="dissolved oxygen"), size=1) +
  theme_classic() + 
  xlab("Time (h)") + 
  ylab("Aeration (lpm)") + 
  scale_y_continuous(sec.axis = sec_axis(~.*2, name = "Dissolved oxygen (%)")) + 
  theme(legend.position="bottom", legend.title=element_blank())

grid_arrange_shared_legend(p1, p2,p3)

这 returns 只是第一个情节的图例，而不是三个情节的结合图例。

Answer 1

我没有你的数据，所以我会用一些基本数据集来说明。对于图例周围的一些空白，该方法并不完美，但评论中的某些人可能知道解决方案。

我提出的答案是使用 gtables 和 patchwork 及其内部函数。

library(ggplot2)
library(grid)
library(patchwork) #https://github.com/thomasp85/patchwork

# Make plots as usual
g1 <- ggplot(iris, aes(Sepal.Width, Sepal.Length)) +
  geom_point(aes(colour = Species))

g2 <- ggplot(mtcars, aes(mpg, disp)) +
  geom_point(aes(colour = as.factor(cyl)))


# specify a legend position and a orientation for plots
position <- "bottom"
orientation <- "vertical"

# Add as many plots as you want to this list
plots <- list(g1, g2)

# Grab legends from plots in list
legends <- lapply(plots, function(p) {
  p <- ggplotGrob(p + theme(legend.position = position))$grobs
  p[[which(sapply(p, function(x) x$name) == "guide-box")]]
})

# Combine the legends
legend <- switch(position,
                 "bottom" = do.call(gtable:::cbind.gtable, legends),
                 "right" = do.call(gtable:::rbind.gtable, legends))

# Now make versions of the plots without the legend
stripped <- lapply(plots, function(p) p + theme(legend.position = "none"))

# Combine all the plots
stripped <- switch(orientation,
                   "horizontal" = do.call(patchwork:::ggplot_add.ggplot, stripped),
                   "vertical"   = do.call(patchwork:::`/.ggplot`, stripped))

# Combine plots with legend
out <- switch(position,
              "bottom" = stripped / legend,
              "right" = stripped + legend)
out

^{由 reprex package (v0.3.0)}

于 2019-08-17 创建

如果空格确实是个问题，您可以提供绘图布局，但这必须是手动判断才能做出：

out + plot_layout(heights = c(1,1,0.2))

Answer 2

我认为关键是在您的第一个情节中添加所有图例。为此，您可以在数据中添加一些假行，并根据所有图的图例标记它们。假设这些图例是 "a"、"b"、"c"、"d"、"e" 和 "f"：

library(tidyverse)
# insert several rows with values outside your plot range
data <- add_row(mtcars,am=c(2, 3, 4, 5), mpg = 35, disp = 900)
data1<-data %>% 
  mutate (
   by1 = factor(am, levels = c(0, 1, 2, 3, 4, 5), 
             labels = c("a", "b","c","d", "e","f")))
p1 <- ggplot(data1, aes(x = mpg, y=disp, col=by1)) + 
  geom_point() +
  ylim(50,500)

你会得到你需要的所有图例，grid_arrange_shared_legend(p1, p2,p3) 会选择这个。如您所见，只有 "a" 和 "b" 用于第一个图，其余的用于其他图。

组合具有不同图例的图时添加组合图例

Add a combined legend when combining plots with different legends

r

ggplot2

legend

gridextra