从图A中提取图例并将其添加到图B

Question

我想从template中提取确切的图例并将其添加到p。

library(ggplot2)
hc <- c("#00000000", heat.colors(4, alpha = 1))
ds <- cbind(expand.grid(1:4,1:4),z=sample(200:300,16))

p <-ggplot(ds, aes(Var1, Var2)) +
    geom_raster(aes(fill = z)) +
    scale_fill_gradientn(colours=hc) +
    theme( 
        legend.position="bottom",
    ) +
    ggtitle("My title")

tmp <- cbind(expand.grid(1:10,1:10),z=1:100)
template <-ggplot(tmp, aes(Var1, Var2)) +
    geom_raster(aes(fill = z)) + 
    scale_fill_gradientn(colours=hc,breaks=c(25,50,75,100) ,labels=paste0(c(25,50,75,100),"%"),limits=c(1,100))  +
    theme( 
        legend.position="bottom",
        legend.title = element_blank()
    ) +
    ggtitle("My template")

我尝过这样的话：

p$scales <- template$scales

和“玩”

g <- ggplotGrob(template)

Answer 1

我的解决方案使用ggplot_build和ggplot_gtable来提取图例，然后将其简单地放入其他图中。

library(ggplot2)
# Extract legend from ggplot object
extractLegend <- function(gg) {
    grobs <- ggplot_gtable(ggplot_build(gg))
    foo <- which(sapply(grobs$grobs, function(x) x$name) == "guide-box")
    grobs$grobs[[foo]]
}

# Extract wanted legend
wantedLegend <- extractLegend(template)

# Extract grobs from plot
grobsToReplace <- ggplot_gtable(ggplot_build(p))
foo <- which(sapply(grobsToReplace$grobs, function(x) x$name) == "guide-box")
# Replace legend with wanted legend
grobsToReplace$grobs[[foo]] <- wantedLegend
plot(grobsToReplace)

<强>之前

<强>后

Answer 2

不确定第一次发布这个问题时 cowplot::get_legend 是否已经出现，但将其与 cowplot::plot_grid（或来自 patchwork 或 egg 等软件包的其他绘图布局函数）结合起来) 可让您轻松提取图例并将其添加到不同的 ggplot 对象中。

library(ggplot2)
cowplot::plot_grid(
  p + theme(legend.position = "none"),
  cowplot::get_legend(template),
  ncol = 1, rel_heights = c(5, 1)
)

在 rel_heights 中随意调整您认为合适的高度比例。