在模仿中精进数据可视化_使用ggplot2手搓一个聚类热图
❝最近，有小伙伴给我发私信，说在咸鱼有人贴出我的公众号的图，也带上了在模仿中精进数据可视化的标签。
怎么说呢，感谢大家对我的能力的认可，我应该是没有火到这种程度。
不过，还是要适当有度。
我可是没有咸鱼的，大家要避免上当受骗。
最后，欢迎私信举报。
❝
在模仿中精进数据可视化该系列推文中，我们将从各大顶级学术期刊的Figure入手，
解读文章的绘图思路，
模仿文章的作图风格，
构建适宜的绘图数据，
并且将代码应用到自己的实际论文中。
绘图缘由：小伙伴们总会展示出一些非常好看且精美的图片。我大概率会去学习和复现一下。其实每个人的时间和精力都非常有限和异常宝贵的。之所以我会去做，主要有以下原因：
图片非常好看，我自己看着也手痒痒 图片我自己在Paper也用的上，储备着留着用 保持了持续学习的状态
❝叶师兄总会给我分享各种好看的Figure，供我学习和参考。
其实能遇到这种相互促进，互相交流的好朋友，是真的很荣幸。
我不管，我就等着叶师兄毕业，然后带我起飞了。
学习编程，从来都不是一个人的事情，一个人闭门造车，永远都造不出来。
与其盲人摸象，不如相互交流。
最后，欢迎各位朋友、好友、关注公众号的朋友们，加入技术交流群，一起交流技术。
原图
❝其实一眼就知道
pheatmap完全可以搞定，咱们尝试基于ggplot2去做一下。
复现
❝测试数据都是编造的，没有任何实际意义。
其实结果有点儿小瑕疵，就是列的树，没有完全的对其。
细节我是不想再扣了。
但是扣一扣，肯定是能出来的。
❝上述的图，很大一部分的功劳是基于
Y叔的ggtree以及其组合包。
公众号的推文里面，很大一部分的内容，其实都调用了Y叔的各种各样的包。
在这里对Y叔致以崇高的敬意。
直接上代码：
加载R包
rm(list = ls())
####----load R Package----####
library(tidyverse)
library(readxl)
library(ggtree)
library(treeio)
library(tidytree)
library(psych)
library(ape)
library(aplot)
library(ggfun)
source("R/cluster.R")
source("R/create_tree.R")
加载数据
####----load Data----####
ASV_B <- read_xlsx(path = "Input/ASV_B.xlsx", col_names = T) %>%
tibble::column_to_rownames(var = "ASV") %>%
t() %>%
as.data.frame()
ASV_F <- read_xlsx(path = "Input/ASV_F.xlsx", col_names = T) %>%
tibble::column_to_rownames(var = "ASV") %>%
t() %>%
as.data.frame()
cor_out_odata <- corr.test(ASV_B, ASV_F)
# 浅浅的做一个聚类
cluster_out <- cluster(cor_out_odata$r, "euclidean", "complete")
row_clust_df <- cutree(cluster_out[[1]],k = 2) %>%
as.data.frame() %>%
purrr::set_names("RowGroups") %>%
tibble::rownames_to_column(var = "row") %>%
dplyr::mutate(RowGroups = str_c("RowGroups", RowGroups))
col_clust_df <- cutree(cluster_out[[2]],k = 2) %>%
as.data.frame() %>%
purrr::set_names("ColGroups") %>%
tibble::rownames_to_column(var = "col") %>%
dplyr::mutate(ColGroups = str_c("CowGroups", ColGroups))
cor_out_odata_r <- cor_out_odata$r %>%
as.data.frame() %>%
tibble::rownames_to_column(var = "Bacterial") %>%
tidyr::pivot_longer(cols = -Bacterial, names_to = "Fungle", values_to = "r")
cor_out_odata_p <- cor_out_odata$p %>%
as.data.frame() %>%
tibble::rownames_to_column(var = "Bacterial") %>%
tidyr::pivot_longer(cols = -Bacterial, names_to = "Fungle", values_to = "PValue") %>%
dplyr::mutate(signif = case_when(
PValue > 0.05 ~ "",
PValue > 0.01 & PValue < 0.05 ~ "*",
PValue < 0.01 & PValue > 0.001 ~ "**",
PValue < 0.001 ~ "***"
))
# create plot
cor_out_df <- cor_out_odata_r %>%
dplyr::left_join(cor_out_odata_p, by = c("Bacterial", "Fungle")) %>%
dplyr::left_join(row_clust_df, by = c("Bacterial" = "row")) %>%
dplyr::left_join(col_clust_df, by = c("Fungle" = "col")) %>%
dplyr::mutate(Bacterial = factor(Bacterial, levels = cluster_out[[3]], ordered = T)) %>%
dplyr::mutate(Fungle = factor(Fungle, levels = cluster_out[[4]], ordered = T)) %>%
dplyr::mutate(ColGroups = factor(ColGroups, levels = c("CowGroups2", "CowGroups1"), ordered = T))
绘图
####----Plot----####
# tree1
row_g <- create_tree(cluster_out[[1]], n = 2)
row_p <- ggtree(cluster_out[[1]], branch.length = "none") +
geom_tree(linewidth = 1.2) +
xlim(NA, 5) +
theme(legend.background = element_roundrect(color = "#969696"))
row_clades <- sapply(row_g, function(n) MRCA(row_p, n))
row_p <- row_p %>% groupClade(., sapply(row_g, function(n) MRCA(row_p, n)),group_name='subtree') +
aes(color=subtree)
# tree2
col_g <- create_tree(cluster_out[[2]], n = 2)
col_p <- ggtree(cluster_out[[2]], linetype='dashed', branch.length = "none", layout = "dendrogram") +
geom_tree(linewidth = 1.2) +
theme(legend.background = element_roundrect(color = "#969696"))
col_p <- col_p %>% groupClade(., sapply(col_g, function(n) MRCA(col_p, n)), group_name='subtree') +
aes(color=subtree)
# heatmap
p_heatmap <- ggplot(data = cor_out_df) +
geom_tile(aes(x = Fungle, y = Bacterial, fill = r), color = "#ffffff", linewidth = 1) +
geom_text(data = cor_out_df %>% dplyr::filter(PValue < 0.05),
aes(x = Fungle, y = Bacterial, label = round(PValue, 2)),
color = "#000000") +
scale_x_discrete(expand = c(0,0)) +
scale_y_discrete(expand = c(0,0), position = "right") +
scale_fill_gradient2(low = "#1d91c0", high = "#fdae61", mid = "#ffffff", midpoint = 0) +
facet_grid(RowGroups~ColGroups, scales = "free", space = "free") +
theme(
panel.border = element_rect(linetype = "dashed", fill = NA, linewidth = 2, color = "#2171b5"),
axis.ticks = element_blank(),
axis.text = element_text(color = "#000000", size = 10),
axis.title = element_text(color = "#000000", size = 15),
axis.text.x = element_text(angle = 90),
strip.text = element_blank(),
strip.background = element_blank(),
legend.background = element_roundrect(color = "#969696")
)
####----combine----####
p_combine <- p_heatmap %>%
insert_left(row_p, width = 0.25) %>%
insert_top(col_p, height = 0.25)
p_combine
ggsave(filename = "Output/p_combine.pdf",
plot = p_combine,
height = 10,
width = 16)
版本信息
R version 4.3.0 (2023-04-21)
Platform: x86_64-apple-darwin20 (64-bit)
Running under: macOS 15.1.1
Matrix products: default
BLAS: /System/Library/Frameworks/Accelerate.framework/Versions/A/Frameworks/vecLib.framework/Versions/A/libBLAS.dylib
LAPACK: /Library/Frameworks/R.framework/Versions/4.3-x86_64/Resources/lib/libRlapack.dylib; LAPACK version 3.11.0
locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
time zone: Asia/Shanghai
tzcode source: internal
attached base packages:
[1] stats graphics grDevices utils datasets methods base
other attached packages:
[1] ggfun_0.1.5 aplot_0.2.3 ape_5.8 psych_2.3.9 tidytree_0.4.5 treeio_1.26.0 ggtree_3.10.0 readxl_1.4.3
[9] lubridate_1.9.3 forcats_1.0.0 stringr_1.5.1 dplyr_1.1.4 purrr_1.0.2 readr_2.1.5 tidyr_1.3.1 tibble_3.2.1
[17] ggplot2_3.5.1 tidyverse_2.0.0
loaded via a namespace (and not attached):
[1] yulab.utils_0.1.7 utf8_1.2.4 generics_0.1.3 ggplotify_0.1.2 stringi_1.8.3 lattice_0.22-5
[7] hms_1.1.3 digest_0.6.37 magrittr_2.0.3 grid_4.3.0 timechange_0.2.0 cellranger_1.1.0
[13] jsonlite_1.8.9 fansi_1.0.6 scales_1.3.0 textshaping_0.3.7 lazyeval_0.2.2 mnormt_2.1.1
[19] cli_3.6.3 rlang_1.1.4 munsell_0.5.1 withr_3.0.1 tools_4.3.0 parallel_4.3.0
[25] tzdb_0.4.0 colorspace_2.1-1 vctrs_0.6.5 R6_2.5.1 gridGraphics_0.5-1 lifecycle_1.0.4
[31] fs_1.6.5 ragg_1.2.6 pkgconfig_2.0.3 pillar_1.9.0 gtable_0.3.5 glue_1.8.0
[37] Rcpp_1.0.13 systemfonts_1.1.0 tidyselect_1.2.1 rstudioapi_0.15.0 farver_2.1.2 nlme_3.1-163
[43] patchwork_1.2.0.9000 labeling_0.4.3 compiler_4.3.0
历史绘图合集
公众号推文一览
进化树合集
环状图
散点图
基因家族合集
换一个排布方式：
首先查看基础版热图:
然后再看进阶版热图:
基因组共线性
WGCNA ggplot2版本
其他科研绘图
合作、联系和交流
有很多小伙伴在后台私信作者，非常抱歉，我经常看不到导致错过，请添加下面的微信联系作者，一起交流数据分析和可视化。
