INFORME DE ANÁLISIS MULTIVARIADO
ARTURO JOSE BELTRAN MENDOZA Y LAURA ESTEFANIA MORA JOAQUI
29/02/2021
OBJETIVOS
- Identificar grupos de individuos con caracteristicas comunes a partir de las observaciones de las variables de la base de datos.
INTRODUCCIÓN
El examen de Icfes o Pruebas saber 11, es conocido en Colombia por los estudiantes como la prueba que define la entrada a la educación superior permitiendo postularles tanto a universidades públicas como privadas a los estudiantes que se perfilan a estudiar una profesión.
Esta prueba consiste en evaluar cinco módulos conocidos como núcleos o competencias que evalúan tu conocimiento aprendido en el trascurso de tu educación media, estos módulos están comprendidos de la siguiente manera: matemáticas, lectura crítica, ciencias sociales, ciencias naturales e inglés.
Esta prueba está definida con un puntaje global de 0 a 500 puntos el cual definirá detalladamente el puntaje en que el estudiante esta perfilado de acuerdo con su conocimiento.
La base de datos utilizada para el análisis cluster tiene 100 observaciones y 8 variables, de las cuales 3 variables son cualitativas y 5 variables son cuantitativas.
datos## # A tibble: 100 x 8
## Departamento Municipio Colegio P_Lectura P_Matematica P_Ciencia P_Sociales
## <chr> <chr> <chr> <dbl> <dbl> <dbl> <dbl>
## 1 MAGDALENA SANTA ANA COL DP~ 47 48 37 30
## 2 BOGOTÁ BOGOTÁ D~ GIMN S~ 60 65 54 59
## 3 BOLIVAR CARTAGEN~ INSTIT~ 66 57 41 74
## 4 BOGOTÁ BOGOTÁ D~ COL VI~ 62 54 61 73
## 5 BOGOTÁ BOGOTÁ D~ CENT E~ 63 57 55 57
## 6 ATLANTICO SOLEDAD INSTIT~ 49 29 41 41
## 7 VALLE CALI CORPOR~ 76 70 70 68
## 8 SANTANDER BUCARAMA~ IE ESC~ 57 65 63 66
## 9 CUNDINAMARCA SOACHA INSTIT~ 62 62 66 39
## 10 SUCRE SINCELEJO CENTRO~ 68 66 63 77
## # ... with 90 more rows, and 1 more variable: P_Ingles <dbl>departamento<-datos$Departamentodatos1<-datos[c(4:8)]# Datos aleatorios
set.seed(123)
#Tomar 15 aleatorios entre 1 y 50
ss <- sample(1:50, 15)
# Subconjunto en datos1
df <- datos1[ss, ]
# Estandarizar variables
df.scaled <- scale(df)- Se estandarizan las variables para que tengan media cero y desviación estándar 1, para que la variable que tenga mas peso en la base de datos, no domine en el PCA.
# Calcular las distancias euclidianas
dist.eucl <- dist(df.scaled, method = "euclidean")
# redondeo
round(as.matrix(dist.eucl)[1:3, 1:3], 1)## 1 2 3
## 1 0.0 1.1 2.5
## 2 1.1 0.0 2.4
## 3 2.5 2.4 0.0#Distancias basadas en correlación
dist.cor <- get_dist(df.scaled, method = "pearson")
# redondeo
round(as.matrix(dist.cor)[1:3, 1:3], 1)## 1 2 3
## 1 0.0 0.7 1.0
## 2 0.7 0.0 1.6
## 3 1.0 1.6 0.0#Distancia para datos mixtos
# datos
data(flower)
head(flower, 3)## V1 V2 V3 V4 V5 V6 V7 V8
## 1 0 1 1 4 3 15 25 15
## 2 1 0 0 2 1 3 150 50
## 3 0 1 0 3 3 1 150 50# estructura
str(flower)## 'data.frame': 18 obs. of 8 variables:
## $ V1: Factor w/ 2 levels "0","1": 1 2 1 1 1 1 1 1 2 2 ...
## $ V2: Factor w/ 2 levels "0","1": 2 1 2 1 2 2 1 1 2 2 ...
## $ V3: Factor w/ 2 levels "0","1": 2 1 1 2 1 1 1 2 1 1 ...
## $ V4: Factor w/ 5 levels "1","2","3","4",..: 4 2 3 4 5 4 4 2 3 5 ...
## $ V5: Ord.factor w/ 3 levels "1"<"2"<"3": 3 1 3 2 2 3 3 2 1 2 ...
## $ V6: Ord.factor w/ 18 levels "1"<"2"<"3"<"4"<..: 15 3 1 16 2 12 13 7 4 14 ...
## $ V7: num 25 150 150 125 20 50 40 100 25 100 ...
## $ V8: num 15 50 50 50 15 40 20 15 15 60 ...# Matriz de distancias
dd <- daisy(flower)
round(as.matrix(dd)[1:3, 1:3], 2)## 1 2 3
## 1 0.00 0.89 0.53
## 2 0.89 0.00 0.51
## 3 0.53 0.51 0.00#Visualizar distancia
fviz_dist(dist.eucl)
- Podemos observar en el gráfico que algunos puntos estan relacionados, tienen algun tipo de cercanias, como otros puntos que no, pero se puede notar que hay ciertas tendencias, por lo tanto es razonable realizar el análisis cluster.
# Carga de base de datos escalados
df<-scale(datos1)
head(df,n=3)## P_Lectura P_Matematica P_Ciencia P_Sociales P_Ingles
## [1,] -0.8822019 -0.5671353 -1.3991610 -1.3879564 0.03890076
## [2,] 0.4093099 0.8805074 0.1802372 0.7305034 0.68724684
## [3,] 1.0053922 0.1992638 -1.0275379 1.8262584 0.75928530##¿Cuántos cluster escoger?
fviz_nbclust(df,kmeans,method="wss")+geom_vline(xintercept=4,linetype=2)
# Se escoge k=4 clusters- La figura de números óptimos de cluster indica que con los datos de la base, existen máximo 10 clusters, pero mediante la técnica del codito se eligen unicamente cuatro cluster ya que nos puede dar una mejor representación.
Análisis de k-medias.
Utilizamos el análisis de k-medias para hallar la medias de las distancias de cada uno de los individuos agrupados en el cluster.
#Análisis de k-medias. Importante que nstart sea "grande".
km.res<-kmeans(df,4,nstart=20)# Resultados
print(km.res)## K-means clustering with 4 clusters of sizes 30, 21, 29, 20
##
## Cluster means:
## P_Lectura P_Matematica P_Ciencia P_Sociales P_Ingles
## 1 -0.2198882 -0.1555506 -0.3617131 -0.6111878 -0.2876736
## 2 -1.3789372 -1.4511300 -1.1868049 -1.0679264 -1.3332602
## 3 0.4743993 0.5486948 0.2955685 0.6876808 0.5133609
## 4 1.0898372 0.9614051 1.3601405 1.0409673 1.0870603
##
## Clustering vector:
## [1] 1 3 3 3 3 2 4 3 3 4 2 2 3 3 1 1 3 1 1 1 3 1 1 2 3 4 3 1 2 4 1 1 3 1 1 1 2
## [38] 4 3 2 4 4 1 4 1 4 3 4 4 1 1 3 2 1 3 2 4 1 1 4 4 3 4 4 4 2 4 2 3 2 3 4 2 1
## [75] 1 3 3 3 3 4 2 3 2 2 1 1 1 1 3 3 2 1 2 2 3 2 1 2 3 1
##
## Within cluster sum of squares by cluster:
## [1] 38.73101 30.65291 39.36009 27.76082
## (between_SS / total_SS = 72.4 %)
##
## Available components:
##
## [1] "cluster" "centers" "totss" "withinss" "tot.withinss"
## [6] "betweenss" "size" "iter" "ifault"aggregate(datos1,by=list(cluster=km.res$cluster),mean)## cluster P_Lectura P_Matematica P_Ciencia P_Sociales P_Ingles
## 1 1 53.66667 52.83333 48.16667 40.63333 49.46667
## 2 2 42.00000 37.61905 39.28571 34.38095 34.95238
## 3 3 60.65517 61.10345 55.24138 58.41379 60.58621
## 4 4 66.85000 65.95000 66.70000 63.25000 68.55000# agregar número del cluster a la base de datos
datosdd<-cbind(datos1,cluster=km.res$cluster)
head(dd)## [1] 0.8875408 0.5272467 0.3517974 0.4115605 0.2269199 0.2876225En el Cluster means, en el item 1 y 2, indica que algunos estudiantes que presentaron el icfes obtuvieron menos puntaje en los componentes de Lectura, Matemáticas, Ciencias, Sociales e Ingles.
En el Cluster means, en el item 3 y 4, indica que algunos estudiantes que presentaron el icfes obtuvieron mas puntaje en los componentes de Lectura, Matemáticas, Ciencias, Sociales e Ingles.
El cluster4 nos dice que un grupo de estudiantes obtuvieron un puntaje alto en las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles.
El cluster2 nos dice que un grupo de estudiantes obtuvieron un puntaje muy bajo en las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles.
La suma de cuadrado total que es la varianza explicada por el clauster es del 72,4%.
##Salidas
# Núermo de cluster de cada individuo
km.res$cluster## [1] 1 3 3 3 3 2 4 3 3 4 2 2 3 3 1 1 3 1 1 1 3 1 1 2 3 4 3 1 2 4 1 1 3 1 1 1 2
## [38] 4 3 2 4 4 1 4 1 4 3 4 4 1 1 3 2 1 3 2 4 1 1 4 4 3 4 4 4 2 4 2 3 2 3 4 2 1
## [75] 1 3 3 3 3 4 2 3 2 2 1 1 1 1 3 3 2 1 2 2 3 2 1 2 3 1# tamaño de cluster
km.res$size## [1] 30 21 29 20# medias del cluster
km.res$centers## P_Lectura P_Matematica P_Ciencia P_Sociales P_Ingles
## 1 -0.2198882 -0.1555506 -0.3617131 -0.6111878 -0.2876736
## 2 -1.3789372 -1.4511300 -1.1868049 -1.0679264 -1.3332602
## 3 0.4743993 0.5486948 0.2955685 0.6876808 0.5133609
## 4 1.0898372 0.9614051 1.3601405 1.0409673 1.0870603res.pca<-PCA(datos1,graph=FALSE)
fviz_eig(res.pca,addlabels=TRUE)
var<-get_pca_var(res.pca)
fviz_pca_var(res.pca,col.var="cos2",
gradient.cols=c("#00AFBB","#E7B800","#FC4E07"),
repel=TRUE#Avoidtextoverlapping
)
fviz_pca_var(res.pca,col.var="contrib",
gradient.cols=c("#00AFBB","#E7B800","#FC4E07"),
repel=TRUE#Avoidtextoverlapping
)
La información se puede resumir en 84.2% en las dos primeras componentes principales.
La varianza explicada es mayor en la primera componente que en las demas componentes.
Las variables tienen un coseno cuadrado alto, por lo tanto, tienen una buena representación en el componente principal en las dimesiones 1 y 2.
Como las variables se encuentran cerca de la circunferencia del circulo de correlación, las variables tienen una buena representación.
La proyección para la variable puntaje Sociales es muy buena.
Las variables Puntaje en Matemáticas, puntaje en Ciencias y puntaje en Ingles están relacionadas con la dimensión 1 y la variable puntaje en Sociales y puntaje en Lectura estan relacionadas con la dimensión 2, por lo tanto, estas variables son las mas importantes para explicar la variablidad en el conjunto de datos.
La variable puntaje en Ingles es la que mas constribuye en el componente 1.
La variable puntaje en Sociales es la que mas constribuye en el componente 2.
Las variables Puntaje en Matemáticas y puntaje en Ciencias son las que menos constribuyen en el componente 1.
La variable puntaje en Lectura es la que menos constribuye en el componente 2.
ind<-get_pca_ind(res.pca)
fviz_pca_ind(res.pca, pointsize="cos2", pointshape=21, fill="#E7B800", repel=TRUE)
fviz_pca_biplot(res.pca,repel = TRUE,
col.var = "#2E9FDF")
Los puntos que se encuentran alejados del centro tienen un mejor coseno cuadrado.
El gráfico nos indica que los individuos como 10 y 95 tienen un valor alto para la variable puntaje en Sociales.
El gráfico nos indica que los individuos como 47, 17 y 67 tienen un valor alto para la variable puntaje en Lectura.
El gráfico nos indica que los individuos como 80, 30 y 64 tienen un valor alto para la variable puntaje en Matemáticas.
El gráfico nos indica que los individuos como 38, 65 y 41 tienen un valor alto para la variable puntaje en Ingles.
El gráfico nos indica que los individuos como 49 y 89 tienen un valor alto para la variable puntaje en Ciencias.
Visualización utilizando las componentes principales
fviz_cluster(km.res,data=df)
fviz_cluster(km.res,data=df, ellipse.type="norm", palette="set2", ggtheme=theme_minimal())
km_clusters <- kmeans(x = df, centers = 4, nstart = 50)
fviz_cluster(object = km_clusters, data = df, show.clust.cent = TRUE,
ellipse.type = "euclid", star.plot = TRUE, repel = TRUE,
pointsize=0.5,outlier.color="darkred") +
labs(title = "Resultados clustering K-means") +
theme_bw() + theme(legend.position = "none")
require(cluster)
pam.res <- pam(df, 4)
# Visualización
fviz_cluster(pam.res, geom = "point", ellipse.type = "norm",
show.clust.cent = TRUE,star.plot = TRUE)+
labs(title = "Resultados clustering K-means")+ theme_bw()
El cluster4 nos dice que un grupo de estudiantes obtuvieron un puntaje alto en las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles.
El cluster2 nos dice que un grupo de estudiantes obtuvieron un puntaje muy bajo en las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles.
En el gráfico se observa el centroide y cada uno de los puntos asociados a los cluster.
Los puntos 22, 50, y 86 pertenecen al cluster1.
Los puntos 6, 37 y 93 pertenecen al cluster2.
Los puntos 3, 4 y 77 pertenecen al cluster3.
Los puntos 10, 26 y 48 pertenecen al cluster4.
En la gráfica se observa que en el cluster2, el punto 68 se aleja del punto 98 que es el centro del cluster.
Los puntos 31, 51, 96 y 100 se encuentran en el medio del cluster1 y el cluster2.
fviz_pca_biplot(res.pca, label="var", habillage=as.factor(km_clusters$cluster)) +
labs(color=NULL) + ggtitle("") +
theme(text = element_text(size = 15),
panel.background = element_blank(),
panel.grid.major = element_blank(),
panel.grid.minor = element_blank(),
axis.line = element_line(colour = "black"),
legend.key = element_rect(fill = "white"))
En el gráfico se combinan el método K-Means con el método PCA. Los dos componentes graficados representan 84.2% de la variabilidad de los datos, por lo que es suficiente trabajar con estas dos componentes.
hay algunos datos que presentan inconsistencia, especialmente en la zona de conflicto entre los clusters. Vamos a probar un método más robusto (k-medioides) que no se ve afectado por valores extremos.
k-medioides (Algoritmo PAM)
data(datos1)## Warning in data(datos1): data set 'datos1' not founddf<-scale(datos1)
head(df,n=5)## P_Lectura P_Matematica P_Ciencia P_Sociales P_Ingles
## [1,] -0.8822019 -0.5671353 -1.3991610 -1.3879564 0.03890076
## [2,] 0.4093099 0.8805074 0.1802372 0.7305034 0.68724684
## [3,] 1.0053922 0.1992638 -1.0275379 1.8262584 0.75928530
## [4,] 0.6080040 -0.0562026 0.8305776 1.7532081 -0.03313769
## [5,] 0.7073510 0.1992638 0.2731430 0.5844027 -0.10517614##Método Silhouette para "determinar" el número de clusetrs
fviz_nbclust(df,pam,method="wss")+
theme_classic()
- Observando la figura, podemos deducir que cuatro es el número indicado de cluster.
### Análisis cluster con el algoritmo PAM
pam.res<-pam(df,4)
print(pam.res)## Medoids:
## ID P_Lectura P_Matematica P_Ciencia P_Sociales P_Ingles
## [1,] 81 -1.27959010 -0.90775712 -1.1204436 -1.3149061 -1.3298298
## [2,] 2 0.40930988 0.88050737 0.1802372 0.7305034 0.6872468
## [3,] 46 1.10473928 0.96566283 1.3880123 1.2418557 1.1194776
## [4,] 34 -0.08742541 0.02895285 -0.1913859 -0.2922014 -0.1772146
## Clustering vector:
## [1] 1 2 2 2 2 1 3 2 2 3 1 1 2 2 1 4 2 4 4 4 2 4 4 1 2 3 2 4 1 3 1 4 2 4 4 4 1
## [38] 3 2 1 2 3 4 3 4 3 2 3 3 4 1 2 1 4 2 1 3 4 4 3 3 2 3 3 3 1 3 1 2 1 4 3 1 4
## [75] 4 2 2 2 2 3 1 2 1 1 4 4 4 4 2 4 1 4 1 1 2 1 4 1 4 1
## Objective function:
## build swap
## 1.180357 1.147631
##
## Available components:
## [1] "medoids" "id.med" "clustering" "objective" "isolation"
## [6] "clusinfo" "silinfo" "diss" "call" "data"En el Cluster Medoids, observamos en la primera fila que un grupo de estudiantes presentaron un bajo puntaje en los componentes de las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles.
En la segunda fila se puede observar que un grupo de estudiante obtuvieron un puntaje medianamente regular en las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles.
En la tercera fila se observar que un grupo de estudiante obtuvieron un puntaje alto en las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles.
En la segunda fila se puede observar que un grupo de estudiante obtuvieron un puntaje medianamente bajo en las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles.
# clasificación
dd<-cbind(datos,cluster=pam.res$cluster)
head(dd,n=20)## Departamento Municipio
## 1 MAGDALENA SANTA ANA
## 2 BOGOTÁ BOGOTÁ D.C.
## 3 BOLIVAR CARTAGENA DE INDIAS
## 4 BOGOTÁ BOGOTÁ D.C.
## 5 BOGOTÁ BOGOTÁ D.C.
## 6 ATLANTICO SOLEDAD
## 7 VALLE CALI
## 8 SANTANDER BUCARAMANGA
## 9 CUNDINAMARCA SOACHA
## 10 SUCRE SINCELEJO
## 11 BOLIVAR MONTECRISTO
## 12 MAGDALENA CONCORDIA
## 13 BOGOTÁ BOGOTÁ D.C.
## 14 BOGOTÁ BOGOTÁ D.C.
## 15 ANTIOQUIA MEDELLÍN
## 16 CESAR EL PASO
## 17 BOYACA DUITAMA
## 18 HUILA NEIVA
## 19 VALLE RESTREPO
## 20 ATLANTICO BARRANQUILLA
## Colegio P_Lectura
## 1 COL DPTAL ANTONIO BRUGES CARMONA 47
## 2 GIMN SAN ANGELO 60
## 3 INSTITUCION EDUCATIVA PROMOCION SOCIAL DE C/GENA. 66
## 4 COL VIRGINIA GUTIERREZ DE PINEDA (INS EDUC DIST) 62
## 5 CENT EDUC DIST PALERMO CEDIP 63
## 6 INSTITUTO PARA LA CAPACITACIÓN SIMÓN RODRÍGUEZ - SEDE PRINCIPAL 49
## 7 CORPORACION EDUCATIVA ADVENTISTA- CÁMBULOS 76
## 8 IE ESCUELA NORMAL SUPERIOR DE BUCARAMANGA SEDE C 57
## 9 INSTITUCION EDUCATIVA INTEGRADO DE SOACHA 62
## 10 CENTRO EDUCATIVO LICEO PANAMERICANO - SEDE PRINCIPAL 68
## 11 I.E.T.A. Y MINERA MONTECRISTO - SEDE PRINCIPAL 42
## 12 ERM NRO 1 38
## 13 COLEGIO UNILATINA - SEDE PRINCIPAL 64
## 14 COL JOSE JOAQUIN VARGAS 52
## 15 INST EDUC JUAN MARIA CESPEDES 54
## 16 I.E. BENITO RAMOS TRESPALACIOS 52
## 17 PRINCIPAL INTEGRADO 63
## 18 COL COOPERATIVO UTRAHUILCA 48
## 19 JORGE ELIECER GAITAN 52
## 20 INST REINA DE LOS ANGELES 61
## P_Matematica P_Ciencia P_Sociales P_Ingles cluster
## 1 48 37 30 54 1
## 2 65 54 59 63 2
## 3 57 41 74 64 2
## 4 54 61 73 53 2
## 5 57 55 57 52 2
## 6 29 41 41 35 1
## 7 70 70 68 72 3
## 8 65 63 66 60 2
## 9 62 66 39 63 2
## 10 66 63 77 51 3
## 11 40 28 39 38 1
## 12 31 41 26 24 1
## 13 56 59 60 68 2
## 14 66 54 52 58 2
## 15 49 40 33 44 1
## 16 55 61 50 46 4
## 17 68 54 69 67 2
## 18 54 58 50 55 4
## 19 55 49 32 44 4
## 20 38 44 45 54 4El estudiante del colegio ANTONIO BRUGES CARMONA, ubicado en el municipio de Santa Ana del departamento del Magdalena cuyos puntajes en las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles fueron: 47, 48, 37, 30 y 54 pertence al cluster1.
El estudiante del colegio INSTITUCION EDUCATIVA PROMOCION SOCIAL, ubicado en el municipio de Cartagena del departamento de Bolivar cuyos puntajes en las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles fueron: 66, 57, 41, 74 y 64 pertence al cluster2.
El estudiante del colegio CENTRO EDUCATIVO LICEO PANAMERICANO, ubicado en el municipio de Sincelejo del departamento de Sucre cuyos puntajes en las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles fueron: 68, 66, 63, 77 y 51 pertence al cluster3.
El estudiante del colegio INST REINA DE LOS ANGELES, ubicado en el municipio de Barranquilla del departamento del Atlantico cuyos puntajes en las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles fueron: 61, 38, 44, 45 y 54 pertence al cluster4.
# medioides del análisis
pam.res$medoids## P_Lectura P_Matematica P_Ciencia P_Sociales P_Ingles
## [1,] -1.27959010 -0.90775712 -1.1204436 -1.3149061 -1.3298298
## [2,] 0.40930988 0.88050737 0.1802372 0.7305034 0.6872468
## [3,] 1.10473928 0.96566283 1.3880123 1.2418557 1.1194776
## [4,] -0.08742541 0.02895285 -0.1913859 -0.2922014 -0.1772146# Cluster para cada individuo
head(pam.res$clustering)## [1] 1 2 2 2 2 1# Dibujo de los cluster en las componentes principales consideradas.
fviz_cluster(pam.res,palette=c("#2E9FDF","#00AFBB","#E7B800","#FC4E07"),# color paletteellipse.type="t",# Concentration ellipserepel=TRUE,# Avoid label overplotting (slow)ggtheme=theme_classic()
)
En el Cluster1 indica un grupo de estudiantes presentaron los puntajes mas bajos en las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles.
En el Cluster3 indica un grupo de estudiantes presentaron los puntajes mas altos en las asígnaturas de Lectura, Matemáticas, Ciencias, Sociales e Ingles.
CLUSTER JERARQUICO
# datos
df<-scale(datos1)
head(df,nrow=6)## P_Lectura P_Matematica P_Ciencia P_Sociales P_Ingles
## [1,] -0.8822019 -0.5671353 -1.3991610 -1.3879564 0.03890076
## [2,] 0.4093099 0.8805074 0.1802372 0.7305034 0.68724684
## [3,] 1.0053922 0.1992638 -1.0275379 1.8262584 0.75928530
## [4,] 0.6080040 -0.0562026 0.8305776 1.7532081 -0.03313769
## [5,] 0.7073510 0.1992638 0.2731430 0.5844027 -0.10517614
## [6,] -0.6835078 -2.1850889 -1.0275379 -0.5844027 -1.32982984# matriz de disimilitudesres.
res.dist<-dist(df,method="euclidean")
as.matrix(res.dist)[1:6,1:6]## 1 2 3 4 5 6
## 1 0.000000 3.341616 3.890837 4.162404 3.133944 2.305315
## 2 3.341616 0.000000 1.866547 1.704326 1.100378 4.224740
## 3 3.890837 1.866547 0.000000 2.075824 2.017448 4.325877
## 4 4.162404 1.704326 2.075824 0.000000 1.325580 4.098608
## 5 3.133944 1.100378 2.017448 1.325580 0.000000 3.489596
## 6 2.305315 4.224740 4.325877 4.098608 3.489596 0.000000##Cluster
res.hc<-hclust(d=res.dist,method="ward.D2")
# cex: label size
fviz_dend(res.hc,cex=0.5)
##Cluster
res.hc<-hclust(d=res.dist,method="ward.D2")
plot(res.hc, labels=departamento,cex=0.5)
# Cortar el árbol en 4 grupos
grp<-cutree(res.hc,k=4)
head(grp,n=4)## [1] 1 2 2 2# Número de individuos en cada cluster
table(grp)## grp
## 1 2 3 4
## 33 28 20 19El punto 31 pertenece al cluster1.
El punto 28 pertence al cluster2.
El punto 20 pertenece al cluster3
El punto 19 pertenece al cluster4
# Cortar y pintar los 4 grupos
fviz_dend(res.hc,k=4,# Cut in four groups
cex=0.5,
# label size
k_colors=c("#2E9FDF","#00AFBB","#E7B800","#FC4E07"),color_labels_by_k=TRUE,
# color labels by groupsrect=TRUE# Add rectangle around groups
)
fviz_cluster(list(data=df,cluster=grp),palette=c("#2E9FDF","#00AFBB","#E7B800","#FC4E07"),ellipse.type="convex",# Concentration ellipserepel=TRUE,# Avoid label overplotting (slow)show.clust.cent=FALSE,ggtheme=theme_minimal()
)
# Agglomerative (Cluster Jerárquico)
res.agnes<-agnes(x=datos1,# datos stand=TRUE,# Estandarizadosmetric="euclidean",# Métricasmethod="ward"# Método
)# DIvisive ANAlysis Clustering
res.diana<-diana(x=datos1,# data matrixstand=TRUE,# standardize the datametric="euclidean"# metric for distance matrix
)fviz_dend(res.agnes,cex=0.6,k=4)
fviz_dend(res.diana,cex=0.6,k=4)
- Se puede notar que al agrupar los datos en los dos dendogramas, existe una similitud de distancias entre ciertos puntos los cuales se van agrupando entre si, formando cluster distintos.
###Comparación de dendogramas
df<-scale(datos1)
# Subconjunto de tamaño 10
set.seed(123)
ss<-sample(1:50,10)
df<-df[ss,]
#Matriz de distancias
res.dist<-dist(df,method="euclidean")
# Calcular dos análisis cluster por métodos diferentes
hc1<-hclust(res.dist,method="average")
hc2<-hclust(res.dist,method="ward.D2")# Crear dendongramas
dend1<-as.dendrogram (hc1)
dend2<-as.dendrogram (hc2)
# objeto que los contiene a ambos
dend_list<-dendlist(dend1,dend2)
#comparación
tanglegram(dend1,dend2)
Se puede ver en el gráfico que el agrupamiento en los dos dendogramas es similar, pero las distancias no son iguales.
Para los puntos de la imagen se tiene que la distancia que agrupa a los individuos 2, 1, 6, 7, 9, 3, 5, 10, 8 y 4 en el dendograma de la izquierda es aproximadamente 2.9, mientras que en el de la derecha es aproximadamente 3.9.
# Matriz de correlaciones entre una lista de dendogramas
# Matrices de correlaciones
cor.dendlist(dend_list,method="cophenetic")## [,1] [,2]
## [1,] 1.000000 0.979434
## [2,] 0.979434 1.000000cor.dendlist(dend_list,method="baker")## [,1] [,2]
## [1,] 1.0000000 0.9521383
## [2,] 0.9521383 1.0000000# Correlaciones
cor_cophenetic(dend1,dend2)## [1] 0.979434cor_bakers_gamma(dend1,dend2)## [1] 0.9521383- Como los dos dendogramas tienen una fuerte correlación podemos concluir que los dendogramas son estadisticamente similares.
REFERENCIAS
Practical Guide To Clauter Analysis in R Unsupervised Machine Learning by Alboukadel kassambara, Edition 1.
https://bookdown.org/dparedesi/data-science-con-r/aprendizaje-no-supervisado.html.