EjercicioClase - Muestreo Estratificado
Diego Alejandro Orjuela Hurtado
2022-05-24
0. Instalación de librerias.
remotes::install_github("vqv/ggbiplot")## Skipping install of 'ggbiplot' from a github remote, the SHA1 (7325e880) has not changed since last install.
## Use `force = TRUE` to force installationlibrary(readxl)
library(rgl)
library(corrplot)## corrplot 0.92 loadedlibrary(ggbiplot)## Loading required package: ggplot2## Loading required package: plyr## Loading required package: scales## Loading required package: gridlibrary(factoextra)## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa1. Entrada y visualización inicial de datos.
Cargando datos
dfcie = read_excel("C:/Users/daorjuelah/Downloads/Cielab_tueste_cafe.xlsx")
head(dfcie)## # A tibble: 6 x 4
## L a b tueste
## <dbl> <dbl> <dbl> <chr>
## 1 15.2 23.7 22.0 verde
## 2 12.3 20.8 21.0 verde
## 3 13.5 23.3 23.9 verde
## 4 13.6 21.1 20.4 verde
## 5 13.3 19.5 20.7 verde
## 6 12.4 21.9 20.8 verdeVisualización de datos
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)2. Determinación de los Componentes principales (PC)
Componentes principales, mediante la funcion scale para estandarizar los datos
dfcie.pca <- prcomp(dfcie[,c(1,2,3)],center = T,scale. = T)
summary(dfcie.pca)## Importance of components:
## PC1 PC2 PC3
## Standard deviation 1.6040 0.6290 0.17725
## Proportion of Variance 0.8576 0.1319 0.01047
## Cumulative Proportion 0.8576 0.9895 1.00000Con los dos primeros componentes se explican el 98.95% del comportamiento de los datos.
Se aplica la funcion “str” muestra que cosas se pueden extraer después de hacer componentes principales; sdev, rotation, center, scale, entre otros.
str(dfcie.pca)## List of 5
## $ sdev : num [1:3] 1.604 0.629 0.177
## $ rotation: num [1:3, 1:3] 0.531 0.588 0.61 -0.832 0.497 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : chr [1:3] "L" "a" "b"
## .. ..$ : chr [1:3] "PC1" "PC2" "PC3"
## $ center : Named num [1:3] 19.4 20.3 21.2
## ..- attr(*, "names")= chr [1:3] "L" "a" "b"
## $ scale : Named num [1:3] 5.92 4 4.99
## ..- attr(*, "names")= chr [1:3] "L" "a" "b"
## $ x : num [1:120, 1:3] 0.207 -0.591 0.238 -0.507 -0.723 ...
## ..- attr(*, "dimnames")=List of 2
## .. ..$ : NULL
## .. ..$ : chr [1:3] "PC1" "PC2" "PC3"
## - attr(*, "class")= chr "prcomp"Desviación estandar
dfcie.pca$sdev## [1] 1.6040326 0.6290170 0.1772488Extracción de los valores con mayor variabilidad
var_pca<-dfcie.pca$sdev**2
100*var_pca/sum(var_pca)## [1] 85.764015 13.188748 1.047237variabilidad acumulada
cumsum(100* var_pca/sum(var_pca))## [1] 85.76401 98.95276 100.00000Al utilizar la matriz de rotación, se puede eliminar la elevada correlación, mediante la transformación de los datos sin cambiar su estructura original.
Creamos la matriz de rotación
matriz_rotacion<-dfcie.pca$rotation; matriz_rotacion## PC1 PC2 PC3
## L 0.5308812 -0.8322630 0.1596982
## a 0.5879159 0.4974223 0.6379075
## b 0.6103443 0.2447640 -0.7533727Centroides
centroide<-dfcie.pca$center; centroide## L a b
## 19.42803 20.30929 21.20293Desviación estándar
desv_est<-dfcie.pca$scale; desv_est## L a b
## 5.918993 3.999667 4.990121Extracción de variables rotadas y latentes
ext_var<-dfcie.pca$x; head(ext_var)## PC1 PC2 PC3
## [1,] 0.2068932 1.0510244 0.30646710
## [2,] -0.5908611 1.0474046 -0.08881768
## [3,] 0.2384999 1.3323015 -0.08684860
## [4,] -0.5066929 0.8767963 0.08465799
## [5,] -0.7229047 0.7330504 -0.21263483
## [6,] -0.4445071 1.1751348 0.11775774Variables originales
var_orig<-cor(dfcie[,-4]); var_orig## L a b
## L 1.0000000 0.6424449 0.7492989
## a 0.6424449 1.0000000 0.9563176
## b 0.7492989 0.9563176 1.0000000Mapa de calor de las variables originales
heatmap(var_orig)
Mapa de calor de las variables rotadas
heatmap(cor(ext_var))
Comparación de las correlaciones entre las variables rotadas y originales
dfcie_join<-cbind(dfcie[,-4],ext_var); head(dfcie_join)## L a b PC1 PC2 PC3
## 1 15.19033 23.66875 21.96465 0.2068932 1.0510244 0.30646710
## 2 12.32775 20.77712 21.01656 -0.5908611 1.0474046 -0.08881768
## 3 13.53224 23.29917 23.88311 0.2384999 1.3323015 -0.08684860
## 4 13.59665 21.07822 20.41236 -0.5066929 0.8767963 0.08465799
## 5 13.34435 19.52530 20.69592 -0.7229047 0.7330504 -0.21263483
## 6 12.35368 21.90245 20.84171 -0.4445071 1.1751348 0.11775774La matriz de correlacion de las variables originales y de las variables rotadas. se busca comprobar qué no hay correlaciones entre las variables rotadas o latentes.
cor_var<-cor(dfcie_join); cor_var## L a b PC1 PC2 PC3
## L 1.00000000 0.6424449 0.7492989 8.515507e-01 -5.235076e-01 2.830631e-02
## a 0.64244487 1.0000000 0.9563176 9.430362e-01 3.128871e-01 1.130683e-01
## b 0.74929894 0.9563176 1.0000000 9.790121e-01 1.539607e-01 -1.335344e-01
## PC1 0.85155068 0.9430362 0.9790121 1.000000e+00 1.370284e-16 -3.003468e-15
## PC2 -0.52350759 0.3128871 0.1539607 1.370284e-16 1.000000e+00 -1.177156e-15
## PC3 0.02830631 0.1130683 -0.1335344 -3.003468e-15 -1.177156e-15 1.000000e+00Uso de mapas de color para observar las correlaciones entre variables originales y rotadas (PC).
corrplot::corrplot(cor_var)
Es observable la mayor representabilidad en el componente principal 1 y
2.
Gráfico 3D para variables rotadas
plot3d(ext_var,type = "s",col = gl(4,30,120,c("green","orange","pink","purple")))Gráfico del componente principal Numero 1
plot(ext_var[,1],pch=16,col=as.factor(dfcie$tueste))
Gráfico de relación entre componente principal Numero 1 y Numero 2
plot(ext_var[,c(1,2)],pch=16,col=as.factor(dfcie$tueste))
Se procedera a crear un análisis entre los componentes principales PC1 y PC2.
ggbiplot(dfcie.pca)+
geom_hline(yintercept = 0)+
geom_vline(xintercept = 0)
ggbiplot(dfcie.pca, labels=rownames(dfcie))
ggbiplot(dfcie.pca,ellipse=TRUE,labels=rownames(dfcie[,1:3]),
groups=dfcie$tueste)
ggbiplot(dfcie.pca,ellipse=TRUE,choices=c(1,3),
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")
3. Cluster de las variables representativas.
Creamos un ANOVA para el componente b
M = dfcie[,-4]
Ms = scale(M)
fviz_nbclust(dfcie[,'b'],
FUNcluster = kmeans,
method = 'gap_stat',
diss = get_dist(Ms, 'euclidean'))
De acuerdo con el análisis de cluster en la variable b, el número optimo de clusters es 3
clus = kmeans(Ms,3)
table(dfcie$tueste,clus$cluster)##
## 1 2 3
## claro 0 0 30
## medio 2 28 0
## oscuro 5 25 0
## verde 29 1 0Graficamos los clusters
plot(dfcie.pca$x[,c(1)], pch = 16,
col = as.factor(dfcie$tueste))
Creamos un ANOVA para el componente l
#Análisis de cluster de la variable l
library(factoextra)
M1 = dfcie[,-4]
Ms1 = scale(M1)
fviz_nbclust(dfcie[,'L'],
FUNcluster = kmeans,
method = 'gap_stat',
diss = get_dist(Ms1, 'euclidean'))
De acuerdo con el análisis de cluster en la variable L, el número optimo de clusters es 3
clus = kmeans(Ms,3)
table(dfcie$tueste,clus$cluster)##
## 1 2 3
## claro 0 0 30
## medio 2 28 0
## oscuro 5 25 0
## verde 29 1 0Graficamos los clusters
plot(dfcie.pca$x[,c(1)], pch = 16,
col = as.factor(dfcie$tueste))
Como resultado, podemos observar como solo son necesarios los componentes “b” y “L” de los datos, para representar hasta en un 98.95% el conjunto de datos recolectados, adicionalmente, podemos recolectar (mediante el cluster) los datos en 3 conjuntos (verde, medio+oscuro y claro).