Code
library(tidyverse)
library(faraway)
library(kableExtra)
library(CDR)
library(cluster)
library(factoextra)
library(ggrepel)
library(jsonlite)Unidad 5: Aprendizaje No Supervisado: técnicas no jerárquicas
Técnicas no jerárquicas
Fernández-Avilés and Montero (2024)
Rodrigo (2017)
Dada la utilidad del clustering en disciplinas muy distintas (genómica, marketing…), se han desarrollado multitud de variantes y adaptaciones de sus métodos y algoritmos. Pueden diferenciarse tres grupos principales:
Partitioning Clustering: Este tipo de algoritmos requieren que el usuario especifique de antemano el número de clusters que se van a crear (K-means, K-medoids, CLARA).
Hierarchical Clustering: Este tipo de algoritmos no requieren que el usuario especifique de antemano el número de clusters. (agglomerative clustering, divisive clusterig).
Kassambara (2017)
- Métodos que combinan o modifican los anteriores (hierarchical K-means, fuzzy clustering, model based clustering y density based clustering).
K-Means
Necesitamos saber previamente el número de clústers: K
El método encuentra los K mejores clústers. Se entiende como mejor clúster como aquel cuya varianza interna (varianza de los elementos que lo componen), es la mínima posible.
- Toda observación i, pertenece a un clúster k
- No hay ninguna observación que pertenezca a más de un clúster
Las medidas más comunes para definir la varianza son:
Suma de las distancias euclídeas al cuadrado entre cada observación y el centroide del clúster.
Suma de las distancias euclídeas al cuadrado entre todos los pares de observaciones que forman el clúster, dividida entre el número de observaciones del clúster.
Encontrar este mínimo es una función compleja, debido a la gran variedad de configuraciones que podría tener el clúster. Sin embargo, se aplica un algoritmo que es buena, sin ser necesariamente la óptima (mínimo local).
Asignar aleatoriamente un número entre 1 y K a cada observación. (Asignación inicial)
Iterar los siguientes pasos hasta que la asignación de las observaciones a los clusters no cambie o se alcance un número máximo de iteraciones predeterminado.
2.1. Para cada clúster se calcula el centroide, calculando la media de cada variable.
2.2. Se asigna a cada observación al clúster cuyo centroide está más próximo.
Otra alternativa:
Seleccionar de forma aleatoria k observaciones como centroides
Asignar cada observación al centroide más cercano
Para cada clúster, recalcular su centroide
Repetir los pasos 2 y 3 hasta que las asignaciones no cambien o se alcance un número máximo de iteraciones predeterminado
Ventajas
- Sencillez y velocidad
Desventajas
- Requiere conocer K. Hay estrategias para optimizar K
- No es 100 % determinista, por ello, se recomienda repetir el proceso y buscar el resultado que menor varianza interna tenga.
- Sensible a outliers.
Código R
Code
lqsa <- read.csv("https://raw.githubusercontent.com/jesusturpin/curintel2324/main/data/lqsa.csv")
nombres <- lqsa$Nombre
rownames(lqsa) <- nombresCode
lqsa2d <- lqsa %>%
select_if(is.numeric) %>%
select(Atractivo, Convivencia) %>%
mutate_all(scale)
lqsa5d <- lqsa %>%
select_if(is.numeric) %>%
mutate_all(scale)Code
set.seed(123)
km_clusters2d <- kmeans(x = lqsa2d, centers = 4, nstart = 50)
km_clusters5d <- kmeans(x = lqsa5d, centers = 4, nstart = 50)Code
# Objeto devuelto por kmeans: media de las variables en los clusters
# Vector con los elementos y el grupo al que pertenece
# La suma de los cuadrados interna de cada cluster
km_clusters2dK-means clustering with 4 clusters of sizes 11, 5, 9, 5
Cluster means:
Atractivo Convivencia
1 0.05156841 -0.7050180
2 0.27285563 1.8336351
3 -1.09620945 0.1006702
4 1.58687088 -0.4638018
Clustering vector:
Ongombo Violeta Javi Estela Reynolds La chusa
2 1 1 4 1
Vicente Enrique Pastor Amador Doña Fina Berta
2 3 1 3 1
Judith Lola Nines Clara Leo
4 4 3 3 3
Maxi Los Cuquitos Padre Alejandro Yoli Coque
3 2 2 4 1
Menchu Alba Raquel Antonio Recio Bruno
3 3 4 1 1
Maite Fermín Araceli Patricio Teodoro
1 2 1 3 1
Within cluster sum of squares by cluster:
[1] 3.150152 4.213857 2.156246 1.226957
(between_SS / total_SS = 81.5 %)
Available components:
[1] "cluster" "centers" "totss" "withinss" "tot.withinss"
[6] "betweenss" "size" "iter" "ifault" Code
lqsa2d %>%
mutate(cluster = as.factor(km_clusters2d$cluster)) %>%
ggplot() +
geom_text_repel(aes(x = Atractivo, y = Convivencia, label = rownames(lqsa2d),
color = cluster), size = 3.5)+
geom_point(aes(x = Atractivo, y = Convivencia, color = cluster))+
theme_bw()
Code
fviz_cluster(object = km_clusters2d, data = lqsa2d, ellipse.type = "t",
repel = TRUE) +
theme_bw() +
labs(title = "Resultados clustering PAM") +
theme(legend.position = "none")
Code
codo <- fviz_nbclust(x = scale(lqsa2d),
FUNcluster = kmeans,
method = "wss",
k.max = 10,
nstart = 25,
diss = dist(lqsa2d, method = "euclidean"))+
ggtitle("Número óptimo de clusters")
codo 
Code
(codo$data) clusters y
1 1 58.000000
2 2 34.525428
3 3 17.006213
4 4 10.747211
5 5 7.991157
6 6 5.248731
7 7 4.354529
8 8 3.493682
9 9 2.659938
10 10 2.273717Code
wss_values <- codo$data$y
# Calcular las diferencias porcentuales en el decremento de WSS
codo$data$perc_dec <- c(0, diff(wss_values) / head(wss_values, -1) * -100)Code
codo$data clusters y perc_dec
1 1 58.000000 0.00000
2 2 34.525428 40.47340
3 3 17.006213 50.74293
4 4 10.747211 36.80421
5 5 7.991157 25.64437
6 6 5.248731 34.31826
7 7 4.354529 17.03653
8 8 3.493682 19.76901
9 9 2.659938 23.86434
10 10 2.273717 14.51993Para las 5 dimensiones:
Code
codo5d <- fviz_nbclust(x = scale(lqsa5d),
FUNcluster = kmeans,
method = "wss",
k.max = 10,
nstart = 25,
diss = dist(lqsa2d, method = "euclidean"))+
ggtitle("Número óptimo de clusters 5 dimensiones")
codo5d
Code
wss_values <- codo5d$data$y
# Calcular las diferencias porcentuales en el decremento de WSS
codo5d$data$perc_dec <- c(0, diff(wss_values) / head(wss_values, -1) * -100)
codo5d$data clusters y perc_dec
1 1 58.000000 0.000000
2 2 47.545284 18.025373
3 3 28.140956 40.812309
4 4 21.369922 24.061137
5 5 15.671777 26.664322
6 6 15.130104 3.456363
7 7 12.658218 16.337531
8 8 9.970953 21.229414
9 9 6.192435 37.895252
10 10 6.092544 1.613118Code
set.seed(123)
km_clusters5d <- kmeans(x = lqsa5d, centers = 3, nstart = 50)
# Las funciones del paquete factoextra emplean el nombre de las filas del
# dataframe que contiene los datos como identificador de las observaciones.
# Esto permite añadir labels a los gráficos.
fviz_cluster(object = km_clusters5d, data = lqsa5d, show.clust.cent = TRUE,
ellipse.type = "euclid", star.plot = TRUE, repel = TRUE) +
labs(title = "Resultados clustering K-means") +
theme_bw() +
theme(legend.position = "none")
K-medoids (PAM)
La idea es similar a K-Means, pero cada cluster está representado por una observación presente en el cluster. Medoide, en lugar de centroide. El medoide es el elemento dentro de un cluster cuya distancia promedio entre él y todos los demás es la mínima posible. Es el elemento central, y por lo tanto, el más representativo del cluster. El algoritmo más empleado para aplicar K-medoid se conoce como PAM (Partitioning Around Medoids) y se implementa siguiendo los siguientes pasos:
- Seleccionar k observaciones como medoides iniciales, aunque se pueden identificar explícitamente.
- Calcular la matriz de distancia entre todas las observaciones
- Asignar a cada observación, su medoide más cercano
- Para cada cluster, comprobar si, seleccionando otra observación, se consigue reducir la distancia promedio del cluster y si es así, esa será el nuevo medoide.
- Si hubo algún cambio, volver al paso 3, sino, ya terminó.
Mientras que k-means minimiza la suma de las distancias al cuadrado de cada observación respecto a su centroide, k-medoids minimiza la suma de las diferencias de cada observación respecto a su medoide.
K-medoids, se usa cuando hay outliers, por ello, se recomienda usar distancia de Manhattan en lugar de euclídea.
Ventajas
- Robustez frente a ruido y outliers
Desventajas
- Se necesita conocer k
- Para dataset grandes, se requiere gran carga computacional
Code
codo2d_pam <- fviz_nbclust(x = lqsa2d,
FUNcluster = pam,
method = "wss",
k.max = 10,
diss = dist(lqsa2d, method = "manhattan"))
codo2d_pam
Code
wss_values <- codo2d_pam$data$y
# Calcular las diferencias porcentuales en el decremento de WSS
codo2d_pam$data$perc_dec <- c(0, diff(wss_values) / head(wss_values, -1) * -100)
codo2d_pam$data clusters y perc_dec
1 1 93.746380 0.00000
2 2 59.041758 37.01969
3 3 35.053993 40.62847
4 4 16.437568 53.10786
5 5 12.584631 23.43982
6 6 7.737153 38.51903
7 7 6.682680 13.62869
8 8 5.543018 17.05397
9 9 4.368617 21.18703
10 10 3.829048 12.35103Code
set.seed(123)
pam_clusters <- pam(x = lqsa2d, k = 4, metric = "manhattan")
pam_clustersMedoids:
ID Atractivo Convivencia
Fermín 27 -0.2225927 1.5747690
Coque 20 0.2082319 -0.8521010
Judith 11 1.6084121 -0.5285184
Doña Fina 9 -1.1919483 0.2804383
Clustering vector:
Ongombo Violeta Javi Estela Reynolds La chusa
1 2 2 3 2
Vicente Enrique Pastor Amador Doña Fina Berta
1 4 2 4 2
Judith Lola Nines Clara Leo
3 3 4 4 4
Maxi Los Cuquitos Padre Alejandro Yoli Coque
4 1 1 3 2
Menchu Alba Raquel Antonio Recio Bruno
4 4 3 2 2
Maite Fermín Araceli Patricio Teodoro
2 1 2 4 2
Objective function:
build swap
0.7672129 0.6180105
Available components:
[1] "medoids" "id.med" "clustering" "objective" "isolation"
[6] "clusinfo" "silinfo" "diss" "call" "data" Code
fviz_cluster(object = pam_clusters, data = lqsa2d, ellipse.type = "t",
repel = TRUE) +
theme_bw() +
labs(title = "Resultados clustering PAM") +
theme(legend.position = "none")
Code
codo5d_pam <- fviz_nbclust(x = lqsa5d,
FUNcluster = pam,
method = "wss",
k.max = 10,
diss = dist(lqsa5d, method = "manhattan"))
codo5d_pam
Code
wss_values <- codo5d_pam$data$y
# Calcular las diferencias porcentuales en el decremento de WSS
codo5d_pam$data$perc_dec <- c(0, diff(wss_values) / head(wss_values, -1) * -100)
codo5d_pam$data clusters y perc_dec
1 1 495.01513 0.000000
2 2 374.89660 24.265628
3 3 223.68554 40.334071
4 4 175.00772 21.761718
5 5 140.85920 19.512582
6 6 125.86036 10.648107
7 7 95.59865 24.043876
8 8 76.03511 20.464247
9 9 66.90749 12.004480
10 10 60.67630 9.313141Code
set.seed(123)
pam_clusters <- pam(x = lqsa5d, k = 3, metric = "manhattan")
pam_clustersMedoids:
ID Poder Convivencia Liante Atractivo Locura
Ongombo 1 0.9069029 1.25118630 -0.8426670 1.0698813 -1.1602019
Coque 20 -0.7174008 -0.85210102 -0.5238200 0.2082319 0.5916699
Nines 13 -0.3113249 -0.04314436 0.2960722 -1.1919483 0.6247241
Clustering vector:
Ongombo Violeta Javi Estela Reynolds La chusa
1 2 2 2 2
Vicente Enrique Pastor Amador Doña Fina Berta
1 1 2 3 1
Judith Lola Nines Clara Leo
2 2 3 3 3
Maxi Los Cuquitos Padre Alejandro Yoli Coque
3 3 1 2 2
Menchu Alba Raquel Antonio Recio Bruno
3 3 1 3 2
Maite Fermín Araceli Patricio Teodoro
2 3 2 3 2
Objective function:
build swap
2.791864 2.595406
Available components:
[1] "medoids" "id.med" "clustering" "objective" "isolation"
[6] "clusinfo" "silinfo" "diss" "call" "data" Code
fviz_cluster(object = pam_clusters, data = lqsa2d, ellipse.type = "t",
repel = TRUE) +
theme_bw() +
labs(title = "Resultados clustering PAM") +
theme(legend.position = "none")
Code
# Como hay más de 2 variables, se están representando las 2 primeras componentes
# de un PCA. Se tienen que calcular el PCA y extraer las proyecciones almacenadas
# en el elemento x.
medoids <- prcomp(lqsa5d)$x
# Se seleccionan únicamente las proyecciones de las observaciones que son medoids
medoids <- medoids[rownames(pam_clusters$medoids), c("PC1", "PC2")]
medoids <- as.data.frame(medoids)
# Se emplean los mismos nombres que en el objeto ggplot
colnames(medoids) <- c("x", "y")
# Creación del gráfico
fviz_cluster(object = pam_clusters, data = lqsa5d, ellipse.type = "t",
repel = TRUE) +
theme_bw() +
# Se resaltan las observaciones que actúan como medoids
geom_point(data = medoids, color = "firebrick", size = 2) +
labs(title = "Resultados clustering PAM") +
theme(legend.position = "none")
CLARA
Para resolver las limitaciones del método k-medoids, que para grandes datasets, requiere mucha RAM, se combina el algoritmo PAM, con remuestreo. No se buscan los medoides de todos los datos, sino que se extrae una muestra de un tamaño determinado y se le aplica el algoritmo PAM.
Pasos:
Dividir el conjunto en n partes de igual tamaño. n es un valor a determinar por el analista, dependerá de la capacidad de cómputo y el tamño del dataset.
Para cada una de las n partes: 2.1 Aplicar PAM e identificar los medoides 2.2 Usar los medoides para todo el set de datos 2.3 Calcular la suma total de las distancias entre las observaciones del set completo y su medoide
Seleccionar como clustering final aquel que haya conseguido menor suma total de distancias en el paso 2.3
Code
url_map_school <- "https://mapaescolar.murciaeduca.es/mapaescolar-api/api/centros"
col.df <- fromJSON(url_map_school)
col.simp.df <- col.df %>%
select(codcen, 'geo-referencia') %>%
unnest_wider('geo-referencia') %>%
as.data.frame %>%
drop_na()
rownames(col.simp.df) <- col.simp.df$codcen
col.simp.df <- col.simp.df %>% select(-codcen)
col.mat <- as.matrix(col.simp.df)Determinar el número de clusters:
Code
codo_col <- fviz_nbclust(col.simp.df, FUNcluster = clara, method = "wss", k.max = 8)
codo_col
Code
wss_values <- codo_col$data$y
# Calcular las diferencias porcentuales en el decremento de WSS
codo_col$data$perc_dec <- c(0, diff(wss_values) / head(wss_values, -1) * -100)
codo_col$data clusters y perc_dec
1 1 113.71311 0.000000
2 2 76.65825 32.586269
3 3 39.06879 49.035112
4 4 29.23678 25.165908
5 5 19.58450 33.014146
6 6 18.13019 7.425863
7 7 14.14346 21.989431
8 8 12.64734 10.578159Code
fit <- clara(col.simp.df, 5)
# Crear un data frame con los resultados del clúster
col.simp.df$cluster <- factor(fit$clustering)
# Usar ggplot2 para visualizar los datos en un mapa
ggplot(col.simp.df, aes(x = lon, y = lat, color = cluster)) +
geom_point(aes(size = 3)) +
ggtitle("Visualización de Clústeres Geográficos") +
theme_minimal() +
labs(color = "Cluster") +
borders("world", xlim = range(col.simp.df$lon) + c(-0.1, 0.1), ylim = range(col.simp.df$lat) + c(-0.1, 0.1)) +
theme(legend.position = "right")
Code
# Asumiendo que el número óptimo de clústeres es 3 y que ya tenemos los datos de clúster en col.simp.df
library(ggplot2)
library(maps)Warning: package 'maps' was built under R version 4.3.3
Attaching package: 'maps'The following object is masked from 'package:cluster':
votes.repubThe following object is masked from 'package:faraway':
ozoneThe following object is masked from 'package:purrr':
mapCode
# Establecer los límites basándose en los datos proporcionados, centrados y con un pequeño margen alrededor
lon_range <- range(col.simp.df$lon) + c(-0.05, 0.05) # pequeño margen longitudinal
lat_range <- range(col.simp.df$lat) + c(-0.05, 0.05) # pequeño margen latitudinal
# Crear el gráfico
ggplot(col.simp.df, aes(x = lon, y = lat, color = cluster)) +
geom_point(size = 2) + # puntos más grandes para mejor visualización
ggtitle("Visualización de Clústeres Geográficos con Zoom") +
theme_minimal() +
labs(color = "Cluster") +
borders("world", xlim = lon_range, ylim = lat_range) + # añadir bordes de mapa con el rango ajustado
coord_fixed(ratio = 1 / cos(mean(lat_range) * pi / 180)) + # mantener la proporción adecuada en el mapa
xlim(lon_range) + # establecer límites longitudinales
ylim(lat_range) + # establecer límites latitudinales
theme(legend.position = "right")
Bibliografía
Fernández-Avilés, Gema, and José-María Montero. 2024. Fundamentos de Ciencia de Datos Con r. 1st ed. Publicado: 1 de Enero de 2024. https://cdr-book.github.io/.
Kassambara, Alboukadel. 2017. Practical Guide to Cluster Analysis in r. 1st ed. Publicado: 2017. http://www.sthda.com.
Rodrigo, Joaquín Amat. 2017. “Clustering y Heatmaps: Aprendizaje No Supervisado.” https://cienciadedatos.net/documentos/37_clustering_y_heatmaps.