使用“gridGraphics”包绘制多个热图答案

【问题标题】：Using "gridGraphics" package to plot multiple heatmaps使用“gridGraphics”包绘制多个热图
【发布时间】：2020-03-24 09:02:58
【问题描述】：

我从@baptiste 那里看到了这个答案，它使用 R 中的 gridGraphics 包来绘制多个热图。 https://stackoverflow.com/a/31768236/11696009

但是，虽然我能够重新创建示例（显然），但我需要将其应用于我自己的独特条件。我有一个 Excel 工作簿，里面有 6 张纸。我想将每张工作表绘制为单独的热图，以便将所有 6 个热图绘制在 3x2 网格中（3 个热图排列在另一个下方）。

我对 R 很陌生，但如果我能够将所有这些工作表传递给 arr[[]] ，我可能可以使用此代码。请帮助我如何做到这一点。

这是我正在尝试调整的代码。

library(gridGraphics)
library(grid)

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

arr <- replicate(4, matrix(sample(1:100),nrow=10,ncol=10), simplify = FALSE)

library(gplots)
gl <- lapply(1:4, function(i){
  heatmap.2(arr[[i]], dendrogram ='row',
            Colv=FALSE, col=greenred(800), 
            key=FALSE, keysize=1.0, symkey=FALSE, density.info='none',
            trace='none', colsep=1:10,
            sepcolor='white', sepwidth=0.05,
            scale="none",cexRow=0.2,cexCol=2,
            labCol = colnames(arr[[i]]),                 
            hclustfun=function(c){hclust(c, method='mcquitty')},
            lmat=rbind( c(0, 3), c(2,1), c(0,4) ), lhei=c(0.25, 4, 0.25 ),                 
  )
  grab_grob()
})

grid.newpage()
library(gridExtra)
grid.arrange(grobs=gl, ncol=2, clip=TRUE)

谢谢。

编辑：所以，我添加了一些线，得到了 6 个图（每行 3 个），但它只绘制了两个图 - 列表中的第一个和最后一个。即第一张的热图进入第一行（重复三次），第六张的热图进入第二行（重复三次）。

for (i in 6) {
    arr = as.data.frame(SheetList[i])


    g1 <- lapply(1:6, function(j){
      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.2,cexCol=0.9,
                breaks = col_breaks,col=my_palette,
                labRow = arr[,1],                 
                hclustfun=function(c){hclust(c, method='mcquitty')},
                lmat=rbind(c(0, 3), c(2,1), c(0,4)), lhei=c(0.25, 4, 0.25),                 
      )
      grab_grob()
    })
}

grid.newpage()
grid.arrange(grobs = g1, ncol=3, clip=TRUE)

This is the plot I get

【问题讨论】：

标签： r heatmap

【解决方案1】：

对于那些可能需要它的人。

# load and install necessary packages
install.packages("pacman")
library(pacman)
pacman::p_load(gridGraphics,grid,gridExtra,gplots,lubridate, install = TRUE)

file = "something.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) #provide col breaks
my_palette<-colorRampPalette(c("red4","red1","darkorange2","gold2",
                               "yellow4","yellow",
                               "chartreuse3","green4")) #color ramp

#Define a new function to create Row labels
#I have six heatmaps; three with same date row 
#First three heatmap start from 1982-2017 and last three from 2021-2100
rname <- function(i){
  if (i <= 3)
    rname = seq(as.Date("1982-01-01"), as.Date("2017-12-01"), by = "months")
  else
    rname = seq(as.Date("2021-01-01"), as.Date("2100-12-01"), by = "months")
}

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 = format(ymd(rname(i)),"%b-%Y"),
            labCol = c("spei-3", "spei-6", "spei-9", "spei-12", "spei-15", "spei-24"),
            colsep = 0:3, sepwidth = c(0.01),
            sepcolor = c("grey")
  )

  grab_grob()
}
)


grid.newpage()
title1=textGrob("MAIN TITLE", gp=gpar(fontface="bold"), vjust = 0.7)
grid.arrange(grobs = g1, ncol = 3, clip = TRUE, top = title1)

【讨论】：