1. Introducción

Este informe presenta un Análisis de Correspondencias Múltiples (ACM) aplicado a una selección de variables de la base Boston, seguido de técnicas de clustering (k-means y jerárquico) para identificar patrones entre observaciones. Las interpretaciones se presentan de manera clara y directa.

2. Carga y preparación de datos

library(MASS)
library(dplyr)
library(FactoMineR)
library(factoextra)
library(cluster)
library(NbClust)
library(tidyr)

data("Boston", package = "MASS")
df <- Boston %>%
  select(crim, chas, nox, rm, age, dis, tax, ptratio, lstat) %>%
  mutate(id = row_number()) %>%
  select(id, everything())

3. Discretización de variables

Se discretizan todas las variables continuas en cuatro categorías usando cuantiles; chas se mantiene como factor.

df_cat <- df %>%
  mutate(
    chas = factor(chas, labels = c("No", "Si")),
    crim_q = cut(crim, breaks = quantile(crim, probs = 0:4/4, na.rm=TRUE),
                 include.lowest = TRUE, labels = c("crim_Low","crim_MedLow","crim_MedHigh","crim_High")),
    nox_q  = cut(nox,  breaks = quantile(nox, probs = 0:4/4, na.rm=TRUE),
                 include.lowest = TRUE, labels = c("nox_Low","nox_MedLow","nox_MedHigh","nox_High")),
    rm_q   = cut(rm,   breaks = quantile(rm, probs = 0:4/4, na.rm=TRUE),
                 include.lowest = TRUE, labels = c("rm_Low","rm_MedLow","rm_MedHigh","rm_High")),
    age_q  = cut(age,  breaks = quantile(age, probs = 0:4/4, na.rm=TRUE),
                 include.lowest = TRUE, labels = c("age_Young","age_MidYoung","age_MidOld","age_Old")),
    dis_q  = cut(dis,  breaks = quantile(dis, probs = 0:4/4, na.rm=TRUE),
                 include.lowest = TRUE, labels = c("dis_Near","dis_MedNear","dis_MedFar","dis_Far")),
    tax_q  = cut(tax,  breaks = quantile(tax, probs = 0:4/4, na.rm=TRUE),
                 include.lowest = TRUE, labels = c("tax_Low","tax_MedLow","tax_MedHigh","tax_High")),
    ptratio_q = cut(ptratio, breaks = quantile(ptratio, probs = 0:4/4, na.rm=TRUE),
                    include.lowest = TRUE, labels = c("ptr_Low","ptr_MedLow","ptr_MedHigh","ptr_High")),
    lstat_q = cut(lstat, breaks = quantile(lstat, probs = 0:4/4, na.rm=TRUE),
                  include.lowest = TRUE, labels = c("lstat_Low","lstat_MedLow","lstat_MedHigh","lstat_High"))
  ) %>%
  select(id, chas, crim_q, nox_q, rm_q, age_q, dis_q, tax_q, ptratio_q, lstat_q)

4. Análisis de Correspondencias Múltiples (ACM)

El ACM permite visualizar relaciones entre categorías y observar la estructura de la data.

mca_input <- df_cat %>% select(-id) %>% mutate_all(as.factor)
res.mca <- MCA(mca_input, graph = FALSE, ncp = 10)

4.1 Gráfica de individuos

Interpretación: Se observan agrupamientos naturales de observaciones según combinaciones de categorías.

fviz_mca_ind(res.mca, label = "none") +
  ggtitle("MCA: Individuos")

4.2 Gráfica de variables

Interpretación: Las variables que aparecen cercanas están relacionadas; las categorías extremas tienden a separarse.

fviz_mca_var(res.mca, repel = TRUE) +
  ggtitle("MCA: Variables y Categorías")

5. Determinación del número de clusters

Se utiliza el índice silhouette para sugerir un número adecuado de grupos.

set.seed(123)
nc <- NbClust(res.mca$ind$coord, distance = "euclidean",
              min.nc = 2, max.nc = 6, method = "ward.D2", index = "silhouette")
nc$Best.nc
## Number_clusters     Value_Index 
##          2.0000          0.2164

6. Clustering k-means

k_try <- 3
coords <- as.data.frame(res.mca$ind$coord)
colnames(coords) <- paste0("Dim.", seq_len(ncol(coords)))
coords$id <- df_cat$id

kres <- kmeans(coords %>% select(Dim.1:Dim.5), centers = k_try, nstart = 50)
coords$kcluster <- factor(kres$cluster)

6.1 Visualización de k-means sobre el ACM

Interpretación: Los clusters muestran patrones diferenciados según las combinaciones de categorías.

fviz_mca_ind(res.mca, label = "none", habillage = coords$kcluster,
             addEllipses = TRUE, ellipse.level = 0.68) +
  ggtitle("MCA: Individuos agrupados por k-means")

7. Clustering jerárquico (Ward)

d <- dist(coords %>% select(Dim.1:Dim.5))
hc <- hclust(d, method = "ward.D2")
coords$hcluster <- factor(cutree(hc, k = k_try))

7.1 Dendrograma

Interpretación: Se observan tres bloques bien definidos según el método jerárquico.

fviz_dend(hc, k = k_try, rect = TRUE, show_labels = FALSE) +
  ggtitle("Dendrograma (Ward)")

8. Perfil de clusters

Se resumen las categorías más frecuentes por variable dentro de cada cluster.

df_cat2 <- df_cat %>%
  left_join(coords %>% select(id, kcluster), by = "id")

profile_k2 <- df_cat2 %>%
  pivot_longer(cols = -c(id, chas, kcluster), names_to = "var", values_to = "cat") %>%
  group_by(kcluster, var, cat) %>%
  summarise(n = n(), .groups = "drop") %>%
  group_by(kcluster, var) %>%
  mutate(freq = n / sum(n)) %>%
  arrange(kcluster, var, desc(freq))

profile_k2 %>% group_by(kcluster, var) %>% slice_max(freq, n = 1)
## # A tibble: 24 × 5
## # Groups:   kcluster, var [24]
##    kcluster var       cat              n  freq
##    <fct>    <chr>     <fct>        <int> <dbl>
##  1 1        age_q     age_Old        105 0.614
##  2 1        crim_q    crim_High      124 0.725
##  3 1        dis_q     dis_Near       120 0.702
##  4 1        lstat_q   lstat_High     102 0.596
##  5 1        nox_q     nox_High       117 0.684
##  6 1        ptratio_q ptr_MedHigh    135 0.789
##  7 1        rm_q      rm_Low          69 0.404
##  8 1        tax_q     tax_MedHigh    160 0.936
##  9 2        age_q     age_MidYoung    83 0.432
## 10 2        crim_q    crim_MedHigh    85 0.443
## # ℹ 14 more rows

Interpretación general: Cada cluster presenta un perfil distinto, reflejando combinaciones típicas de categorías (por ejemplo: alta criminalidad, alto impuesto, baja distancia al trabajo, etc.).

9. Evaluación del clustering (silhouette)

sil <- silhouette(as.integer(coords$kcluster), dist(coords %>% select(Dim.1:Dim.5)))
summary(sil)
## Silhouette of 506 units in 3 clusters from silhouette.default(x = as.integer(coords$kcluster), dist = dist(coords %>% select(Dim.1:Dim.5))) :
##  Cluster sizes and average silhouette widths:
##       171       192       143 
## 0.4393793 0.1405590 0.3900279 
## Individual silhouette widths:
##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
## -0.1192  0.1511  0.3103  0.3120  0.4849  0.6162
fviz_silhouette(sil)
##   cluster size ave.sil.width
## 1       1  171          0.44
## 2       2  192          0.14
## 3       3  143          0.39

Interpretación: Un silhouette promedio positivo refleja que la separación entre clusters es razonable.

10. Conclusiones