Algoritmos de Clústerización
Diego Zamarripa
31/12/2020
Algorítmo k-medias
Como siempre lo primero es la carga de datos y selección de variables. Después de revisar la información al respecto de las variables nos quedamos solo con “tam_loc”, “est_socio”, “clase_hog”, “educa_jefe”, “tot_integ”, “percep_ing”, “ing_cor” y “gasto_mon” esto porque variables como “tot_integ”, “ing_cor” y “gasto_mon” contenia a otras variables por lo que de esta forma las incluimos sin cargar al algoritmo de muchas variables por analizar. Además, con variables como “tam_loc”, “est_socio”, “clase_hog”, “educa_jefe”, “tot_integ” y “percep_ing” podemos analizar la parte geográfica y sociodemográfica.
# Filtrado de Datos
data <- read.csv("concentradohogar.csv", header = T, sep = ",")
D1 <- data[,c(4, 5, 9, 12, 13, 21, 23, 57)]El siguiente paso es decidir cuantos grupos formar, para esto se aplicó una técnica conocida como el Método del Codo que busca encontrar el número óptimo de grupos. Para ello, aplicaremos la función “k-means” al conjunto de datos, variando en cada caso el valor de k, y acumulando los valores de WCSS obtenidos. Una vez obtenido estos valores, los graficamos.
Como sabemos con cualquier prueba de codo se elige el valor a partir del cual la variación ya no cambia de manera significante. En este caso elegiremos k = 8.
Una vez decidido esto aplicamos el algoritmo en sus 4 variaciones.
Hartigan-Wong
# Algoritmo
k8h <- kmeans(D1, centers = 8, algorithm = "Hartigan-Wong", iter.max = 1000, nstart = 1)
# Gráfica
fviz_cluster(k8h, data)
# Variación
k8h$tot.withinss## [1] 4.519695e+13# Centers
k8h$centers## tam_loc est_socio clase_hog educa_jefe tot_integ percep_ing ing_cor
## 1 2.027965 2.435180 2.324530 6.772225 4.241153 2.860176 73027.03
## 2 1.775000 3.100000 2.150000 9.175000 3.425000 2.275000 1029315.04
## 3 1.587612 3.057050 2.243684 8.821516 3.951100 2.757946 204463.19
## 4 1.800094 2.719006 2.345676 7.775955 4.214436 2.917741 123684.12
## 5 2.390583 2.125426 2.239431 5.728391 3.935484 2.588539 41490.76
## 6 2.900000 2.400000 2.100000 8.200000 4.600000 2.500000 3137139.39
## 7 2.983078 1.732861 1.983789 4.471074 3.024718 2.050427 18694.40
## 8 1.815126 2.991597 2.210084 8.806723 3.915966 2.596639 420528.14
## gasto_mon
## 1 45606.46
## 2 299089.75
## 3 126031.31
## 4 69354.96
## 5 27772.17
## 6 402336.81
## 7 13551.98
## 8 159449.53Lloyd
# Algoritmo
k8l <- kmeans(D1, centers = 8, algorithm = "Lloyd", iter.max = 1000, nstart = 1)
# Gráfica
fviz_cluster(k8l, data)
# Variación
k8l$tot.withinss## [1] 4.519695e+13# Centers
k8l$centers## tam_loc est_socio clase_hog educa_jefe tot_integ percep_ing ing_cor
## 1 1.589097 3.056957 2.243287 8.818552 3.947925 2.755899 204433.60
## 2 2.027881 2.435218 2.324471 6.771946 4.240483 2.859646 73021.32
## 3 2.900000 2.400000 2.100000 8.200000 4.600000 2.500000 3137139.39
## 4 1.815126 2.991597 2.210084 8.806723 3.915966 2.596639 420528.14
## 5 1.800562 2.718303 2.346145 7.775955 4.217717 2.920084 123643.41
## 6 2.390736 2.125411 2.239362 5.728384 3.935331 2.588429 41488.55
## 7 1.775000 3.100000 2.150000 9.175000 3.425000 2.275000 1029315.04
## 8 2.982983 1.732859 1.983787 4.470978 3.024660 2.050402 18692.73
## gasto_mon
## 1 125933.54
## 2 45603.68
## 3 402336.81
## 4 159449.53
## 5 69349.89
## 6 27770.29
## 7 299089.75
## 8 13551.52Forgy
# Algoritmo
k8f <- kmeans(D1, centers = 8, algorithm = "Forgy", iter.max = 1000, nstart = 1)
# Gráfica
fviz_cluster(k8f, data)
# Variación
k8f$tot.withinss## [1] 4.519695e+13# Centers
k8f$centers## tam_loc est_socio clase_hog educa_jefe tot_integ percep_ing ing_cor
## 1 1.775000 3.100000 2.150000 9.175000 3.425000 2.275000 1029315.04
## 2 1.589097 3.056957 2.243287 8.818552 3.947925 2.755899 204433.60
## 3 2.390736 2.125411 2.239362 5.728384 3.935331 2.588429 41488.55
## 4 2.027881 2.435218 2.324471 6.771946 4.240483 2.859646 73021.32
## 5 2.900000 2.400000 2.100000 8.200000 4.600000 2.500000 3137139.39
## 6 2.982983 1.732859 1.983787 4.470978 3.024660 2.050402 18692.73
## 7 1.815126 2.991597 2.210084 8.806723 3.915966 2.596639 420528.14
## 8 1.800562 2.718303 2.346145 7.775955 4.217717 2.920084 123643.41
## gasto_mon
## 1 299089.75
## 2 125933.54
## 3 27770.29
## 4 45603.68
## 5 402336.81
## 6 13551.52
## 7 159449.53
## 8 69349.89MacQueen
# Algoritmo
k8m <- kmeans(D1, centers = 8, algorithm = "MacQueen", iter.max = 1000, nstart = 1)
# Gráfica
fviz_cluster(k8m, data)
# Variación
k8m$tot.withinss## [1] 4.519695e+13# Centers
k8m$centers## tam_loc est_socio clase_hog educa_jefe tot_integ percep_ing ing_cor
## 1 2.982983 1.732859 1.983787 4.470978 3.024660 2.050402 18692.73
## 2 2.390736 2.125411 2.239362 5.728384 3.935331 2.588429 41488.55
## 3 1.800562 2.718303 2.346145 7.775955 4.217717 2.920084 123643.41
## 4 2.900000 2.400000 2.100000 8.200000 4.600000 2.500000 3137139.39
## 5 1.589097 3.056957 2.243287 8.818552 3.947925 2.755899 204433.60
## 6 1.775000 3.100000 2.150000 9.175000 3.425000 2.275000 1029315.04
## 7 1.815126 2.991597 2.210084 8.806723 3.915966 2.596639 420528.14
## 8 2.027881 2.435218 2.324471 6.771946 4.240483 2.859646 73021.32
## gasto_mon
## 1 13551.52
## 2 27770.29
## 3 69349.89
## 4 402336.81
## 5 125933.54
## 6 299089.75
## 7 159449.53
## 8 45603.68Primero notamos que los resultados obtenidos por cada uno de los algoritmos son muy parecidos el uno con el otro por lo que no es posible decir cuál es el mejor. A simple vista parece que todos lo hicieron bien.
El análisis de los datos se hará para el algoritmo de Hartigan-Wong aunque es similar para los demás.
# Centers
k8m$centers## tam_loc est_socio clase_hog educa_jefe tot_integ percep_ing ing_cor
## 1 2.982983 1.732859 1.983787 4.470978 3.024660 2.050402 18692.73
## 2 2.390736 2.125411 2.239362 5.728384 3.935331 2.588429 41488.55
## 3 1.800562 2.718303 2.346145 7.775955 4.217717 2.920084 123643.41
## 4 2.900000 2.400000 2.100000 8.200000 4.600000 2.500000 3137139.39
## 5 1.589097 3.056957 2.243287 8.818552 3.947925 2.755899 204433.60
## 6 1.775000 3.100000 2.150000 9.175000 3.425000 2.275000 1029315.04
## 7 1.815126 2.991597 2.210084 8.806723 3.915966 2.596639 420528.14
## 8 2.027881 2.435218 2.324471 6.771946 4.240483 2.859646 73021.32
## gasto_mon
## 1 13551.52
## 2 27770.29
## 3 69349.89
## 4 402336.81
## 5 125933.54
## 6 299089.75
## 7 159449.53
## 8 45603.68Tomemos el grupo 2 y 7 para analizar los datos, el grupo 2 es el grupo que tiene el est_socio, educa_jefe y percep_ing más altos de los demás grupos también corresponden a localidades de tamaño grande y la proporcion de integrantes que perciben ingresos entre integrantes totales es cercana a 1. Lo opuesto ocurre con el grupo 7 que es el grupo con menor est_socio, educa_jefe y percep_ing. Si ahondamos un poco más vemos que esta distribución se repite para los demás grupos, esto muestra que efectivamente son grupos con comportamientos distintos y que existe un patrón sociodemográfico. Pues los grupos se componen por observaciones que presentan valores similares para cada variable.
Algorítmo jerárquico
Dado que no es posible utilizar las 74647 observaciones en este algoritmo se eligieron al azar 1000 y se trabajó con estas.
# Filtrado de Datos
set.seed(123)
s <- sample(1:74647, 1000)
m <- D1[s,]Una vez teniendo los datos que usaremos aplicamos el algoritmo ultizando las distintas métricas.
Euclideana
# Euclidean
jeuc <- hclust(dist(m, method = 'euclidean'), method = "complete")
fviz_dend(jeuc)
Máximo
# Maximum
jmax <- hclust(dist(m, method = 'maximum'), method = "complete")
fviz_dend(jmax)
Manhattan
# Manhattan
jman <- hclust(dist(m, method = 'manhattan'), method = "complete")
fviz_dend(jman)
Minkowsky
# Minkowski
jmin <- hclust(dist(m, method = 'minkowski'), method = "complete")
fviz_dend(jmin)
Los árboles son distintos en el sentido que parecieran más cargados de un lado que de otro, tanto el árbol de la métrica euclidiana como de la métrica Minkowsky se ven cargados hacía la izquierda mientras que el árbol de la métrica Manhattan y la métrica Máxima están cargados hacia la derecha. En cuanto a las alturas no hay mucha diferencia entre los árboles pues todas tienen valores entre 0 y 1, 000, 000. Considero que la distancia Manhattan es la mejor por cómo está definida y dados la variación de los datos y los árboles parece un buen “punto medio” entre las otras métricas.
Probaremos los distintos métodos de aglomeración utilizando la métrica de Manhattan y utilizando k = 8, no solo por la prueba de codos realizada para el algoritmo anterior sino también porque a partir de los árboles resultantes parece un buen numero.
Complete
#Complete
jmanco <- hclust(dist(m, method = 'manhattan'), method = "complete")
fviz_dend(jmanco, k = 8)
Single
# Single
jmans <- hclust(dist(m, method = 'manhattan'), method = "single")
fviz_dend(jmans, k = 8)
Average
# Average
jmana <- hclust(dist(m, method = 'manhattan'), method = "average")
fviz_dend(jmana, k = 8)
Centroid
# Centroid
jmance <- hclust(dist(m, method = 'manhattan'), method = "centroid")
fviz_dend(jmance, k = 8)## Warning in get_col(col, k): Length of color vector was shorter than the number
## of clusters - color vector was recycled
Al igual que cuando probamos con las distintas métricas, la diferencia más notoria entre cada árbol es cuán cargado están hacia algún lado. En especial podemos notar que para el algoritmo single está muy cargado a la izquierda lo que hace sentido dada la naturaleza del método además la altura de este es la mitad de la altura del resto de los árboles.
Dados nuestros datos, las únicas variables que tiene diferencias amplias son las de ing_cor y gas_mon, considero que debido a esto el mejor método es “complete” pues la diferencia entre los valores de estas dos variables llega a ser bastante grande.
Considero que al igual que en el algoritmo de k-means debe haber un patrón geográfico y/o sociodemográfico en la asignación de los grupos sin embargo carezca del conocimiento suficiente del algoritmo jerárquico como para emitir un juicio.