在R的热图2包中，多个热图的通用图例和标题。

Question

我已经在一个布局中绘制了多个热图，使用 grid.arrange 但我想再增加两个功能。我想绘制一个共同的图例，并为每个单独的热图加上一个标题。但我无法做到这一点。如果我使用 main = "XYZ，它抛出一个错误。

这是我使用的代码。我想使用 sheets 名称作为相应热图的标题，并为所有热图提供一个共同的图例（最好是底部的横条）。当然，在顶部会有一个主标题，就像我代码中的标题一样。有什么方法可以做到这一点吗？

file = "I:/COMPARISON/heatmap.xlsx"

## load all sheets
sheets <- openxlsx::getSheetNames(file)
SheetList <- lapply(sheets,openxlsx::read.xlsx,xlsxFile=file)
names(SheetList) <- sheets


## create color ramp and colour breaks
col_breaks <- c(-2,-1.5,-1,0,1,1.5,2)
my_palette<-colorRampPalette(c("red4","red1","darkorange2","gold2",
                               "yellow4","yellow",
                               "chartreuse3","green4"))

#Define a new function to create Row labels
rname <- function(i){
  if (i <= 3)
    rname = format(ymd(seq(as.Date("1982-01-01"), as.Date("2017-12-01"), by = "months")), "%b-%Y")
  else
    rname = format(ymd(seq(as.Date("2021-01-01"), as.Date("2100-12-01"), by = "months")), "%b-%Y")
}

grab_grob <- function(){
  grid.echo()
  grid.grab()
}

g1 = lapply(1:6, function(i) {
  arr = as.data.frame(SheetList[i])
  heatmap.2(as.matrix(arr[2:7]),
            dendrogram ='none',
            Colv=FALSE, Rowv = FALSE, 
            key=FALSE, keysize=1.0, symkey=FALSE, density.info='none',
            trace='none',
            scale="none",cexRow=0.7,cexCol=0.9,
            breaks = col_breaks,col=my_palette,
            labRow = rname(i),
            labCol = c("spei-3", "spei-6", "spei-9", "spei-12", "spei-15", "spei-24"),
            colsep = 0:ncol(arr), sepwidth = c(0.01),
            sepcolor = c("grey")
  )

  grab_grob()
}
)


grid.newpage()
title1 = textGrob("Drought Progression Across Time Scales", gp=gpar(fontface="bold", fontsize = 18), vjust = 0.5)
grid.arrange(grobs = g1, ncol = 3, clip = TRUE, top = title1)

编辑：使用 grid::grid.text 手动贴标签

#Label heatmap in 2nd row
grid::grid.text(label = "Upper: 2021-2100", x = unit(0.17, "npc"), y = unit(0.42, "npc"), 
                gp = gpar(fontface = "bold"))
grid::grid.text(label = "Middle: 2021-2100", x = unit(0.5, "npc"), y = unit(0.42, "npc"), 
                gp = gpar(fontface = "bold"))
grid::grid.text(label = "Lower: 2021-2100", x = unit(0.83, "npc"), y = unit(0.42, "npc"), 
                gp = gpar(fontface = "bold"))

#Label heatmap in 1st row
grid::grid.text(label = "Upper: 1982-2017", x = unit(0.17, "npc"), y = unit(0.90, "npc"), 
                gp = gpar(fontface = "bold"))
grid::grid.text(label = "Middle: 1982-2017", x = unit(0.5, "npc"), y = unit(0.90, "npc"), 
                gp = gpar(fontface = "bold"))
grid::grid.text(label = "Lower: 1982-2017", x = unit(0.83, "npc"), y = unit(0.90, "npc"), 
                gp = gpar(fontface = "bold"))

ThanksEdit：抱歉，我错过了问题中最重要的部分。输入的数据。有11张表，其中我正在绘制前六张。

> sheets
 [1] "hr-up"                           "hr-mi"                           "hr-lo"                          
 [4] "fr-up"                           "fr-mi"                           "fr-lo"                          
 [7] "Severe and Extreme Drought Year" "Sheet3"                          "Drought Years"                  
[10] "Sheet1" 

每张纸都有一些正值和负值。这是数据在 hr-up

> head(arr, 24)
   hr.up.Date hr.up.spei.3 hr.up.spei.6 hr.up.spei.9 hr.up.spei.12 hr.up.spei.15 hr.up.spei.24
1       29952           NA           NA           NA            NA            NA            NA
2       29983           NA           NA           NA            NA            NA            NA
3       30011    1.4130876           NA           NA            NA            NA            NA
4       30042    1.4712732           NA           NA            NA            NA            NA
5       30072    0.5564964           NA           NA            NA            NA            NA
6       30103   -1.2459968   -0.5623140           NA            NA            NA            NA
7       30133   -1.7858451   -1.4540796           NA            NA            NA            NA
8       30164   -1.0875569   -0.9654640           NA            NA            NA            NA
9       30195   -1.3201110   -1.4099878   -1.2005973            NA            NA            NA
10      30225   -0.8063094   -1.5222028   -1.3334039            NA            NA            NA
11      30256   -1.6281357   -1.4216326   -1.3572572            NA            NA            NA
12      30286   -0.7776727   -1.3805879   -1.4655774    -1.2753331            NA            NA
13      30317    0.3703999   -0.7713255   -1.4535241    -1.2633736            NA            NA
14      30348    0.1290419   -1.4367198   -1.3660294    -1.2868081            NA            NA
15      30376    0.2806614   -0.4843129   -1.2882978    -1.3826657     -1.191301            NA
16      30407    1.2569239    1.0307590   -0.4222725    -1.2912207     -1.069121            NA
17      30437    0.6828162    0.5760019   -1.2077939    -1.2987510     -1.204489            NA
18      30468   -0.6508188   -0.5750230   -0.9207008    -1.4586072     -1.558509            NA
19      30498   -1.2616172   -0.9499083   -0.9993924    -1.1904968     -1.763035            NA
20      30529   -1.0117591   -0.8607768   -0.8791052    -1.3347798     -1.565065            NA
21      30560   -1.0278092   -0.9915982   -0.9721936    -1.1852030     -1.523914            NA
22      30590   -0.5786023   -1.0784944   -0.8861200    -0.9186963     -1.094952            NA
23      30621   -0.7426414   -1.0677353   -0.9443890    -0.9816226     -1.348177            NA
24      30651    0.2466843   -0.9279672   -0.9099656    -0.8790897     -1.094521     -1.449477

Answer 1

你可以使用以下方法发布你的数据 dput(data). 这是最简单的分享数据的方法，确保你发一个可复制的例子。我编了一些数据，但原理应该是不变的。解决方案使用 ggplot2. 希望能帮到你。

library(tidyverse)
data <- list(
  sheet1 = data.frame(
    category = c(paste0("rep_", 1:10)),
    value1 = rnorm(10),
    value2 = rnorm(10)),
  sheet2 = data.frame(
    category = c(paste0("rep_", 1:10)),
    value1 = rnorm(10),
    value2 = rnorm(10)),
  sheet3 = data.frame(
    category = c(paste0("rep_", 1:10)),
    value1 = rnorm(10),
    value2 = rnorm(10)))

data <- bind_rows(data, .id = "id") %>% 
  pivot_longer(c(-id, -category))

ggplot(data, aes(x= category, y=name)) +
  geom_tile(aes(fill = value)) + 
  facet_wrap(~id) +
  ggtitle("One title for all")+
  theme(plot.title = element_text(hjust = 0.5))

^{创建于2020-04-27，由 重读包 (v0.3.0)}