Resumen Clase: Análisis de Clusters
Presentado por: Stiven Taborda, Sara Norato.
Parte 1. Cluster jerarquico
Importar datos de humedad, proteina y almidon para tres tipos de harinas.
library(readxl)
dat1 <- read_excel("C:/Users/sararita/Documents/Sara/Universidad Nacional/Semestre 12/Metodos Multivariados/Excel/chaa.xlsx")
head(dat1)## # A tibble: 6 x 4
## humedad almidon proteina harina
## <dbl> <dbl> <dbl> <chr>
## 1 7.72 45.9 10.1 cha
## 2 7.65 46.0 10.6 cha
## 3 9.12 49.3 11.9 cha
## 4 10.3 49.3 10.9 cha
## 5 9.73 53.7 11.8 cha
## 6 8.03 44.9 10.6 cha- Crear una matriz de distancias
dist_mat<-dist(dat1[,-4],method = 'euclidean')
# Dimensiones de la matriz
dim(as.matrix(dist_mat))## [1] 90 90- Mapa de calor de la matriz de distancias
# Las menores distancias son las que presentan colores mas claros
heatmap(as.matrix(dist_mat))
- Elaborando un mapa de calor con la matriz de correlaciones
R<-cor(dat1[,-4])
# Las correlaciones pueden considerarse otra forma de distancia
heatmap(R)
- Matriz de correlaciones
library(corrplot)## Warning: package 'corrplot' was built under R version 4.0.3## corrplot 0.84 loaded# Con coeficientes de correlación con distintas visualizaciones
corrplot(R,method='number')
corrplot.mixed(R,order='AOE')
# Con el paquete corrplot
pval<-cor.mtest(R, conf.level=0.95)
corrplot(R,p.mat=pval$p,insig = 'p-value')
# Con el paquete performance analytics
library(PerformanceAnalytics)## Warning: package 'PerformanceAnalytics' was built under R version 4.0.5## Loading required package: xts## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric##
## Attaching package: 'PerformanceAnalytics'## The following object is masked from 'package:graphics':
##
## legend
chart.Correlation(dat1[,-4]) # Ver patrones de agrupación en graficos de dispersión
- Método vecino mas cercano
vec_cer<-hclust(dist_mat,method = 'single')
plot(vec_cer) # Dendograma cluster
abline(h=2.5,col='red') # Punto de corte aleatorio para mirar grupos (4)
- Método vecino mas lejano
vec_lej<-hclust(dist_mat,method = 'complete')
plot(vec_lej) # Dendograma cluster
# Ensayando diferentes puntos de corte para ver como varian el numero de clusters
abline(h=15,col='red') # 3 Grupos
abline(h=30,col='blue') # 2 grupos
abline(h=10,col='green') # 4 grupos
- Método de ward.D
ward<-hclust(dist_mat,method = 'ward.D')
plot(ward) # Dendograma cluster
- Método Average
avera<-hclust(dist_mat,method = 'average')
plot(avera) # Dendograma cluster
abline(h=5,col='red') # Punto de corte aleatorio para mirar grupos (4)
- Generación de modelos para cada método empleando la función cutree() y comparación de las clasificaciones correctas de cada cluster (3 clusters) mediante una matriz de confusión. Se asume que la correcta clasificación corresponde al tipo de harina en el dataframe orginal, y las clasificaciones generadas por el metodo se encuentran en los grupo “1, 2 y 3”, de esta froma es posible calcular el porcentaje de correctas clasificaciones para cada modelo.
# Modelo 1: Ward
mod1<-cutree(ward,k=3)
plot(ward)
# Para cortar el dendograma en k grupos y los encierra en rectangulos
rect.hclust(ward,k=3,border = "green")
# Porcentaje de correctas clasificaciones Ward.D
table(dat1$harina,mod1)## mod1
## 1 2 3
## ama 0 30 0
## arr 0 1 29
## cha 27 3 0((30+29+27)/90)*100## [1] 95.55556# Modelo 2: Vecino mas cercano
plot(vec_cer)
mod2<-cutree(vec_cer,k=3)
# Para cortar el dendograma en k grupos y los encierra en rectangulos
rect.hclust(vec_cer,k=3,border = "green")
# Porcentaje de correctas clasificaciones vecino mas cercano
table(dat1$harina,mod2) # Agrupación ama y charr en un mismo cluster## mod2
## 1 2 3
## ama 0 0 30
## arr 0 0 30
## cha 27 3 0((30+30+27)/90)*100## [1] 96.66667# Modelo 3: Vecino mas lejano
plot(vec_lej)
mod3<-cutree(vec_lej,k=3)
# Para cortar el dendograma en k grupos y los encierra en rectangulos
rect.hclust(vec_lej,k=3,border = "green")
# Porcentaje de correctas clasificaciones vecino mas lejanos
table(dat1$harina,mod3)## mod3
## 1 2 3
## ama 0 30 0
## arr 0 1 29
## cha 27 3 0((30+29+27)/90)*100## [1] 95.55556# Modelo 4: Average
plot(avera)
mod4=cutree(avera,k=3)
# Para cortar el dendograma en k grupos y los encierra en rectangulos
rect.hclust(avera,k=3,border = "green")
# Porcentaje de correctas clasificaciones average
table(dat1$harina,mod4)## mod4
## 1 2 3
## ama 0 30 0
## arr 0 1 29
## cha 27 3 0((30+29+27)/90)*100## [1] 95.55556- Guardando los resultados de clasificación de cada modelo en un dataframe y representación grafica de la matriz de confusión sin datos estandarisados
library(caret)## Warning: package 'caret' was built under R version 4.0.5## Loading required package: ggplot2## Loading required package: latticelibrary(cvms)## Warning: package 'cvms' was built under R version 4.0.5library(tibble)# Metodo Ward.D (Modelo 1)
# Creando un nuevo df donde se compara la prediccción (prediction) vs la clasificación oroginal (target)
df_cm<- tibble(
prediction= factor(mod1,c(2,3,1),c('ama','arr','cha'),ordered = T),
target= factor(dat1$harina,ordered = T))
# Matriz de confusión
cm<- as.tibble(table(df_cm));cm## # A tibble: 9 x 3
## prediction target n
## <chr> <chr> <int>
## 1 ama ama 30
## 2 arr ama 0
## 3 cha ama 0
## 4 ama arr 1
## 5 arr arr 29
## 6 cha arr 0
## 7 ama cha 3
## 8 arr cha 0
## 9 cha cha 27# Grafico matriz de confusión
plot_confusion_matrix(cm,target_col = "target",
prediction_col = "prediction",
counts_col = "n")
# La sumatoria de la diagonal del grafico equivale al porcentaje de correctas clasificaciones del metodo# Metodo Vecino mas cercano (Modelo 2)
# Creando un nuevo df donde se compara la prediccción (prediction) vs la clasificación oroginal (target)
df_cm2<- tibble(
prediction= factor(mod2,c(3,3,1),c('ama','arr','cha'),ordered = T),
target= factor(dat1$harina,ordered = T))
# Matriz de confusión
cm2<- as.tibble(table(df_cm2))
plot_confusion_matrix(cm2,target_col = "target",
prediction_col = "prediction",
counts_col = "n")
# La sumatoria de la diagonal del grafico equivale al porcentaje de correctas clasificaciones del metodo# Metodo Vecino mas lejano (Modelo 3)
# Creando un nuevo df donde se compara la prediccción (prediction) vs la clasificación oroginal (target)
df_cm3<- tibble(
prediction= factor(mod3,c(2,3,1),c('ama','arr','cha'),ordered = T),
target= factor(dat1$harina,ordered = T))
# Matriz de confusión
cm3<- as.tibble(table(df_cm3))
plot_confusion_matrix(cm3,target_col = "target",
prediction_col = "prediction",
counts_col = "n")
# La sumatoria de la diagonal del grafico equivale al porcentaje de correctas clasificaciones del metodo# Metodo Average (Modelo 4)
# Creando un nuevo df donde se compara la prediccción (prediction) vs la clasificación oroginal (target)
df_cm4<- tibble(
prediction= factor(mod4,c(2,3,1),c('ama','arr','cha'),ordered = T),
target= factor(dat1$harina,ordered = T))
# Matriz de confusión
cm4<- as.tibble(table(df_cm4))
plot_confusion_matrix(cm4,target_col = "target",
prediction_col = "prediction",
counts_col = "n")
# La sumatoria de la diagonal del grafico equivale al porcentaje de correctas clasificaciones del metodo- Estandarizando las variables del dataframe original con scale(). Posteriormente se realiza el analisis de cluster con la función agnes() para los cuatro metodos anteriores.
library(cluster)
# Datos estandarizado
dfb <-scale(dat1[,1:3])
m<- c("average","single","complete","ward")
ac <- function(x){
agnes(dfb,method = x)$ac
}
# Comparación entre metodos AGNES (Entre mas cercano a 1, mejor es el metodo)
sapply(m,ac) # El mejor metodo es Ward.D## average single complete ward
## 0.9183692 0.8615611 0.9460516 0.9868489- Aplicando la función agnes() a los datos NO estandarizados para comparar
library(cluster)
# Datos NO estandarizados
dfb1<-dat1[,1:3]
m<- c("average","single","complete","ward")
ac1 <-function(x){
agnes(dfb1,method = x)$ac
}
# Comparación entre metodos AGNES (Entre mas cercano a 1, mejor es el metodo)
sapply(m,ac1) # El mejor metodo es Ward.D## average single complete ward
## 0.9585437 0.8229332 0.9749480 0.992659712.1 Representación grafica de la matriz de confusión con datos estandarizados
# Metodo Ward.D (Modelo 1)
dist_mat1<-dist(dfb,method = 'euclidean')
ward1<-hclust(dist_mat1,method = 'ward.D')
mod11=cutree(ward1,k=3)
# Creando un nuevo df donde se compara la prediccción (prediction) vs la clasificación oroginal (target)
df_cm11<- tibble(
prediction= factor(mod11,c(2,3,1),c('ama','arr','cha'),ordered = T),
target= factor(dat1$harina,ordered = T))
# Matriz de confusión
cm11<- as.tibble(table(df_cm11));cm11## # A tibble: 9 x 3
## prediction target n
## <chr> <chr> <int>
## 1 ama ama 30
## 2 arr ama 0
## 3 cha ama 0
## 4 ama arr 0
## 5 arr arr 30
## 6 cha arr 0
## 7 ama cha 0
## 8 arr cha 0
## 9 cha cha 30# Grafico matriz de confusión
plot_confusion_matrix(cm11,target_col = "target",
prediction_col = "prediction",
counts_col = "n")
# La sumatoria de la diagonal del grafico equivale al porcentaje de correctas clasificaciones del metodo
table(dat1$harina,mod11)## mod11
## 1 2 3
## ama 0 30 0
## arr 0 0 30
## cha 30 0 0# Metodo Vecino mas cercano (Modelo 2)
vec_cer1<-hclust(dist_mat1,method = 'single')
mod12=cutree(vec_cer1,k=3)
# Creando un nuevo df donde se compara la prediccción (prediction) vs la clasificación oroginal (target)
df_cm12<- tibble(
prediction= factor(mod12,c(2,2,1),c('ama','arr','cha'),ordered = T),
target= factor(dat1$harina,ordered = T))
# Matriz de confusión
cm12<- as.tibble(table(df_cm12));cm12## # A tibble: 9 x 3
## prediction target n
## <chr> <chr> <int>
## 1 ama ama 29
## 2 arr ama 0
## 3 cha ama 0
## 4 ama arr 30
## 5 arr arr 0
## 6 cha arr 0
## 7 ama cha 0
## 8 arr cha 0
## 9 cha cha 30# Grafico matriz de confusión
plot_confusion_matrix(cm12,target_col = "target",
prediction_col = "prediction",
counts_col = "n")
# La sumatoria de la diagonal del grafico equivale al porcentaje de correctas clasificaciones del metodo
table(dat1$harina,mod12)## mod12
## 1 2 3
## ama 0 29 1
## arr 0 30 0
## cha 30 0 0# Metodo Vecino mas lejano (Modelo 3)
vec_lej1<-hclust(dist_mat1,method = 'complete')
mod13=cutree(vec_lej1,k=3)
# Creando un nuevo df donde se compara la prediccción (prediction) vs la clasificación oroginal (target)
df_cm13<- tibble(
prediction= factor(mod13,c(2,2,1),c('ama','arr','cha'),ordered = T),
target= factor(dat1$harina,ordered = T))
# Matriz de confusión
cm13<- as.tibble(table(df_cm13));cm13## # A tibble: 9 x 3
## prediction target n
## <chr> <chr> <int>
## 1 ama ama 24
## 2 arr ama 0
## 3 cha ama 0
## 4 ama arr 30
## 5 arr arr 0
## 6 cha arr 0
## 7 ama cha 0
## 8 arr cha 0
## 9 cha cha 30# Grafico matriz de confusión
plot_confusion_matrix(cm13,target_col = "target",
prediction_col = "prediction",
counts_col = "n")
# La sumatoria de la diagonal del grafico equivale al porcentaje de correctas clasificaciones del metodo
table(dat1$harina,mod13)## mod13
## 1 2 3
## ama 0 24 6
## arr 0 30 0
## cha 30 0 0# Metodo Average (Modelo 4)
avera1<-hclust(dist_mat1,method = 'average')
mod14=cutree(avera1,k=3)
# Creando un nuevo df donde se compara la prediccción (prediction) vs la clasificación oroginal (target)
df_cm14<- tibble(
prediction= factor(mod14,c(2,2,1),c('ama','arr','cha'),ordered = T),
target= factor(dat1$harina,ordered = T))
# Matriz de confusión
cm14<- as.tibble(table(df_cm14));cm14## # A tibble: 9 x 3
## prediction target n
## <chr> <chr> <int>
## 1 ama ama 29
## 2 arr ama 0
## 3 cha ama 0
## 4 ama arr 30
## 5 arr arr 0
## 6 cha arr 0
## 7 ama cha 0
## 8 arr cha 0
## 9 cha cha 30# Grafico matriz de confusión
plot_confusion_matrix(cm14,target_col = "target",
prediction_col = "prediction",
counts_col = "n")
# La sumatoria de la diagonal del grafico equivale al porcentaje de correctas clasificaciones del metodo
table(dat1$harina,mod14)## mod14
## 1 2 3
## ama 0 29 1
## arr 0 30 0
## cha 30 0 0- Calculando el mejor numero de clusters con la función clusGap() para los datos estandarizados
library(cluster)
library(factoextra)## Warning: package 'factoextra' was built under R version 4.0.5## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBagab_sts<- clusGap(dfb, FUN=hcut,
nstart= 25,
K.max = 10,B=50)
fviz_gap_stat(gab_sts)# El número ideal de clusters es 3 de acuerdo al gráfico
- Calculando el mejor numero de clusters con la función clusGap() para los datos NO estandarizados
library(cluster)
library(factoextra)
gab_sts1<- clusGap(dfb1, FUN=hcut,
nstart= 25,
K.max = 10,B=50)
fviz_gap_stat(gab_sts1)# El número ideal de clusters es 9 de acuerdo al gráfico
- Caracterización de los clusters con media y desviación estandar de humedad, proteina y almidon
# Resumen estadistico por cluster del Modelo 1 (Ward.D)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:xts':
##
## first, last## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, uniondat2<-dat1 %>% mutate(clust_mod1=mod1)
dat2 %>%
group_by(clust_mod1) %>%
summarise(med_humedad= mean(humedad),
med_proteina=mean(proteina),
med_almidon= mean(almidon),
sd_humedad= sd(humedad),
sd_proteina=sd(proteina),
sd_almidon= sd(almidon))## `summarise()` ungrouping output (override with `.groups` argument)## # A tibble: 3 x 7
## clust_mod1 med_humedad med_proteina med_almidon sd_humedad sd_proteina
## <int> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 7.97 10.6 45.5 0.731 0.446
## 2 2 10.6 8.66 57.7 0.992 1.18
## 3 3 11.2 7.48 68.7 0.773 0.528
## # ... with 1 more variable: sd_almidon <dbl>Parte 2. Cluster de particiones
- MANOVA para comparar entre tipos de harinas para las tres variables
y<-cbind(dat1$humedad,dat1$almidon,dat1$proteina)
mod5<-manova(y~dat1$harina)
summary(mod5) # Hay diferencias entre la harinas## Df Pillai approx F num Df den Df Pr(>F)
## dat1$harina 2 1.4658 78.65 6 172 < 2.2e-16 ***
## Residuals 87
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1- Gráfico tridimensional para buscar patrones
library(rgl)## Warning: package 'rgl' was built under R version 4.0.5# Colores de los tipos de harina
cool<-ifelse(dat1$harina=="cha",1,ifelse(dat1$harina=="arr",2,3))
# Gráfico tridimensional de las tres variables evaluadas
plot3d(dat1$humedad,dat1$almidon,dat1$proteina,col=cool)
# Grafico de dispersion eliminando la variable de proteina
plot(dat1$humedad,dat1$almidon,col=cool)
- Graficos de sedimentación y clusters
library(cluster)
library(factoextra)
fviz_nbclust(dfb,kmeans,method= "wss")
km<- kmeans(dfb,centers = 3,nstart = 25)
# Gráfico de clusters datos estandarizados
fviz_cluster(km,data=dfb)
# Caracterización de clusters
aggregate(dfb, by=list(cluster=km$cluster), mean)## cluster humedad almidon proteina
## 1 1 0.4212798 0.04391756 -0.3166988
## 2 2 -1.1650820 -1.18443389 1.2604144
## 3 3 0.7438022 1.14051632 -0.9437156