2020-2021下學(xué)期可視化課程復(fù)習(xí)
降維：PCA,t-SNE,UMAP.SOM,LLE
聚類：k-MEANS,DBSCAN,OPTICS
準(zhǔn)備加載包
library("tidyverse")
library("mclust")
library("GGally")
library("factoextra")
install.packages("Rtsne")
library("Rtsne")
library(umap)
install.packages("kohonen")
library("kohonen")
install.packages("lle")
library("lle")
library(plot3D)
library("rgl")
library("plot3Drgl")
各個(gè)PC(主要成分)必須正交(線性不相關(guān))
PCA降維eg1:聯(lián)邦財(cái)政的假鈔識(shí)別
將banknote轉(zhuǎn)換為tibble數(shù)據(jù)格式
note <- as_tibble(mclust::banknote)
note
ggpairs(data,aes(col= ))表示創(chuàng)建散點(diǎn)圖矩陣
theme_bw()表示白色背景主題,theme是解決圖是否美觀的一個(gè)工具袜瞬，與scale最大的區(qū)別在于不受數(shù)據(jù)左右；先scale再theme
ggpairs(note,aes(col=Status))+theme_bw()
聯(lián)邦財(cái)務(wù)部假鈔識(shí)別數(shù)據(jù)散點(diǎn)圖矩陣
正式進(jìn)行pca降維,dplyr::select()由于Rstudio中有多個(gè)包含有select函數(shù)摔吏，需要指定包才能正常使用select()函數(shù)
prcomp()主成分分析的函數(shù)疯暑，center與scale均為對(duì)數(shù)據(jù)進(jìn)行標(biāo)準(zhǔn)化處理饰及，center(中心化)將數(shù)據(jù)減去均值(有多的異常點(diǎn)右蕊，不中心化),scale(標(biāo)準(zhǔn)化)在中心化后的基礎(chǔ)上再除以數(shù)據(jù)的標(biāo)準(zhǔn)差,使各個(gè)變量均在同樣的可比較范圍內(nèi)
pca <- dplyr::select(note, -Status) %>%
prcomp(center = T, scale = T)
PCA處理后的4個(gè)主成分
summary(pca)
PCA各個(gè)主成分的統(tǒng)計(jì)描述變量值
map_dfc()表示將計(jì)算結(jié)果以列的方式展現(xiàn)
pca中的rotation行與sdev的列相乘,表示旋轉(zhuǎn)之后的軸與現(xiàn)軸之間的關(guān)系
#特征值分解
#rotation特征向量
#sdev特征值的開方
map_dfc(1:6,~pca$rotation[,.]*sqrt(pca$sdev^2)[.])
image.png
prcomp函數(shù)輸出有sdev(各主成份的奇異值),rotation(特征向量,回歸系數(shù)),x(score得分矩陣)
pcaDat <- get_pca(pca)
image.png
#碎石圖,直接把x與rotation繪圖，而不標(biāo)準(zhǔn)化
fviz_pca_biplot(pca, label = "var")
#變量相關(guān)性可視化圖
fviz_pca_var(pca)
#coord是坐標(biāo)(實(shí)際的loading)脯丝，與cor數(shù)值相同
#coord=eigen vector * stdev
#相關(guān)圖中商膊，靠近的變量表示正相關(guān)；對(duì)向的是負(fù)相關(guān)宠进。
#箭頭越遠(yuǎn)離遠(yuǎn)原點(diǎn)晕拆、越靠經(jīng)圓圈表明PC對(duì)其的代表性高（相關(guān)性強(qiáng)）
fviz_screeplot(pca, addlabels = T, choice = "eigenvalue")
#碎石圖,展示方差解釋度
fviz_screeplot(pca, addlabels = T, choice = "variance")
image.png
image.png
image.png
image.png
notePCA <- note %>%
mutate(PCA1 = pca$x[,1], PCA2 = pca$x[,2])
ggplot(notePCA, aes(PCA1, PCA2, col = Status)) +
geom_point()
image.png
newNotes <- tibble::tibble(
Length = c(214, 216),
Left = c(130, 128),
Right = c(132, 129),
Bottom = c(12, 7),
Top = c(12, 8),
Diagonal = c(138, 142)
)
newPCA <- predict(pca, newNotes) %>% as_tibble()
ggplot(notePCA, aes(PCA1, PCA2, col = Status)) +
geom_point() +
stat_ellipse(level = 0.90) +
geom_point(data = newPCA, aes(PC1,PC2),col = "black", size = 4)
image.png
