PCA para el clustering
Mihai Cristian Mihalache Farcas
2025-05-26
datos_Z <- readRDS("intento_pca2018.Rds")set.seed(100)
n_obs <- nrow(datos_Z) # 16
m_vec <- c(5, 8, 10, 12) # tamaños de muestra viables
seeds <- sample(1:1000, 10) # 10 semillas
hop_val <- numeric()
for (m in m_vec) {
for (s in seeds) {
h <- get_clust_tendency(data = datos_Z,
n = m,
seed = s,
graph = FALSE)$hopkins_stat
hop_val <- c(hop_val, as.numeric(h))
}
}
summary(hop_val)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.5464 0.5629 0.5733 0.5768 0.5892 0.6225Observamos el valor del estadístico de Hopkins que supera por poco el 0,5 , y su valor maáximo llega a los 0,6395. Esto indica una débil o moderada tendencia al agrupamiento.
No es un valor extremadamente alto con el que podamos afirmar de manera segura que se forman clústers muy bien definidos.
Sin embargo, como contamos con pocos distritos(filas) en el dataframe, con 37 variables distintas y hemos apreciado antes que no hay clusters tan bien definidos, realizaremos un PCA como paso intermedio para eliminar el ruido que generan varias variables y conseguir un clustering más robusto y fiable.
res.pca = PCA(datos_Z, scale.unit = TRUE, graph = FALSE, ncp = 10)
eig.val <- get_eigenvalue(res.pca)
VPmedio = 100 * (1/nrow(eig.val))
fviz_eig(res.pca, addlabels = TRUE) +
geom_hline(yintercept=VPmedio, linetype=2, color="red")
kable(eig.val[1:10,])| eigenvalue | variance.percent | cumulative.variance.percent | |
|---|---|---|---|
| Dim.1 | 32.959509 | 34.332822 | 34.33282 |
| Dim.2 | 12.149356 | 12.655579 | 46.98840 |
| Dim.3 | 8.845278 | 9.213831 | 56.20223 |
| Dim.4 | 7.576776 | 7.892475 | 64.09471 |
| Dim.5 | 6.169907 | 6.426987 | 70.52169 |
| Dim.6 | 4.666025 | 4.860443 | 75.38214 |
| Dim.7 | 4.371529 | 4.553676 | 79.93581 |
| Dim.8 | 4.085154 | 4.255369 | 84.19118 |
| Dim.9 | 3.608679 | 3.759041 | 87.95022 |
| Dim.10 | 3.274784 | 3.411233 | 91.36146 |
Viendo el Scree Plot y la varianza acumulada de las dimensiones hemos decidido elegir 5 componentes Principales, explicando el 75,16% de la varianza total. A partir de la sexta componente, el incremento es más plano y la ganancia es marginal. Siguiendo esa línea, las primeras 5 componentes están por encima de esa media, la sexta está justo al límite.
Como con los gráficos de variables es imposible sacar ninguna conclusión visualmente. Usaremos de forma complementaria unos gráfico auxiliares para las PC que deseemos representar, en nuestro caso las 5:
fviz_contrib(res.pca, choice = "var", axes = 1)
fviz_contrib(res.pca, choice = "var", axes = 2)
fviz_contrib(res.pca, choice = "var", axes = 3)
fviz_contrib(res.pca, choice = "var", axes = 4)
fviz_contrib(res.pca, choice = "var", axes = 5)
fviz_contrib(res.pca, choice = "var", axes = 6)
# Gráfico de scores
fviz_pca_ind(res.pca, axes = c(1,2), geom = c("point", "text"),
repel = TRUE, labelsize = 2)
K = 6
res.pca = PCA(datos_Z, scale.unit = TRUE, graph = FALSE, ncp = K)
# 1. Extraer las coordenadas de los distritos en las 5 primeras componentes
coords_pca <- res.pca$ind$coord[, 1:K]
# 2. Calcular matriz de distancias
dist_mat_pca <- dist(coords_pca, method = "euclidean")
set.seed(101)
n_obs <- nrow(coords_pca) # 16 distritos
m_vec <- c(5, 8, 10, 12) # tamaños viables de muestra (todos < 16)
seeds <- sample(1:1000, 10) # 10 semillas aleatorias
hop_val_nuevo <- numeric()
for (m in m_vec) {
for (s in seeds) {
h <- get_clust_tendency(data = coords_pca,
n = m,
seed = s,
graph = FALSE)$hopkins_stat
hop_val_nuevo <- c(hop_val_nuevo, h)
}
}
summary(hop_val_nuevo)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 0.4154 0.4918 0.5265 0.5205 0.5414 0.6851con pca
library(grid)
library(gridExtra)## Warning: package 'gridExtra' was built under R version 4.4.3##
## Adjuntando el paquete: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combinep1 = fviz_nbclust(x = coords_pca, FUNcluster = hcut, method = "silhouette",
hc_method = "ward.D2", k.max = 10, verbose = FALSE,
hc_metric = "euclidean") + labs(title = "Num. optimo clusters")
p2 = fviz_nbclust(x = coords_pca, FUNcluster = hcut, method = "wss",
hc_method = "ward.D2", k.max = 10, verbose = FALSE,
hc_metric = "euclidean") + labs(title = "Num. optimo clusters")
grid.arrange(p1, p2, nrow = 1)
clustering con pca
dist_mat <- dist(coords_pca, method = "euclidean")
clust2 <- hclust(dist_mat, method="ward.D2")
grupos2 <- cutree(clust2, k=5)
table(grupos2)## grupos2
## 1 2 3 4 5
## 8 2 1 4 1fviz_dend(clust2, k = 5,
cex = 0.5, color_labels_by_k = TRUE,
rect = TRUE) # dibujar rectángulos## Warning: The `<scale>` argument of `guides()` cannot be `FALSE`. Use "none" instead as
## of ggplot2 3.3.4.
## ℹ The deprecated feature was likely used in the factoextra package.
## Please report the issue at <https://github.com/kassambara/factoextra/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
con pca
p1 = fviz_nbclust(x = coords_pca, FUNcluster = kmeans, method = "silhouette",
k.max = 10, verbose = FALSE) +
labs(title = "K-means")
p2 = fviz_nbclust(x = coords_pca, FUNcluster = kmeans, method = "wss",
k.max = 10, verbose = FALSE) +
labs(title = "K-means")
grid.arrange(p1, p2, nrow = 1)
res.km <- NbClust(
data = coords_pca, # <- así sí lo reconoce
diss = NULL,
distance = "euclidean",
min.nc = 3,
max.nc = 5,
method = "kmeans",
index = "all"
)## Warning in pf(beale, pp, df2): Se han producido NaNs
## *** : The Hubert index is a graphical method of determining the number of clusters.
## In the plot of Hubert index, we seek a significant knee that corresponds to a
## significant increase of the value of the measure i.e the significant peak in Hubert
## index second differences plot.
## 
## *** : The D index is a graphical method of determining the number of clusters.
## In the plot of D index, we seek a significant knee (the significant peak in Dindex
## second differences plot) that corresponds to a significant increase of the value of
## the measure.
##
## *******************************************************************
## * Among all indices:
## * 8 proposed 3 as the best number of clusters
## * 8 proposed 4 as the best number of clusters
## * 8 proposed 5 as the best number of clusters
##
## ***** Conclusion *****
##
## * According to the majority rule, the best number of clusters is 3
##
##
## *******************************************************************set.seed(111)
clust_k_means_pca <- kmeans(coords_pca, centers = 5, nstart = 20)
table(clust_k_means_pca$cluster)##
## 1 2 3 4 5
## 3 2 2 5 4res.pca <- prcomp(datos_Z, scale. = TRUE)
clust3 <- kmeans(res.pca$x[, 1:2], centers = 5, nstart = 20)
fviz_pca_ind(res.pca,
axes = c(1, 2),
geom = "point",
habillage = factor(clust3$cluster),
palette = "jco",
addEllipses = TRUE,
ellipse.type = "convex",
repel = TRUE) +
ggtitle("PCA: distritos coloreados por cluster (k-means)") +
theme_minimal()
A la vista de los dos gráficos —el PCA con los 16 distritos y el mismo PCA coloreado por k-means (k = 5)— se aprecian cinco “perfiles” muy nítidos:
-> Encontramos la zona del casco histórico y de edificación densa
Distritos: Ciutat Vella, L’Eixample, Extramurs y El Pla del Real.
Encontramos unos scores muy negativos sobre la primera componente (poca superficie construida media en todos los rangos de precio) y PC2 cercana a 0.Son barrios más antiguos.
-> Barrios de alta superficie “económica”
Distritos: Jesús, Camins al Grau y Benimaclet.
PC1 negativa-media pero PC2 claramente negativa.
zonas con mucha oferta de pisos más “baratos” pero de gran tamaño (bloques de los años 60–70), con menos presencia de producto caro.
Áreas mixtas de densidad media
Distritos: Algirós, L’Olivereta y Campanar.
PC1 ligeramente positiva y PC2 alrededor de cero a moderadamente negativa.
Interpretación: barrios de densidad media, con inventario tanto económico como de precio medio, superficies modestas en los tramos más altos.
Residencial popular de mediana-alta superficie
Distritos: Patraix, La Saïdia y Rascanya.
PC1 positiva-media y PC2 positiva-baja.
Interpretación: productos de precio medio con superficies mínimas algo elevadas: bloques construidos en la expansión de los 80–90 orientados a clase trabajadora.
Zonas de nueva planta y altos estándares
Distritos: Poblats Marítims, Benicalap y Quatre Carreres.
PC1 claramente positiva y PC2 muy positiva.
Interpretación: desarrollos recientes con demanda de vivienda “cara”, grandes superficies y calidades superiores.
El clustering sobre el PCA refleja perfectamente la heterogeneidad de Valencia: desde el compacto casco histórico (cluster 1), pasando por los barrios de bloques grandes y baratos (cluster 2), hasta los nuevos desarrollos de alto standing (cluster 5), con otros dos perfiles intermedios (clusters 3 y 4).