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

UMAP(Uniform Manifold Approximation and Projection，統(tǒng)一流形逼近與投影)是一種非線性降維的算法，相對于t-SNE，UMAP算法更加快速，該方法的原理是利用流形學(xué)和投影技術(shù)，達(dá)到降維目的，首先計算高維空間中的點之間的距離，將它們投影到低維空間，并計算該低維空間中的點之間的距離。然后，它使用隨機梯度下降來最小化這些距離之間的差異。
相比 t-SNE 的優(yōu)勢：
1.速度快得多
2.確定性算法
3.保留雙結(jié)構(gòu)

1、UMAP的超參數(shù)

四個重要超參數(shù)：
n_neighbors：控制模糊搜索區(qū)域的半徑：更少鄰域 到 更多鄰域;
min_dist：低維下允許的行間最小距離：更集中 到 更分散；
metric：選擇距離的測度方法：歐氏距離、曼哈頓距離等；
n_epochs：優(yōu)化步驟的迭代次數(shù)。

2、實例

> arrests <- USArrests
> # 查看數(shù)據(jù)結(jié)構(gòu)
> 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 ...

數(shù)據(jù)框包含4個變量，50個觀測。
Murder：每十萬人中因謀殺逮捕人數(shù)
Assault：每十萬人中因攻擊逮捕人數(shù)
UrbanPop：城鎮(zhèn)人口百分比
Rape：每十萬人中因強奸逮捕人數(shù)

> # 檢查缺失值
> 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)
> 
> # 查看降維后的數(shù)據(jù)
> 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 %>% 
+   # 轉(zhuǎn)換為數(shù)據(jù)框
+   as.data.frame() %>% 
+   # 更改列名
+   setNames(c("umap1", "umap2")) %>% 
+   ggplot(aes(umap1, umap2)) +
+   geom_point(size = 2) +
+   theme_bw()

降維后的聚類

根據(jù)umap1的大小將數(shù)據(jù)分簇，并設(shè)置不同的顏色：

> arrests.umap$layout %>% 
+   # 轉(zhuǎn)換為數(shù)據(jù)框
+   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")

降維后的聚類

設(shè)定 n_components = 3， 再運行 UMAP，將得到結(jié)果的 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()

降維后的變量相關(guān)性

4、t-SNE和UMAP的優(yōu)缺點

t-SNE 及 UMAP 的優(yōu)點：
1.可學(xué)習(xí)非線性規(guī)律；
2.能更好地分簇；
3.UMAP 可預(yù)測新數(shù)據(jù)；
4.UMAP 計算量不太大；
5.UMAP 保持雙結(jié)構(gòu)。

t-SNE 及 UMAP 的缺點：
1.新軸線難解釋；
2.t-SNE 不可預(yù)測新數(shù)據(jù)；
3.t-SNE 計算量太大；
4.t-SNE 不保持全局結(jié)構(gòu)；
5.不能直接處理分類變量。