一、 t-SNE
非线性降维，计算数据集中每行与其他行的距离（默认为欧氏距离）转换为概率。
PCA属于线性降维，不能解释复杂多项式之间的关系，t-SNE是根据t分布随机领域的嵌入找到数据之间的结构特点。原始空间中的相似度由高斯联合概率表示，嵌入空间的相似度由“学生t分布”表示。
加载所需包
library(tidyverse)
pacman::p_load(Rtsne,umap,kohonen,lle)
【步骤】
第一步：计算数据集中每行与其他行的距离（默认为欧式距离），转换为概率向量；
第二步：对每一行重复操作，得到概率矩阵；
第三步：沿两条新轴用学生t分布对数据随机化；
第四步：逐渐迭代，通过最小化KL散度，使得二维空间的新概率矩阵尽可能接近原高维空间。
【特点】
较于正态分布，使用t分布能更好地分散可能的数据簇，更易识别；基于所实现的精度，将t-SNE与PCA和其他线性降维模型相比，结果表明t-SNE能够提供更好的结果,这是因为算法定义了数据的局部和全局结构之间的软边界。
缺点：不能保留全局结构、.计算量较大、不可预测新数据、无法像PCA一样投影新数据、簇间距离意义不大。
【参数】
dims ：参数设置降维之后的维度，默认值为2
perplexity：控制距离转化为概率的分布：局部结构 5-30-50 全局结构，取值小于 (nrow(data) - 1)/ 3，数据集越大，需要参数值越大;
theta：权衡速度与精度，取值越大，精度越低。精确 0-0.5-1 最快，默认值0.5；
eta：学习率，越少越精确，越多迭代次数越少，默认值200；
max_iter：最多迭代次数，默认值1000。
【例】
真假钞数据,将banknote数据集去掉Status标签列后赋值给 bn.tsne
pacman::p_load(mclust,GGally,factoextra,dplyr)
note <- as_tibble(mclust::banknote)
bn.tsne <- note %>%
select(-Status) %>%
Rtsne(perplexity = 30, theta = 0, max_iter = 5000, verbose = F)
- 查看降维后的数据结构
str( bn.tsne)
- 查看降维后的数据
head(bn.tsne$Y)
可视化
note %>%
*将数值型变量标准化
mutate(across(where(is.numeric), .fns = scale)) %>%
*将降维后的数据加入数据框
mutate(tsne1 = bn.tsneY[, 2]) %>%
ggplot(aes(tsne1, tsne2, col = Status)) +
geom_point(size = 2) +
geom_hline(yintercept = 0, lty = 2, col = "blue") +
theme_bw() +
theme(legend.position = "top")
查看每个特征的降维效果图：
note %>%
*将数值型变量标准化
mutate(across(where(is.numeric), .fns = scale)) %>%
*将降维后的数据加入数据框
mutate(tsne1 = bn.tsneY[, 2]) %>%
*保留tsne1, tsne2, Status列，将其他列宽表变长表，便于画图
tidyr::pivot_longer(names_to = "Variable", values_to = "Value",
c(-tsne1, -tsne2, -Status)) %>%
ggplot(aes(tsne1, tsne2, col = Value, shape = Status)) +
facet_wrap(~ Variable) +
geom_point(size = 2) +
*梯度填充颜色
scale_color_gradient(low = "dark blue", high = "cyan") +
theme_bw() +
theme(legend.position = "top")
https://www.jianshu.com/p/824be2661d42
二、 UMAP
假设数据分布在流形上，并沿着流形测量行间距离，利用流形学和投影技术达到降维目的。
【步骤】
第一步，计算高维空间中的点之间的距离，将它们投影到低维空间，并计算该低维空间中的点之间的距离；
第二步，使用随机梯度下降来最小化这些距离之间的差异。
【 特点】
相较于 t-SNE ，计算量较小、可预测新数据、确定性算法、保留双结构
【参数】
n_neighbors：控制模糊搜索区域的半径：更少邻域 到 更多邻域;
min_dist：低维下允许的行间最小距离：更集中 到 更分散；
metric：选择距离的测度方法：欧氏距离、曼哈顿距离等；
n_epochs：优化步骤的迭代次数。
【例】
arrests <- USArrests
*查看数据结构
str(arrests)
数据框包含4个变量，50个观测。
Murder：每十万人中因谋杀逮捕人数
Assault：每十万人中因攻击逮捕人数
UrbanPop：城镇人口百分比
Rape：每十万人中因强奸逮捕人数
*检查缺失值
DataExplorer::profile_missing(arrests)
summary(arrests)
使用曼哈顿距离
arrests.umap <- umap(arrests, n_neibours = 7, min_dist = 0.05,
metric = "manhattan", n_epochs = 200, verbose = F)
*查看降维后的数据
arrests.umap$layout %>%
head()
【可视化】
arrests.umap$layout %>%
*转换为数据框
as.data.frame() %>%
*更改列名
setNames(c("umap1", "umap2")) %>%
ggplot(aes(umap1, umap2)) +
geom_point(size = 2) +
theme_bw()
根据umap1的大小将数据分簇，并设置不同的颜色：
arrests.umap$layout %>%
*转换为数据框
as.data.frame() %>%
- 更改列名
setNames(c("umap1", "umap2")) %>%
mutate(stat = case_when(umap1 < -3 ~ "a",
umap1 < -1 ~ "b",
umap1 < 2 ~ "c",
TRUE ~ "d")) %>%
ggplot(aes(umap1, umap2, col = stat)) +
geom_point(size = 2) +
theme_bw() +
theme(legend.position = "none")
设定 n_components = 3， 再运行 UMAP，将得到结果的 layout 部分传递给 ggpairs()。
arrests.umap2 <- umap(arrests, n_neibours = 3, min_dist = 0.05,
metric = "manhattan", n_epochs = 200, verbose = F)
arrests.umap2$layout %>%
as.data.frame() %>%
setNames(c("umap1", "umap2")) %>%
GGally::ggpairs() +
theme_bw()
https://www.jianshu.com/p/ffe8a7e1e5a0
三、 SOM
是一种自组织（竞争型）神经网络，用两个维度来表示一个数据集，使相似的行更靠近。将距离小的个体集合划分为同一类别，距离大的个体集合划分为不同类别。
相较于K-means，SOM无需预先提供聚类数量。
【特点】
SOM 与 LLE 的优点：非线性还原算法、新数据可以映射到SOM上、训练成本相当不高、LLE算法可重复。
SOM 与 LLE 的缺点：
1.不能处理分类变量。
2.不能直接用原始变量解释。
3.对不同尺度的数据很敏感。
4.新数据不能映射到LLE上。
5.不一定保留数据的全局结构。
6.SOM算法每次都会产生不同的结果。
7.SOM在大型数据集上效果更好。
【步骤】
1.输入层网络：输入层网络节点与数据集同行数，同列数，但数据集需要归一化。
2.输出层网络：一般根据数据集的维度来构建输出层网络。
（例：二维情况，希望分为4类，输出层可设计为4*2的矩阵）
3.随机给每个节点分配权重
根据输入层的数据集的维度和输出层的的预估分类数，定义权重节点的维度。
（例：数据集是二维的，权重的行数就定为2，分4类，权重的列数就选4。权重值一般给定一个0-1之间的随机值）
4.随机选择一行，并计算其与网格中每个节点权重的距离（相似度，通常为欧式距离），把此行放到权重与该行距离最小的节点中（BMU，best matching unit）。
5.更新BMU（基本思想是：越靠近优胜节点，更新幅度越大；越远离优胜节点，更新幅度越小）及其邻域内节点的权重（取决于邻域函数）。
6.重复步骤3-5，迭代指定次数。
【案例】
data(flea)
ggpairs(flea, aes(color = species))
newDataFlea <- tibble(tars1 = c(120, 200),
tars2 = c(125, 120),
head = c(52, 48),
aede1 = c(140, 128),
aede2 = c(12, 14),
aede3 = c(100, 85))
四、 LLE
LLE是广泛使用的图形图像降维方法，属于流形学习(Manifold Learning)的一种，实现简单，其假设数据在较小的局部是线性的，也就是说，某一个数据可以由它邻域中的几个样本来线性表示。（LLE 非常适合处理卷起或扭曲状的数据，但不能是闭合流形，不能是稀疏的数据集，不能是分布不均匀的数据集等等，这限制了它的应用。）
【步骤】
1.计算行间距，设定超参数k。
2.对一行选出其最近的k行，表示为其线性组合，该线性组合系数为权重。
3.对每行重复操作，使得数据在2或3维空间中（近乎）保持该线性组合关系。
【特点】
优点：可以学习任意维的局部线性的低维流形、计算复杂度相对较小、实现容易。
缺点：算法对最近邻样本数的选择敏感，不同的最近邻数对最后的降维结果有很大影响。
【参数】
除了维数，k （近邻数量）是唯一需要确定的超参数，K可以通过函数计算出来：calc_k()
① m 表示维数，通常2 或 3
② kmin，kmax 决定 k 取值域
③ parallel，是否多核运行，默认为否
④ cpus 指定使用 cpu 核数
【案例】
准备数据
data(lle_scurve_data, package = "lle")
scurve <- as.data.frame(lle_scurve_data)
str(scurve)
设置列名
names(scurve) <- c("x", "y", "z")
检查缺失值
DataExplorer::profile_missing(scurve)
3D图形展示
scatter3D(x = scurvey, z = scurve$z, pch = 19,
bty = "b2", colkey = F, theta = 35, phi = 10,
col = ramp.col(c("red", "cyan")))
让3D图像可以用鼠标转动
plot3Drgl::plotrgl( )
降维
llek <- calc_k(scurve, m = 2, kmin = 1, kmax = 20, parallel = T,
cpus = parallel::detectCores())
找出使rho最小的K值
k <- filter(llek, rho == min(llek$rho))
k
使用最优的K值，降维：
lle.scurve <- lle(scurve, m = 2, k = k$k)
str(lle.scurve)
使用降维后的数据画图：
tibble(LLE1 = lle.scurveY[, 2],
z = scurve$z) %>%
ggplot(aes(LLE1, LLE2, col = z)) +
geom_point(size = 1) +
scale_color_gradient(low = "cyan", high = "red") +
theme_bw() +
theme(legend.position = "top")