标签 ggplot 拼凑

Question

我正在尝试将 9 个地块与一些独特的标签和一些常见的标签合二为一。在另一篇文章中，有人告诉我使用拼凑而不是 grid.arrange（因为我对图例有问题），但使用拼凑我无法放置所有标签。

这是绘图的代码：

library(ggplot2)

df <- data.frame(
  index = 1:21,
  corr = c(0.10470688, 0.10827255, 0.12322448, 0.11887717, 0.12719741, 0.12635607, 0.13427974,
           0.13539245, 0.13636687, 0.13834174, 0.13864013, 0.13816236, 0.13640052, 0.13775515,
           0.13563827, 0.13968726, 0.12499506, 0.11836173, 0.11097081, 0.09829338, 0.10470688),
  group = c(rep("Group A", 14), rep("Group B", 7))
)

p1 <- ggplot(df) +
  aes(x = index, y = corr, shape = group) +
  geom_point(size = 2) +
  theme_light()
library(patchwork)
p1 + p1 + p1 + p1 + p1 + p1 + p1 + p1 + p1 +
  plot_layout(ncol = 3, nrow = 3, guides = "collect")

但是我不知道具体的标签怎么放。在这里你可以看到我是如何使用 grid.arrange 做到的：

library(ggplot2)
library(gridExtra)
library(grid)
library(lattice)

t <- textGrob("Proportion of S1>S2 on Variable1")

lay <- rbind(c(1,2,3),
             c(1,2,3),
             c(1,2,3),
             c(1,2,3),
             c(1,2,3),
             c(1,2,3),
             c(1,2,3),
             c(4,4,4),
             c(5,6,7),
             c(5,6,7),
             c(5,6,7),
             c(5,6,7),
             c(5,6,7),
             c(5,6,7),
             c(5,6,7),
             c(8,8,8),
             c(9,10,11),
             c(9,10,11),
             c(9,10,11),
             c(9,10,11),
             c(9,10,11),
             c(9,10,11),
             c(9,10,11),
             c(12,12,12))

grid.arrange (arrangeGrob (p1, top="High w", left="High p correlation")
,arrangeGrob(p1,top="Medium w correlation")
,arrangeGrob(p1,top="Low w correlation")
,arrangeGrob(t)
,arrangeGrob(p1, left="Medium p correlation")
,arrangeGrob(p1)
,arrangeGrob(p1)
,t
,arrangeGrob(p1, left="Low p correlation")
,arrangeGrob(p1)
,arrangeGrob(p1)
,t
, ncol=3,nrow=24,top="Title", layout_matrix=lay)

但我需要使用 pachwork 来实现共享图例，而不是每个情节都有 9 个图例。

有没有办法像我在 grid.arrange 中那样在拼凑中添加标签？

我已经看到了grind.arrange 的这个函数来提取共享图例，但我不能让它在我的例子中工作：

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

在这里工作：

grid_arrange_shared_legend(p1, p1, p1, p1)

但我不能让它在这里工作：

grid.arrange (arrangeGrob (p1, top="High w", left="High p correlation")
,arrangeGrob(p1,top="Medium w correlation")
,arrangeGrob(p1,top="Low w correlation")
,arrangeGrob(t)
,arrangeGrob(p1, left="Medium p correlation")
,arrangeGrob(p1)
,arrangeGrob(p1)
,t
,arrangeGrob(p1, left="Low p correlation")
,arrangeGrob(p1)
,arrangeGrob(p1)
,t
, ncol=3,nrow=24,top="Title", layout_matrix=lay)

有什么想法吗？ 非常感谢您，非常感谢您在此论坛中提供的所有帮助和支持。

祝你好运

Answer 1

在这里您可以找到不同的策略（不同的功能）来解决您的任务： https://github.com/thomasp85/patchwork/issues/43

• 作为一个例子，使用这个提供的函数为你的地块添加一个全局标签：

add_global_label <- function(pwobj, Xlab = NULL, Ylab = NULL, Xgap = 0.03, Ygap = 0.03, ...) {
  ylabgrob <- patchwork::plot_spacer()
  if (!is.null(Ylab)) {
    ylabgrob <- ggplot() +
      geom_text(aes(x = .5, y = .5), label = Ylab, angle = 90, ...) +
      theme_void()
  }
  if (!is.null(Xlab)) {
    xlabgrob <- ggplot() +
      geom_text(aes(x = .5, y = .5), label = Xlab, ...) +
      theme_void()
  }
  if (!is.null(Ylab) & is.null(Xlab)) {
    return((ylabgrob + patchworkGrob(pwobj)) + 
             patchwork::plot_layout(widths = 100 * c(Ygap, 1 - Ygap)))
  }
  if (is.null(Ylab) & !is.null(Xlab)) {
    return((ylabgrob + pwobj) + 
             (xlabgrob) +
             patchwork::plot_layout(heights = 100 * c(1 - Xgap, Xgap),
                                    widths = c(0, 100),
                                    design = "
                                   AB
                                   CC
                                   "
             ))
  }
  if (!is.null(Ylab) & !is.null(Xlab)) {
    return((ylabgrob + pwobj) + 
             (xlabgrob) +
             patchwork::plot_layout(heights = 100 * c(1 - Xgap, Xgap),
                                    widths = 100 * c(Ygap, 1 - Ygap),
                                    design = "
                                   AB
                                   CC
                                   "
             ))
  }
  return(pwobj)
}

然后使用：

require(magrittr)
(p1 + p1 + p1 + p1 + p1 + p1 + p1 + p1 + p1) %>%
  add_global_label(Ylab = "Global Y title",
                   #       size = 8,
                   #      Ygap = 0.04
  ) + plot_layout(guides = "collect")

导致：