在Patchwork中合并两个y轴标题

Question

有什么想法可以将两个相同的y轴标题合并成一个，并将这个y轴标题放置在图形中间？我已经成功地通过使用plot_layout(guides = "collect")来合并图例，但是我似乎找不到类似于轴的东西。在这种情况下，我想将称为disp_disp_disp的两个轴标题合并成一个。

mtcars

library(ggplot2)
library(patchwork)

p1 <- ggplot(mtcars) + 
  geom_point(aes(mpg, disp)) + 
  labs(x = "mpg", y = "disp_disp_disp_disp_disp")

p2 <- ggplot(mtcars) + 
  geom_boxplot(aes(gear, disp, group = gear)) + 
  labs(x = "gear", y = "disp_disp_disp_disp_disp")

p3 <- ggplot(mtcars) + 
  geom_point(aes(hp, wt, colour = mpg)) + 
  ggtitle('Plot 3')

p1 / (p2 | p3)

- Tiptop

---

旧功能请求在Patchwork上（仍未解决）https://github.com/thomasp85/patchwork/issues/43 - undefined

Answer 1

我想在绘图之前剥离y轴标题会稍微容易一些，然后在绘制完毕后再重新添加上去：

library(ggplot2)
library(patchwork)

p1 <- ggplot(mtcars) + 
  geom_point(aes(mpg, disp)) + 
  labs(x = "mpg", y = "disp_disp_disp_disp_disp")

p2 <- ggplot(mtcars) + 
  geom_boxplot(aes(gear, disp, group = gear)) + 
  labs(x = "gear", y = "disp_disp_disp_disp_disp")

p3 <- ggplot(mtcars) + 
  geom_point(aes(hp, wt, colour = mpg)) + 
  ggtitle('Plot 3')

ylab <- p1$labels$y
p1$labels$y <- p2$labels$y <- " "

p1 / (p2 | p3)
grid::grid.draw(grid::textGrob(ylab, x = 0.02, rot = 90))

如果您想完全避免与grobs打交道，另一种选择是指定一个仅包含文本的ggplot，并将其添加为轴文本：

p4 <- ggplot(data.frame(l = p1$labels$y, x = 1, y = 1)) +
      geom_text(aes(x, y, label = l), angle = 90) + 
      theme_void() +
      coord_cartesian(clip = "off")

p1$labels$y <- p2$labels$y <- " "

p4 + (p1 / (p2 | p3)) + plot_layout(widths = c(1, 25))

调整大小时这个表现得更好一些。

- Allan Cameron

---

最后一个 p4 很棒。 - Paul 'Joey' McMurdie

Answer 2

我所能想到的唯一方法是在gtable层面上进行黑客攻击，但我也很想学习更方便的方法。以下是gtable方法：

library(ggplot2)
library(patchwork)
library(grid)

p1 <- ggplot(mtcars) + 
  geom_point(aes(mpg, disp)) + 
  labs(x = "mpg", y = "disp_disp_disp_disp_disp")

p2 <- ggplot(mtcars) + 
  geom_boxplot(aes(gear, disp, group = gear)) + 
  labs(x = "gear", y = "disp_disp_disp_disp_disp")

p3 <- ggplot(mtcars) + 
  geom_point(aes(hp, wt, colour = mpg)) + 
  ggtitle('Plot 3')

p123 <- p1 / (p2 | p3)

# Convert to gtable
gt <- patchworkGrob(p123)

# Stretching one y-axis title
is_yaxis_title <- which(gt$layout$name == "ylab-l")
# Find new bottom position based on gtable::gtable_show_layout(gt)
gt$layout$b[is_yaxis_title] <- gt$layout$b[is_yaxis_title] + 18

# Deleting other y-axis title in sub-patchwork
is_patchwork <- which(gt$layout$name == "patchwork-table")
pw <- gt$grobs[[is_patchwork]]
pw <- gtable::gtable_filter(pw, "ylab-l", invert = TRUE)

# Set background to transparent
pw$grobs[[which(pw$layout$name == "background")[1]]]$gp$fill <- NA

# Putting sub-patchwork back into main patchwork
gt$grobs[[is_patchwork]] <- pw

# Render
grid.newpage(); grid.draw(gt)

^{由reprex包 (v0.3.0)在2020-12-14创建}

- teunbrand

Answer 3

使用 gridExtra 还有另一种方法。

library(ggplot2)
library(patchwork)
library(gridExtra)

p1 <- ggplot(mtcars) + 
  geom_point(aes(mpg, disp)) + 
  labs(x = "mpg") +
  theme(axis.title.y = element_blank())

p2 <- ggplot(mtcars) + 
  geom_boxplot(aes(gear, disp, group = gear)) + 
  labs(x = "gear") +
  theme(axis.title.y = element_blank())

p3 <- ggplot(mtcars) + 
  geom_point(aes(hp, wt, colour = mpg)) + 
  ggtitle('Plot 3')


grid.arrange(patchworkGrob(p1 / (p2 | p3)), left = "disp_disp_disp_disp_disp")

- Henry Holm