如何在地塊之間添加標題

Question

為簡單起見，假設我有四個圖表：

data("midwest", package = "ggplot2")
p1<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p2<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p3<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p4<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
grid.arrange(p1,p2,p3,p4,ncol=2) 

現在，我想在每兩個標題之間創建一個標題（標題 1、標題 2），如下所示：

任何想法如何做到這一點？

Answer 1

這是您的問題的 gtable 解決方案。 那里可能有更簡單的解決方案，但這應該可行。

首先，我們將在最左邊的圖中烘焙一些標題

library(grid) # needed later for plotting

data("midwest", package = "ggplot2")
p1<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point() + ggtitle("Title 1")
p2<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()
p3<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point() + ggtitle("Title 2")
p4<-ggplot(midwest, aes(x=area, y=poptotal)) + geom_point()

然后我們可以按照我們認為合適的方式將這些圖cbind和rbind結合在一起。

p12 <- cbind(ggplotGrob(p1), ggplotGrob(p2), size = "first")
p34 <- cbind(ggplotGrob(p3), ggplotGrob(p4), size = "first")

all <- rbind(p12, p34, size = "first")

grid.newpage(); grid.draw(all)

請注意，我們必須使用grid.newpage()和grid.draw()來獲取我們的繪圖，因為我們已經離開了 ggplot 球體，現在位於 gtables 和網格的 realm 中。 無論如何，生成的 plot 如下所示：

從您的示例中，我希望您希望這些標題居中。 這會有點挑剔：

# Decide what is a title
is_title <- grep("^title$", all$layout$name)
# Grab all titles
titles <- all$grobs[is_title]
# Exclude empty titles
is_title <- is_title[!sapply(titles, inherits, "zeroGrob")]

# Center title
all$grobs[is_title] <- lapply(all$grobs[is_title], function(title) {
  title$children[[1]]$hjust <- 0.5
  title$children[[1]]$x <- unit(0.5, "npc")
  title
})

# Spread title over all panels
# You can see the number you'd need from the l/r coordinates of the 'panel' grobs
# which you can find by printing `all` or `all$layout`.
all$layout[is_title, "r"] <- 14 


grid.newpage(); grid.draw(all)

編輯：添加了添加額外標題的示例

您可以添加額外的標題，但為此您需要 gtable package。

library(gtable)

# First make extra titles
left <- textGrob("Left Title", gp = gpar(fontsize = 13.2, col = "black",
                                         lineheight = 0.9, font = 1))
right <- textGrob("Right Title", gp = gpar(fontsize = 13.2, col = "black",
                                           lineheight = 0.9, font = 1))

# Find a height that was 0, assign new height based on extra title
all$heights[[2]] <- unit(1, "grobheight", left)
# Add the titles (t = top position, l = left position)
all <- gtable_add_grob(all, left, t = 2, l = 5, clip = "off")
all <- gtable_add_grob(all, right, t = 2, l = 14, clip = "off")

grid.newpage(); grid.draw(all)