(Puntos 6 y 7)

1. Librerías

library(pacman)

p_load(
  tidyverse,
  sampling,
  haven,
  FactoMineR,
  factoextra
)

2. Cargar la base de datos

datos <- read_sav(
  "C:/Users/equipo/Desktop/lab/DEPARTAMENTAL/HOGARES (DEPARTAMENTAL) 2025/HOGARES (DEPARTAMENTAL) 2025.sav"
)

3. Selección de la muestra

semilla <- 1234

# Tamaño total de la muestra
n_total <- 30000

# Afijación proporcional

tam_estrato <- datos |>
  count(DEPARTAMENTO) |>
  mutate(
    nh = round(n / sum(n) * n_total)
  )

# Muestreo estratificado

set.seed(semilla)

muestra <- strata(
  data = datos,
  stratanames = "DEPARTAMENTO",
  size = tam_estrato$nh,
  method = "srswor"
)

# Base final de trabajo

df_datos <- getdata(datos, muestra)

4. Selección de variables del IPM

En este ejemplo se usan las dimensiones:

Educación
Niñez y juventud
Trabajo

vars_datos <- df_datos |>
  select(
    DEPARTAMENTO,

    # EDUCACIÓN
    analfabetismo,
    logro_educativo,

    # NIÑEZ Y JUVENTUD
    inasistencia_escolar,
    rezago_escolar,
    atencion_integral,
    trabajo_infantil,

    # TRABAJO
    desempleo_larga_duracion,
    empleo_formal
  )

5. Construcción de la base por departamento

Se calcula el promedio de privaciones para cada departamento.

departamentos <- vars_datos |>
  group_by(DEPARTAMENTO) |>
  summarise(
    across(
  where(is.numeric),
  \(x) mean(x, na.rm = TRUE)
  )
)

6. Análisis de Componentes Principales (ACP)

# Guardar nombres de departamentos
rownames_dep <- departamentos$DEPARTAMENTO

# Matriz numérica
matriz_pca <- departamentos |>
  select(-DEPARTAMENTO)

# Ejecutar ACP
res_pca <- PCA(
  matriz_pca,
  scale.unit = TRUE,
  graph = FALSE
)

# Asignar nombres
rownames(res_pca$ind$coord) <- rownames_dep

PUNTO 6

6.1 Plano de individuos coloreado por cos²

El cos² mide qué tan bien representado está cada departamento en el plano factorial.

Valores altos → mejor representación.
Valores bajos → peor representación.

fviz_pca_ind(
  res_pca,
  col.ind = "cos2",
  gradient.cols = c("blue", "yellow", "red"),
  repel = TRUE
)

Los departamentos con colores cálidos (amarillo o rojo) presentan mejor representación en el plano 1-2, mientras que los azules tienen menor calidad de representación.

6.2 Plano de individuos coloreado por contribución

La contribución indica qué departamentos participan más en la construcción de los ejes factoriales.

fviz_pca_ind(
  res_pca,
  col.ind = "contrib",
  gradient.cols = c("blue", "yellow", "red"),
  repel = TRUE
)

Los departamentos ubicados lejos del origen y con colores cálidos son los que más contribuyen a la formación de las componentes principales.

6.3 Departamentos con mejor calidad de vida

Se identifican usando la coordenada del eje 1.

coord_ind <- as.data.frame(res_pca$ind$coord)
coord_ind$DEPARTAMENTO <- rownames(coord_ind)

mejor_calidad <- coord_ind |>
  arrange(Dim.1) |>
  slice(1:4)

mejor_calidad

##        Dim.1      Dim.2      Dim.3       Dim.4      Dim.5 DEPARTAMENTO
## 88 -4.416526 -2.9731514 -0.6567856  0.04028776  0.2363746           88
## 11 -3.439575 -1.6991087 -0.1411451  0.06985502  0.6915044           11
## 25 -2.809199  0.1986418  1.0614679 -0.29640647  0.2924470           25
## 63 -2.576388  0.6974535  0.1171371 -0.02855725 -0.3170862           63

Los departamentos seleccionados corresponden a aquellos ubicados en el extremo asociado a menores privaciones multidimensionales.

6.4 Departamentos peor representados en el plano 1-2

cos2 <- as.data.frame(res_pca$ind$cos2)
cos2$DEPARTAMENTO <- rownames(cos2)

cos2$calidad_12 <- cos2$Dim.1 + cos2$Dim.2

peor_representados <- cos2 |>
  arrange(calidad_12) |>
  slice(1:4)

peor_representados

##          Dim.1        Dim.2      Dim.3       Dim.4        Dim.5 DEPARTAMENTO
## 27 0.006075489 4.018037e-05 0.83169851 0.029789858 0.0378109793           27
## 4  0.018694561 4.183028e-04 0.04284542 0.004700571 0.2854843911            4
## 21 0.009641547 1.821168e-02 0.81755559 0.001388494 0.0002160866           21
## 16 0.054732750 2.027375e-03 0.16013074 0.055772166 0.5083107794           16
##    calidad_12
## 27 0.00611567
## 4  0.01911286
## 21 0.02785322
## 16 0.05676012

Estos departamentos presentan bajos valores de cos², por lo que el plano factorial no representa adecuadamente su comportamiento.

6.5 Departamentos con perfiles más similares

Se usa distancia euclidiana sobre el plano factorial.

coords <- coord_ind |>
  select(Dim.1, Dim.2)

rownames(coords) <- coord_ind$DEPARTAMENTO

mat_dist <- as.matrix(dist(coords))

mat_dist[
  lower.tri(mat_dist, diag = TRUE)
] <- NA

min_dist <- which(
  mat_dist == min(mat_dist, na.rm = TRUE),
  arr.ind = TRUE
)

similar1 <- rownames(mat_dist)[min_dist[1]]
similar2 <- colnames(mat_dist)[min_dist[2]]

cat("Departamentos más similares:
")

## Departamentos más similares:

cat(similar1, "y", similar2)

## 13 y 86

Los departamentos encontrados poseen perfiles multidimensionales muy parecidos respecto a las privaciones analizadas.

6.6 Departamentos con perfiles más opuestos

max_dist <- which(
  mat_dist == max(mat_dist, na.rm = TRUE),
  arr.ind = TRUE
)

opuesto1 <- rownames(mat_dist)[max_dist[1]]
opuesto2 <- colnames(mat_dist)[max_dist[2]]

cat("Departamentos más opuestos:
")

## Departamentos más opuestos:

cat(opuesto1, "y", opuesto2)

## 88 y 99

Estos departamentos presentan comportamientos completamente diferentes en términos de privaciones del IPM.

PUNTO 7

7.1 Biplot del ACP

El biplot permite observar simultáneamente:

Los departamentos.
Las variables.
Las relaciones entre ambos.

fviz_pca_biplot(
  res_pca,
  repel = TRUE,
  col.var = "red",
  col.ind = "gray40"
)

7.2 Departamento ubicado en el extremo derecho del eje 1

extremo_derecho <- coord_ind |>
  arrange(desc(Dim.1)) |>
  slice(1)

extremo_derecho

##       Dim.1     Dim.2      Dim.3     Dim.4      Dim.5 DEPARTAMENTO
## 94 3.374214 -2.094134 -0.5595839 0.3577465 -0.0479757           94

Interpretación sugerida

El departamento ubicado en el extremo derecho del eje 1 representa el perfil con mayor asociación a las variables que apuntan en esa misma dirección.

7.3 Variables que caracterizan ese departamento

contrib_vars <- as.data.frame(
  res_pca$var$contrib
)

contrib_vars$Variable <- rownames(contrib_vars)

contrib_vars |>
  arrange(desc(Dim.1))

##                              Dim.1      Dim.2        Dim.3        Dim.4
## empleo_formal            18.357218  7.6544258  0.029802833 6.690599e-03
## rezago_escolar           18.091803 10.0707378  0.005138477 8.050832e-04
## inasistencia_escolar     15.664004  0.3938324  0.012206368 5.608864e+01
## analfabetismo            15.324742  0.8010810 23.964667781 1.431173e+01
## logro_educativo          10.702547 25.1913079  0.220962278 3.178729e+00
## trabajo_infantil          9.167972  8.3340330 30.502297781 2.044361e+01
## atencion_integral         7.721922 26.5970758 10.757213551 5.969375e+00
## desempleo_larga_duracion  4.969792 20.9575062 34.507710931 4.188919e-04
##                               Dim.5                 Variable
## empleo_formal            12.9722317            empleo_formal
## rezago_escolar            4.6425544           rezago_escolar
## inasistencia_escolar     13.1793357     inasistencia_escolar
## analfabetismo             1.2171770            analfabetismo
## logro_educativo           9.5884880          logro_educativo
## trabajo_infantil         27.9770432         trabajo_infantil
## atencion_integral         0.7889627        atencion_integral
## desempleo_larga_duracion 29.6342073 desempleo_larga_duracion

Las variables con mayor contribución positiva al eje 1 son las que caracterizan al departamento ubicado en el extremo derecho.

Si las variables asociadas corresponden a privaciones (analfabetismo, desempleo, rezago, etc.), entonces ese departamento presenta mayores niveles de pobreza multidimensional.

En cambio, si las variables positivas representan mejores condiciones, la interpretación será opuesta.