Aplicación de métodos de clustering para definir la cantidad de grupos

# Método Silhoute
set.seed(12345)
fviz_nbclust(vars_selecc, kmeans, method = "silhouette", k.max = 10)

El método Silhoute encont ramos el número óptimo de grupos, en este caso nos recomienda 2 grupos.

## Método de distancia cuadrada dentro (método del codo)
set.seed(12345)
fviz_nbclust(vars_selecc, kmeans, method = "wss", k.max = 10)

Se aplica el método de distancia cuadrada dentro llamado método del codo, no nos suguiere la cantidad de grupos pero basados en la gráfica se define que serían 3 grupos.

Se define que se tendrán en cuenta 4 grupos

K-medias

set.seed(12345)
kmedias <- kmeans(vars_selecc, 4)
vars_selecc$grupo_kmedias <- kmedias$cluster |> as.character()

ggplot(vars_selecc, aes(x = median_income, y = median_house_value, color = grupo_kmedias)) +
  geom_point(alpha = 0.6, size = 1) +
  labs(title = "K-medias (k=4)", 
       x = "Median income (scaled)", 
       y = "Median house value (scaled)") +
  theme_minimal()

El gráfico de K-medias con k = 4 muestra cómo los datos se dividieron en cuatro grupos diferenciados a partir de las variables de ingreso medio y valor medio de la vivienda las cuales fueron escaladas. Se observa que a mayores ingresos corresponden viviendas de mayor valor, y que el algoritmo logró separar distintos segmentos socioeconómicos dentro de la base. Aunque los grupos se traslapan en las zonas intermedias, se distinguen bien cuatro perfiles: hogares de bajo ingreso y bajo valor de vivienda, grupos de ingresos y valores medios, y un grupo más reducido de alto ingreso con viviendas más costosas. En conjunto, el modelo captura patrones lógicos de relación entre ingreso y precio de vivienda, resumiendo la estructura de la base en cuatro categorías representativas.

DBSCAN

## DBSCAN

# Selección de variables continuas
datos_db <- housing |>
  dplyr::select(housing_median_age, population, median_income, median_house_value) |>
  na.omit()

# Escalamiento
X <- scale(datos_db)

# Ajuste de DBSCAN
set.seed(123)
dbscan_model <- dbscan(X, eps = 0.3, minPts = 8)

# Resultados
table(dbscan_model$cluster)

## 
##     0     1     2     3     4     5     6     7     8     9    10    11    12 
##  3718 16583     5    36     8    11    14     8     7     7     7    25    18 
##    13    14    15    16    17    18    19    20    21    22    23    24    25 
##    20    10     5    17     7    25     8    17     6     9     8     7     4 
##    26    27    28    29    30    31 
##     8    11     8    11     8     4

# Agregar clúster al dataset
datos_db$cluster_db <- as.factor(dbscan_model$cluster)

# Visualización
ggplot(datos_db, aes(x = median_income, y = median_house_value, color = cluster_db)) +
  geom_point(alpha = 0.7, size = 1.5) +
  labs(title = "Clasificación con DBSCAN (4 grupos)",
       x = "median_income",
       y = "median_house_value") +
  theme_minimal()

El gráfico de DBSCAN de 4 grupos, evidencia que la mayor parte de los datos quedaron agrupados en un solo grupo grande, mientras que el resto se fragmenta en grupos muy pequeños y puntos considerados como ruido. A diferencia de K-medias, aquí no se observan cuatro segmentos bien balanceados, sino un patrón donde predomina un conglomerado principal de viviendas con ingresos y valores similares, acompañado de subgrupos minoritarios que representan casos atípicos o zonas menos densas de la muestra.

Curva de Codo

##Curva de Codo para encontrar el valor óptimo de K (K-PROTOTYPES)

if(!exists("data")||is.function(data)){
  if(exists("housing")) data<-housing else if(exists("housing_cat")) data<-housing_cat else stop("Define 'data' con tu dataset (p.ej., data <- housing).")
}
data<-as.data.frame(data)
if(!NROW(data)) stop("'data' no tiene filas.")

cost<-numeric()#Vector para almacenar el costo
K<-1:4#Rango de K a probar

set.seed(123)#Para reproducibilidad

#Identificar columnas numéricas y categóricas
num_cols<-names(data)[sapply(data,is.numeric)]
cat_cols<-names(data)[sapply(data,is.factor)]
lambda<-1#peso de variables categóricas

for(num_clusters in K){
  if(NROW(data)<num_clusters) stop("K > nrow(data).")#FIX:evita muestrear más filas de las que hay
  
  #Inicializar prototipos aleatorios
  proto_idx<-sample.int(NROW(data),num_clusters)
  proto_num<-if(length(num_cols)) data[proto_idx,num_cols,drop=FALSE] else NULL
  proto_cat<-if(length(cat_cols)) data[proto_idx,cat_cols,drop=FALSE] else NULL
  
  #Asignar clústeres
  clusters<-rep(NA_integer_,NROW(data))
  for(i in 1:NROW(data)){
    dists<-numeric(num_clusters)
    for(k in 1:num_clusters){
      d_num<-if(length(num_cols)) sum((as.numeric(data[i,num_cols])-as.numeric(proto_num[k,,drop=FALSE]))^2,na.rm=TRUE) else 0
      mism<-if(length(cat_cols)) {
        xi<-as.character(data[i,cat_cols,drop=FALSE][1,])
        pj<-as.character(proto_cat[k,cat_cols,drop=FALSE][1,])
        sum(xi!=pj,na.rm=TRUE)
      } else 0
      dists[k]<-d_num+lambda*mism
    }
    if(anyNA(dists)) dists[is.na(dists)]<-Inf#FIX:evita which.min con NA
    clusters[i]<-which.min(dists)
  }
  
  #CÁLCULO MANUAL DEL COSTO
  current_cost<-0
  for(i in 1:NROW(data)){
    k<-clusters[i]
    d_num<-if(length(num_cols)) sum((as.numeric(data[i,num_cols])-as.numeric(proto_num[k,,drop=FALSE]))^2,na.rm=TRUE) else 0
    mism<-if(length(cat_cols)) {
      xi<-as.character(data[i,cat_cols,drop=FALSE][1,])
      pj<-as.character(proto_cat[k,cat_cols,drop=FALSE][1,])
      sum(xi!=pj,na.rm=TRUE)
    } else 0
    current_cost<-current_cost+d_num+lambda*mism
  }
  
  cost[num_clusters]<-current_cost
}

#Dataframe
elbow_data<-data.frame(K=K,Cost=cost)

#Gráfica de codo
ggplot(elbow_data,aes(x=K,y=Cost))+
  geom_line(color="blue")+
  geom_point(color="blue",size=3)+
  labs(
    title="Método del Codo para K óptimo (K-Prototypes)",
    x="Número de clústeres (K)",
    y="Costo total"
  )+
  theme_minimal()

La gráfica del método del codo muestra cómo disminuye el costo total que suma de distancias mixtas, a medida que aumenta el número de grupos en el modelo K-Prototypes. Se observa una fuerte caída del costo al pasar de K = 1 a K = 2, lo que indica que dividir la base en dos grupos mejora significativamente la homogeneidad interna. Sin embargo, al aumentar a K = 3 o K = 4 la reducción adicional del costo es mucho menor y la curva tiende a estabilizarse. Por lo tanto, el “codo” se identifica alrededor de K = 2, lo que sugiere que este es el número óptimo de grupos para clasificar las viviendas.

Modelo final con K-Prototypes (3 grupos)

### Modelo final con K-Prototypes (3 grupos)

set.seed(42)#Semilla para reproducibilidad
num_clusters <- 3
lambda <- 1#Peso de categóricas

#Inicializar prototipos aleatorios
proto_idx <- sample.int(nrow(data), num_clusters) #FIX
proto_num <- data[proto_idx, num_cols, drop = FALSE]
proto_cat <- data[proto_idx, cat_cols, drop = FALSE]

#Asignar clúster a cada observación
clusters <- rep(NA, nrow(data))
for (i in 1:nrow(data)) {
  dists <- numeric(num_clusters)
  for (k in 1:num_clusters) {
    d_num <- sum((as.numeric(data[i, num_cols]) - as.numeric(proto_num[k, ]))^2, na.rm = TRUE) 
    mism  <- sum(as.character(data[i, cat_cols]) != as.character(proto_cat[k, ]), na.rm = TRUE)
    dists[k] <- d_num + lambda * mism }
  if (anyNA(dists)) dists[is.na(dists)] <- Inf 
  clusters[i] <- which.min(dists)
}
print(table(clusters))

## clusters
##     1     2     3 
##  3046  3800 13794

#Añadir el clúster al dataset
data_clustered <- data |>
  mutate(Cluster = clusters)

print(head(data_clustered,10))

##    longitude latitude housing_median_age total_rooms total_bedrooms population
## 1    -122.23    37.88                 41         880            129        322
## 2    -122.22    37.86                 21        7099           1106       2401
## 3    -122.24    37.85                 52        1467            190        496
## 4    -122.25    37.85                 52        1274            235        558
## 5    -122.25    37.85                 52        1627            280        565
## 6    -122.25    37.85                 52         919            213        413
## 7    -122.25    37.84                 52        2535            489       1094
## 8    -122.25    37.84                 52        3104            687       1157
## 9    -122.26    37.84                 42        2555            665       1206
## 10   -122.25    37.84                 52        3549            707       1551
##    households median_income median_house_value ocean_proximity Cluster
## 1         126        8.3252             452600        NEAR BAY       3
## 2        1138        8.3014             358500        NEAR BAY       3
## 3         177        7.2574             352100        NEAR BAY       3
## 4         219        5.6431             341300        NEAR BAY       3
## 5         259        3.8462             342200        NEAR BAY       3
## 6         193        4.0368             269700        NEAR BAY       3
## 7         514        3.6591             299200        NEAR BAY       3
## 8         647        3.1200             241400        NEAR BAY       3
## 9         595        2.0804             226700        NEAR BAY       3
## 10        714        3.6912             261100        NEAR BAY       3

El 66.8% de las viviendas quedaron en el grupo 3 (13 794 casos), 18.4% en el grupo 2 (3 800) y 14.8% en el grupo 1 (3 046), sobre un total de 20 640 observaciones. La partición está cargada hacia el grupo 3.

Es recomendable primero perfilar cada grupo (medias/modas) y si para conseguir más equilibrio se debe pruebar otros valores de K o ajustar el peso de las variable categóricas.

Aplicación cluster.carac

library(FactoClass)

#Usa la columna de clúster que creaste
cl <- as.factor(data_clustered$Cluster)

#Variable continuas
cluster.carac(tabla = data_clustered[sapply(data_clustered, is.numeric)],
              class = cl, tipo.v = "continuas")

## class: 1
##                    Test.Value Class.Mean Frequency Global.Mean
## latitude                5.444     35.826      3046      35.632
## population              4.736   1515.208      3046    1425.477
## longitude               3.896   -119.439      3046    -119.570
## housing_median_age     -8.375     26.876      3046      28.639
## median_income         -28.483      2.965      3046       3.871
## median_house_value    -43.849 122208.470      3046  206855.817
## Cluster              -123.166      1.000      3046       2.521
## ------------------------------------------------------------ 
## class: 2
##                    Test.Value Class.Mean Frequency Global.Mean
## latitude               32.739     36.657      3800      35.632
## longitude              -7.496   -119.790      3800    -119.570
## population            -12.835   1212.495      3800    1425.477
## households            -17.050    404.022      3800     499.540
## total_rooms           -18.963   2029.573      3800    2635.763
## Cluster               -48.150      2.000      3800       2.521
## median_income         -55.677      2.321      3800       3.871
## median_house_value    -76.540  77435.262      3800  206855.817
## ------------------------------------------------------------ 
## class: 3
##                    Test.Value Class.Mean Frequency Global.Mean
## Cluster               132.421      3.000     13794       2.521
## median_house_value     96.040 261200.744     13794  206855.817
## median_income          67.289      4.498     13794       3.871
## total_rooms            17.077   2818.455     13794    2635.763
## households             13.885    525.572     13794     499.540
## population              6.997   1464.335     13794    1425.477
## housing_median_age      6.092     29.015     13794      28.639
## longitude               3.235   -119.538     13794    -119.570
## latitude              -31.051     35.307     13794      35.632

Grupo 1: Este grupo se caracteriza por viviendas con valores y condiciones por debajo del promedio general. Se observa que la edad mediana de las viviendas es menor al global, al igual que el ingreso mediano y el valor medio de la casa, lo que sugiere zonas con construcciones más recientes pero de bajo nivel socioeconómico. Aunque la población es ligeramente más alta que la media, los ingresos y precios de vivienda están significativamente por debajo, indicando un grupo con concentración de hogares de bajos recursos.

Grupo 2: En este grupo predominan viviendas con menor número de habitaciones y hogares respecto al promedio, así como ingresos y valores de vivienda más bajos. La latitud es mayor, lo que puede estar asociado a una localización geográfica distinta más hacia el norte. El perfil refleja comunidades con mayor densidad poblacional, viviendas de menor tamaño y valor, y menores ingresos, lo cual corresponde a áreas más vulnerables o con desarrollo urbano limitado.

Grupo 3: Este grupo reúne las viviendas de mayor nivel socioeconómico. Aquí el valor medio de la vivienda y el ingreso mediano son significativamente superiores al promedio general. Además, el número de habitaciones y hogares es mayor, lo que denota viviendas más grandes y con mayor capacidad habitacional. Aunque la latitud es más baja que la media posible ubicación hacia el sur, el conjunto muestra características de zonas consolidadas, con mayor poder adquisitivo y precios de vivienda elevados.