超详细的R语言热图之complexheatmap系列3

我们继续学习complexheatmap包的内容，这是本系列的第3篇文章。本系列内容非常多，将通过多篇推文逐渐介绍，欢迎大家关注我的公众号：医学和生信笔记。

本篇内容主要是介绍热图注释条的各种设置！希望大家都能学会，毕竟各种花式注释条才是热图最炫酷的技能，也是很多高分SCI文章的常用展示方法！

complexheatmap系列第1篇：超详细的R语言热图之complexheatmap系列1

complexheatmap系列第2篇：超详细的R语言热图之complexheatmap系列2

本系列是对ComplexeHeatmap包的学习笔记，部分内容根据自己的理解有适当的改动，但总体不影响原文。如有不明之处，以原文为准。原文请见：https://jokergoo.github.io/ComplexHeatmap-reference/book/

第三章 注释条

注释条是热图的重要组成部分，ComplexHeatmap包提供灵活的注释条设置。注释条可以放在热图的上下左右四个位置，通过top_annotation、bottom_annotation、left_annotation、right_annotation设置，所有的注释条都是通过HeatmapAnnotation()函数完成的（还有一个rowAnnotation()，但是可以通过设置HeatmapAnnotation(..., which = "row")实现，可以看做是变体）。一个简单的小例子：

library(ComplexHeatmap)

## 载入需要的程辑包：grid

## ========================================
## ComplexHeatmap version 2.8.0
## Bioconductor page: http://bioconductor.org/packages/ComplexHeatmap/
## Github page: https://github.com/jokergoo/ComplexHeatmap
## Documentation: http://jokergoo.github.io/ComplexHeatmap-reference
## 
## If you use it in published research, please cite:
## Gu, Z. Complex heatmaps reveal patterns and correlations in multidimensional 
##   genomic data. Bioinformatics 2016.
## 
## The new InteractiveComplexHeatmap package can directly export static 
## complex heatmaps into an interactive Shiny app with zero effort. Have a try!
## 
## This message can be suppressed by:
##   suppressPackageStartupMessages(library(ComplexHeatmap))
## ========================================

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

column_ann <- HeatmapAnnotation(foo1 = runif(10), bar1 = anno_barplot(runif(10)))
row_ann <- HeatmapAnnotation(foo2 = runif(10), bar2 = anno_barplot(runif(10)), which = "row") # 或使用`rowAnnotation()`

Heatmap(mat, name = "mat1", top_annotation = column_ann, right_annotation = row_ann)

plot of chunk unnamed-chunk-1

也可以改变位置：

Heatmap(mat, name = "mat2", bottom_annotation = column_ann, left_annotation = row_ann)

plot of chunk unnamed-chunk-2

在上面的例子中，foo1和foo2这种被称为简单注释条，bar1和bar2这种被称为复杂注释条，它们都应该被设置成名字-向量这种形式。注释条也可以独立于热图，将在第四章讨论

3.1 简单注释条

简单注释条最常见，颜色用来映射数值，只需要一个向量和一个名字即可。

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

plot of chunk unnamed-chunk-3

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

plot of chunk unnamed-chunk-4

改变颜色映射：

library(circlize)

## ========================================
## circlize version 0.4.13
## CRAN page: https://cran.r-project.org/package=circlize
## Github page: https://github.com/jokergoo/circlize
## Documentation: https://jokergoo.github.io/circlize_book/book/
## 
## If you use it in published research, please cite:
## Gu, Z. circlize implements and enhances circular visualization
##   in R. Bioinformatics 2014.
## 
## This message can be suppressed by:
##   suppressPackageStartupMessages(library(circlize))
## ========================================

col_fun <- colorRamp2(c(0, 5, 10), c("blue", "white", "red"))
ha <- HeatmapAnnotation(foo = 1:10, col = list(foo = col_fun))
draw(ha)

plot of chunk unnamed-chunk-5

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

plot of chunk unnamed-chunk-6

同时多个简单注释条：

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")
  )
)
draw(ha)

plot of chunk unnamed-chunk-7

处理NA值：

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

plot of chunk unnamed-chunk-8

gp参数控制样式：

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")
)
draw(ha)

plot of chunk unnamed-chunk-9

也可以直接使用数据框或矩阵：

ha <- HeatmapAnnotation(foo = cbind(a = runif(10), b = runif(10))) # 有不同的名字
draw(ha)

plot of chunk unnamed-chunk-10

ha <- HeatmapAnnotation(foo = cbind(runif(10), runif(10))) # 用相同的名字
draw(ha)

plot of chunk unnamed-chunk-11

数据框：

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

plot of chunk unnamed-chunk-12

border参数用于控制边框：

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

plot of chunk unnamed-chunk-13

控制简单注释条的高度，simple_anno_size:

ha <- HeatmapAnnotation(
  foo = cbind(a = 1:10, b = 10:1),
  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")
)
draw(ha)

plot of chunk unnamed-chunk-14

3.2 注释条作为注释条函数

foo = 1:10其实是foo = anno_simple(1:10)的简写，使用全称还可以添加pch,pt_pg,pt_size参数增加更多样式。

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

plot of chunk unnamed-chunk-15

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

plot of chunk unnamed-chunk-16

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

plot of chunk unnamed-chunk-17

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

plot of chunk unnamed-chunk-18

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

plot of chunk unnamed-chunk-19

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

plot of chunk unnamed-chunk-20

pch <- matrix(1:20, nc = 2)
pch[sample(length(pch), 10)] <- NA
ha <- HeatmapAnnotation(foo = anno_simple(cbind(1:10, 10:1), pch = pch))
draw(ha)

plot of chunk unnamed-chunk-21

set.seed(123)
pvalue <- 10^-runif(10, min = 0, max = 3)
is_sig <- pvalue < 0.01
pch <- rep("*", 10)
pch[!is_sig] <- NA
# color mapping for -log10(pvalue)
pvalue_col_fun <- colorRamp2(c(0, 2, 3), c("green", "white", "red"))
ha <- HeatmapAnnotation(
  pvalue = anno_simple(-log10(pvalue), col = pvalue_col_fun, pch = pch),
  annotation_name_side = "left"
)
ht <- Heatmap(matrix(rnorm(100), 10), name = "mat", top_annotation = ha)
# now we generate two legends, one for the p-value
# see how we define the legend for pvalue
lgd_pvalue <- Legend(
  title = "p-value", col_fun = pvalue_col_fun, at = c(0, 1, 2, 3),
  labels = c("1", "0.1", "0.01", "0.001")
)
# and one for the significant p-values
lgd_sig <- Legend(pch = "*", type = "points", labels = "< 0.01")
# these two self-defined legends are added to the plot by `annotation_legend_list`
draw(ht, annotation_legend_list = list(lgd_pvalue, lgd_sig))

plot of chunk unnamed-chunk-22

更改高度的另一种方法，在anno_simple里面使用：

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

plot of chunk unnamed-chunk-23

3.3 空注释条

ha <- HeatmapAnnotation(foo = anno_empty(border = TRUE))

random_text <- function(n) {
  sapply(1:n, function(i) {
    paste0(sample(letters, sample(4:10, 1)), collapse = "")
  })
}
text_list <- list(
  text1 = random_text(4),
  text2 = random_text(4),
  text3 = random_text(4),
  text4 = random_text(4)
)
# note how we set the width of this empty annotation
ha <- rowAnnotation(foo = anno_empty(
  border = FALSE,
  width = max_text_width(unlist(text_list)) + unit(4, "mm")
))
Heatmap(matrix(rnorm(1000), nrow = 100), name = "mat", 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 = i, col = NA), just = "left")
    grid.text(paste(text_list[[i]], collapse = "\n"), x = unit(4, "mm"), just = "left")
  })
}

plot of chunk unnamed-chunk-25

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)
value <- runif(10)
decorate_annotation("foo", {
  # value on x-axis is always 1:ncol(mat)
  x <- 1:10
  # while values on y-axis is the value after column reordering
  value <- value[co]
  pushViewport(viewport(xscale = c(0.5, 10.5), 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"
  )
  grid.yaxis(at = c(0, 0.5, 1))
  popViewport()
})

plot of chunk unnamed-chunk-26

3.4 注释条分割

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

增加更多样式：

Heatmap(matrix(rnorm(100), 10),
  top_annotation = HeatmapAnnotation(foo = anno_block(
    gp = gpar(fill = 2:4),
    labels = c("group1", "group2", "group3"),
    labels_gp = gpar(col = "white", fontsize = 10)
  )),
  column_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)
  )),
  row_km = 3
)

plot of chunk unnamed-chunk-28

set.seed(123)
mat2 <- matrix(rnorm(50 * 50), nrow = 50)
ha <- HeatmapAnnotation(foo = anno_block(gp = gpar(fill = 2:6), labels = LETTERS[1:5]))
split <- rep(1:5, each = 10)
Heatmap(mat2,
  name = "mat2", column_split = split, top_annotation = ha,
  column_title = NULL
)

plot of chunk unnamed-chunk-29

更加复杂的用法，需要自己写函数，也需要对grid绘图系统有一定了解

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

library(GetoptLong) # for the function qq()

## Warning: 程辑包'GetoptLong'是用R版本4.1.2 来建造的

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

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

plot of chunk unnamed-chunk-30

3.5 图形注释条（我一直没成功）

来自网站:  https://github.com/Keyamoon/IcoMoon-Free

# image_png = sample(dir("IcoMoon-Free-master/PNG/64px", full.names = TRUE), 10)
# image_svg = sample(dir("IcoMoon-Free-master/SVG/", full.names = TRUE), 10)
# image_eps = sample(dir("IcoMoon-Free-master/EPS/", full.names = TRUE), 10)
# image_pdf = sample(dir("IcoMoon-Free-master/PDF/", full.names = TRUE), 10)

# we only draw the image annotation for PNG images, while the others are the same
# ha = HeatmapAnnotation(foo = anno_image(image_png))

3.6 点状注释条

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

plot of chunk unnamed-chunk-32

以上就是本系列第3篇的内容，本系列内容较多，更多内容将逐步推送！

欢迎关注我的公众号：医学和生信笔记

医学和生信笔记 公众号主要分享：1.医学小知识、肛肠科小知识；2.R语言和Python相关的数据分析、可视化、机器学习等；3.生物信息学学习资料和自己的学习笔记！

---

往期精彩内容：