Redução de Dimensionalidade
lsj
August 21, 2019
aula de hoje: redução de dimensionalidade
- PCA: análise de componentes principais
- LLE: locally linear embbeding
- o pacote dimRed e algoritmos de redução de dimensionalidade
1. PCA - Análise de Componentes Principais
PCA é uma excelente técnica para vizualização de dados multidimensionais. Vamos ilustrar o PCA inicialmente com dados do levantamento fotométrico S-PLUS, que utiliza um sistema de 12 filtros para obter bons redshifts fotométricos e estudar evolução de galáxias. Aqui vamos considerar apenas as cores (11) de galáxias com redshifts fotométricos entre 0.10 e 0.15 com fotometria em todas as bandas. A precisão dos redshifts fotométricos do S-PLUS é \(\sim \Delta_z/(1+z) = 0.02\)
inicialização
set.seed(123)
library(lle)## Loading required package: scatterplot3d## Loading required package: MASS## Loading required package: snowfall## Loading required package: snowlibrary(plot3D)
library(KernSmooth)## KernSmooth 2.23 loaded
## Copyright M. P. Wand 1997-2009library(dimRed)## Loading required package: DRR## Loading required package: kernlab## Loading required package: CVST## Loading required package: Matrix##
## Attaching package: 'dimRed'## The following object is masked from 'package:stats':
##
## embed## The following object is masked from 'package:base':
##
## as.data.framelibrary(fastICA)
library(RSpectra)
library(keras)
library(corrplot)## corrplot 0.84 loadedt0 = Sys.time()leitura dos dados do S-PLUS: cores relativas à banda r_petro
cores = read.table('cores010015.dat',header=T, fill=T)Algumas características destes dados:
dim(cores)## [1] 1575 11head(cores)## uJAVA_petro.r_petro F378_petro.r_petro F395_petro.r_petro
## 1 2.20 1.74 1.25
## 2 1.17 2.22 1.02
## 3 1.23 0.94 0.92
## 4 1.96 1.63 1.71
## 5 1.82 1.61 0.93
## 6 2.00 2.04 2.01
## F410_petro.r_petro F430_petro.r_petro g_petro.r_petro F515_petro.r_petro
## 1 1.34 0.65 0.56 0.26
## 2 0.57 0.54 0.31 0.22
## 3 0.69 0.31 0.27 0.49
## 4 1.37 0.97 0.67 0.33
## 5 0.36 0.74 0.32 0.48
## 6 0.91 0.89 0.71 0.26
## F660_petro.r_petro i_petro.r_petro F861_petro.r_petro z_petro.r_petro
## 1 -0.32 -0.38 -0.65 -0.74
## 2 -0.09 -0.24 -0.41 -0.47
## 3 0.01 0.16 -0.28 -0.07
## 4 -0.16 -0.35 -0.49 -0.56
## 5 -0.09 -0.23 -0.35 -0.42
## 6 -0.19 -0.36 -0.62 -0.50Vamos agora calcular o PCA, padronizando as variáveis com média zero e variância unitária:
pca.cores = prcomp(cores, retx=TRUE, center=TRUE, scale=TRUE)
# raiz quadrada dos autovalores
sd = pca.cores$sdev
# autovalores
lambda = sd^2
# fraçao da variância explicada
round(cumsum(lambda)/sum(lambda),digits = 2)## [1] 0.38 0.55 0.62 0.69 0.75 0.80 0.85 0.90 0.94 0.97 1.00# autovetores
autovec = pca.cores$rotation
# componentes principais
pc = pca.cores$x
# scree plot
screeplot(pca.cores, main=" scree plot")
# duas primeiras componentes
par(mfrow = c(1,1))
plot(pc[,1], pc[,2], xlab="PCA 1", ylab="PCA 2",asp=1,pch=20,col='red')
par(mfrow = c(2,2))
smoothScatter(pc[,1],pc[,2],nrpoints=0,add=FALSE,, xlab='pc1', ylab='pc2', main = '',asp = 1)
smoothScatter(pc[,1],pc[,3],nrpoints=0,add=FALSE,, xlab='pc1', ylab='pc3', main = '',asp = 1)
smoothScatter(pc[,1],pc[,4],nrpoints=0,add=FALSE,, xlab='pc1', ylab='pc4', main = '',asp = 1)
smoothScatter(pc[,2],pc[,3],nrpoints=0,add=FALSE,, xlab='pc2', ylab='pc3', main = '',asp = 1)
distância de Mahalanobis: distância entre dois pontos num espaço multivariado que leva em conta a correlação entre variáveis:
\[ D_{M}(x)={\sqrt {(x-\mu )^{T}S^{-1}(x-\mu )}} \] \(S\): matriz de covariância
ndim=dim(cores)[2]
for (j in 1:ndim){
media= mean(cores[,j])
sdj=sd(cores[,j])
mah = mahalanobis(cores,center=T,cov=cov(cores))}
par(mfrow = c(1,1))
id = seq(1,dim(cores)[1],1)
lmah = log10(mah)
plot(id,lmah,main = 'log da distância de mahalanobis', xlab= 'obj id', ylab = 'log(D)')
esta distância muitas vezes é usada para se identificar outliers
vamos agora examinar a relação entre as cores das galáxias e as duas primeiras componentes principais via análise de correlação:
# primeiro criamos uma matriz com as cores e as duas componentes principais do PCA:
aux = cbind(pc[,1],pc[,2],cores)
# análise de correlação
correlacao = cor(aux, method = "spearman")
#jpeg('corr.jpg')
par(mfrow = c(1,1))
corrplot(correlacao, type = "upper", tl.col = "black", tl.srt = 45)
# coeficientes de correlação:
aux = as.matrix(cbind(pc[,1],pc[,2],cores))
aux = cbind(pc[,1],pc[,2],cores)
correlacao = cor(aux, method = "spearman")
#jpeg('corr.jpg')
par(mfrow = c(1,1))
corrplot(correlacao, type = "upper", tl.col = "black", tl.srt = 45)
correlacao## pc[, 1] pc[, 2] uJAVA_petro.r_petro
## pc[, 1] 1.000000000 0.006698229 -0.6524729
## pc[, 2] 0.006698229 1.000000000 -0.1726259
## uJAVA_petro.r_petro -0.652472855 -0.172625895 1.0000000
## F378_petro.r_petro -0.608852513 -0.274933913 0.3896224
## F395_petro.r_petro -0.575784243 -0.204968282 0.3649365
## F410_petro.r_petro -0.647016219 -0.199632375 0.3757954
## F430_petro.r_petro -0.741433053 -0.199426000 0.4483620
## g_petro.r_petro -0.805285825 -0.198609568 0.5444221
## F515_petro.r_petro -0.504383450 -0.473605986 0.3606841
## F660_petro.r_petro 0.325454282 -0.701436910 -0.1067624
## i_petro.r_petro 0.653802017 -0.492704133 -0.3223626
## F861_petro.r_petro 0.667730949 -0.415956510 -0.3567251
## z_petro.r_petro 0.743311181 -0.365980353 -0.3719825
## F378_petro.r_petro F395_petro.r_petro
## pc[, 1] -0.6088525 -0.57578424
## pc[, 2] -0.2749339 -0.20496828
## uJAVA_petro.r_petro 0.3896224 0.36493647
## F378_petro.r_petro 1.0000000 0.36150573
## F395_petro.r_petro 0.3615057 1.00000000
## F410_petro.r_petro 0.4178213 0.35728748
## F430_petro.r_petro 0.4616368 0.41635390
## g_petro.r_petro 0.4939474 0.43303139
## F515_petro.r_petro 0.3580908 0.33037524
## F660_petro.r_petro -0.0347785 -0.08794922
## i_petro.r_petro -0.2805226 -0.28910284
## F861_petro.r_petro -0.2917768 -0.29126457
## z_petro.r_petro -0.3453992 -0.31870845
## F410_petro.r_petro F430_petro.r_petro g_petro.r_petro
## pc[, 1] -0.64701622 -0.74143305 -0.80528583
## pc[, 2] -0.19963237 -0.19942600 -0.19860957
## uJAVA_petro.r_petro 0.37579541 0.44836203 0.54442211
## F378_petro.r_petro 0.41782128 0.46163682 0.49394739
## F395_petro.r_petro 0.35728748 0.41635390 0.43303139
## F410_petro.r_petro 1.00000000 0.47561127 0.53214639
## F430_petro.r_petro 0.47561127 1.00000000 0.63539454
## g_petro.r_petro 0.53214639 0.63539454 1.00000000
## F515_petro.r_petro 0.32081262 0.42426497 0.47998641
## F660_petro.r_petro -0.09885729 -0.09918295 -0.08867052
## i_petro.r_petro -0.32850582 -0.37118170 -0.37204490
## F861_petro.r_petro -0.31499528 -0.39030704 -0.47144753
## z_petro.r_petro -0.39542018 -0.45835752 -0.52193909
## F515_petro.r_petro F660_petro.r_petro i_petro.r_petro
## pc[, 1] -0.5043834 0.32545428 0.6538020
## pc[, 2] -0.4736060 -0.70143691 -0.4927041
## uJAVA_petro.r_petro 0.3606841 -0.10676240 -0.3223626
## F378_petro.r_petro 0.3580908 -0.03477850 -0.2805226
## F395_petro.r_petro 0.3303752 -0.08794922 -0.2891028
## F410_petro.r_petro 0.3208126 -0.09885729 -0.3285058
## F430_petro.r_petro 0.4242650 -0.09918295 -0.3711817
## g_petro.r_petro 0.4799864 -0.08867052 -0.3720449
## F515_petro.r_petro 1.0000000 0.10532002 -0.1325445
## F660_petro.r_petro 0.1053200 1.00000000 0.5178519
## i_petro.r_petro -0.1325445 0.51785191 1.0000000
## F861_petro.r_petro -0.1848162 0.45489911 0.5936204
## z_petro.r_petro -0.2260435 0.43140362 0.6822189
## F861_petro.r_petro z_petro.r_petro
## pc[, 1] 0.6677309 0.7433112
## pc[, 2] -0.4159565 -0.3659804
## uJAVA_petro.r_petro -0.3567251 -0.3719825
## F378_petro.r_petro -0.2917768 -0.3453992
## F395_petro.r_petro -0.2912646 -0.3187085
## F410_petro.r_petro -0.3149953 -0.3954202
## F430_petro.r_petro -0.3903070 -0.4583575
## g_petro.r_petro -0.4714475 -0.5219391
## F515_petro.r_petro -0.1848162 -0.2260435
## F660_petro.r_petro 0.4548991 0.4314036
## i_petro.r_petro 0.5936204 0.6822189
## F861_petro.r_petro 1.0000000 0.6013348
## z_petro.r_petro 0.6013348 1.00000002. LLE: locally linear embbeding
pacote LLE
vamos considerar inicialmente a curva S em 3 dimensões:
data(lle_scurve_data)
X <- lle_scurve_data
head(X, n=6)## [,1] [,2] [,3]
## [1,] 0.9553277 4.9512047 -0.1744640
## [2,] -0.6600097 3.2669075 -0.7732213
## [3,] -0.9832013 1.2573407 -0.2963627
## [4,] 0.9543690 1.6825490 -0.1797167
## [5,] 0.9576142 0.1857008 -0.1612359
## [6,] 0.8520630 0.5582119 -0.4707255# plot 3-D dos dados
par(mfrow = c(1,1))
scatterplot3d(x=X[,1], y=X[,2], z=X[,3], color=X[,2])
a análise depende do número de vizinhos de cada ponto
se o número de vizinhos é pequeno, o mapeamento não vai refletir nenhuma propriedade global, enquanto que se for muito grande vais perder seu caráter não-linear e se comportar como PCA
vamos inicialmente ver o resultado para vários valores do número de vizinhos k:
# K=5
# m: dimensão intrínseca dos dados- para visualização; a dimensão intrínseca é calculada pelo programa
# reg: método de regularização
# v:
k5 <- lle(X, m=2, k=5, reg=2, ss=FALSE, id=TRUE, v=0.9 )## finding neighbours
## calculating weights
## intrinsic dim: mean=1.92125, mode=2
## computing coordinatesplot(k5$Y, main="K=5 data", xlab=expression(y[1]), ylab=expression(y[2]))
# K=15
k15 <- lle(X, m=2, k=15, reg=2, ss=FALSE, id=TRUE, v=0.9 )## finding neighbours
## calculating weights
## intrinsic dim: mean=2, mode=2
## computing coordinatesplot(k15$Y, main="K=15 data", xlab=expression(y[1]), ylab=expression(y[2]))
# K=40
k40 <- lle(X, m=2, k=40, reg=2, ss=FALSE, id=TRUE, v=0.9 )## finding neighbours
## calculating weights
## intrinsic dim: mean=2.00625, mode=2
## computing coordinatesplot(k40$Y, main="K=40 data", xlab=expression(y[1]), ylab=expression(y[2]))
o pacote lle tem uma rotina para escolher o “melhor” valor de k:
# deve-se escolher k que dá o menor valor de 1-rho^2
par(mfrow = c(1,1))
calc_k(X, m=2, kmin=1, kmax=40, plotres=TRUE, parallel=TRUE, cpus=8, iLLE=FALSE)## Warning in searchCommandline(parallel, cpus = cpus, type = type,
## socketHosts = socketHosts, : Unknown option on commandline:
## rmarkdown::render('/home/laerte/cursos/dados/2019B/aula3/R/
## aula3.Rmd',~+~~+~encoding~+~## R Version: R version 3.6.1 (2019-07-05)## snowfall 1.84-6.1 initialized (using snow 0.4-3): parallel execution on 8 CPUs.## Library lle loaded.## Library lle loaded in cluster.##
## Stopping cluster
## k rho
## 1 1 0.9987824
## 2 2 0.9876860
## 3 3 0.9925197
## 4 4 0.9127051
## 5 5 0.6969111
## 6 6 0.6765670
## 7 7 0.4045646
## 8 8 0.4181170
## 9 9 0.3045077
## 10 10 0.2730377
## 11 11 0.1722015
## 12 12 0.1522597
## 13 13 0.1589914
## 14 14 0.1489428
## 15 15 0.1605777
## 16 16 0.1512468
## 17 17 0.1468803
## 18 18 0.2965946
## 19 19 0.1507325
## 20 20 0.1694365
## 21 21 0.2238161
## 22 22 0.1745816
## 23 23 0.2007847
## 24 24 0.2011773
## 25 25 0.2389543
## 26 26 0.2231868
## 27 27 0.3097121
## 28 28 0.2208020
## 29 29 0.4766895
## 30 30 0.2791912
## 31 31 0.1252955
## 32 32 0.1472460
## 33 33 0.1350042
## 34 34 0.1492596
## 35 35 0.1546612
## 36 36 0.1470390
## 37 37 0.1288793
## 38 38 0.1175156
## 39 39 0.1228238
## 40 40 0.1176667escolhendo k=31:
k31 <- lle(X, m=2, k=31, reg=2, ss=FALSE, id=TRUE, v=0.9 )## finding neighbours
## calculating weights
## intrinsic dim: mean=2, mode=2
## computing coordinatesplot(k31$Y, main="K=31 data", xlab=expression(y[1]), ylab=expression(y[2]))
uma das saídas do lle é o “número intrínseco de dimensões”: isso é definido pelo número de componentes que “explicam” uma fração \(v\) da variância; em geral se usa \(v\) entre 0.9 e 0.99
Vamos agora analisar nossa amostra com as cores das galáxias do S-PLUS. Vamos começar vendo os resultados para alguns valores de k:
k5 <- lle(cores, m=2, k=5, reg=2, ss=FALSE, id=TRUE, v=0.9 )## finding neighbours
## calculating weights
## intrinsic dim: mean=3.364444, mode=3
## computing coordinatesplot(k5$Y, main="K=5 data", xlab=expression(y[1]), ylab=expression(y[2]))
# K=15
k15 <- lle(cores, m=2, k=15, reg=2, ss=FALSE, id=TRUE, v=0.9 )## finding neighbours
## calculating weights
## intrinsic dim: mean=5.069841, mode=5
## computing coordinatesplot(k15$Y, main="K=15 data", xlab=expression(y[1]), ylab=expression(y[2]))
# K=40
k40 <- lle(cores, m=2, k=40, reg=2, ss=FALSE, id=TRUE, v=0.9 )## finding neighbours
## calculating weights
## intrinsic dim: mean=5.653333, mode=6
## computing coordinatesplot(k40$Y, main="K=40 data", xlab=expression(y[1]), ylab=expression(y[2]))
qual seria o melhor valor de k?
calc_k(cores, m=2, kmin=1, kmax=40, plotres=TRUE, parallel=TRUE, cpus=8, iLLE=FALSE)## Warning in searchCommandline(parallel, cpus = cpus, type = type,
## socketHosts = socketHosts, : Unknown option on commandline:
## rmarkdown::render('/home/laerte/cursos/dados/2019B/aula3/R/
## aula3.Rmd',~+~~+~encoding~+~## snowfall 1.84-6.1 initialized (using snow 0.4-3): parallel execution on 8 CPUs.## Library lle loaded.## Library lle loaded in cluster.##
## Stopping cluster
## k rho
## 1 1 0.9980250
## 2 2 0.9877269
## 3 3 0.8519231
## 4 4 0.8395129
## 5 5 0.7685058
## 6 6 0.8027322
## 7 7 0.7554615
## 8 8 0.8276032
## 9 9 0.8679262
## 10 10 0.8752581
## 11 11 0.7889229
## 12 12 0.8468184
## 13 13 0.7057745
## 14 14 0.7284917
## 15 15 0.6521474
## 16 16 0.5215134
## 17 17 0.4460243
## 18 18 0.4458253
## 19 19 0.5474950
## 20 20 0.4220398
## 21 21 0.3506301
## 22 22 0.4803771
## 23 23 0.3790212
## 24 24 0.3218850
## 25 25 0.3855203
## 26 26 0.3637025
## 27 27 0.4670727
## 28 28 0.3751212
## 29 29 0.4447791
## 30 30 0.3710600
## 31 31 0.3207646
## 32 32 0.3997840
## 33 33 0.3437415
## 34 34 0.3808011
## 35 35 0.3817986
## 36 36 0.4371570
## 37 37 0.4006051
## 38 38 0.4109186
## 39 39 0.3420062
## 40 40 0.3489851para k=24:
k24 <- lle(cores, m=2, k=24, reg=2, ss=FALSE, id=TRUE, v=0.9 )## finding neighbours
## calculating weights
## intrinsic dim: mean=5.466032, mode=6
## computing coordinatesplot(k24$Y, main="K=24 data", xlab=expression(y[1]), ylab=expression(y[2]))
plot(k24$id, main="intrinsic dimension", type="l", xlab=expression(x[i]), ylab="id", lwd=2 )
vamos agora examinar a correlação entre as cores das galáxias e suas coordenadas no espaço reduzido:
# criamos uma matriz com as cores e as duas dimensões do espaço projetado:
aux = cbind(k24$Y,cores)
# análise de correlação
correlacao = cor(aux, method = "spearman")
par(mfrow = c(1,1))
corrplot(correlacao, type = "upper", tl.col = "black", tl.srt = 45)
correlacao## 1 2 uJAVA_petro.r_petro
## 1 1.00000000 0.09382637 0.6769820
## 2 0.09382637 1.00000000 0.3616589
## uJAVA_petro.r_petro 0.67698204 0.36165887 1.0000000
## F378_petro.r_petro 0.25315451 0.75734277 0.3896224
## F395_petro.r_petro 0.82548166 0.28296875 0.3649365
## F410_petro.r_petro 0.18784748 0.70597318 0.3757954
## F430_petro.r_petro 0.34291068 0.77402692 0.4483620
## g_petro.r_petro 0.42703354 0.63967239 0.5444221
## F515_petro.r_petro 0.34975798 0.40953160 0.3606841
## F660_petro.r_petro -0.08291645 -0.12263624 -0.1067624
## i_petro.r_petro -0.26122251 -0.41973686 -0.3223626
## F861_petro.r_petro -0.28855249 -0.43682312 -0.3567251
## z_petro.r_petro -0.27476398 -0.51628293 -0.3719825
## F378_petro.r_petro F395_petro.r_petro
## 1 0.2531545 0.82548166
## 2 0.7573428 0.28296875
## uJAVA_petro.r_petro 0.3896224 0.36493647
## F378_petro.r_petro 1.0000000 0.36150573
## F395_petro.r_petro 0.3615057 1.00000000
## F410_petro.r_petro 0.4178213 0.35728748
## F430_petro.r_petro 0.4616368 0.41635390
## g_petro.r_petro 0.4939474 0.43303139
## F515_petro.r_petro 0.3580908 0.33037524
## F660_petro.r_petro -0.0347785 -0.08794922
## i_petro.r_petro -0.2805226 -0.28910284
## F861_petro.r_petro -0.2917768 -0.29126457
## z_petro.r_petro -0.3453992 -0.31870845
## F410_petro.r_petro F430_petro.r_petro g_petro.r_petro
## 1 0.18784748 0.34291068 0.42703354
## 2 0.70597318 0.77402692 0.63967239
## uJAVA_petro.r_petro 0.37579541 0.44836203 0.54442211
## F378_petro.r_petro 0.41782128 0.46163682 0.49394739
## F395_petro.r_petro 0.35728748 0.41635390 0.43303139
## F410_petro.r_petro 1.00000000 0.47561127 0.53214639
## F430_petro.r_petro 0.47561127 1.00000000 0.63539454
## g_petro.r_petro 0.53214639 0.63539454 1.00000000
## F515_petro.r_petro 0.32081262 0.42426497 0.47998641
## F660_petro.r_petro -0.09885729 -0.09918295 -0.08867052
## i_petro.r_petro -0.32850582 -0.37118170 -0.37204490
## F861_petro.r_petro -0.31499528 -0.39030704 -0.47144753
## z_petro.r_petro -0.39542018 -0.45835752 -0.52193909
## F515_petro.r_petro F660_petro.r_petro i_petro.r_petro
## 1 0.3497580 -0.08291645 -0.2612225
## 2 0.4095316 -0.12263624 -0.4197369
## uJAVA_petro.r_petro 0.3606841 -0.10676240 -0.3223626
## F378_petro.r_petro 0.3580908 -0.03477850 -0.2805226
## F395_petro.r_petro 0.3303752 -0.08794922 -0.2891028
## F410_petro.r_petro 0.3208126 -0.09885729 -0.3285058
## F430_petro.r_petro 0.4242650 -0.09918295 -0.3711817
## g_petro.r_petro 0.4799864 -0.08867052 -0.3720449
## F515_petro.r_petro 1.0000000 0.10532002 -0.1325445
## F660_petro.r_petro 0.1053200 1.00000000 0.5178519
## i_petro.r_petro -0.1325445 0.51785191 1.0000000
## F861_petro.r_petro -0.1848162 0.45489911 0.5936204
## z_petro.r_petro -0.2260435 0.43140362 0.6822189
## F861_petro.r_petro z_petro.r_petro
## 1 -0.2885525 -0.2747640
## 2 -0.4368231 -0.5162829
## uJAVA_petro.r_petro -0.3567251 -0.3719825
## F378_petro.r_petro -0.2917768 -0.3453992
## F395_petro.r_petro -0.2912646 -0.3187085
## F410_petro.r_petro -0.3149953 -0.3954202
## F430_petro.r_petro -0.3903070 -0.4583575
## g_petro.r_petro -0.4714475 -0.5219391
## F515_petro.r_petro -0.1848162 -0.2260435
## F660_petro.r_petro 0.4548991 0.4314036
## i_petro.r_petro 0.5936204 0.6822189
## F861_petro.r_petro 1.0000000 0.6013348
## z_petro.r_petro 0.6013348 1.0000000Compare as cores “mais explicativas” nesse caso com as obtidas por PCA
3. o pacote dimRed
O R tem um pacote, o dimRed, que reune os principais algoritmos de redução de dimensionalidade, com uma interface comum para análise e plot.
para saber os métodos disponíveis:
dimRedMethodList()## [1] "AutoEncoder" "DiffusionMaps" "DRR"
## [4] "FastICA" "KamadaKawai" "DrL"
## [7] "FruchtermanReingold" "HLLE" "Isomap"
## [10] "kPCA" "PCA_L1" "LaplacianEigenmaps"
## [13] "LLE" "MDS" "nMDS"
## [16] "NNMF" "PCA" "tSNE"
## [19] "UMAP"o pacote disponibiliza também vários conjuntos de dados para testes:
## lista dos conjuntos de dados disponíveis:
dataSetList()## [1] "Swiss Roll" "Broken Swiss Roll" "Helix"
## [4] "Twin Peaks" "Sphere" "Ball"
## [7] "FishBowl" "3D S Curve" "variable Noise Helix"
## [10] "Iris" "Cube"## para carregar um conjunto de dados:
curva_s <- loadDataSet("3D S Curve")
plot(curva_s, type = "3vars")
neste pacote a função embed é usada para implementar os métodos de redução de dimensionalidade.
vamos fazer um teste com LLE aplicado à curva S usando 45 vizinhos:
emb_LLE <- embed(curva_s, "LLE", knn = 45)## finding neighbours
## calculating weights
## computing coordinatesprint(emb_LLE)## Method:
## lle
## Parameters:
## List of 2
## $ knn : num 45
## $ ndim: num 2plot(emb_LLE, type = "2vars")
como avaliar a qualidade da redução de dimensionalidade?
do manual do dimRed:
Rank based criteria
Q_local, Q_global, and mean_R_nx are quality criteria based on the Co-ranking matrix. Q_local and Q_global determine the local/global quality of the embedding, while mean_R_nx determines the quality of the overall embedding. They are parameter free and return a single number. The object must include the original data. The number returns is in the range [0, 1], higher values mean a better local/global embedding.
quality(emb_LLE,'Q_local')## [1] 0.5001746quality(emb_LLE,'Q_global')## 86
## 0.2520802quality(emb_LLE,'mean_R_NX')## [1] 0.492865vamos agora testar vários métodos:
# PCA
emb_PCA <- embed(curva_s, "PCA")
print(emb_PCA)## Method:
## PCA
## Parameters:
## List of 2
## $ center: logi TRUE
## $ scale.: logi FALSEplot(emb_PCA, type = "2vars")
# Isomap:
emb_isomap <- embed(curva_s, "Isomap", knn = 10)## 2019-09-10 09:55:17: Isomap START## 2019-09-10 09:55:17: constructing knn graph## 2019-09-10 09:55:17: calculating geodesic distances## 2019-09-10 09:55:18: Classical Scalingprint(emb_isomap)## Method:
## Isomap
## Parameters:
## List of 4
## $ knn : num 10
## $ ndim : num 2
## $ get_geod: logi FALSE
## $ eps : num 0plot(emb_isomap, type = "2vars")
# ICA: Indepentend Component Analysis
emb_ica <- embed(curva_s, "FastICA", ndim = 2)
print(emb_ica)## Method:
## FastICA
## Parameters:
## List of 1
## $ ndim: num 2plot(emb_ica, type = "2vars")
# autoencoder
emb_ae <- embed(curva_s, "AutoEncoder")
print(emb_ae)## Method:
## AutoEncoder
## Parameters:
## List of 10
## $ ndim : num 2
## $ n_hidden : num [1:3] 10 2 10
## $ activation : chr [1:3] "tanh" "lin" "tanh"
## $ weight_decay : num 0.001
## $ learning_rate: num 0.15
## $ graph :List of 7
## ..$ encoder :Tensor("Add_1:0", shape=(?, 2), dtype=float32)
## ..$ decoder :Tensor("Add_3:0", shape=(?, 3), dtype=float32)
## ..$ network :Tensor("Add_5:0", shape=(?, 3), dtype=float32)
## ..$ loss :Tensor("Add_14:0", shape=(), dtype=float32)
## ..$ in_data :Tensor("input:0", shape=(?, 3), dtype=float32)
## ..$ in_decoder:Tensor("nlpca:0", shape=(?, 2), dtype=float32)
## ..$ session :<tensorflow.python.client.session.Session>
## $ keras_graph : NULL
## $ autoencoder : NULL
## $ batchsize : logi NA
## $ n_steps : num 500plot(emb_ae, type = "2vars")
# t-SNE
emb_tsne <- embed(curva_s, "tSNE", perplexity = 80)
print(emb_tsne)## Method:
## tsne
## Parameters:
## List of 4
## $ d :function (x, method = "euclidean", diag = FALSE, upper = FALSE, p = 2)
## $ perplexity: num 80
## $ theta : num 0.5
## $ ndim : num 2plot(emb_tsne, type = "2vars")
vamos avaliar a qualidade da redução de dimensionalidade:
quality(emb_PCA,'Q_local')## [1] 0.513354quality(emb_ica,'Q_local')## [1] 0.4859207quality(emb_LLE,'Q_local')## [1] 0.5001746quality(emb_isomap,'Q_local')## [1] 0.8404466quality(emb_ae,'Q_local')## [1] 0.5946022quality(emb_tsne,'Q_local')## [1] 0.8209852# ###
quality(emb_PCA,'Q_global')## 433
## 0.328098quality(emb_ica,'Q_global')## 344
## 0.2639754quality(emb_LLE,'Q_global')## 86
## 0.2520802quality(emb_isomap,'Q_global')## 60
## 0.4020893quality(emb_ae,'Q_global')## 328
## 0.3295583quality(emb_tsne,'Q_global')## 35
## 0.3714159# ###
quality(emb_PCA,'mean_R_NX')## [1] 0.7500491quality(emb_ica,'mean_R_NX')## [1] 0.5359744quality(emb_LLE,'mean_R_NX')## [1] 0.492865quality(emb_isomap,'mean_R_NX')## [1] 0.6753742quality(emb_ae,'mean_R_NX')## [1] 0.7151416quality(emb_tsne,'mean_R_NX')## [1] 0.6118899Sys.time() - t0## Time difference of 4.780629 mins