Home > Net >  Function to save multiple Complex Heatmap plots with added elements in a list using sapply - R
Function to save multiple Complex Heatmap plots with added elements in a list using sapply - R

Time:08-27

I'm trying to create a list of heatmaps with added elements to the plot. The code I'm using is derived from the complex heatmap tutorial: https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html

Here is a simplified version of my function:

library(ComplexHeatmap)
library(GetoptLong)  # for the function qq()

make_heatmap <-
  function(seed) {
    set.seed(seed)
    mat2 = matrix(rnorm(50 * 50), nrow = 50)
    split = rep(1:5, each = 10)
    
    ha = HeatmapAnnotation(
      empty = anno_empty(border = FALSE, height = unit(8, "mm")),
      foo = anno_block(gp = gpar(fill = 2:6), labels = LETTERS[1:5])
    )
    
    
    group_block_anno = function(group,
                                empty_anno,
                                gp = gpar(),
                                label = NULL,
                                label_gp = gpar()) {
      seekViewport(qq("annotation_@{empty_anno}_@{min(group)}"))
      loc1 = deviceLoc(x = unit(0, "npc"), y = unit(0, "npc"))
      seekViewport(qq("annotation_@{empty_anno}_@{max(group)}"))
      loc2 = deviceLoc(x = unit(1, "npc"), y = unit(1, "npc"))
      
      seekViewport("global")
      grid.rect(
        loc1$x,
        loc1$y,
        width = loc2$x - loc1$x,
        height = loc2$y - loc1$y,
        just = c("left", "bottom"),
        gp = gp
      )
      if (!is.null(label)) {
        grid.text(
          label,
          x = (loc1$x   loc2$x) * 0.5,
          y = (loc1$y   loc2$y) * 0.5,
          gp = label_gp
        )
      }
    }
    
    htmp <-
      Heatmap(
        mat2,
        name = "mat2",
        column_split = split,
        top_annotation = ha,
        column_title = NULL
      )
    print(htmp)
    group_block_anno(1:3, "empty", gp = gpar(fill = "red"), label = "group 1")
    group_block_anno(4:5, "empty", gp = gpar(fill = "blue"), label = "group 2")
    
  }

Then, I want to save the plots with different parameters in a list using sapply:

heatmap.list <- sapply(c(1,10,100,1000), make_heatmap)

By calling heatmap.list[1] I would expect a heatmap like this:

heatmap

However, my output for heatmap.list is the following:

heatmap.list
              [,1]              [,2]              [,3]              [,4]             
label         "group 2"         "group 2"         "group 2"         "group 2"        
x             6.86002           6.86002           6.86002           6.86002          
y             5.88428           5.88428           5.88428           5.88428          
just          "centre"          "centre"          "centre"          "centre"         
hjust         NULL              NULL              NULL              NULL             
vjust         NULL              NULL              NULL              NULL             
rot           0                 0                 0                 0                
check.overlap FALSE             FALSE             FALSE             FALSE            
name          "GRID.text.33404" "GRID.text.33501" "GRID.text.33598" "GRID.text.33695"
gp            List,0            List,0            List,0            List,0           
vp            NULL              NULL              NULL              NULL 

I tried using recordPlot() at the end of my function,

make_heatmap <-
  function(seed) {
  #same as before
  .
  .
  .
  print(htmp)
  group_block_anno(1:3, "empty", gp = gpar(fill = "red"), label = "group 1")
  group_block_anno(4:5, "empty", gp = gpar(fill = "blue"), label = "group 2")

  record.htmp <- recordPlot()
  plot.new()
  record.htmp
  }

heatmap.list <- sapply(c(1, 10, 100, 1000), make_heatmap)

But the output is as follows:

heatmap.list
     [,1]      [,2]      [,3]      [,4]     
[1,] List,502  List,502  List,502  List,502 
[2,] Raw,35992 Raw,35992 Raw,35992 Raw,35992
[3,] List,2    List,2    List,2    List,2   

Is there a way to get my desired heatmap list? I have searched a lot, but I couldn't find a solution.

EDIT Solution:

As Robert Hacken suggested, using lapply() instead of sapply() solves the problem. I posted the corrected function here for possibly similar problems:

library(ComplexHeatmap)
library(GetoptLong)  # for the function qq()

make_heatmap <-
  function(seed) {
    set.seed(seed)
    mat2 = matrix(rnorm(50 * 50), nrow = 50)
    split = rep(1:5, each = 10)

    ha = HeatmapAnnotation(
      empty = anno_empty(border = FALSE, height = unit(8, "mm")),
      foo = anno_block(gp = gpar(fill = 2:6), labels = LETTERS[1:5])
    )


    group_block_anno = function(group,
                                empty_anno,
                                gp = gpar(),
                                label = NULL,
                                label_gp = gpar()) {
      seekViewport(qq("annotation_@{empty_anno}_@{min(group)}"))
      loc1 = deviceLoc(x = unit(0, "npc"), y = unit(0, "npc"))
      seekViewport(qq("annotation_@{empty_anno}_@{max(group)}"))
      loc2 = deviceLoc(x = unit(1, "npc"), y = unit(1, "npc"))

      seekViewport("global")
      grid.rect(
        loc1$x,
        loc1$y,
        width = loc2$x - loc1$x,
        height = loc2$y - loc1$y,
        just = c("left", "bottom"),
        gp = gp
      )
      if (!is.null(label)) {
        grid.text(
          label,
          x = (loc1$x   loc2$x) * 0.5,
          y = (loc1$y   loc2$y) * 0.5,
          gp = label_gp
        )
      }
    }

    htmp <-
      Heatmap(
        mat2,
        name = "mat2",
        column_split = split,
        top_annotation = ha,
        column_title = NULL
      )
    print(htmp)
    group_block_anno(1:3, "empty", gp = gpar(fill = "red"), label = "group 1")
    group_block_anno(4:5, "empty", gp = gpar(fill = "blue"), label = "group 2")

  record.htmp <- recordPlot()
  plot.new()
  record.htmp
  }

heatmap.list <- lapply(c(1, 10, 100, 1000), make_heatmap)

EDIT 2:

heatmap.list <- sapply(c(1, 10, 100, 1000), make_heatmap, simplify = F)

Works aswell, which allows to access the elements of the list by name with heatmap.list$parameter, which might improve the workflow.

CodePudding user response:

You can use lapply instead of sapply so that the result is not simplified into a matrix and then get e.g. the first element with heatmap.list[[1]].

  • Related