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

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

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

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

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

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

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

3.7 折线注释条

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

plot of chunk unnamed-chunk-33

3.8 条形图注释条

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

plot of chunk unnamed-chunk-34

ha <- HeatmapAnnotation(foo = anno_barplot(seq(-5, 5), baseline = "min"))
draw(ha)

plot of chunk unnamed-chunk-35

ha <- HeatmapAnnotation(foo = anno_barplot(seq(-5, 5), baseline = 0))
draw(ha)

plot of chunk unnamed-chunk-36

ha <- HeatmapAnnotation(foo = anno_barplot(cbind(1:10, 10:1),
  gp = gpar(fill = 2:3, col = 2:3)
))
draw(ha)

plot of chunk unnamed-chunk-37

m <- matrix(runif(4 * 10), nc = 4)
m <- t(apply(m, 1, function(x) x / sum(x)))
ha <- HeatmapAnnotation(foo = anno_barplot(m,
  gp = gpar(fill = 2:5),
  bar_width = 1, height = unit(6, "cm")
))
draw(ha)

plot of chunk unnamed-chunk-38

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

plot of chunk unnamed-chunk-39

3.9 箱线图注释条

ha <- HeatmapAnnotation(foo = anno_boxplot(m,
  height = unit(4, "cm"),
  gp = gpar(fill = 1:10)
))
draw(ha)

plot of chunk unnamed-chunk-40

ha <- HeatmapAnnotation(foo = anno_boxplot(m,
  height = unit(4, "cm"),
  box_width = 0.9, outline = FALSE
))
draw(ha)

plot of chunk unnamed-chunk-41

3.10 直方图注释条

m <- matrix(rnorm(1000), nc = 100)
ha <- rowAnnotation(foo = anno_histogram(m, n_breaks = 20, gp = gpar(fill = 1:10)))
draw(ha)

plot of chunk unnamed-chunk-42

3.11 密度图注释条

ha <- rowAnnotation(foo = anno_density(m,
  joyplot_scale = 2,
  gp = gpar(fill = "#CCCCCC80")
))
draw(ha)

plot of chunk unnamed-chunk-43

ha <- rowAnnotation(foo = anno_density(m,
  type = "violin",
  gp = gpar(fill = 1:10)
))
draw(ha)

plot of chunk unnamed-chunk-44

行太多了就变成热图注释条

m2 <- matrix(rnorm(50 * 10), nrow = 50)
ha <- rowAnnotation(foo = anno_density(m2, type = "heatmap", width = unit(6, "cm")))
draw(ha)

plot of chunk unnamed-chunk-45

ha <- rowAnnotation(foo = anno_density(m2,
  type = "heatmap", width = unit(6, "cm"),
  heatmap_colors = c("white", "orange")
))
draw(ha)

plot of chunk unnamed-chunk-46

3.12 Joyplot注释条

m <- matrix(rnorm(1000), nc = 10)
lt <- apply(m, 2, function(x) data.frame(density(x)[c("x", "y")]))
ha <- rowAnnotation(foo = anno_joyplot(lt,
  width = unit(4, "cm"),
  gp = gpar(fill = 1:10), transparency = 0.75
))
draw(ha)

plot of chunk unnamed-chunk-47

m <- matrix(rnorm(5000), nc = 50)
lt <- apply(m, 2, function(x) data.frame(density(x)[c("x", "y")]))
ha <- rowAnnotation(foo = anno_joyplot(lt,
  width = unit(4, "cm"), gp = gpar(fill = NA),
  scale = 4
))
draw(ha)

plot of chunk unnamed-chunk-48

3.13 Horizon chart 注释条

lt <- lapply(1:20, function(x) cumprod(1 + runif(1000, -x / 100, x / 100)) - 1)
ha <- rowAnnotation(foo = anno_horizon(lt))
draw(ha)

plot of chunk unnamed-chunk-49

ha <- rowAnnotation(foo = anno_horizon(lt,
  gp = gpar(pos_fill = "orange", neg_fill = "darkgreen")
)) # 正值颜色和负值颜色
draw(ha)

plot of chunk unnamed-chunk-50

ha <- rowAnnotation(foo = anno_horizon(lt,
  gp = gpar(
    pos_fill = rep(c("orange", "red"), each = 10),
    neg_fill = rep(c("darkgreen", "blue"), each = 10)
  )
))
draw(ha)

plot of chunk unnamed-chunk-51

控制正值从上开始

ha <- rowAnnotation(foo = anno_horizon(lt, negative_from_top = TRUE))
draw(ha)

plot of chunk unnamed-chunk-52

宽度

ha <- rowAnnotation(foo = anno_horizon(lt, gap = unit(1, "mm")))
draw(ha)

plot of chunk unnamed-chunk-53

3.14 文本注释条

ha <- rowAnnotation(foo = anno_text(month.name,
  location = 1, rot = 30,
  just = "right", gp = gpar(fontsize = 1:12 + 4)
))
draw(ha)

plot of chunk unnamed-chunk-54

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

plot of chunk unnamed-chunk-55

更复杂的文本，借助gridtext包

text <- sapply(LETTERS[1:10], function(x) {
  qq("<span style='color:red'>**@{x}**<sub>@{x}</sub></span>_@{x}_<sup>@{x}</sup>")
})
ha <- rowAnnotation(
  foo = anno_text(gt_render(text,
    align_widths = TRUE,
    r = unit(2, "pt"),
    padding = unit(c(2, 2, 2, 2), "pt")
  ),
  gp = gpar(box_col = "blue", box_lwd = 2),
  just = "right",
  location = unit(1, "npc")
  )
)

## 载入需要的名字空间：gridtext

draw(ha)

plot of chunk unnamed-chunk-56

3.15 标记型注释条

m <- matrix(rnorm(1000), nrow = 100)
rownames(m) <- 1:100
ha <- rowAnnotation(foo = anno_mark(at = c(1:4, 20, 60, 97:100), labels = month.name[1:10]))
Heatmap(m,
  name = "mat", cluster_rows = FALSE, right_annotation = ha,
  row_names_side = "left", row_names_gp = gpar(fontsize = 4)
)

plot of chunk unnamed-chunk-57

3.16 总结性注释条

ha <- HeatmapAnnotation(summary = anno_summary(height = unit(4, "cm")))
v <- sample(letters[1:2], 50, replace = TRUE)
split <- sample(letters[1:2], 50, replace = TRUE)

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

plot of chunk unnamed-chunk-58

ha <- HeatmapAnnotation(summary = anno_summary(
  gp = gpar(fill = 2:3),
  height = unit(4, "cm")
))
v <- rnorm(50)
Heatmap(v,
  name = "mat", top_annotation = ha, width = unit(2, "cm"),
  row_split = split
)

plot of chunk unnamed-chunk-59

m <- matrix(rnorm(50 * 10), nrow = 50)
ht_list <- Heatmap(m, name = "main_matrix")

ha <- HeatmapAnnotation(summary = anno_summary(height = unit(3, "cm")))
v <- sample(letters[1:2], 50, replace = TRUE)
ht_list <- ht_list + Heatmap(v, name = "mat1", top_annotation = ha, width = unit(1, "cm"))

ha <- HeatmapAnnotation(summary = anno_summary(
  gp = gpar(fill = 2:3),
  height = unit(3, "cm")
))
v <- rnorm(50)
ht_list <- ht_list + Heatmap(v, name = "mat2", top_annotation = ha, width = unit(1, "cm"))

split <- sample(letters[1:2], 50, replace = TRUE)
lgd_boxplot <- Legend(
  labels = c("group a", "group b"), title = "group",
  legend_gp = gpar(fill = c("red", "blue"))
)
draw(ht_list,
  row_split = split, ht_gap = unit(5, "mm"),
  heatmap_legend_list = list(lgd_boxplot)
)

plot of chunk unnamed-chunk-60

3.17 空间/连接性注释条

set.seed(123)
m <- matrix(rnorm(100 * 10), nrow = 100)
subgroup <- sample(letters[1:3], 100, replace = TRUE, prob = c(1, 5, 10))
rg <- range(m)
panel_fun <- function(index, nm) {
  pushViewport(viewport(xscale = rg, yscale = c(0, 2)))
  grid.rect()
  grid.xaxis(gp = gpar(fontsize = 8))
  grid.boxplot(m[index, ], pos = 1, direction = "horizontal")
  popViewport()
}
anno <- anno_link(
  align_to = subgroup, which = "row", panel_fun = panel_fun,
  size = unit(2, "cm"), gap = unit(1, "cm"), width = unit(4, "cm")
)
Heatmap(m, name = "mat", right_annotation = rowAnnotation(foo = anno), row_split = subgroup)

plot of chunk unnamed-chunk-61

3.18 多个注释条

3.18.1 一般设置

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)

plot of chunk unnamed-chunk-62

ha <- HeatmapAnnotation(
  foo = 1:10,
  bar = cbind(1:10, 10:1),
  pt = anno_points(1:10),
  gp = gpar(col = "red")
)
draw(ha)

plot of chunk unnamed-chunk-63

ha <- HeatmapAnnotation(
  foo = 1:10,
  bar = cbind(1:10, 10:1),
  pt = anno_points(1:10),
  show_annotation_name = c(bar = FALSE), # only turn off `bar`
  border = c(foo = TRUE) # turn on foo
)
draw(ha)

plot of chunk unnamed-chunk-64

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

plot of chunk unnamed-chunk-65

3.18.2 注释条宽度

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

plot of chunk unnamed-chunk-66

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

plot of chunk unnamed-chunk-67

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

plot of chunk unnamed-chunk-68

3.18.3 注释条标签

ha <- HeatmapAnnotation(
  foo = 1:10,
  bar = cbind(1:10, 10:1),
  pt = anno_points(1:10),
  annotation_label = c("Annotation_foo", "Annotation_bar", "Annotation_pt")
)
draw(ha)

plot of chunk unnamed-chunk-69

ha <- HeatmapAnnotation(
  foo = 1:10,
  bar = cbind(1:10, 10:1),
  pt = anno_points(1:10),
  annotation_name_rot = 45
)
Heatmap(matrix(rnorm(100), 10), name = "mat", top_annotation = ha)

plot of chunk unnamed-chunk-70

ha <- rowAnnotation(
  foo = 1:10,
  bar = cbind(1:10, 10:1),
  pt = anno_points(1:10),
  annotation_name_rot = 45
)
Heatmap(matrix(rnorm(100), 10), name = "mat", left_annotation = ha)

plot of chunk unnamed-chunk-71

sessionInfo()

## R version 4.1.0 (2021-05-18)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 19044)
## 
## Matrix products: default
## 
## locale:
## [1] LC_COLLATE=Chinese (Simplified)_China.936 
## [2] LC_CTYPE=Chinese (Simplified)_China.936   
## [3] LC_MONETARY=Chinese (Simplified)_China.936
## [4] LC_NUMERIC=C                              
## [5] LC_TIME=Chinese (Simplified)_China.936    
## 
## attached base packages:
## [1] grid      stats     graphics  grDevices utils     datasets  methods  
## [8] base     
## 
## other attached packages:
## [1] GetoptLong_1.0.5     circlize_0.4.13      ComplexHeatmap_2.8.0
## 
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.7          compiler_4.1.0      RColorBrewer_1.1-2 
##  [4] highr_0.9           iterators_1.0.13    tools_4.1.0        
##  [7] digest_0.6.27       evaluate_0.14       clue_0.3-59        
## [10] png_0.1-7           rlang_0.4.11        foreach_1.5.1      
## [13] magick_2.7.3        parallel_4.1.0      xfun_0.25          
## [16] stringr_1.4.0       knitr_1.33          cluster_2.1.2      
## [19] xml2_1.3.2          GlobalOptions_0.1.2 S4Vectors_0.30.0   
## [22] IRanges_2.26.0      stats4_4.1.0        gridtext_0.1.4     
## [25] magrittr_2.0.1      codetools_0.2-18    matrixStats_0.60.0 
## [28] BiocGenerics_0.38.0 shape_1.4.6         colorspace_2.0-2   
## [31] stringi_1.7.3       doParallel_1.0.16   markdown_1.1       
## [34] crayon_1.4.1        rjson_0.2.20        Cairo_1.5-12.2

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

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

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

---

更多精彩内容：