Clusterización
Luis Alberto Abaunza Guevara
11/12/2020
Datos
Trabajaremos con los datos del concentrado de hogares de la Encuesta Nacional de Ingresos y Gastos de los Hogares de 2018. Podemos observar que los datos que tenemos están completos. Tomaremos las columnas que tengan datos sociodemográficos y la información sobre ingresos, tomando en cuenta que esto es suficiente ya que los gastos van en función de los ingresos de los hogares.
enigh <- read.csv("C:/Users/luisa/Downloads/concentradohogar.csv",
encoding = "UTF-8-BOM")
sum(colSums(is.na(enigh)))## [1] 0K-Medias
Veremos cuantos clusters serían adecuados para nuestros datos basándonos en que tan pequeña es la variación de las observaciones dentro de cada cluster:
library(tidyverse)
library(factoextra)
library(DataExplorer)
library(cluster)
library(reshape)
set.seed(123)
wssplot <- function(data, nc=15, seed=123){
wss <- c()
for (i in 1:nc){
set.seed(seed)
wss[i] <- kmeans(data, centers = i,nstart = 25, iter.max = 100)$tot.withinss
}
plot(1:nc, wss, type="b", pch = 19, frame = FALSE,
xlab="Number of clusters K",
ylab="Total within-clusters sum of squares",
col = "dodgerblue")
}
wssplot(ingresos, nc = 10)
Podemos ver que después de 4 clusters la variación no cambia significativamente, por lo que decidimos tomar 4 clusters como el valor apropiado.
A continuación probaremos los 4 algoritmos que tenemos disponibles y veremos como separan.
in_kmeans <- kmeans(scale(ingresos), centers = 4, nstart = 25, iter.max = 100,
algorithm = "Hartigan-Wong")
in_kmeans2 <- kmeans(scale(ingresos), centers = 4, nstart = 25, iter.max = 100,
algorithm = "Lloyd")
in_kmeans3 <- kmeans(scale(ingresos), centers = 4, nstart = 25, iter.max = 100,
algorithm = "Forgy")
in_kmeans4 <- kmeans(scale(ingresos), centers = 4, nstart = 25, iter.max = 100,
algorithm = "MacQueen")
fviz_cluster(in_kmeans, scale(ingresos)) + labs(title = "Hartigan-Wong")
Es muy parecido el resultado de los 4 algoritmos, sin embargo el que presenta una mejor separación es el obtenido usando Hartigan-Wong.
Veamos como se ve la media de cada variable (exceptuando la de ubicación geográfica ya que la media de esta variable no tiene sentido).
kmeans_cluster <- as.data.frame(scale(ingresos)) %>%
mutate(Cluster = in_kmeans$cluster) %>%
group_by(Cluster) %>%
summarise_all('mean')
info_kmeans <- as.data.frame(t(kmeans_cluster))
info_kmeans$Names <- rownames(info_kmeans)
info_kmeans <- melt(info_kmeans, id.vars = c('Names'))
info_kmeans$variable <- c(rep('Cluster 1', 50), rep('Cluster 2', 50), rep('Cluster 3', 50), rep('Cluster 4', 50))
info_kmeans <- info_kmeans[-c(1,2,51,52,101,102,151,152),]
ggplot(info_kmeans, aes(x = Names, y = value, color = variable, group = variable)) + geom_line() +
geom_point() + theme(text = element_text(size=12),
axis.text.x = element_text(angle=90, hjust=1))
Podemos ver que al menos respecto a la media, los clusters 2, 3 y 4 son muy similares. Además de que el primer cluster agrupa a la gente con mayores ingresos.
Dada esta razón, consideramos que es mejor quedarnos con dos clusters con el objetivo de tener el grupo con mayores ingresos y menor número de integrantes en el hogar, y otro con el de menores ingresos y mayor número de integrantes.
k.means <- kmeans(scale(ingresos), centers = 2, nstart = 25, iter.max = 100,
algorithm = "Hartigan-Wong")
fviz_cluster(k.means, scale(ingresos))
kmeans_cluster2 <- as.data.frame(scale(ingresos)) %>%
mutate(Cluster = k.means$cluster) %>%
group_by(Cluster) %>%
summarise_all('mean')
kmeans_cluster2 <- kmeans_cluster2[,c(1,3:50)]
info <- as.data.frame(t(kmeans_cluster2))
info$Names <- rownames(info)
info <- melt(info, id.vars = c('Names'))
info$variable <- c(rep('Cluster 1', 49), rep('Cluster 2',49))
info <- info[-c(1,50),]
ggplot(info, aes(x = Names, y = value, color = variable, group = variable)) + geom_line() +
geom_point() + theme(text = element_text(size=12),
axis.text.x = element_text(angle=90, hjust=1))
Así podemos ver que en este caso ya estan más y mejor separados los datos, donde en uno cluster tenemos a la gente mayores ingresos, mayormente con jefes de familia hombres y gente joven que viven en localidades con mucha gente, mientras que en el otro están mayormente jefas de familia, que reciben más remesas y gente mayor que recibe dinero de su jubilación, además de gente que recibe mayor dinero por transferencias.
Clusterización jerárquica
Para ayudar a la computadora a hacer los cálculos de las distancias escalaremos los datos originales. Además debido al gran número de datos y nuestra limitada memoria RAM, tomaremos una muestra aleatoria de los datos esperando que sea lo suficientemente representativa ya que es solo del 15%, también debido al tiempo en que se tardan en calcular todas las distancias, cargaremos las distancias obtenidas anteriormente.
library(caTools)
ingresos <- scale(ingresos) %>%
as.data.frame()
split <- sample.split(ingresos$mujeres, SplitRatio = 0.15)
x <- subset(ingresos, split == T)load('euclidean.Rda')
load('maximum.Rda')
load('manhattan.Rda')
load('minkowski.Rda')
load('datosHC.Rda')
hclust1 <- hclust(euclidean, method = 'complete')
hclust2 <- hclust(maximum, method = 'complete')
hclust3 <- hclust(manhattan, method = 'complete')
hclust4 <- hclust(minkowski, method = 'complete')
summary(euclidean)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.2192 5.2450 6.5007 7.6541 8.2829 315.1195## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.1134 2.4567 3.0502 4.2687 4.1889 215.4148## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.5238 18.6875 24.1670 26.6487 31.2295 659.6193## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.2192 5.2450 6.5007 7.6541 8.2829 315.1195
Los dendogramas como podemos ver no son muy claros, sin embargo, podemos ver que las distancias más pequeñas se dan usando la norma infinito (maximum), por esto y por nuestro afán de comparar este algoritmo con el de k-medias, utilizaremos 2 clusters.
## cluster n
## 1 1 11198
## 2 2 1## ubica_geo tam_loc est_socio clase_hog sexo_jefe edad_jefe educa_jefe
## 1 15850.3 2.543531 2.057684 2.147692 1.281989 49.89794 5.505402
## tot_integ hombres mujeres mayores menores ocupados percep_ing perc_ocupa
## 1 3.591928 1.749531 1.842397 2.834182 0.7577462 1.695687 2.410215 1.648004
## ing_cor ingtrab trabajo sueldos horas_extr comisiones aguinaldo indemtrab
## 1 45691 30461.9 25812.46 22196.68 269.5284 623.4006 1160.681 110.7525
## otra_rem negocio noagrop industria comercio servicios agrope agricolas
## 1 556.4686 3397.268 2651.491 625.4901 959.2534 1066.747 745.7769 408.3942
## pecuarios reproducc pesca otros_trab rentas utilidad arrenda transfer
## 1 306.0271 11.06171 20.29393 1252.165 2440.628 1939.965 500.663 7987.47
## jubilacion becas donativos remesas bene_gob otros_ing percep_tot
## 1 3541.565 109.2331 1024.228 521.1179 808.088 46.80545 4584.867
## retiro_inv prestamos otras_perc cluster
## 1 662.1582 481.1748 1944.549 1.000089Aquí podemos ver que el algoritmo prácticamente agrupo todas las observaciones en un solo cluster, y que ese cluster acaparador es prácticamente un grupo en medio de los dos que tenemos en k-medias. Veamos que pasa si vamos aumentando los grupos.
## cluster n
## 1 1 11195
## 2 2 3
## 3 3 1## cluster n
## 1 1 11193
## 2 2 3
## 3 3 1
## 4 4 1
## 5 5 1Vemos que prácticamente sigue pasando lo mismo y es que la division es mala, esto probablemente se debe a que la muestra que tomamos no es representativa y que agarramos muchos datos pertenecientes a un sector, que sería el de las personas en medio de los de ingresos altos y los de ingresos bajos.