简体   繁体   English

Function 使用 sapply - R 在列表中保存多个带有添加元素的复杂热图图

[英]Function to save multiple Complex Heatmap plots with added elements in a list using sapply - R

I'm trying to create a list of heatmaps with added elements to the plot.我正在尝试创建一个带有添加到 plot 元素的热图列表。 The code I'm using is derived from the complex heatmap tutorial: https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.html我使用的代码源自复杂的热图教程: https://jokergoo.github.io/ComplexHeatmap-reference/book/heatmap-annotations.ZFC35FDC70D5FC69D269883A8

Here is a simplified version of my function:这是我的 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:然后,我想使用 sapply 将具有不同参数的图保存在列表中:

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

By calling heatmap.list[1] I would expect a heatmap like this:通过调用heatmap.list[1]我希望得到这样的热图:

heatmap热图

However, my output for heatmap.list is the following:但是,我的 heatmap.list 的heatmap.list如下:

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,我尝试在 function 末尾使用recordPlot()

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:但是output如下:

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.正如 Robert Hacken 所建议的,使用lapply()而不是sapply()可以解决问题。 I posted the corrected function here for possibly similar problems:我在这里发布了更正后的 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")

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

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

EDIT 2:编辑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.也可以工作,它允许使用heatmap.list$parameter按名称访问列表的元素,这可能会改善工作流程。

You can use lapply instead of sapply so that the result is not simplified into a matrix and then get eg the first element with heatmap.list[[1]] .您可以使用lapply而不是sapply以便结果不会简化为矩阵,然后使用heatmap.list[[1]]获取例如第一个元素。

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM