> library(pacman)
> p_load(dplyr, umap, ggplot2)

UMAP(Uniform Manifold Approximation and Projection，统一流形逼近与投影)是一种非线性降维的算法，相对于t-SNE，UMAP算法更加快速，该方法的原理是利用流形学和投影技术，达到降维目的，首先计算高维空间中的点之间的距离，将它们投影到低维空间，并计算该低维空间中的点之间的距离。然后，它使用随机梯度下降来最小化这些距离之间的差异。
相比 t-SNE 的优势：
1.速度快得多
2.确定性算法
3.保留双结构

1、UMAP的超参数

四个重要超参数：
n_neighbors：控制模糊搜索区域的半径：更少邻域 到 更多邻域;
min_dist：低维下允许的行间最小距离：更集中 到 更分散；
metric：选择距离的测度方法：欧氏距离、曼哈顿距离等；
n_epochs：优化步骤的迭代次数。

2、实例

> arrests <- USArrests
> # 查看数据结构
> str(arrests)

## 'data.frame':    50 obs. of  4 variables:
##  $ Murder  : num  13.2 10 8.1 8.8 9 7.9 3.3 5.9 15.4 17.4 ...
##  $ Assault : int  236 263 294 190 276 204 110 238 335 211 ...
##  $ UrbanPop: int  58 48 80 50 91 78 77 72 80 60 ...
##  $ Rape    : num  21.2 44.5 31 19.5 40.6 38.7 11.1 15.8 31.9 25.8 ...

数据框包含4个变量，50个观测。
Murder：每十万人中因谋杀逮捕人数
Assault：每十万人中因攻击逮捕人数
UrbanPop：城镇人口百分比
Rape：每十万人中因强奸逮捕人数

> # 检查缺失值
> DataExplorer::profile_missing(arrests)

##    feature num_missing pct_missing
## 1   Murder           0           0
## 2  Assault           0           0
## 3 UrbanPop           0           0
## 4     Rape           0           0

> summary(arrests)

##      Murder          Assault         UrbanPop          Rape      
##  Min.   : 0.800   Min.   : 45.0   Min.   :32.00   Min.   : 7.30  
##  1st Qu.: 4.075   1st Qu.:109.0   1st Qu.:54.50   1st Qu.:15.07  
##  Median : 7.250   Median :159.0   Median :66.00   Median :20.10  
##  Mean   : 7.788   Mean   :170.8   Mean   :65.54   Mean   :21.23  
##  3rd Qu.:11.250   3rd Qu.:249.0   3rd Qu.:77.75   3rd Qu.:26.18  
##  Max.   :17.400   Max.   :337.0   Max.   :91.00   Max.   :46.00

> # 使用曼哈顿距离
> arrests.umap <- umap(arrests, n_neibours = 7, min_dist = 0.05, 
+                      metric = "manhattan", n_epochs = 200, verbose = F)
> 
> # 查看降维后的数据
> arrests.umap$layout %>% 
+   head()

##                  [,1]      [,2]
## Alabama    -2.2478996 -2.625963
## Alaska     -2.9482743 -3.347010
## Arizona    -3.2269841 -4.172101
## Arkansas   -0.4000816 -1.252967
## California -2.7127556 -4.068527
## Colorado   -0.7536647 -1.497600

3、可视化

> 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()

降维后的变量相关性

4、t-SNE和UMAP的优缺点

t-SNE 及 UMAP 的优点：
1.可学习非线性规律；
2.能更好地分簇；
3.UMAP 可预测新数据；
4.UMAP 计算量不太大；
5.UMAP 保持双结构。

t-SNE 及 UMAP 的缺点：
1.新轴线难解释；
2.t-SNE 不可预测新数据；
3.t-SNE 计算量太大；
4.t-SNE 不保持全局结构；
5.不能直接处理分类变量。