R 数据可视化 —— 聚类热图 ComplexHeatmap(二)注释

热图注释

前面我们介绍了如何绘制聚类热图，在这一节我们将介绍如何添加注释

热图的注释是聚类热图的重要组成部分，能够将热图的行、列附加信息添加到热图中。

ComplexHeatmap 提供了灵活的热图注释功能，可以在热图主体的上、下、左、右四个方向上添加注释，且支持自定义注释图形。

热图注释使用 HeatmapAnnotation 类来构建，例如

column_ha <- HeatmapAnnotation(
  foo1 = runif(10), 
  bar1 = anno_barplot(runif(10))
  )
row_ha <- rowAnnotation(
  foo2 = runif(10), 
  bar2 = anno_barplot(runif(10))
  )

其中 rowAnnotation 是行注释 HeatmapAnnotation(..., which = "row") 的简便写法，对应的也有 columnAnnotation

在这里，我们分别创建了行列注释，每个注释中包含一个颜色条和一个柱状图。

注意，注释图形是以 name-value 对的方式指定，即 foo1 表示绘制的图形名称，value 为绘制的内容。

如果传递的值是向量，则绘制的图形是 简单注释，而想柱状图这种称为 复杂注释

我们可以将这些注释添加到热图中

set.seed(123)
mat <- matrix(rnorm(100), 10)
rownames(mat) <- paste0("R", 1:10)
colnames(mat) <- paste0("C", 1:10)

Heatmap(
  mat, 
  name = "mat", 
  top_annotation = column_ha, 
  right_annotation = row_ha
  )

其中 top_annotation、right_annotation 指定了注释放置的位置，我们也可以将注释放置另外两个位置

Heatmap(
  mat, 
  name = "mat", 
  bottom_annotation = column_ha, 
  left_annotation = row_ha
  )

热图注释是可以独立于热图而存在的，可以使用 +（水平添加）或 %v%（竖直添加）将注释添加到热图中

Heatmap(
  mat, 
  name = "mat"
  ) + row_ha

Heatmap(
  mat, 
  name = "mat"
  ) %v% column_ha

查看注释对象信息

> row_ha
A HeatmapAnnotation object with 2 annotations
  name: heatmap_annotation_1 
  position: row 
  items: 10 
  width: 15.3514598035146mm 
  height: 1npc 
  this object is subsetable
  9.96242222222223mm extension on the bottom 

 name   annotation_type color_mapping width
 foo2 continuous vector        random   5mm
 bar2    anno_barplot()                10mm

1. 简单注释

简单注释是最常用的热图注释，只需要传递一个向量，会将向量的值映射到颜色值，绘制出一个颜色条，例如

grid.newpage()
pushViewport(viewport(y = 0.7, height = 0.6, width = 0.8))

ha <- HeatmapAnnotation(foo = 1:10)
draw(ha)

这样就可以单独绘制注释了，为了方便，除非必要，后面我们将只贴出注释的代码，重要的是知道怎么绘制的就行。

离散型颜色条

ha <- HeatmapAnnotation(
  bar = sample(letters[1:3], 10, replace = TRUE)
  )

这些颜色是随机的，每次运行的结果都不一样，如果要固定颜色，需要用到 col 参数

library(circlize)

col_fun <- colorRamp2(
  c(0, 5, 10), 
  c("#ff7f00", "white", "#1f78b4")
  )

ha <- HeatmapAnnotation(
  foo = 1:10,
  col = list(
    foo = col_fun
  )
  )

注意：col 参数的值是一个 list，这意味着，如果有多个注释图形，可以分别为不同的图形指定颜色

例如，我们添加离散型数据

ha <- HeatmapAnnotation(
  foo = 1:10,
  bar = sample(letters[1:3], 10, replace = TRUE),
  col = list(
    foo = col_fun,
    bar = c("a" = "red", "b" = "green", "c" = "blue")
    )
  )

NA 值可以的颜色使用 na_col 参数来设置

ha <- HeatmapAnnotation(
  foo = c(1:4, NA, 6:10),
  bar = c(sample(letters[1:3], 4, replace = TRUE), NA, sample(letters[1:3], 5, replace = TRUE)),
  col = list(
    foo = col_fun,
    bar = c("a" = "red", "b" = "green", "c" = "blue")
    ),
  na_col = "black"
  )

设置图形属性

ha <- HeatmapAnnotation(
  foo = 1:10,
  bar = sample(letters[1:3], 10, replace = TRUE),
  col = list(
    foo = col_fun,
    bar = c("a" = "red", "b" = "green", "c" = "blue")
    ),
  gp = gpar(col = "black")
  )

简单注释也可以接受一个数值或字符矩阵，传入的矩阵的列对应于列注释的行，例如

ha <- HeatmapAnnotation(
  foo = cbind(a = runif(10), b = runif(10))
  )

如果矩阵没有列名，则会将参数名放置在注释的中间

ha <- HeatmapAnnotation(
  foo = cbind(runif(10), runif(10))
  )

可以将一个数据框传递给 df 参数

ha <- HeatmapAnnotation(
  df = data.frame(
    foo = 1:10,
    bar = sample(letters[1:3], 10, replace = TRUE)
    )
  )

混合使用

ha <- HeatmapAnnotation(
  df = data.frame(
    foo = 1:10,
    bar = sample(letters[1:3], 10, replace = TRUE)
    ),
  foo2 = rnorm(10),
  col = list(
    foo = col_fun,
    bar = c("a" = "red", "b" = "green", "c" = "blue")
  )
  )

使用 border = TRUE 来添加单个注释的框线

ha <- HeatmapAnnotation(
  df = data.frame(
    foo = 1:10,
    bar = sample(letters[1:3], 10, replace = TRUE)
    ),
  foo2 = cbind(rnorm(10), rnorm(10)),
  col = list(
    foo = col_fun,
    bar = c("a" = "red", "b" = "green", "c" = "blue")
  ),
  border = TRUE
  )

注意：矩阵型和数据框型的区别，矩阵表示的是一个注释，而数据框的每个变量都是一个注释

所有单个注释的高度是一样的，使用 simple_anno_size 来设置单个注释的高度

ha <- HeatmapAnnotation(
  df = data.frame(
    foo = 1:10,
    bar = sample(letters[1:3], 10, replace = TRUE)
    ),
  col = list(
    foo = col_fun,
    bar = c("a" = "red", "b" = "green", "c" = "blue")
  ),
  simple_anno_size = unit(1, "cm")
  )

也可以设置全局变量 ht_opt$simple_anno_size 的值来控制单个注释的大小

2. 注释函数

HeatmapAnnotation 支持将注释作为一个函数，注释函数定义了如何在指定的位置绘制相应的图片。

ComplexHeatmap 定义了许多注释函数，还可以自定义自己的注释函数

所有注释函数都是 anno_*() 的形式，不需要指定要将其绘制在什么位置，它会自动检测该放置在行还是列上。

上述的简单注释，都是隐式的使用了 anno_simple() 函数，直接使用 anno_simple() 不会自动生成图例，在后面的章节我们将会介绍如何绘制图例

例如

ha <- HeatmapAnnotation(
  foo = anno_simple(1:10)
  )

等价于

ha <- HeatmapAnnotation(
  foo = 1:10
  )

anno_simple() 可以在注释中添加额外的点或单字母字符，并通过 pch, pt_gp 和 pt_size 参数来控制

ha <- HeatmapAnnotation(
  foo = anno_simple(
    1:10, 
    pch = 1,
    pt_gp = gpar(col = "red"),
    pt_size = unit(1:10, "mm"))
  )

将 pch 设置为向量

ha <- HeatmapAnnotation(
  foo = anno_simple(
    1:10, 
    pch = 1:10
  )
)

将 pch 设置为字符向量

ha <- HeatmapAnnotation(
  foo = anno_simple(
    1:10, 
    pch = sample(letters[1:3], 10, replace = TRUE)
  )
)

如果 pch 值向量中有 NA 值，则什么也不会画

ha <- HeatmapAnnotation(
  foo = anno_simple(
    1:10, 
    pch = c(1:4, NA, 6:8, NA, 10, 11)
  )
)

如果 anno_simple() 函数的值是矩阵，那么 pch 的长度与矩阵的行数、列数或矩阵的长度一致

例如，pch 与列数一致

ha <- HeatmapAnnotation(
  foo = anno_simple(
    cbind(1:10, 10:1), 
    pch = 1:2
  )
)

pch 对应行数

ha <- HeatmapAnnotation(
  foo = anno_simple(
    cbind(1:10, 10:1), 
    pch = 1:10
  )
)

pch 为矩阵

pch <- matrix(1:20, nc = 2)
pch[sample(length(pch), 10)] <- NA

ha <- HeatmapAnnotation(
  foo = anno_simple(
    cbind(1:10, 10:1), 
    pch = pch
  )
)

anno_simple() 也有 simple_anno_size 参数，用于控制单个注释的高度，height/width 参数用于控制简单注释的高度和宽度

ha <- HeatmapAnnotation(
  foo = anno_simple(
    1:10,
    height = unit(2, "cm")
  )
)

ha <- HeatmapAnnotation(
  foo = anno_simple(
    cbind(1:10, 10:1), 
    simple_anno_size = unit(2, "cm")
  )
)

注意：

应该在 anno_*() 函数内设置 width 和 height。HeatmapAnnotation() 函数内的 width, height, annotation_width 和 annotation_height 参数是用来设置多热图的大小

3. 空注释

anno_empty() 函数用于绘制一个空白占位符，可以在之后使用 decorate_annotation() 函数将自定义图形添加到该空白处

anno = anno_empty()
draw(anno, test = "anno_empty")

下面我们举一个简单的例子，decoration 函数的具体介绍将放在后面

有时候，我们想根据基因所在的通路对基因进行分组，我们将文本注释放置在热图的右边，同时添加颜色柱形

group <- list(
  A = "Cell cycle",
  B = "DNA replication",
  C = "Mismatch repair",
  D = "MAPK signaling pathway"
)

ha = rowAnnotation(
  foo = anno_empty(
    border = FALSE, 
    # 计算空白注释的宽度
    width = max_text_width(unlist(group)) + unit(4, "mm"))
  )

Heatmap(matrix(
  rnorm(1000), nrow = 100), 
  name = "mat", 
  # 分 4 块
  row_km = 4, 
  right_annotation = ha
  )

for(i in 1:4) {
  decorate_annotation(
    "foo", 
    # 选择热图块
    slice = i, {
    # 添加颜色框
    grid.rect(
      x = 0, 
      width = unit(2, "mm"), 
      gp = gpar(
        fill = rainbow(4)[i], 
        col = NA
        ), 
      just = "left"
      )
    # 绘制文本
    grid.text(
      group[[i]], 
      x = unit(4, "mm"), 
      gp = gpar(
        col = rainbow(4)[i]
      ),
      just = "left")
  })
}

在来个例子吧，我们使用 decorate_annotation 函数来绘制一个散点图

ha <- HeatmapAnnotation(
  foo = anno_empty(
    border = TRUE, 
    # 固定注释的高度
    height = unit(3, "cm"))
  )

ht <- Heatmap(
  matrix(rnorm(100), nrow = 10), 
  name = "mat", 
  top_annotation = ha
  )

# 先绘制热图
ht <- draw(ht)
# 获取热图的列顺序
co <- column_order(ht)
# 生成 10 个均匀分布的随机值
value <- runif(10)
# 将空白装饰一下
decorate_annotation("foo", {
  # 对应于矩阵的列
  x = 1:10
  # 根据列顺序重排这些随机值，用于设置 y 轴的值
  value = value[co]
  # 添加 viewport
  pushViewport(
    viewport(
      # x 轴范围
      xscale = c(0.5, 10.5), 
      # y 轴范围
      yscale = c(0, 1))
    )
  # 在中间添加一条水平虚线
  grid.lines(
    c(0.5, 10.5), c(0.5, 0.5), 
    gp = gpar(lty = 2),
    default.units = "native"
    )
  # 添加点
  grid.points(
    x, value, 
    pch = 16, 
    size = unit(2, "mm"),
    gp = gpar(
      # 虚线上下的值设置不同颜色
      col = ifelse(value > 0.5, "red", "blue")), 
    default.units = "native"
    )
  # 设置 y 轴断点
  grid.yaxis(at = c(0, 0.5, 1))
  popViewport()
})

虽然代码比较长，但是还是很简单的。当然，你首先得看懂我前面说的 grid 系统是个什么东西

获取代码:https://github.com/dxsbiocc/learn/blob/main/R/plot/decorate_example.R

4. 块注释

块注释也就是添加一个颜色条，用于标识不同的分组，例如

Heatmap(
  matrix(rnorm(100), 10), 
  name = "mat",
  top_annotation = HeatmapAnnotation(
    foo = anno_block(
      gp = gpar(fill = 2:4))
    ),
  column_km = 3
  )

可以在每个块中添加文本注释

Heatmap(
  matrix(rnorm(100), 10), 
  column_km = 3,
  # 添加上方注释
  top_annotation = HeatmapAnnotation(
    foo = anno_block(
      # 设置填充色
      gp = gpar(fill = 2:4),
      # 设置文本标签
      labels = c("group1", "group2", "group3"), 
      # 文本标签样式
      labels_gp = gpar(col = "white", fontsize = 10)
      )
    ),
  row_km = 3,
  # 设置左边注释
  left_annotation = rowAnnotation(
    foo = anno_block(
      gp = gpar(fill = 2:4),
      labels = c("group1", "group2", "group3"), 
      labels_gp = gpar(col = "white", fontsize = 10))
    )
  )

记住：标签和图形参数的长度必须与热图块的数量一致

anno_block() 函数只能为一个切片绘制一个颜色块，那如果分组是两个层级呢？比如，基因有与之相关的通路，通路又可以分为信号通路、细胞进程等

例如

set.seed(123)
mat <- matrix(
  rnorm(50*50), 
  nrow = 50
  )

group <- c(
  "MAPK",
  "PI3K-Akt",
  "ErbB",
  "Cell cycle",
  "Apoptosis"
)

ha <- HeatmapAnnotation(
  foo = anno_block(
    gp = gpar(
      fill = 2:6,
      fontsize = 10), 
    labels = group
    )
  )

split = rep(1:5, each = 10)

Heatmap(
  mat, name = "mat", 
  column_split = split, 
  top_annotation = ha, 
  column_title = NULL
  )

现在，我们想再添加一个块注释，标识前三个为信号通路，后两个为细胞进程通路

该怎么添加呢？要绘制图形，首先要有个位置来绘制图片，那可不可以先在上方添加一个空白的注释

ha <- HeatmapAnnotation(
  empty = anno_empty(border = FALSE),
  foo = anno_block(
    gp = gpar(fill = 2:6), 
    labels = LETTERS[1:5]
    )
)
Heatmap(
  mat, name = "mat", 
  column_split = split, 
  top_annotation = ha, 
  column_title = NULL
  )

现在，已经有位置来绘制颜色块了，还有一个关键信息，如何获取到前三个块的坐标，和后两个块的坐标呢？

对于每个注释，都有相应的 viewport，其命名方式为 annotation_{annotation_name}_{slice_index}，可以使用 list_components() 函数来获取所有的 viewport

> list_components()
 [1] "ROOT"                       "global"                     "global_layout"              "global-heatmaplist"        
 [5] "main_heatmap_list"          "heatmap_mat"                "mat_heatmap_body_wrap"      "mat_heatmap_body_1_1"      
 [9] "mat_heatmap_body_1_2"       "mat_heatmap_body_1_3"       "mat_heatmap_body_1_4"       "mat_heatmap_body_1_5"      
[13] "mat_dend_row_1"             "mat_dend_column_1"          "mat_dend_column_2"          "mat_dend_column_3"         
[17] "mat_dend_column_4"          "mat_dend_column_5"          "annotation_empty_1"         "annotation_foo_1"          
[21] "annotation_empty_2"         "annotation_foo_2"           "annotation_empty_3"         "annotation_foo_3"          
[25] "annotation_empty_4"         "annotation_foo_4"           "annotation_empty_5"         "annotation_foo_5"          
[29] "global-heamap_legend_right" "heatmap_legend"

我们可以看到，空白注释的 viewport 为 annotation_empty_1 - 5

知道了 viewport 的名称，可以使用 seekViewport 函数切换到对应的 viewport

# 获取第一个切片的左侧坐标
seekViewport("annotation_empty_1")
loc1 <- deviceLoc(
  x = unit(0, "npc"), 
  y = unit(0, "npc")
  )
# 获取第三个切片的右侧坐标
seekViewport("annotation_empty_3")
loc2 <- deviceLoc(
  x = unit(1, "npc"), 
  y = unit(1, "npc")
  )

然后使用 grid::deviceLoc() 函数来获取 viewport 对应点在整个图形设备中的坐标

> loc1
$x
[1] 0.492125984251969in

$y
[1] 7.11417322834646in

获取到所有信息之后，我们要切换到 global 这个全局的 viewport 下，绘制颜色块

seekViewport("global")
grid.rect(
  loc1$x, loc1$y,
  width = loc2$x - loc1$x, 
  height = loc2$y - loc1$y, 
  just = c("left", "bottom"), 
  gp = gpar(fill = "red")
  )
grid.text(
  "Signal transduction", 
  x = (loc1$x + loc2$x) * 0.5, 
  y = (loc1$y + loc2$y) * 0.5
  )

最后，献上完整的代码

pdf("~/Downloads/hm.pdf")

set.seed(123)
mat <- matrix(
  rnorm(50*50), 
  nrow = 50
  )

group <- c(
  "MAPK",
  "PI3K-Akt",
  "ErbB",
  "Cell cycle",
  "Apoptosis"
)

split = rep(1:5, each = 10)

ha <- HeatmapAnnotation(
  empty = anno_empty(border = FALSE),
  foo = anno_block(
    gp = gpar(fill = 2:6), 
    labels = group
    )
)

Heatmap(
  mat, name = "mat", 
  column_split = split, 
  top_annotation = ha, 
  column_title = NULL
  )

library(glue)
block_group_anno <- function(group, empty_anno, gp = gpar(),
                             label = NULL, label_gp = gpar()) {
  # 获取最左侧 viewport
  seekViewport(glue(
    'annotation_{anno}_{slice}', 
    slice = min(group),
    anno = empty_anno)
    )
  # 获取左下角坐标点
  loc1 <- deviceLoc(
    x = unit(0, "npc"), 
    y = unit(0, "npc")
  )
  # 获取最右侧 viewport
  seekViewport(glue(
    'annotation_{anno}_{slice}', 
    slice = max(group),
    anno = empty_anno)
  )
  # 获取右上角坐标点
  loc2 <- deviceLoc(
    x = unit(1, "npc"), 
    y = unit(1, "npc")
  )
  # 切换到全局 viewport
  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
    )
  }
}
# 将前三个热图块作为一组
block_group_anno(1:3, "empty", gp = gpar(fill = "red"), label = "Signal transduction")
# 后两个作为一组
block_group_anno(4:5, "empty", gp = gpar(fill = "green"), label = "Cellular Processes")

dev.off()

获取代码：https://github.com/dxsbiocc/learn/blob/main/R/plot/multi_group_plock_anno.R

注意：我们将图片保存成了文件，而不是在 RStudio 中直接绘制。

可能是由于 deviceLoc 获取的是图形设备的坐标位置，而不是相对于绘图窗口的位置，所以，在 RStudio 中需要拉伸绘图窗口才能看到后面绘制的矩形。所以我们直接使用 pdf 来保存成文件，就不会有这个问题了。

5. 图片注释

可以将图片作为注释添加到热图中，anno_image() 函数支持 png, svg, pdf, eps, jpeg/jpg, tiff 图片格式

anno_image() 函数会在内部自动解析各种格式的图片，只需要传递图片路径即可。但是需要安装对应的包

grImport2：该包用于处理 svg 图片，但是安装之后所有图片都无法显示，有问题，不建议安装
rsvg：转换 svg 格式
grImport：处理 pdf 和 eps 图片

同时，要确保系统中安装了 ghostscript，不然无法使用 pdf 和 eps 格式文件

例如，我们从 https://github.com/Keyamoon/IcoMoon-Free 下载到图标文件

path <- '~/Downloads/IcoMoon-Free-master/'

image_png = sample(dir(glue("{path}/PNG/64px"), full.names = TRUE), 10)
image_eps = sample(dir(glue("{path}/EPS/"), full.names = TRUE), 10)
image_pdf = sample(dir(glue("{path}/PDF/"), full.names = TRUE), 10)

添加图标注释

grid.newpage()
pushViewport(viewport(y = 0.6, height = 0.6, width = 0.8))

ha <- HeatmapAnnotation(foo = anno_image(image_png))

draw(ha)

混合不同格式的图片

ha <- HeatmapAnnotation(
  foo = anno_image(
    c(image_png[1:3], 
      image_eps[1:3], 
      image_pdf[1:3]
      ),
    gp = gpar(
      fill = rainbow(9),
      col = "grey"
    )
  )
)

设置边框以及图片周围空白填充间距

ha <- HeatmapAnnotation(
  foo = anno_image(
    image_pdf,
    border = TRUE,
    space = unit(3, "mm"),
    gp = gpar(
      fill = rainbow(9),
      col = "grey"
    )
  )
)

如果图片的路径为空或 NA，则不会显示

image_pdf[1:2] = c("", NA)
ha <- HeatmapAnnotation(
  foo = anno_image(
    image_pdf,
    border = TRUE,
    space = unit(3, "mm"),
    gp = gpar(
      fill = rainbow(9),
      col = "grey"
    )
  )
)

6. 点注释

散点注释使用 anno_points() 函数来展示点的分布。

点数据对象可以是向量或矩阵，如果是矩阵，则图形属性参数如 pch、size 和 gp 是按列设置的。

注意：矩阵的行对应热图的列

传递一个向量

image_pdf[1:2] = c("", NA)
ha <- HeatmapAnnotation(
  foo = anno_points(runif(10))
)

传递矩阵，图形参数值的长度与列数一致

ha <- HeatmapAnnotation(
  foo = anno_points(
    matrix(runif(20), nc = 2), 
    pch = 1:2, 
    gp = gpar(col = 2:3)
    )
)

ylim 可以设置 y 轴的范围，extend 控制数据轴上的扩展空间，axis 参数控制是否显示轴，axis_param 参数用于设置轴

使用 default_axis_param() 可以获取行或列注释的轴默认属性

> default_axis_param("column")
$at
NULL

$labels
NULL

$labels_rot
[1] 0

$gp
$fontsize
[1] 8


$side
[1] "left"

$facing
[1] "outside"

$direction
[1] "normal"

自定义轴属性

ha <- HeatmapAnnotation(
  foo = anno_points(
    runif(10),
    ylim = c(0, 1),
    extend = 0.1,
    axis_param = list(
      side = "right",
      at = c(0, 0.5, 1), 
      labels = c("zero", "half", "one")
    )
    )
)

标签旋转

ha <- rowAnnotation(
  foo = anno_points(
    runif(10),
    ylim = c(0, 1),
    extend = 0.1,
    width = unit(2, "cm"),
    axis_param = list(
      side = "bottom",
      at = c(0, 0.5, 1), 
      labels = c("zero", "half", "one"),
      labels_rot = 45
    )
    )
)

其他有轴的图形设置都是类似的

7. 线注释

anno_lines() 用于绘制线条，与点注释类似，数据对象可以是数值向量

ha <- HeatmapAnnotation(
  foo = anno_lines(
    runif(10)
  )
)

或者矩阵

ha <- HeatmapAnnotation(
  foo = anno_lines(
    cbind(c(1:5, 1:5), c(5:1, 5:1)),
    gp = gpar(col = 2:3),
    add_points = TRUE,
    pt_gp = gpar(col = 5:6),
    pch = c(1, 5)
  )
)

我们可以设置 add_points = TRUE 来添加点，pt_gp 设置点的图形属性，pch 设置点的形状

可以设置 smooth = TRUE 来添加拟合曲线，在这种情况下，add_points 默认为 TRUE。同时也需要注意，拟合是按照排序后的列顺序执行的，需要确保该顺序符合你的要求

ha <- HeatmapAnnotation(
  foo = anno_lines(
    cbind(c(1:5, 1:5), c(5:1, 5:1)),
    gp = gpar(col = 2:3),
    smooth = TRUE,
    pt_gp = gpar(col = 5:6),
    pch = c(1, 5)
  )
)

线注释的默认大小为 5mm，可以在函数内使用 height/width 来调整

8. 条形图注释

anno_barplot() 函数用于添加条形图注释，其中一些参数，如 ylim, axis, axis_param 与 anno_points() 一样

ha <- HeatmapAnnotation(
  foo = anno_barplot(1:10)
)

bar_width 用于设置条形的宽度，其值为相对于热图主体单元格的宽度

ha <- HeatmapAnnotation(
  foo = anno_barplot(
    1:10,
    bar_width = 0.8)
)

设置图形属性

ha <- HeatmapAnnotation(
  foo = anno_barplot(
    1:10,
    gp = gpar(
      fill = rainbow(10)
    ))
)

使用 baseline 参数来设置基线

ha <- HeatmapAnnotation(
  foo = anno_barplot(
    -5:5,
    baseline = 0,
    gp = gpar(
      fill = rainbow(10)
    ))
)

ha <- HeatmapAnnotation(
  foo = anno_barplot(
    -5:5,
    baseline = "min",
    gp = gpar(
      fill = rainbow(10)
    ))
)

如果输入的是矩阵，可以设置堆积条形图

ha <- HeatmapAnnotation(
  foo = anno_barplot(
    matrix(c(1:10, 10:1), nc = 2),
    gp = gpar(
      fill = rainbow(2),
      col = 3:4
    )
  )
)

图形属性参数的长度与矩阵列数一致

条形图注释的大小默认为 5mm，我们可以使用 height/width 设置其高度和宽度

ha <- HeatmapAnnotation(
  foo = anno_barplot(
    matrix(c(1:10, 10:1), nc = 2),
    height = unit(2, "cm"),
    gp = gpar(
      fill = rainbow(2),
      col = 3:4
    )
  )
)

绘制百分比条形图

m <- matrix(runif(4*10), nc = 4)
m <- t(apply(m, 1, function(x) x/sum(x)))

ha <- HeatmapAnnotation(
  foo = anno_barplot(
    m,
    height = unit(6, "cm"),
    bar_width = 1,
    gp = gpar(
      fill = rainbow(4))
  )
)

也可以设置轴的朝向

ha_list <- 
  rowAnnotation(
    axis_reverse = anno_barplot(
      m, gp = gpar(fill = rainbow(4)), 
      axis_param = list(direction = "reverse"), 
      bar_width = 1, width = unit(4, "cm"))
    ) +
  rowAnnotation(
    axis_normal = anno_barplot(
      m, gp = gpar(fill = rainbow(4)), 
      bar_width = 1, 
      width = unit(4, "cm"))
    )
draw(ha_list, ht_gap = unit(4, "mm"))

9. 箱线图注释

anno_boxplot() 用于绘制箱线图注释，数据对象为矩阵或列表。

如果数据是矩阵，且为列注释，将会按列对矩阵进行统计，行注释将按行执行统计

注意：箱线图适用于小型数据，如果数据列太多，不推荐使用

mat <- matrix(rnorm(100), 10)
ha <- HeatmapAnnotation(
  foo = anno_boxplot(
    mat,
    height = unit(4, "cm")
  )
)

添加图形属性

mat <- matrix(rnorm(100), 10)
ha <- HeatmapAnnotation(
  foo = anno_boxplot(
    mat,
    height = unit(4, "cm"),
    gp = gpar(
      fill = rainbow(10)
    )
  )
)

outline 用于设置是否显示离群点，box_width 用于设置箱子宽度

mat <- matrix(rnorm(100), 10)
ha <- HeatmapAnnotation(
  foo = anno_boxplot(
    mat,
    height = unit(4, "cm"),
    box_width = 0.8,
    outline = FALSE,
    gp = gpar(
      fill = rainbow(10)
    )
  )
)

10。直方图注释

anno_histogram() 用于添加直方图注释，适用于行注释，其参数与 anno_boxplot() 类似

mat <- matrix(rnorm(1000), nc = 100)
ha <- rowAnnotation(
  foo = anno_histogram(
    mat,
    n_breaks = 20,
    gp = gpar(fill = rainbow(10))
  )
)

n_breaks 用于设置柱子的数量

11. 密度注释

anno_density() 函数用于绘制密度曲线注释

mat <- matrix(rnorm(1000), nc = 100)
ha <- rowAnnotation(
  foo = anno_density(
    mat,
    joyplot_scale = 2,
    gp = gpar(fill = rainbow(10))
  )
)

使用 joyplot_scale 来控制分布峰值的高度，让它看起来像山脊图

以小提琴的方式绘制

ha <- rowAnnotation(
  foo = anno_density(
    mat,
    type = "violin",
    gp = gpar(fill = rainbow(10))
  )
)

如果行数太多了，可以绘制热图

ha <- rowAnnotation(
  foo = anno_density(
    mat,
    type = "heatmap",
    heatmap_colors = c("#9970ab", "#5aae61")
  )
)

使用 heatmap_colors 来控制热图的颜色

12. Joyplot 注释

joyplot 图也就是我们说的山脊图，使用 anno_joyplot() 函数绘制，接受矩阵或列表数据

如果数据为矩阵，则总是按列计算的，如果你不确定怎么设置，可以转换为 list

输入变量的格式为：

矩阵：x 坐标为 1:nrow(matrix) 且矩阵的每一列是一个分布
列表：数据框列表，每个数据框包含两列，表示 x 和 y 坐标

mat <- matrix(rnorm(1000), nc = 10)
lt <- apply(mat, 2, function(x) data.frame(density(x)[c("x", "y")]))

ha <- rowAnnotation(
  foo = anno_joyplot(
    lt,
    width = unit(4, "cm"),
    gp = gpar(fill = rainbow(10)),
    transparency = 0.6
  )
)

或者，只显示线条，同时使用 scale 设置峰值的高度

ha <- rowAnnotation(
  foo = anno_joyplot(
    lt,
    width = unit(4, "cm"),
    gp = gpar(fill = NA),
    scale = 2
  )
)

13. 地平线图注释

地平线图只能作为行注释，输入数据的格式类似于 anno_joyplot()

lt <- lapply(1:20, function(x) cumprod(1 + runif(1000, -x/100, x/100)) - 1)

ha <- rowAnnotation(
  foo = anno_horizon(
    lt,
    height = unit(6, "cm"),
    gp = gpar(
      pos_fill = "orange",
      neg_fill = "darkgreen"
    )
  )
)

使用 pos_fill 和 neg_fill 来设置正负值的填充色

也可以为 pos_fill 和 neg_fill 设置向量值

ha <- rowAnnotation(
  foo = anno_horizon(
    lt,
    height = unit(6, "cm"),
    gp = gpar(
      pos_fill = rep(rainbow(10)[5:6], 10),
      neg_fill = rep(rainbow(10)[8:9], 10)
    )
  )
)

使用 gap 设置两张图的间距，negative_from_top 参数用于设置负值的峰值是否从顶部开始

ha <- rowAnnotation(
  foo = anno_horizon(
    lt,
    height = unit(6, "cm"),
    negative_from_top = TRUE,
    gap = unit(1, "mm"),
    gp = gpar(
      pos_fill = rep(rainbow(10)[5:6], 10),
      neg_fill = rep(rainbow(10)[8:9], 10)
    )
  )
)

14 文本注释

使用 anno_text() 来添加文本注释

ha <- rowAnnotation(
  foo = anno_text(
    month.name,
    location = 1,
    just = "center",
    rot = 45,
    gp = gpar(
      fontsize = 5:17
    )
  )
)

location 和 just 会根据注释的位置自动计算，如果注释放置在右边，则文本会左对齐，反之，在左边，右对齐

根据所有文本会自动计算 width/height 的值，一般不需要手动设置

ha <- rowAnnotation(
  foo = anno_text(
    month.name,
    location = 0.5,
    just = "center",
    gp = gpar(
      fill = rep(rainbow(10)[2:5], each = 4),
      col = "black",
      border = "black"
    ),
    width = max_text_width(month.name) * 1.2
  )
)

可以使用 gridtext 包绘制更复杂的文本

15. 标记注释

anno_mark（代替了被替换的 anno_link）用于标记某些行/列，并使用线条连接文本和对应的行/列

anno_mark() 至少需要两个参数，at 提供原始数据矩阵的索引，labels 为相应的文本标记

mat <- matrix(rnorm(1000), nrow = 100)
rownames(mat) <- 1:100
ha <- rowAnnotation(
  foo = anno_mark(
    at = c(1:4, 20, 60, 97:100), 
    labels = month.name[1:10])
  )

Heatmap(
  mat, name = "mat", 
  cluster_rows = FALSE, 
  right_annotation = ha,
  row_names_side = "left", 
  row_names_gp = gpar(fontsize = 4)
  )

16 摘要注释

anno_summary() 用于对只有一行或一列的热图提供统计汇总注释

如果数据为离散型向量，将绘制条形图

v <- sample(letters[1:2], 50, replace = TRUE)
split <- sample(letters[1:2], 50, replace = TRUE)

ha <- HeatmapAnnotation(
  summary = anno_summary(height = unit(4, "cm"))
)

Heatmap(
  v, name = "mat", 
  col = c("a" = "red", "b" = "blue"),
  top_annotation = ha, 
  width = unit(2, "cm"), 
  row_split = split
)

对于连续型向量将绘制箱线图

v <- rnorm(50)

ha <- HeatmapAnnotation(
  summary = anno_summary(
    gp = gpar(fill = 3:4),
    height = unit(4, "cm")
    )
)

Heatmap(
  v, name = "mat", 
  top_annotation = ha, 
  width = unit(2, "cm"), 
  row_split = split
)

我们通常不会单独绘制只包含一列的热图，而是会与其他热图绘制在一起

比如，我们在基因表达矩阵的边上，绘制一个 lncRNA 或 MiRNA 的表达热图

# 设置热图配色
col_fun <- colorRamp2(
  c(-2, 0, 2), 
  c("#8c510a", "white", "#01665e")
)

# 绘制主热图
exp <- matrix(rnorm(50*10), nrow = 50)
main <- Heatmap(
  exp, name = "main_matrix",
  col = col_fun
  )

# 绘制一列离散型热图
v <- sample(letters[1:2], 50, replace = TRUE)
lnc <- Heatmap(
  v, name = "mat1", 
  # 设置离散型颜色
  col = structure(c("#f46d43", "#66bd63"), name = letters[1:2]),
  top_annotation = HeatmapAnnotation(
    summary = anno_summary(
      height = unit(3, "cm")
    )
  ), 
  width = unit(1, "cm"),
  )

# 绘制一列连续型热图
v <- rnorm(50)
mi <- Heatmap(
  v, name = "mat2", 
  col = col_fun,
  top_annotation = HeatmapAnnotation(
    summary = anno_summary(
      gp = gpar(fill = 2:3), 
      height = unit(3, "cm"))
  ), 
  width = unit(1, "cm")
  )

# 按列添加多个热图
ht_list <- main + lnc + mi

split <- sample(letters[1:2], 50, replace = TRUE)

draw(ht_list, 
     row_split = split, 
     ht_gap = unit(5, "mm"), 
     heatmap_legend_list = list(lgd_boxplot)
     )

17. 缩放/连接注释

anno_mark() 用于将某些行/列连接到文本标签，anno_zoom() 则用于将行列子集连接到一个绘图区域，并可在该区域绘制自定义图形。可以理解为从热图矩阵中拿出部分子集来绘制一个任意的图形

例如，我们可以为每个分组绘制一个箱线图

# 设置热图配色
col_fun <- colorRamp2(
  c(-2, 0, 2), 
  c("#8c510a", "white", "#01665e")
)

# 生成表达谱
exp <- matrix(rnorm(100*10), nrow = 100)
# 设置分组
group <- sample(letters[1:3], 100, 
                replace = TRUE, 
                prob = c(1, 5, 10)
                )

panel_fun <- function(index, nm) {
  # 添加绘图 viewport
  pushViewport(viewport(xscale = range(exp), yscale = c(0, 2)))
  # 绘制区域外侧框线
  grid.rect()
  grid.xaxis(gp = gpar(fontsize = 8))
  # 添加箱线图
  grid.boxplot(
    exp[index, ], pos = 1, 
    gp = gpar(fill = index + 6),
    direction = "horizontal"
    )
  popViewport()
}

Heatmap(
  exp, name = "exp", 
  col = col_fun,
  row_split = group,
  height = unit(10, "cm"),
  width = unit(12, "cm"),
  right_annotation = rowAnnotation(
    foo = anno_zoom(
      align_to = group,
      which = "row",
      panel_fun = panel_fun,
      size = unit(2, "cm"),
      gap = unit(1, "cm"),
      width = unit(4, "cm")
    ))
  )

anno_zoom() 函数的参数

align_to：定义了行或列的分组绘图区域。如果是索引列表，则其中每个向量为一组，如果为分类变量，则将根据 level 分组
panel_fun：自定义的绘图函数。函数的第一个参数为 index，表示分组在矩阵中的索引，第二个参数为 nm，代表选择的热图区域的名称，该名称来自 align_to 的分类变量或 list 中的名称
size：箱子的大小，可以是绝对值或相对值，相对于热图的宽度和高度
gap：箱子的间隔

18. 多个注释

18.1 常规设置

在前面的示例中，我们以键值对的方式在 HeatmapAnnotation() 函数中添加多个注释，还有一些参数用于控制多个注释，这些参数的值长度要与注释数目相同

不管是向量、矩阵或数据框数据，绘制简单注释都会自动添加图例，使用 show_legend 可以控制图例的显示

对于输入数据的不同，show_legend 的格式也有区别：

长度为简单注释数量的逻辑向量
长度为所有注释的数量，对应于复杂注释的值将被忽略
命名向量，控制简单注释的子集

例如

ha = HeatmapAnnotation(
  foo = 1:10, 
  bar = cbind(1:10, 10:1),
  pt = anno_points(1:10),
  show_legend = c("bar" = FALSE)
)
Heatmap(
  matrix(rnorm(100), 10), 
  name = "mat", 
  top_annotation = ha
  )

border 控制单个注释的外侧框线，show_annotation_name 控制注释名称的显示

ha <- HeatmapAnnotation(
  foo = 1:10, 
  bar = cbind(1:10, 10:1),
  pt = anno_points(1:10),
  gp = gpar(col = "red"),
  show_annotation_name = c(bar = FALSE),
  border = c(foo = TRUE)
)

annotation_name_gp, annotation_name_offset, annotation_name_side 和 annotation_name_rot 用于控制注释名的样式属性和位置，后面三个可以被设置为命名向量。

当 annotation_name_offset 设置为命名向量时，值不需要 unit 函数设置，可以直接使用字符表示
annotation_name_offset = c(foo = "1cm")

gap 参数用于设置两个注释的间隔，可以是单个值或向量

ha <- HeatmapAnnotation(
  foo = 1:10, 
  bar = cbind(1:10, 10:1),
  pt = anno_points(1:10),
  gap = unit(2, "mm")
  )

ha <- HeatmapAnnotation(
  foo = 1:10, 
  bar = cbind(1:10, 10:1),
  pt = anno_points(1:10),
  gap = unit(c(2, 10), "mm")
  )

18.2 注释的大小

height, width, annotation_height 和 annotation_width 用于控制复杂注释的大小，通常来说，简单注释不需要设置，会根据图形自动调整。

例如

# foo: 1cm, bar: 5mm, pt: 1cm
ha <- HeatmapAnnotation(
  foo = cbind(1:10, 10:1), 
  bar = 1:10,
  pt = anno_points(1:10)
  )

当使用 height 参数设置注释的高度时，简单注释的高度不会改变，只会改变复杂注释的高度

# foo: 1cm, bar: 5mm, pt: 4.5cm
ha <- HeatmapAnnotation(
  foo = cbind(1:10, 10:1), 
  bar = 1:10,
  pt = anno_points(1:10),
  height = unit(6, "cm")
  )

simple_anno_size 控制所有简单注释的大小，全局简单注释的大小可以使用 ht_opt$simple_anno_size 设置

# foo: 2cm, bar:1cm, pt: 3cm
ha <- HeatmapAnnotation(
  foo = cbind(1:10, 10:1),  
  bar = 1:10,
  pt = anno_points(1:10),
  simple_anno_size = unit(1, "cm"), 
  height = unit(6, "cm")
  )

所有简单注释都被设置为 1cm

annotation_height 可以分别为每个注释设置高度

# foo: 1cm, bar: 2cm, pt: 3cm
ha <- HeatmapAnnotation(
  foo = cbind(1:10, 10:1), 
  bar = 1:10,
  pt = anno_points(1:10),
  annotation_height = unit(1:3, "cm")
  )

annotation_height 也可以设置为纯数值，会将其作为注释的相对比例值

# foo: 1cm, bar: 2cm, pt: 3cm
ha <- HeatmapAnnotation(
  foo = cbind(1:10, 10:1), 
  bar = 1:10,
  pt = anno_points(1:10),
  annotation_height = 1:3,
  height = unit(6, "cm")
  )

annotation_height 也可以混合绝对值和相对值

# foo: 1.5cm, bar: 1.5cm, pt: 3cm
ha <- HeatmapAnnotation(
  foo = cbind(1:10, 10:1), 
  bar = 1:10,
  pt = anno_points(1:10),
  annotation_height = unit(c(1, 1, 3), c("null", "null", "cm")), 
  height = unit(6, "cm")
)

如果只有简单注释，设置 height 将不会有任何作用

# foo: 1cm, bar: 5mm
ha <- HeatmapAnnotation(
  foo = cbind(1:10, 10:1), 
  bar = 1:10,
  height = unit(6, "cm")
  )

除非将 simple_anno_size_adjust 设置为 TRUE

ha <- HeatmapAnnotation(
  foo = cbind(1:10, 10:1), 
  bar = 1:10,
  simple_anno_size_adjust = TRUE,
  height = unit(6, "cm")
  )

19. 实用函数

有一些实用函数，可以对注释进行更灵活的操作，例如，对于如下注释

ha <- HeatmapAnnotation(
  foo = 1:10, 
  bar = cbind(1:10, 10:1),
  pt = anno_points(1:10)
  )

计算注释的数量，观察值的数量

> draw(ha)
> length(ha)
[1] 3
> nobs(ha)
[1] 10

获取和设置注释的名称

> names(ha)
[1] "foo" "bar" "pt" 
> names(ha) <- c("A", "B", "C")
> names(ha)
[1] "A" "B" "C"

如果两个 HeatmapAnnotation 对象具有相同的观测值且注释名称不同，可以连接起来

ha1 <- HeatmapAnnotation(
  foo = 1:10, 
  bar = cbind(1:10, 10:1),
  pt = anno_points(1:10)
  )
ha2 <- HeatmapAnnotation(
  FOO = runif(10), 
  BAR = sample(c("a", "b"), 10, replace = TRUE),
  PT = anno_points(rnorm(10))
  )
ha <- c(ha1, ha2)

> names(ha)
[1] "foo" "bar" "pt"  "FOO" "BAR" "PT"

可以对 HeatmapAnnotation 对象进行取子集操作，行对应为观察值，列对应注释名称

> ha_subset <- ha[1:5, c("foo", "PT")]
> ha_subset
A HeatmapAnnotation object with 2 annotations
  name: heatmap_annotation_154 
  position: column 
  items: 5 
  width: 1npc 
  height: 15.3514598035146mm 
  this object is subsetable
  5.21733333333333mm extension on the left 
  6.75733333333333mm extension on the right 

 name   annotation_type color_mapping height
  foo continuous vector        random    5mm
   PT     anno_points()                 10mm

20. 自定义注释函数

ComplexHeatmap 中的所有注释函数都是使用 AnnotationFunction 类来构造的

AnnotationFunction 类的重要部分是一个函数，该函数定义如何在与热图中的行或列相对应的特定位置处进行绘制图形

该函数包含三个参数：

index：对应于热图矩阵的行或列的索引，包含行或列重新排序后当前切片的行或列索引的列表
k：代表当前热图块的索引
n：代表所有热图块数目

后两个参数是可选的，注释函数会在每个切片中独立绘制。

var_import 参数用于存储该函数的额外参数

AnnotationFunction 的一个特性是可子集化，用于需要定义输入变量的拆分规则，包中自带了子集化规则函数 subset_gp(), subset_matrix_by_row() 和 subset_vector()，如果未指定，会根据输入对象的类型自动推断

例如，定义一个简单的注释函数

x <- 1:10
anno1 <- AnnotationFunction(
  fun = function(index, k, n) {
    n = length(index)
    # 根据索引长度分配 viewport 空间
    pushViewport(viewport(xscale = c(0.5, n + 0.5), yscale = c(0, 10)))
    grid.rect()
    # 绘制散点
    grid.points(1:n, x[index], default.units = "native")
    if(k == 1) grid.yaxis()
    popViewport()
  },
  # 传递函数的额外参数
  var_import = list(x = x),
  n = 10,
  subsetable = TRUE,
  height = unit(2, "cm")
)

下面来使用它

m = rbind(1:10, 11:20)
Heatmap(
  m, 
  top_annotation = HeatmapAnnotation(foo = anno1)
  )

应用于分割热图块

Heatmap(
  m, 
  top_annotation = HeatmapAnnotation(foo = anno1), 
  column_split = rep(c("A", "B"), each = 5)
  )

上面的函数可以改进，将数据变量放入内部

anno2 <- AnnotationFunction(
    fun = function(index) {
        x = 1:10
        n = length(index)
        pushViewport(viewport())
        grid.points(1:n, x[index])
        popViewport()
    },
    n = 10,
    subsetable = TRUE
)

最精简的方式是，只定义函数

anno3 <- AnnotationFunction(
    fun = function(index) {
        x = 1:10
        n = length(index)
        pushViewport(viewport())
        grid.points(1:n, x[index])
        popViewport()
    }
)

其实，本节中介绍的所有 anno_*() 函数实际上并不是真正的注释函数，它们只是生成具有特定配置的注释函数的函数

事实上，ComplexHeatmap 已经提供了足够多的函数了，可以满足绝大部分的需求。是在没有的，也可以通过 anno_empty() 放置一个空白占位，然后使用 decorate_annotation() 函数快速添加自定义图形。