# 安装包
if (!requireNamespace("data.table", quietly = TRUE)) {
install.packages("data.table")
}
if (!requireNamespace("jsonlite", quietly = TRUE)) {
install.packages("jsonlite")
}
if (!requireNamespace("destiny", quietly = TRUE)) {
install.packages("https://github.com/theislab/destiny/archive/refs/tags/v3.1.1.tar.gz")
}
if (!requireNamespace("ggplotify", quietly = TRUE)) {
install.packages("ggplotify")
}
if (!requireNamespace("scatterplot3d", quietly = TRUE)) {
install.packages("scatterplot3d")
}
if (!requireNamespace("ggpubr", quietly = TRUE)) {
install.packages("ggpubr")
}
# 加载包
library(data.table)
library(jsonlite)
library(destiny)
library(ggplotify)
library(scatterplot3d)
library(ggpubr)扩散映射图
注记
Hiplot 网站
本页面为 Hiplot Diffusion Map 插件的源码版本教程,您也可以使用 Hiplot 网站实现无代码绘图,更多信息请查看以下链接:
扩散映射(diffusion-map)是一种非线性降维算法,可以用于可视化发育轨迹。
环境配置
系统: Cross-platform (Linux/MacOS/Windows)
编程语言: R
依赖包:
data.table;jsonlite;destiny;ggplotify;scatterplot3d;ggpubr
sessioninfo::session_info("attached")─ Session info ───────────────────────────────────────────────────────────────
setting value
version R version 4.5.2 (2025-10-31)
os Ubuntu 24.04.3 LTS
system x86_64, linux-gnu
ui X11
language (EN)
collate C.UTF-8
ctype C.UTF-8
tz UTC
date 2026-01-28
pandoc 3.1.3 @ /usr/bin/ (via rmarkdown)
quarto 1.8.27 @ /usr/local/bin/quarto
─ Packages ───────────────────────────────────────────────────────────────────
package * version date (UTC) lib source
data.table * 1.18.0 2025-12-24 [1] RSPM
destiny * 3.25.0 2025-11-06 [1] Github (theislab/destiny@8cc0bff)
ggplot2 * 4.0.1 2025-11-14 [1] RSPM
ggplotify * 0.1.3 2025-09-20 [1] RSPM
ggpubr * 0.6.2 2025-10-17 [1] RSPM
jsonlite * 2.0.0 2025-03-27 [1] RSPM
scatterplot3d * 0.3-44 2023-05-05 [1] RSPM
[1] /home/runner/work/_temp/Library
[2] /opt/R/4.5.2/lib/R/site-library
[3] /opt/R/4.5.2/lib/R/library
* ── Packages attached to the search path.
──────────────────────────────────────────────────────────────────────────────
数据准备
# 加载数据
data1 <- data.table::fread(jsonlite::read_json("https://hiplot.cn/ui/basic/diffusion-map/data.json")$exampleData[[1]]$textarea[[1]])
data1 <- as.data.frame(data1)
data2 <- data.table::fread(jsonlite::read_json("https://hiplot.cn/ui/basic/diffusion-map/data.json")$exampleData[[1]]$textarea[[2]])
data2 <- as.data.frame(data2)
# 整理数据格式
sample.info <- data2
rownames(data1) <- data1[, 1]
data1 <- as.matrix(data1[, -1])
## tsne
set.seed(123)
dm_info <- DiffusionMap(t(data1))
dm_info <- cbind(DC1 = dm_info$DC1, DC2 = dm_info$DC2, DC3 = dm_info$DC3)
dm_data <- data.frame(
sample = colnames(data1),
dm_info
)
colorBy <- sample.info[match(colnames(data1), sample.info[, 1]), "Group"]
colorBy <- factor(colorBy, level = colorBy[!duplicated(colorBy)])
dm_data$colorBy = colorBy
# 查看数据
head(dm_data) sample DC1 DC2 DC3 colorBy
M1 M1 0.05059918 0.15203860 -0.06533168 G1
M2 M2 0.05030863 0.14435034 -0.06044277 G1
M3 M3 0.04271398 0.09273382 -0.02730427 G1
M4 M4 0.04680742 0.10425273 -0.03789962 G1
M5 M5 0.04971521 0.12786900 -0.05608321 G1
M6 M6 0.04840072 0.12728303 -0.05256815 G1
可视化
1. 2D
# 2D 扩散映射图
p <- ggscatter(data = dm_data, x = "DC1", y = "DC2", color = "colorBy",
size = 2, palette = "lancet", alpha = 1) +
labs(color = "Group") +
ggtitle("Diffusion Map") +
scale_color_manual(values = c("#3B4992FF","#EE0000FF","#008B45FF")) +
theme_classic() +
theme(text = element_text(family = "Arial"),
plot.title = element_text(size = 12,hjust = 0.5),
axis.title = element_text(size = 12),
axis.text = element_text(size = 10),
axis.text.x = element_text(angle = 0, hjust = 0.5,vjust = 1),
legend.position = "right",
legend.direction = "vertical",
legend.title = element_text(size = 10),
legend.text = element_text(size = 10))
p
2. 3D
# 3D 扩散映射图
group.color <- c("#3B4992FF","#EE0000FF","#008B45FF")
names(group.color) <- unique(dm_data$colorBy)
group.color <- group.color[!is.na(names(group.color))]
if (length(group.color) == 0) {
group.color <- c(Default="black")
dm_data$colorBy <- "Default"
}
p <- as.ggplot(function(){
scatterplot3d(x = dm_data$DC1, y = dm_data$DC2, z = dm_data$DC3,
color = alpha(group.color[dm_data$colorBy], 1),
xlim=c(min(dm_data$DC1), max(dm_data$DC1)),
ylim=c(min(dm_data$DC2), max(dm_data$DC2)),
zlim=c(min(dm_data$DC3), max(dm_data$DC3)),
pch = 16, cex.symbols = 0.6,
scale.y = 0.8,
xlab = "DC1", ylab = "DC2", zlab = "DC3",
angle = 40,
main = "Diffusion Map",
col.axis = "#444444", col.grid = "#CCCCCC")
legend("right", legend = names(group.color),
col = alpha(group.color, 0.8), pch = 16)
})
p <- p + theme_classic()
p
