使用“ gridGraphics”软件包绘制多个热图

Posted 2021-04-26

我从@baptiste那里得到了这个答案，该答案在R中使用gridGraphics程序包绘制了多个热图。 https://stackoverflow.com/a/31768236/11696009

但是，尽管我能够重新创建示例（显然），但我需要将其应用于我自己的独特条件。我有一本有6张纸的Excel工作簿。我想将每个工作表绘制为单独的热图，以便将所有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

答案

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

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