# 4 cifras significativas y sin notación científica:
options(digits = 4, scipen = 999)
# líbrerias
library(readxl)
library(dplyr)
library(forcats)
library(FactoClass)
library(ade4)
library(knitr) # para función kable (tablas estáticas)
library(DT) # para tablas interactivas
library(plotly) # para gráficos interactivos
library(scatterplot3d)
library(FactoMineR)
library(factoextra)
library(GDAtools)
library(cluster)Medición de Pobreza Monetaria y Desigualdad 2023
Medición de Pobreza Monetaria y Desigualdad 2023
Variables Seleccionadas
Categóricas
Clase
Sexo
Seguridad social en salud
Régimen de seguridad social en salud
Nivel educativo
Ocupación
Prima de servicios en los últimos 12 meses
Prima de navidad en los últimos 12 meses
Cotiza actualmente en el fondo de pensiones
Trabajo o negocio además de la ocupación principal
Recibió pagos por concepto de arriendos o pensiones en el mes pasado
Recibió ingresos por intereses de préstamos, CDT’s o similares en los últimos 12 meses
Prima de vacaciones en los últimos 12 meses
Parentezco
Realizó horas extras
Cuantitativas
Años cumplidos
Antigüedad en el empleo
Ingresos mes pasado por empleo
Prima de servicios (valor)
Prima de navidad (valor)
Prima de vacaciones (valor)
Ingresos por segundo trabajo o negocio
Pagos por arriendos del mes pasado
Dinero por intereses de préstamos, CDT’s o similares
Ingreso total observado
Ingreso total
Horas laboradas
Librerias
Carga de datos
# Verifica la carpeta de trabajo actual
setwd("C:/Users/DELL/Documents/2024/Ciencia de datos/data") #directorio de trabajoYou can add options to executable code like this
ACM
Ys <- as.data.frame(Ys)
Ys <- lapply(Ys, as.factor)
# Crear la tabla disyuntiva completa (TDC)
tdc <- acm.disjonctif(Y)
Z <- acm.disjonctif(Y)# Calcular la tabla de Burt
Z <- as.matrix(Z)
B <- t(Z) %*% Z
B[, 1:4] Clase.1 Clase.2 Sexo.1 Sexo.2
Clase.1 34751 0 14401 20350
Clase.2 0 3168 1645 1523
Sexo.1 14401 1645 16046 0
Sexo.2 20350 1523 0 21873
Régimen.1 26196 1519 13277 14438
Régimen.2 1679 83 789 973
Régimen.3 6876 1566 1980 6462
Nivel educativo.1 330 209 282 257
Nivel educativo.2 16792 2391 8648 10535
Nivel educativo.8 7020 296 2778 4538
Nivel educativo.10 10609 272 4338 6543
Ocupación.1 28255 1949 13715 16489
Ocupación.2 3215 130 1455 1890
Ocupación.3 3009 372 97 3284
Ocupación.7 272 717 779 210
Realizó horas extras.1 2319 129 1588 860
Realizó horas extras.2 32432 3039 14458 21013
Prima servicios (12M).1 24586 1348 12806 13128
Prima servicios (12M).2 10165 1820 3240 8745
Prima navidad (12M).1 6183 271 2823 3631
Prima navidad (12M).2 28568 2897 13223 18242
Prima vacaciones (12M).1 6334 205 3031 3508
Prima vacaciones (12M).2 28417 2963 13015 18365
Cotizante.1 26349 1464 13542 14271
Cotizante.2 8022 1680 2307 7395
Cotizante.3 380 24 197 207
Trabajo adicional.1 888 132 420 600
Trabajo adicional.2 33863 3036 15626 21273
Recibió ingresos por intereses (12M).1 384 33 265 152
Recibió ingresos por intereses (12M).2 34336 3135 15766 21705
Recibió ingresos por intereses (12M).9 31 0 15 16g <- colSums ( Z )/ nrow ( Z )/4
print(data.frame(t(g)*100)) Clase.1 Clase.2 Sexo.1 Sexo.2 Régimen.1 Régimen.2 Régimen.3 Nivel.educativo.1
1 22.91 2.089 10.58 14.42 18.27 1.162 5.566 0.3554
Nivel.educativo.2 Nivel.educativo.8 Nivel.educativo.10 Ocupación.1
1 12.65 4.823 7.174 19.91
Ocupación.2 Ocupación.3 Ocupación.7 Realizó.horas.extras.1
1 2.205 2.229 0.652 1.614
Realizó.horas.extras.2 Prima.servicios..12M..1 Prima.servicios..12M..2
1 23.39 17.1 7.902
Prima.navidad..12M..1 Prima.navidad..12M..2 Prima.vacaciones..12M..1
1 4.255 20.74 4.311
Prima.vacaciones..12M..2 Cotizante.1 Cotizante.2 Cotizante.3
1 20.69 18.34 6.397 0.2664
Trabajo.adicional.1 Trabajo.adicional.2
1 0.6725 24.33
Recibió.ingresos.por.intereses..12M..1 Recibió.ingresos.por.intereses..12M..2
1 0.2749 24.7
Recibió.ingresos.por.intereses..12M..9
1 0.02044Distribución por nivel educativo:
- El nivel educativo predominante es el Nivel educativo 1 (Ninguno) 22.91%, seguido por el Nivel educativo 2 (Preescolar-Colegio) 12.65%, mientras que otros niveles tienen menor representación, indicando una concentración significativa en los niveles más básicos.
Distribución por ocupación:
- La categoría de ocupación más representativa es la Ocupación 1 (Obrero privado) 19.91%.
Género (Sexo):
- Existe una ligera mayor representación en la categoría Sexo 2 (Femenino) 14.42% en comparación con Sexo 1 (Masculino) 10.58%, indicando una leve asimetría en la distribución por género.
Régimen laboral:
- El Régimen 1 (Contributivo) 18.27% es la categoría dominante, mientras que las demás (Régimen 2, Especial, y Régimen 3, Subsidiado) tienen menores porcentajes, lo que podría reflejar una predominancia en un tipo de relación laboral específica.
Horas extras y trabajo adicional:
- La categoría de Trabajo adicional 2 (No) 24.33% y la categoría de Realizó horas extras 1 (Sí) 23.39% destacan como las más altas, sugiriendo que una proporción importante de los individuos realiza actividades adicionales a su empleo principal.
Primas y beneficios:
- La categoría Prima navidad 2 (No) 20.74% y Prima vacaciones 2 (No) 20.69% muestran una fuerte representación, lo que indica que estos beneficios no son comunes entre los individuos.
Otros ingresos:
- La categoría de ingresos por arriendos o pensiones es minoritaria con solo un 1.267%, indicando que esta fuente de ingresos es poco representativa en la muestra. Por lo tanto decidimos no tomar en cuenta esta variable en lo siguiente.
acm <- MCA(Y)
Dado esto, con ayuda del criterio de Benzécri decidimos considerar solo los dos primeros ejes.
var_contrib <- data.frame(var = rownames(acm$var$contrib),
Dim1 = acm$var$contrib[, "Dim 1"],
Dim2 = acm$var$contrib[, "Dim 2"])
top_dim1 <- subset(var_contrib, Dim1 > 3)$var
top_dim2 <- subset(var_contrib, Dim2 > 3)$var
# Gráfico con las que más aportan en Dim1
fviz_mca_var(acm,
select.var = list(name = top_dim1),
col.var = "cos2",
repel = TRUE,
ggtheme = theme_minimal()
) +
ggtitle("Variables con mayor contribución en Dimensión 1")
# Gráfico con las que más aportan en Dim2
fviz_mca_var(acm,
select.var = list(name = top_dim2),
col.var = "cos2",
repel = TRUE,
ggtheme = theme_minimal()
) +
ggtitle("Variables con mayor contribución en Dimensión 2")
ggplot(data = acm$var$eta2, aes(x = `Dim 3`, y = `Dim 2`)) +
geom_point(colour = "red") + xlim(-0.3,0.4) + ylim(-0.05,0.38) +
geom_text(label=rownames(acm$var$eta2), colour = "red", hjust=1) +
theme_minimal()
Dimensión 1
Presenta una fuerte relación con las variables asociadas a la formalidad laboral, especialmente Régimen, Cotizante y Prima servicios (12M). Por tanto, este eje pone en evidencia diferencias importantes en la pertenencia a un régimen formal y la recepción de beneficios.Dimensión 2
Está fuertemente vinculada a la Ocupación, y también participan variables como Régimen y Prima navidad (12M). Esta dimensión sugiere variaciones en el tipo de ocupación (p. ej., asalariado vs. independiente) y ciertos beneficios complementarios.
fviz_contrib(acm, choice = "var", axes = 1)
fviz_contrib(acm, choice = "var", axes = 2)
Interpretación de los Ejes (Dimensiones)
Eje 1 (Dim1 - 19%):
Este eje explica el 19% de la variabilidad total. Representa la principal fuente de diferenciación entre las categorías.
Categorías opuestas:
En el lado positivo (derecha): Nivel educativo alto (por ejemplo, Nivel educativo 1) y categorías relacionadas con ocupaciones específicas, como Ocupación 7.
En el lado negativo (izquierda): Categorías como Realizó horas extras 1, Prima navidad (12M)_1, y Régimen 2.
Interpretación: El Eje 1 parece capturar una dimensión socioeconómica o laboral, diferenciando entre individuos con mayores niveles educativos y ocupaciones especializadas (lado positivo) versus aquellos con actividades laborales intensivas y menos estables (lado negativo).
Eje 2 (Dim2 - 12%):
Este eje explica el 12% de la variabilidad total. Complementa al Eje 1 y destaca una segunda dimensión de diferenciación.
Categorías relevantes:
En la parte superior (valores positivos): Régimen 2 y Cotizante 3, que podrían representar un nivel más autónomo o inusual de participación en actividades económicas.
En la parte inferior (valores negativos): Sexo 2, Realizó horas extras 1, y Trabajo adicional 2, asociadas con roles tradicionales o ingresos complementarios
Agrupamiento a partir del ACM
1-2. Extraer las coordenadas de las dos primeras dimensiones
# Extrae coordenadas de individuos (primeras 2 dimensiones)
coords <- as.data.frame(acm$ind$coord[, 1:2])- Pre-agrupamiento con k-means
nrow(coords) # [1] 37919[1] 37919nrow(unique(coords)) # [1] 1029[1] 1029set.seed(123) # Para reproducibilidad
pre_km <- kmeans(coords, centers = 500, nstart = 10)
# Ahora cada individuo se asigna a uno de los 500 clusters
#table(pre_km$cluster) # Revisa cómo se repartencoords_pre <- aggregate(coords,
by = list(cluster = pre_km$cluster),
FUN = mean)
# La primera columna es el identificador del cluster
head(coords_pre) cluster Dim 1 Dim 2
1 1 0.27932 -0.06677
2 2 -0.17758 -0.08293
3 3 -0.70656 0.66548
4 4 0.65536 0.33350
5 5 0.08464 -0.23915
6 6 -0.08257 0.03802# Quitamos la columna de identificador (ya no la necesitamos para la matriz)
coords_pre <- coords_pre[, -1]
dim(coords_pre) [1] 500 2# Debería ser 3000 x 2- Agrupamiento jerárquico (Ward) sobre los "super-individuos"
d_pre <- dist(coords_pre)
hc_pre <- hclust(d_pre, method = "ward.D2")
plot(hc_pre, labels = FALSE, main = "Dendrograma super-individuos (Ward)")
for(k in 2:10){
# Cortas el dendrograma
grupos_temp <- cutree(hc_pre, k=k)
# Calculas la silueta en la matriz original (o en 'coords_pre')
sil <- silhouette(grupos_temp, dist(coords_pre))
# Promedio de la silueta
avg_sil <- mean(sil[, 3])
cat("k =", k, ">> Average silhouette =", avg_sil, "\n")
}k = 2 >> Average silhouette = 0.367
k = 3 >> Average silhouette = 0.3777
k = 4 >> Average silhouette = 0.3321
k = 5 >> Average silhouette = 0.328
k = 6 >> Average silhouette = 0.3546
k = 7 >> Average silhouette = 0.3418
k = 8 >> Average silhouette = 0.3189
k = 9 >> Average silhouette = 0.3015
k = 10 >> Average silhouette = 0.3032 5. Decidir el número de grupos y cortar el árbol
k <- 3
super_groups <- cutree(hc_pre, k = k)
table(super_groups)super_groups
1 2 3
246 191 63 6. Realizar un K-means de consolidación, partiendo de los centros de gravedad de la partición obtenida al cortar el árbol.
coords_pre <- coords_pre %>%
rename(
Dim1 = `Dim 1`, # si se llama "Dim 1"
Dim2 = `Dim 2` # si se llama "Dim 2"
)centers_hc <- coords_pre %>%
mutate(cluster = super_groups) %>%
group_by(cluster) %>%
summarize(
Dim1 = mean(Dim1),
Dim2 = mean(Dim2)
) %>%
ungroup()set.seed(123) # para reproducibilidad
km_consolidado <- kmeans(
x = coords,
centers = as.matrix(centers_hc[, c("Dim1", "Dim2")]),
nstart = 1
)
grupos_finales <- km_consolidado$cluster
table(grupos_finales)grupos_finales
1 2 3
9596 25150 3173 Y$cluster_final <- grupos_finales
fviz_cluster(
object = km_consolidado,
data = coords, # (Dim1, Dim2) de los 37.000 individuos
geom = "point",
ellipse.type = "convex",
main = "Cluster final sobre Dim1-Dim2",
ggtheme = theme_minimal()
)
Interpretación de los Agrupamientos
Grupo 3 (Azul):
Predominantemente ubicado en el cuadrante superior izquierdo del plano factorial.
Características principales:
Relacionado con categorías como Régimen 2, Sexo 2, y Realizó horas extras 1.
Representa a individuos con roles laborales más tradicionales o asociados a trabajos operativos y de esfuerzo adicional.
Interpretación: Este grupo podría agrupar a personas con niveles educativos y roles laborales menos especializados, pero con alta actividad laboral.
Grupo 1 (Rojo):
Predominantemente en el cuadrante superior derecho del plano factorial.
Características principales:
Relacionado con categorías como Nivel educativo 1, Clase 2, y Ocupación 7.
Representa a individuos con niveles educativos más altos y ocupaciones relacionadas con habilidades especializadas o mayores ingresos.
Interpretación: Este grupo parece representar a individuos con mayor nivel socioeconómico y roles laborales estables.
Grupo 2 (Verde):
Ubicado principalmente en el centro del plano factorial, pero ligeramente hacia la parte inferior.
Características principales:
Incluye categorías como Cotizante 2, Prima navidad (12M)_2, y Sexo 1.
Representa un grupo más heterogéneo, con características intermedias tanto en nivel educativo como en roles laborales.
Interpretación: Este grupo podría corresponder a una categoría “promedio” o de transición entre los otros dos extremos.
Conclusión
Eje 1: Dimensión socioeconómica y laboral, diferenciando roles especializados (positivo) y operativos (negativo).
Eje 2: Dimensión relacionada con roles laborales tradicionales versus alternativos.
Eje 3: Captura diferencias más específicas en la estabilidad laboral y nivel educativo.
Agrupamientos:
Grupo 1: Personas con roles laborales intensivos y tradicionales.
Grupo 2: Personas con niveles educativos y ocupaciones especializadas.
Grupo 3: Un grupo intermedio que refleja características más balanceadas.
Interpretación general del eje 1
El eje 1 probablemente está relacionado con:
Clase socioeconómica o región geográfica:
Clase.1 (9.2%)yClase.2 (0.8%)podrían estar explicando diferencias entre “Cabecera” y “Resto”.
Ingreso o acceso a beneficios:
- Categorías como
Prima.servicios..12M..1 (6.8%)yPrima.navidad..12M..1 (8.3%)sugieren que los beneficios laborales tienen un impacto importante.
- Categorías como
Participación laboral:
Ocupación.1 (8.0%)tiene una contribución significativa, lo que indica que la ocupación podría estar asociada con las diferencias observadas.
Relación con el sistema de pensiones:
Recibió.arriendos.pensiones..mes.pasado..1 (9.7%)yRecibió.arriendos.pensiones..mes.pasado..2 (9.5%)tienen valores altos, sugiriendo que este factor influye considerablemente en las diferencias.