其他
超详细的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)
也可以改变位置：
Heatmap(mat, name = "mat2", bottom_annotation = column_ann, left_annotation = row_ann)
在上面的例子中，foo1和foo2这种被称为简单注释条，bar1和bar2这种被称为复杂注释条，它们都应该被设置成名字-向量这种形式。注释条也可以独立于热图，将在第四章讨论
3.1 简单注释条
简单注释条最常见，颜色用来映射数值，只需要一个向量和一个名字即可。
ha <- HeatmapAnnotation(foo = 1:10)
draw(ha)
ha <- HeatmapAnnotation(bar = sample(letters[1:3], 10, replace = TRUE))
draw(ha)
改变颜色映射：
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)
ha <- HeatmapAnnotation(
bar = sample(letters[1:3], 10, replace = TRUE),
col = list(bar = c("a" = "red", "b" = "green", "c" = "blue"))
)
draw(ha)
同时多个简单注释条：
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)
处理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)
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)
也可以直接使用数据框或矩阵：
ha <- HeatmapAnnotation(foo = cbind(a = runif(10), b = runif(10))) # 有不同的名字
draw(ha)
ha <- HeatmapAnnotation(foo = cbind(runif(10), runif(10))) # 用相同的名字
draw(ha)
数据框：
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)
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)
控制简单注释条的高度，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)
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)
ha <- HeatmapAnnotation(foo = anno_simple(1:10, pch = 1:10))
draw(ha)
ha <- HeatmapAnnotation(foo = anno_simple(1:10,
pch = sample(letters[1:3], 10, replace = TRUE)
))
draw(ha)
ha <- HeatmapAnnotation(foo = anno_simple(1:10, pch = c(1:4, NA, 6:8, NA, 10, 11)))
draw(ha)
ha <- HeatmapAnnotation(foo = anno_simple(cbind(1:10, 10:1), pch = 1:2))
draw(ha)
ha <- HeatmapAnnotation(foo = anno_simple(cbind(1:10, 10:1), pch = 1:10))
draw(ha)
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)
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))
更改高度的另一种方法，在anno_simple里面使用：
ha <- HeatmapAnnotation(foo = anno_simple(1:10, height = unit(2, "cm")))
draw(ha)
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")
})
}
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()
})
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
)
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
)
更加复杂的用法，需要自己写函数，也需要对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")
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)
以上就是本系列第3篇的内容，本系列内容较多，更多内容将逐步推送！
欢迎关注我的公众号：医学和生信笔记
医学和生信笔记 公众号主要分享：1.医学小知识、肛肠科小知识；2.R语言和Python相关的数据分析、可视化、机器学习等；3.生物信息学学习资料和自己的学习笔记！
往期精彩内容：
使用R语言美化PCA图
R语言生信图表学习之网络图
在VScode中使用R语言