Использование пакета gridGraphics для построения нескольких тепловых карт - PullRequest
Новая
       8

Использование пакета gridGraphics для построения нескольких тепловых карт

0 голосов
/ 24 марта 2020

Я наткнулся на этот ответ от @baptiste, который использует пакет gridGraphics в R для построения нескольких тепловых карт. { ссылка }

Но хотя я смог воссоздать пример (очевидно), мне нужно применить его к моему собственному уникальному состоянию. У меня есть книга Excel с 6 листами. Я хочу построить каждый лист как отдельную тепловую карту, чтобы все 6 тепловых карт были построены в сетке 3х2 (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)

Спасибо.

edit: Итак, я добавил несколько строк и получил 6 графиков (по 3 в каждой строке), но он отображает только два графика - первый в списке и последний. т.е. тепловая карта для 1-го листа идет в первом ряду (повторяется трижды), а тепловая карта 6-го листа - во втором ряду (повторяется трижды). 

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)

Это сюжет, который я получаю

1 Ответ

0 голосов
/ 04 апреля 2020

Для тех, кому это может понадобиться. 

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