> library(pacman)
> p_load(dplyr, Rtsne, ggplot2)
t-SNE：t-distributed stochastic neighbor embedding：t分布随机邻域嵌入是一种用于探索高维数据的非线性降维算法。它将多维数据映射到适合于人类观察的两个或多个维度。t-SNE非线性降维算法通过基于具有多个特征的数据点的相似性识别观察到的簇来在数据中找到模式。本质上是一种降维和可视化技术。另外t-SNE的输出可以作为其他分类算法的输入特征。
1、降维步骤
t-SNE：将数据点之间的相似度转换为概率。原始空间中的相似度由高斯联合概率表示，嵌入空间的相似度由“学生t分布”表示。
第一步：计算数据集中每行与其他行的距离（默认为欧式距离），转换为概率向量；
第二步：对每一行重复操作，得到概率矩阵；
第三步：沿两条新轴用学生t分布对数据随机化；
第四步：逐渐迭代，通过最小化KL散度，使得二维空间的新概率矩阵尽可能接近原高维空间的。
2、t-SNE特点
相较于正态分布，使用t分布能更好地分散可能的数据簇，更易识别；基于所实现的精度，将t-SNE与PCA和其他线性降维模型相比，结果表明t-SNE能够提供更好的结果,这是因为算法定义了数据的局部和全局结构之间的软边界。
缺点：1.t-SNE在低维容易保持局部结构，但全局结构未明确保留；2.计算费时，计算时间随簇数显著增加，在数百万个样本数据集中可能需要几个小时，而PCA可以在几秒钟或几分钟内完成；3.无法像PCA一样投影新数据；4.簇间距离意义不大。
3、超参数
四个重要超参数：
perplexity：控制距离转化为概率的分布：局部结构 5-30-50 全局结构，数据集越大，需要参数值越大;
theta：权衡速度与精度：精确 0-0.5-1 最快；
eta：学习率，越低越精确，越大更少迭代，默认值200；
max_iter：最多迭代次数：默认值1000。
4、实例
数据集：真假钞数据集
> note <- as_tibble(mclust::banknote)
> bn.tsne <- note %>%
+ select(-Status) %>%
+ Rtsne(perplexity = 30, theta = 0, max_iter = 5000, verbose = F)
> # 降维后的数据
> head(bn.tsne$Y)
## [,1] [,2]
## [1,] 14.86749 1.7877223
## [2,] 20.89120 -2.1012873
## [3,] 21.22759 -0.4231654
## [4,] 17.51262 -6.3744448
## [5,] 22.39935 2.4992679
## [6,] 14.66129 0.6295803
可视化：
> note %>%
+ # 将数值型变量标准化
+ mutate(across(where(is.numeric), .fns = scale)) %>%
+ # 将降维后的数据加入数据框
+ mutate(tsne1 = bn.tsne$Y[, 1], tsne2 = bn.tsne$Y[, 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(tsne1 = bn.tsne$Y[, 1], tsne2 = bn.tsne$Y[, 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.tsne$Y[, 1], tsne2 = bn.tsne$Y[, 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")
其中Diagonal特征比较容易区分两种钞票，其他特征分辨能力相对较差，因为颜色梯度填充比较混杂。
