其他
超详细的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)
3.8 条形图注释条
ha <- HeatmapAnnotation(foo = anno_barplot(1:10, bar_width = 1, gp = gpar(fill = 1:10)))
draw(ha)
ha <- HeatmapAnnotation(foo = anno_barplot(seq(-5, 5), baseline = "min"))
draw(ha)
ha <- HeatmapAnnotation(foo = anno_barplot(seq(-5, 5), baseline = 0))
draw(ha)
ha <- HeatmapAnnotation(foo = anno_barplot(cbind(1:10, 10:1),
gp = gpar(fill = 2:3, col = 2:3)
))
draw(ha)
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)
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"))
3.9 箱线图注释条
ha <- HeatmapAnnotation(foo = anno_boxplot(m,
height = unit(4, "cm"),
gp = gpar(fill = 1:10)
))
draw(ha)
ha <- HeatmapAnnotation(foo = anno_boxplot(m,
height = unit(4, "cm"),
box_width = 0.9, outline = FALSE
))
draw(ha)
3.10 直方图注释条
m <- matrix(rnorm(1000), nc = 100)
ha <- rowAnnotation(foo = anno_histogram(m, n_breaks = 20, gp = gpar(fill = 1:10)))
draw(ha)
3.11 密度图注释条
ha <- rowAnnotation(foo = anno_density(m,
joyplot_scale = 2,
gp = gpar(fill = "#CCCCCC80")
))
draw(ha)
ha <- rowAnnotation(foo = anno_density(m,
type = "violin",
gp = gpar(fill = 1:10)
))
draw(ha)
行太多了就变成热图注释条
m2 <- matrix(rnorm(50 * 10), nrow = 50)
ha <- rowAnnotation(foo = anno_density(m2, type = "heatmap", width = unit(6, "cm")))
draw(ha)
ha <- rowAnnotation(foo = anno_density(m2,
type = "heatmap", width = unit(6, "cm"),
heatmap_colors = c("white", "orange")
))
draw(ha)
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)
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)
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)
ha <- rowAnnotation(foo = anno_horizon(lt,
gp = gpar(pos_fill = "orange", neg_fill = "darkgreen")
)) # 正值颜色和负值颜色
draw(ha)
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)
控制正值从上开始
ha <- rowAnnotation(foo = anno_horizon(lt, negative_from_top = TRUE))
draw(ha)
宽度
ha <- rowAnnotation(foo = anno_horizon(lt, gap = unit(1, "mm")))
draw(ha)
3.14 文本注释条
ha <- rowAnnotation(foo = anno_text(month.name,
location = 1, rot = 30,
just = "right", gp = gpar(fontsize = 1:12 + 4)
))
draw(ha)
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)
更复杂的文本，借助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)
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)
)
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
)
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
)
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)
)
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)
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)
ha <- HeatmapAnnotation(
foo = 1:10,
bar = cbind(1:10, 10:1),
pt = anno_points(1:10),
gp = gpar(col = "red")
)
draw(ha)
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)
ha <- HeatmapAnnotation(
foo = 1:10,
bar = cbind(1:10, 10:1),
pt = anno_points(1:10),
gap = unit(c(2, 10), "mm")
)
draw(ha)
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)
# 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)
# 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)
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)
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)
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)
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.生物信息学学习资料和自己的学习笔记！
更多精彩内容：
R语言ggtern包画三元图详解
R语言ggsci配色包详解
R语言画dumbbell chart