clase metodos
18/5/2022
Componentes Principales
library(readxl)
dfcie <- read_excel("C:/Users/Usuario/Downloads/Cielabch_tueste_cafe.xlsx")
head(dfcie)## # A tibble: 6 x 6
## L a b tueste c h
## <dbl> <dbl> <dbl> <chr> <dbl> <dbl>
## 1 10.2 20.2 19.2 verde 27.9 43.5
## 2 13.2 20.7 20.7 verde 29.3 45.0
## 3 10.9 18.0 17.3 verde 24.9 43.8
## 4 12.8 21.3 20.4 verde 29.5 43.8
## 5 14.5 21.0 20.3 verde 29.2 44.0
## 6 14.0 23.4 23.7 verde 33.3 45.3library(rgl)
plot3d(dfcie$L,
dfcie$a,
dfcie$b,
type='s',
col=rep(1:4,each=30))
legend3d('topright',legend=unique(dfcie$tueste),col=1:4,pch=16,cex=1)# Componentes principales
dfcie_pca<-prcomp(dfcie[,c(1:3)],center=TRUE,scale.=TRUE);dfcie_pca## Standard deviations (1, .., p=3):
## [1] 1.6206932 0.5877406 0.1670763
##
## Rotation (n x k) = (3 x 3):
## PC1 PC2 PC3
## L 0.5404957 -0.8188467 0.1932730
## a 0.5828621 0.5300900 0.6158542
## b 0.6067423 0.2202150 -0.7637861summary(dfcie_pca)## Importance of components:
## PC1 PC2 PC3
## Standard deviation 1.6207 0.5877 0.1671
## Proportion of Variance 0.8756 0.1152 0.0093
## Cumulative Proportion 0.8756 0.9907 1.0000str(dfcie_pca)## List of 5
## $ sdev : num [1:3] 1.621 0.588 0.167
## $ rotation: num [1:3, 1:3] 0.54 0.583 0.607 -0.819 0.53 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:3] "L" "a" "b"
## .. ..$ : chr [1:3] "PC1" "PC2" "PC3"
## $ center : Named num [1:3] 19.3 20.4 21.3
## ..- attr(*, "names")= chr [1:3] "L" "a" "b"
## $ scale : Named num [1:3] 6.01 4 4.99
## ..- attr(*, "names")= chr [1:3] "L" "a" "b"
## $ x : num [1:120, 1:3] -1.088 -0.562 -1.583 -0.556 -0.452 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : NULL
## .. ..$ : chr [1:3] "PC1" "PC2" "PC3"
## - attr(*, "class")= chr "prcomp"#valores propios
dfcie_pca$sdev## [1] 1.6206932 0.5877406 0.1670763#var explicada
var_pca<-dfcie_pca$sdev**2
100*var_pca/sum(var_pca) # Varianza explicada## [1] 87.554884 11.514633 0.930483cumsum(100*var_pca/sum(var_pca))## [1] 87.55488 99.06952 100.00000# matriz de rotación
dfcie_pca$rotation## PC1 PC2 PC3
## L 0.5404957 -0.8188467 0.1932730
## a 0.5828621 0.5300900 0.6158542
## b 0.6067423 0.2202150 -0.7637861# centroides
dfcie_pca$center## L a b
## 19.29988 20.37800 21.25144# Desviación estandar
dfcie_pca$scale## L a b
## 6.012171 3.997620 4.994248# Extrayendo las nuevas variables
# Variables rotadas
# Variables latentes
dfcie_pca$x## PC1 PC2 PC3
## [1,] -1.08811874 1.125182347 0.0005948968
## [2,] -0.56194881 0.855111732 -0.0620849519
## [3,] -1.58328419 0.648741679 -0.0271807203
## [4,] -0.55595315 0.971040072 0.0598957432
## [5,] -0.45216175 0.692496594 0.0929340465
## [6,] 0.26299046 1.241653807 -0.0741288970
## [7,] -0.95752092 0.817238101 -0.1176092074
## [8,] -0.71770497 0.837263250 0.0076672338
## [9,] -0.22796001 1.161961820 0.0465039599
## [10,] 0.15814070 1.291082136 0.1778292662
## [11,] 0.07769768 1.009428769 0.0887955537
## [12,] -0.16562546 1.076944904 0.0373474572
## [13,] -0.19313808 0.646201730 -0.1058212756
## [14,] 0.19762329 0.791617060 -0.1235599520
## [15,] -0.25643609 0.918694504 0.0538869369
## [16,] -0.78145529 1.123057727 0.0850157634
## [17,] -0.19284765 1.085774433 0.1290630143
## [18,] 0.21660336 0.720625538 -0.2436677172
## [19,] 0.15602317 1.252421039 -0.0182003610
## [20,] -0.70606564 0.588363483 -0.1984445015
## [21,] -0.12615559 1.049706846 -0.0692452879
## [22,] 0.38449589 1.150475190 0.0877878841
## [23,] 0.04221470 1.168433132 0.1118155829
## [24,] -0.31690237 0.541199501 -0.1864902122
## [25,] -0.68447230 1.201098116 -0.0233559509
## [26,] -0.24960500 0.897630189 -0.3027078884
## [27,] -0.50561262 0.698238910 -0.0699227778
## [28,] 1.29057111 1.047928808 -0.0652937196
## [29,] 0.07541301 0.939435016 -0.0510049346
## [30,] -0.47331744 0.800535397 -0.1862702532
## [31,] 2.61190197 -0.535359789 -0.1173208456
## [32,] 1.84150062 -0.686242214 -0.0158800280
## [33,] 2.67880919 -0.613968245 -0.0617839569
## [34,] 2.16080552 -0.413899119 0.1445427170
## [35,] 3.01871096 -0.124462110 0.2126247358
## [36,] 3.17967080 -0.211279147 -0.0979379072
## [37,] 3.09491799 0.271377341 0.1048015473
## [38,] 2.51387441 -0.158349076 -0.1032210358
## [39,] 2.45915509 -0.459501763 -0.0170986395
## [40,] 2.83808538 -0.251064696 -0.0221065482
## [41,] 2.02281758 -0.532466008 -0.2537070950
## [42,] 1.88883884 -0.236527685 0.0654145141
## [43,] 2.50603352 -0.177654985 0.0685829272
## [44,] 2.86308685 -0.202082910 0.0506742678
## [45,] 2.66613281 -0.151464752 0.0334728429
## [46,] 2.04393579 -0.515257519 -0.0815834668
## [47,] 2.82191871 -0.049649768 -0.1657410535
## [48,] 3.48228149 -0.336302204 0.1557268951
## [49,] 2.82483349 -0.466191292 -0.2133451233
## [50,] 2.27703819 -0.137510470 -0.0016151907
## [51,] 2.28893239 -0.548483798 -0.1314688592
## [52,] 2.56431050 0.137268938 0.0935168829
## [53,] 2.55425462 -0.429550900 0.0389176095
## [54,] 2.43003237 -0.348982659 -0.0964241554
## [55,] 1.86288725 0.017974677 0.1639214602
## [56,] 2.43221057 -0.342280409 -0.0130969872
## [57,] 3.10575274 -0.183586273 0.0758100967
## [58,] 3.05581023 0.086810132 0.0511855186
## [59,] 2.31414797 -0.557484762 -0.2123420764
## [60,] 2.86180209 -0.110602249 0.1013675774
## [61,] -0.48021895 -0.177832114 -0.1338513895
## [62,] -1.04671997 -0.303528462 0.1195029533
## [63,] -0.99680525 -0.031746106 0.1618109715
## [64,] -0.72268644 -0.229330621 0.2736284808
## [65,] -1.65706236 -0.284664593 -0.1226564276
## [66,] -1.77773805 -0.449517449 0.0908265033
## [67,] -1.61718661 -0.212206627 0.1669931896
## [68,] -0.98574175 -0.076298634 -0.0767370850
## [69,] -1.72989470 -0.482145577 0.2608742315
## [70,] -2.03077346 -0.642478415 -0.0852919281
## [71,] -0.25154216 -0.129623060 -0.1465258442
## [72,] -1.91041937 -0.401541086 0.0044945602
## [73,] -1.25112198 -0.034204958 0.1974023496
## [74,] -1.45505077 -0.354690453 -0.1282995768
## [75,] -2.02820867 -0.333143058 0.3118204029
## [76,] -1.16686471 -0.389431900 0.2069687726
## [77,] -0.95156877 -0.466172570 0.0756482239
## [78,] -1.42228238 -0.560624464 -0.0539452973
## [79,] -1.82327708 -0.495030944 -0.1376016648
## [80,] -1.59274215 -0.088727286 -0.5029642349
## [81,] -2.30812629 -0.529864642 0.0829661569
## [82,] -1.19866037 -0.309331750 0.3311249692
## [83,] -1.60951099 -0.406645836 0.1381956276
## [84,] -1.25887404 -0.390486305 -0.3793721915
## [85,] -1.55683367 -0.570591427 -0.1139628028
## [86,] -0.87292451 -0.375526333 0.2081286897
## [87,] -1.27979687 -0.078408487 -0.0059514698
## [88,] -0.11918903 -0.353823064 -0.0051248352
## [89,] -1.29043414 -0.687968858 0.2504169794
## [90,] -1.38872055 -0.170539893 -0.1730009616
## [91,] 0.05549723 0.099634441 -0.0375787410
## [92,] -1.68252552 -0.690830789 -0.0206949610
## [93,] -0.59354861 -0.359211066 -0.1572200857
## [94,] -1.15162290 -0.341058267 -0.0616014007
## [95,] -1.38665915 -0.464724501 0.2418946258
## [96,] -1.51259753 -0.299323122 -0.0029214406
## [97,] -1.60594693 -0.640127783 0.0121686066
## [98,] -0.87498007 -0.296919373 0.2728059540
## [99,] -1.21824668 -0.301847045 -0.1331789211
## [100,] 0.01042637 -0.120764884 0.4227691621
## [101,] -0.95063871 -0.270781049 0.0561576562
## [102,] -1.38893628 -0.469692880 0.1699595475
## [103,] -0.82527480 -0.392193817 -0.1645305164
## [104,] -0.50096689 -0.338781720 0.0644411319
## [105,] -1.14510179 -0.147784896 -0.1145370087
## [106,] -1.07041101 -0.383705632 0.0716779977
## [107,] -0.27276451 -0.417303433 0.2630695221
## [108,] -0.43591893 -0.334767536 0.0118436873
## [109,] -1.53309539 -0.566195470 0.1261529932
## [110,] -0.71059139 0.215333518 0.2778302210
## [111,] -0.08346574 0.005774136 0.2743164355
## [112,] -1.21986301 -0.573080069 0.0052126693
## [113,] -0.77699349 -0.508876777 -0.0638212956
## [114,] -1.35265964 -0.283803862 -0.3039832123
## [115,] -1.39042687 -0.308491278 -0.1938253684
## [116,] -0.77692397 0.038911145 0.2414486067
## [117,] -0.38277721 -0.366329812 -0.0788049125
## [118,] -2.12895795 -0.627808127 -0.4093424996
## [119,] -1.33014552 -0.389118377 0.0782168559
## [120,] -1.31288426 -0.532814820 -0.4734780170# Variables originales
cor(dfcie[,-4])## L a b c h
## L 1.0000000 0.6808647 0.7949755 0.7539533 0.6086140
## a 0.6808647 1.0000000 0.9560998 0.9858156 0.3173531
## b 0.7949755 0.9560998 1.0000000 0.9917106 0.5757233
## c 0.7539533 0.9858156 0.9917106 1.0000000 0.4685355
## h 0.6086140 0.3173531 0.5757233 0.4685355 1.0000000heatmap(cor(dfcie[,-4]))
#Variables rotadas
heatmap(cor(dfcie_pca$x))
# Comparacion correlaciones variables rotadas y originales
dfcie_join<-cbind(dfcie[,-4],dfcie_pca$x)
corrplot::corrplot(cor(dfcie_join))
library(rgl)
plot3d(dfcie_pca$x,
type='s',
col=rep(1:4,each=30))
legend3d('topright',legend=unique(dfcie$tueste),col=1:4,pch=16,cex=1)# PC1
plot(dfcie_pca$x[,1],pch=16,col=as.factor(dfcie$tueste))
# PC1 y PC2
plot(dfcie_pca$x[,c(1,2)],pch=16,col=as.factor(dfcie$tueste))
#install.packages("remotes")
#remotes::install_github("vqv/ggbiplot")library(ggbiplot)
ggbiplot(dfcie_pca)+geom_hline(yintercept=0)+geom_vline(xintercept=0)
Gráfico Biplot
ggbiplot(dfcie_pca,ellipse=TRUE,labels=rownames(dfcie[,1:3]),
groups=dfcie$tueste)
ggbiplot(dfcie_pca,ellipse=TRUE,choices=c(1,2),
labels=rownames(dfcie[,1:3]), groups=dfcie$tueste)
ggbiplot(dfcie_pca,ellipse=TRUE,circle=TRUE,
labels=rownames(dfcie[,1:3]), groups=dfcie$tueste)
ggbiplot(dfcie_pca,ellipse=TRUE,labels=rownames(dfcie[,1:3]), groups=dfcie$tueste) +
scale_colour_manual(name="Origin",values=c("forest green","red3","dark blue","orange"))+
ggtitle("PCA tueste de cafe")+ theme_minimal()+
theme(legend.position = "bottom")
# MANOVA
Y <- as.matrix(dfcie[,-4])
mod1<-manova(Y~dfcie$tueste)
summary(mod1) ## Df Pillai approx F num Df den Df Pr(>F)
## dfcie$tueste 3 1.9032 39.564 15 342 < 2.2e-16 ***
## Residuals 116
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# ANOVA
mod2<-aov(b~tueste,dfcie)
summary(mod2)## Df Sum Sq Mean Sq F value Pr(>F)
## tueste 3 2657.5 885.8 330.8 <2e-16 ***
## Residuals 116 310.6 2.7
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1Clusters
library(factoextra)
M<-dfcie[,-4]
Ms<-scale(M)
fviz_nbclust(Ms,FUNcluster = kmeans,method = 'gap_stat',diss = get_dist(Ms,'euclidean'))
clus1<-kmeans(Ms,3)
table(dfcie$tueste,clus1$cluster)##
## 1 2 3
## claro 21 0 9
## medio 0 30 0
## oscuro 0 30 0
## verde 0 29 1M2<-dfcie[,c('a','b')]
Ms2<-scale(M2)
fviz_nbclust(Ms2,FUNcluster = kmeans,method = 'gap_stat',diss = get_dist(Ms2,'euclidean'))
clus2<-kmeans(Ms2,3)
table(dfcie$tueste,clus2$cluster)##
## 1 2 3
## claro 30 0 0
## medio 0 27 3
## oscuro 0 23 7
## verde 1 1 28M3<-dfcie[,c('b')]
Ms3<-scale(M3)
fviz_nbclust(Ms3,FUNcluster = kmeans,method = 'gap_stat',diss = get_dist(Ms3,'euclidean'))
clus3<-kmeans(Ms3,3)
table(dfcie$tueste,clus3$cluster)##
## 1 2 3
## claro 30 0 0
## medio 0 27 3
## oscuro 0 21 9
## verde 1 1 28M4<-dfcie_pca$x[,1]
Ms4<-scale(M4)
fviz_nbclust(Ms4,FUNcluster = kmeans,method = 'gap_stat',diss = get_dist(Ms4,'euclidean')) 
clus4<-kmeans(Ms4,3)
table(dfcie$tueste,clus4$cluster)##
## 1 2 3
## claro 18 0 12
## medio 0 30 0
## oscuro 0 30 0
## verde 0 29 1Añadiendo las variables de color “c” y “h”
dfcie$C<-with(dfcie,sqrt(a**2+b**2))
dfcie$h<-with(dfcie,atan(b/a)*180/pi)
dfcie$h=round(dfcie$h,0)
dfcie$c=round(dfcie$c,0)
head(dfcie)## # A tibble: 6 x 7
## L a b tueste c h C
## <dbl> <dbl> <dbl> <chr> <dbl> <dbl> <dbl>
## 1 10.2 20.2 19.2 verde 28 43 27.9
## 2 13.2 20.7 20.7 verde 29 45 29.3
## 3 10.9 18.0 17.3 verde 25 44 24.9
## 4 12.8 21.3 20.4 verde 29 44 29.5
## 5 14.5 21.0 20.3 verde 29 44 29.2
## 6 14.0 23.4 23.7 verde 33 45 33.3library(rgl)
plot3d(dfcie$L,
dfcie$a,
dfcie$b,
type='s',
size = unique(dfcie$c/20),
col=unique(dfcie$h))
legend3d('topright',
legend = unique(sort(dfcie$c)),pch= 16,cex=unique(sort(dfcie$c/21)),
col= unique(dfcie$h))# Creando los componentes principales
dfcie.pca2<-prcomp(dfcie[,-4],center=TRUE,scale.=TRUE);dfcie.pca2## Standard deviations (1, .., p=6):
## [1] 2.209359211 0.919475390 0.519713100 0.041005680 0.038823248 0.002543093
##
## Rotation (n x k) = (6 x 6):
## PC1 PC2 PC3 PC4 PC5 PC6
## L 0.3831036 -0.30542570 -0.87058389 0.043773566 0.01068786 -0.0002909870
## a 0.4261782 0.36052584 0.09807497 0.745609218 -0.04800371 -0.3471845353
## b 0.4506057 0.05078236 0.14675836 -0.553256993 -0.49331274 -0.4726382438
## c 0.4445330 0.18877519 0.12376413 -0.309597222 0.80968284 -0.0001715193
## h 0.2702938 -0.83873953 0.42400094 0.200476398 0.05899848 0.0029805808
## C 0.4448483 0.18718263 0.12582768 -0.004030131 -0.30847501 0.8099796238# Grafico Biplot
library(ggbiplot)
ggbiplot(dfcie.pca2)+geom_hline(yintercept=0)+geom_vline(xintercept=0)
cor(dfcie[,-4])## L a b c h C
## L 1.0000000 0.6808647 0.7949755 0.7534332 0.6223486 0.7539533
## a 0.6808647 1.0000000 0.9560998 0.9851283 0.3181196 0.9858156
## b 0.7949755 0.9560998 1.0000000 0.9904591 0.5750856 0.9917106
## c 0.7534332 0.9851283 0.9904591 1.0000000 0.4667874 0.9989753
## h 0.6223486 0.3181196 0.5750856 0.4667874 1.0000000 0.4685725
## C 0.7539533 0.9858156 0.9917106 0.9989753 0.4685725 1.0000000heatmap(cor(dfcie[,-4]))
heatmap(cor(dfcie.pca2$x))
# Comparacion correlaciones variables rotadas y originales
dfcie_join<-cbind(dfcie[,-4],dfcie.pca2$x)
corrplot::corrplot(cor(dfcie_join))