一、 t-SNE

非線性降維，計(jì)算數(shù)據(jù)集中每行與其他行的距離（默認(rèn)為歐氏距離）轉(zhuǎn)換為概率。
PCA屬于線性降維，不能解釋復(fù)雜多項(xiàng)式之間的關(guān)系，t-SNE是根據(jù)t分布隨機(jī)領(lǐng)域的嵌入找到數(shù)據(jù)之間的結(jié)構(gòu)特點(diǎn)。原始空間中的相似度由高斯聯(lián)合概率表示，嵌入空間的相似度由“學(xué)生t分布”表示。
加載所需包

library(tidyverse)
pacman::p_load(Rtsne,umap,kohonen,lle)

【步驟】

第一步：計(jì)算數(shù)據(jù)集中每行與其他行的距離（默認(rèn)為歐式距離），轉(zhuǎn)換為概率向量；
第二步：對(duì)每一行重復(fù)操作，得到概率矩陣；
第三步：沿兩條新軸用學(xué)生t分布對(duì)數(shù)據(jù)隨機(jī)化；
第四步：逐漸迭代，通過最小化KL散度，使得二維空間的新概率矩陣盡可能接近原高維空間。

【特點(diǎn)】

較于正態(tài)分布，使用t分布能更好地分散可能的數(shù)據(jù)簇，更易識(shí)別；基于所實(shí)現(xiàn)的精度，將t-SNE與PCA和其他線性降維模型相比，結(jié)果表明t-SNE能夠提供更好的結(jié)果,這是因?yàn)樗惴ǘx了數(shù)據(jù)的局部和全局結(jié)構(gòu)之間的軟邊界。
缺點(diǎn)：不能保留全局結(jié)構(gòu)、.計(jì)算量較大、不可預(yù)測(cè)新數(shù)據(jù)、無法像PCA一樣投影新數(shù)據(jù)、簇間距離意義不大。

【參數(shù)】

dims ：參數(shù)設(shè)置降維之后的維度，默認(rèn)值為2
perplexity：控制距離轉(zhuǎn)化為概率的分布：局部結(jié)構(gòu) 5-30-50 全局結(jié)構(gòu)，取值小于 (nrow(data) - 1)/ 3，數(shù)據(jù)集越大，需要參數(shù)值越大;
theta：權(quán)衡速度與精度，取值越大，精度越低。精確 0-0.5-1 最快，默認(rèn)值0.5；
eta：學(xué)習(xí)率，越少越精確，越多迭代次數(shù)越少，默認(rèn)值200；
max_iter：最多迭代次數(shù)，默認(rèn)值1000。

【例】

真假鈔數(shù)據(jù),將banknote數(shù)據(jù)集去掉Status標(biāo)簽列后賦值給 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)

• 查看降維后的數(shù)據(jù)結(jié)構(gòu)

str( bn.tsne)

• 查看降維后的數(shù)據(jù)

head(bn.tsne$Y)

可視化

note %>%
*將數(shù)值型變量標(biāo)準(zhǔn)化
mutate(across(where(is.numeric), .fns = scale)) %>%
*將降維后的數(shù)據(jù)加入數(shù)據(jù)框
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")

查看每個(gè)特征的降維效果圖：

note %>%
*將數(shù)值型變量標(biāo)準(zhǔn)化
mutate(across(where(is.numeric), .fns = scale)) %>%
*將降維后的數(shù)據(jù)加入數(shù)據(jù)框
mutate(tsne1 = bn.tsneY[, 2]) %>%
*保留tsne1, tsne2, Status列，將其他列寬表變長(zhǎng)表，便于畫圖
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")

http://www.itdecent.cn/p/824be2661d42

二、 UMAP

假設(shè)數(shù)據(jù)分布在流形上，并沿著流形測(cè)量行間距離，利用流形學(xué)和投影技術(shù)達(dá)到降維目的。

【步驟】

第一步，計(jì)算高維空間中的點(diǎn)之間的距離，將它們投影到低維空間，并計(jì)算該低維空間中的點(diǎn)之間的距離；
第二步，使用隨機(jī)梯度下降來最小化這些距離之間的差異。

【 特點(diǎn)】

相較于 t-SNE ，計(jì)算量較小、可預(yù)測(cè)新數(shù)據(jù)、確定性算法、保留雙結(jié)構(gòu)

【參數(shù)】

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

【例】

arrests <- USArrests
*查看數(shù)據(jù)結(jié)構(gòu)
str(arrests)

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

*檢查缺失值
DataExplorer::profile_missing(arrests)
summary(arrests)

使用曼哈頓距離
arrests.umap <- umap(arrests, n_neibours = 7, min_dist = 0.05,
metric = "manhattan", n_epochs = 200, verbose = F)
*查看降維后的數(shù)據(jù)
arrests.umap$layout %>%
head()

【可視化】

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， 再運(yùn)行 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()

http://www.itdecent.cn/p/ffe8a7e1e5a0

三、 SOM

是一種自組織（競(jìng)爭(zhēng)型）神經(jīng)網(wǎng)絡(luò)，用兩個(gè)維度來表示一個(gè)數(shù)據(jù)集，使相似的行更靠近。將距離小的個(gè)體集合劃分為同一類別，距離大的個(gè)體集合劃分為不同類別。
相較于K-means，SOM無需預(yù)先提供聚類數(shù)量。

【特點(diǎn)】

SOM 與 LLE 的優(yōu)點(diǎn)：非線性還原算法、新數(shù)據(jù)可以映射到SOM上、訓(xùn)練成本相當(dāng)不高、LLE算法可重復(fù)。

SOM 與 LLE 的缺點(diǎn)：

1.不能處理分類變量。
2.不能直接用原始變量解釋。
3.對(duì)不同尺度的數(shù)據(jù)很敏感。
4.新數(shù)據(jù)不能映射到LLE上。
5.不一定保留數(shù)據(jù)的全局結(jié)構(gòu)。
6.SOM算法每次都會(huì)產(chǎn)生不同的結(jié)果。
7.SOM在大型數(shù)據(jù)集上效果更好。

【步驟】

1.輸入層網(wǎng)絡(luò)：輸入層網(wǎng)絡(luò)節(jié)點(diǎn)與數(shù)據(jù)集同行數(shù)，同列數(shù)，但數(shù)據(jù)集需要?dú)w一化。
2.輸出層網(wǎng)絡(luò)：一般根據(jù)數(shù)據(jù)集的維度來構(gòu)建輸出層網(wǎng)絡(luò)。
（例：二維情況，希望分為4類，輸出層可設(shè)計(jì)為4*2的矩陣）
3.隨機(jī)給每個(gè)節(jié)點(diǎn)分配權(quán)重
根據(jù)輸入層的數(shù)據(jù)集的維度和輸出層的的預(yù)估分類數(shù)，定義權(quán)重節(jié)點(diǎn)的維度。
（例：數(shù)據(jù)集是二維的，權(quán)重的行數(shù)就定為2，分4類，權(quán)重的列數(shù)就選4。權(quán)重值一般給定一個(gè)0-1之間的隨機(jī)值）
4.隨機(jī)選擇一行，并計(jì)算其與網(wǎng)格中每個(gè)節(jié)點(diǎn)權(quán)重的距離（相似度，通常為歐式距離），把此行放到權(quán)重與該行距離最小的節(jié)點(diǎn)中（BMU，best matching unit）。
5.更新BMU（基本思想是：越靠近優(yōu)勝節(jié)點(diǎn)，更新幅度越大；越遠(yuǎn)離優(yōu)勝節(jié)點(diǎn)，更新幅度越?。┘捌溧徲騼?nèi)節(jié)點(diǎn)的權(quán)重（取決于鄰域函數(shù)）。
6.重復(fù)步驟3-5，迭代指定次數(shù)。

【案例】

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是廣泛使用的圖形圖像降維方法，屬于流形學(xué)習(xí)(Manifold Learning)的一種，實(shí)現(xiàn)簡(jiǎn)單，其假設(shè)數(shù)據(jù)在較小的局部是線性的，也就是說，某一個(gè)數(shù)據(jù)可以由它鄰域中的幾個(gè)樣本來線性表示。（LLE 非常適合處理卷起或扭曲狀的數(shù)據(jù)，但不能是閉合流形，不能是稀疏的數(shù)據(jù)集，不能是分布不均勻的數(shù)據(jù)集等等，這限制了它的應(yīng)用。）

【步驟】

1.計(jì)算行間距，設(shè)定超參數(shù)k。
2.對(duì)一行選出其最近的k行，表示為其線性組合，該線性組合系數(shù)為權(quán)重。
3.對(duì)每行重復(fù)操作，使得數(shù)據(jù)在2或3維空間中（近乎）保持該線性組合關(guān)系。

【特點(diǎn)】

優(yōu)點(diǎn)：可以學(xué)習(xí)任意維的局部線性的低維流形、計(jì)算復(fù)雜度相對(duì)較小、實(shí)現(xiàn)容易。
缺點(diǎn)：算法對(duì)最近鄰樣本數(shù)的選擇敏感，不同的最近鄰數(shù)對(duì)最后的降維結(jié)果有很大影響。

【參數(shù)】

除了維數(shù)，k （近鄰數(shù)量）是唯一需要確定的超參數(shù)，K可以通過函數(shù)計(jì)算出來：calc_k()
① m 表示維數(shù)，通常2 或 3
② kmin，kmax 決定 k 取值域
③ parallel，是否多核運(yùn)行，默認(rèn)為否
④ cpus 指定使用 cpu 核數(shù)

【案例】

準(zhǔn)備數(shù)據(jù)

data(lle_scurve_data, package = "lle")
scurve <- as.data.frame(lle_scurve_data)
str(scurve)

設(shè)置列名

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圖像可以用鼠標(biāo)轉(zhuǎn)動(dòng)

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

使用最優(yōu)的K值，降維：

lle.scurve <- lle(scurve, m = 2, k = k$k)
str(lle.scurve)

使用降維后的數(shù)據(jù)畫圖：

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