Clustering

Análisis de segmentación y caracterización de clústeres

En este documento se presentan los principales enfoques de clustering aplicados sobre una base de datos de comportamiento de compra.

La idea no es únicamente ejecutar funciones, sino entender qué hace cada técnica, cuándo conviene usarla y cómo interpretar los resultados. A lo largo del material se combinan ejemplos ejecutables con fragmentos ilustrativos que sirven como plantilla para otros conjuntos de datos.

# Cargamos las librerías necesarias.
# Se incluyen paquetes para:
# - manipulación y visualización
# - clustering particional y jerárquico
# - métricas de validación
# - representación gráfica de dendrogramas
list.of.packages <- c(
  "dplyr", "fpc", "reshape2", "tidyr", "ggplot2", "stats", 
  "cluster", "factoextra", "colorspace", "patchwork", 
  "tidyverse", "ggpubr", "NbClust", "HDclassif", "clustMixType", 
  "clusterSim", "pracma", "DataVisualizations", "entropy",
  "clevr", "dendextend", "ggdendro", "gridExtra"
)

new.packages <- list.of.packages[!(list.of.packages %in% installed.packages()[, "Package"])]
if (length(new.packages) > 0) {
  install.packages(new.packages)
}

invisible(lapply(list.of.packages, require, character.only = TRUE))
rm(list.of.packages, new.packages)

# Cargamos la base de datos directamente desde GitHub
url <- "https://raw.githubusercontent.com/ramIA-lab/MLforEducation/refs/heads/main/material/clustering/shopping_behavior_updated.csv"
dades <- read.csv(url)
rm(url)

# Identificamos el tipo de las variables para separar correctamente
# las cuantitativas de las categóricas.
tipo <- sapply(dades, class)

varNum <- names(tipo)[which(tipo %in% c("integer", "numeric"))]
varNum <- varNum[which(!varNum %in% c("Customer.ID"))]

varCat <- names(tipo)[which(tipo %in% c("character", "factor"))]

# Creamos una copia de trabajo
data <- dades

Antes de aplicar cualquier algoritmo, es importante distinguir la naturaleza de las variables. Algunos métodos requieren exclusivamente datos numéricos, mientras que otros permiten trabajar con información mixta. Esta separación será clave más adelante al elegir la distancia y el algoritmo de agrupación.

Idea clave

En clustering no existe un método universalmente mejor. La elección depende del tipo de variables, de la distancia utilizada y del objetivo analítico: segmentar, explorar estructura o describir perfiles.

1 Métodos Particionales

Los métodos particionales generan una partición directa del conjunto de datos en un número prefijado de grupos. A diferencia de los métodos jerárquicos, aquí se fija el valor de (k) y el algoritmo reasigna observaciones hasta optimizar un criterio interno como la inercia o la disimilitud total.

# Escalamos las variables numéricas para que todas contribuyan de forma comparable.
# Este paso es especialmente importante en métodos basados en distancias.
data <- scale(data[, varNum], center = TRUE, scale = TRUE)
str(data)

 num [1:3900, 1:4] 0.7188 -1.6484 0.39 -1.5169 0.0613 ...
 - attr(*, "dimnames")=List of 2
  ..$ : NULL
  ..$ : chr [1:4] "Age" "Purchase.Amount..USD." "Review.Rating" "Previous.Purchases"
 - attr(*, "scaled:center")= Named num [1:4] 44.07 59.76 3.75 25.35
  ..- attr(*, "names")= chr [1:4] "Age" "Purchase.Amount..USD." "Review.Rating" "Previous.Purchases"
 - attr(*, "scaled:scale")= Named num [1:4] 15.208 23.685 0.716 14.447
  ..- attr(*, "names")= chr [1:4] "Age" "Purchase.Amount..USD." "Review.Rating" "Previous.Purchases"

1.1 Calculamos las distintas distancias

Antes de agrupar, conviene estudiar cómo se mide la proximidad entre individuos. La distancia elegida condiciona directamente la forma de los clusters que se obtendrán.

1.1.1 Distancia euclídea

Es la distancia geométrica habitual entre dos puntos en un espacio multidimensional. Es una opción natural cuando trabajamos con variables numéricas previamente escaladas.

mat_dist <- dist(x = data, method = "euclidean")
round(as.matrix(mat_dist)[1:5, 1:5], 2)

     1    2    3    4    5
1 0.00 2.55 1.10 3.69 1.47
2 2.55 0.00 2.53 3.48 2.77
3 1.10 2.53 0.00 2.78 1.32
4 3.69 3.48 2.78 0.00 2.88
5 1.47 2.77 1.32 2.88 0.00

1.1.2 Distancia basada en la correlación de pearson

Esta medida resulta útil cuando interesa comparar perfiles o patrones de comportamiento más que magnitudes absolutas. Dos individuos pueden quedar próximos si evolucionan de forma similar en las variables, aunque sus valores concretos no coincidan.

mat_dist <- get_dist(x = data, method = "pearson")
round(as.matrix(mat_dist)[1:5, 1:5], 2)

     1    2    3    4    5
1 0.00 1.21 0.30 1.64 0.59
2 1.21 0.00 0.75 0.62 1.46
3 0.30 0.75 0.00 0.93 0.38
4 1.64 0.62 0.93 0.00 0.76
5 0.59 1.46 0.38 0.76 0.00

# Esto es equivalente a 1 - correlación de Pearson
round(1 - cor(x = t(data), method = "pearson"), 2)[1:5, 1:5]

     [,1] [,2] [,3] [,4] [,5]
[1,] 0.00 1.21 0.30 1.64 0.59
[2,] 1.21 0.00 0.75 0.62 1.46
[3,] 0.30 0.75 0.00 0.93 0.38
[4,] 1.64 0.62 0.93 0.00 0.76
[5,] 0.59 1.46 0.38 0.76 0.00

1.2 KMEANS

K-means es uno de los algoritmos de clustering más conocidos. Busca particionar las observaciones en (k) grupos minimizando la suma de cuadrados intra-cluster. Funciona especialmente bien cuando los grupos son compactos y aproximadamente esféricos.

Cuándo usarlo

Conviene usar K-means cuando todas las variables son numéricas, están en escalas comparables y se espera una estructura relativamente compacta de los grupos.

set.seed(101)
(km_clusters <- kmeans(x = data, centers = 4, nstart = 50, trace = FALSE))

K-means clustering with 4 clusters of sizes 1047, 958, 972, 923

Cluster means:
         Age Purchase.Amount..USD. Review.Rating Previous.Purchases
1 -0.7655078           -0.04259449   -0.03533381        -0.97553379
2  0.8167698           -0.92700284   -0.34023724         0.12132834
3  0.8277392            0.91828939    0.27543594         0.04958514
4 -0.8510740            0.04343213    0.10316147         0.92844483

Clustering vector:
   [1] 2 1 3 4 2 2 3 1 1 2 2 1 3 3 3 3 4 2 2 3 4 1 2 4 1 1 1 3 3 1 2 4 4 2 4 2 4
  [38] 1 4 3 3 2 1 1 4 2 2 3 4 2 2 3 2 4 3 4 4 1 2 3 2 3 4 4 3 2 1 4 2 1 4 4 1 3
  [75] 1 3 2 4 3 4 1 3 1 4 2 3 4 2 4 3 4 3 3 4 3 4 4 4 1 4 3 4 3 3 2 3 2 4 3 3 2
 [112] 1 4 2 3 3 3 2 2 4 3 1 4 3 4 4 4 4 1 4 1 4 4 2 3 1 1 2 2 3 2 2 4 1 1 4 2 3
 [149] 4 1 3 1 4 2 3 3 4 1 4 2 4 2 3 1 2 1 2 1 1 1 2 1 3 4 2 1 3 4 2 2 3 1 1 2 4
 [186] 2 4 1 1 1 3 3 2 3 3 2 4 3 2 3 4 2 2 2 4 2 1 3 2 3 2 3 3 1 4 2 1 1 1 1 4 1
 [223] 3 4 3 1 1 3 1 2 3 1 2 4 1 3 4 3 2 2 2 4 3 1 2 4 1 1 3 2 1 4 4 3 2 2 2 1 3
 [260] 1 1 1 1 4 1 1 3 2 2 2 1 3 2 2 2 3 1 4 3 4 3 1 1 1 2 1 1 2 4 3 2 2 3 2 2 2
 [297] 1 1 2 4 4 3 4 4 4 2 1 1 2 2 3 2 1 4 1 2 4 3 1 1 3 4 4 3 4 3 2 2 1 2 4 4 1
 [334] 1 2 4 1 1 3 2 4 4 2 4 4 3 1 4 2 1 4 4 1 3 3 1 3 1 2 4 2 3 1 3 3 3 2 2 4 4
 [371] 2 4 1 1 3 2 1 2 3 4 1 2 4 1 2 3 2 3 1 4 1 3 4 1 1 1 3 1 4 2 1 3 4 1 1 1 3
 [408] 1 4 4 1 2 1 3 4 2 1 4 4 3 1 4 2 2 2 1 3 3 1 3 4 4 3 3 2 2 4 2 2 2 4 3 4 1
 [445] 2 1 1 3 4 4 1 2 2 2 1 3 3 4 3 2 3 1 3 4 4 3 2 4 1 4 1 3 1 4 3 1 1 4 4 4 3
 [482] 1 1 1 3 2 4 3 2 3 2 3 1 1 4 1 4 4 3 3 4 2 2 2 2 3 4 2 4 1 1 2 1 4 3 1 1 2
 [519] 1 1 3 4 3 1 2 2 3 4 4 1 2 2 4 3 3 2 3 2 4 4 2 2 4 3 4 4 3 2 4 4 2 4 1 2 2
 [556] 3 3 4 3 2 1 2 2 3 2 2 3 1 3 2 3 3 3 3 3 3 1 4 3 2 3 1 1 4 3 2 1 4 1 4 2 1
 [593] 2 2 1 4 4 3 4 2 4 1 1 4 3 1 4 2 2 4 2 1 2 2 3 3 4 1 3 1 1 2 3 4 3 1 1 2 3
 [630] 1 3 3 1 2 4 4 2 4 2 2 3 3 2 1 3 2 3 3 4 3 1 4 2 4 1 1 1 3 2 2 3 3 4 3 3 4
 [667] 2 4 3 4 2 4 2 4 2 3 4 2 1 3 2 1 4 1 3 3 2 4 4 4 4 2 4 2 2 1 4 3 2 2 3 3 1
 [704] 3 1 4 4 2 1 3 4 2 4 4 4 4 1 1 4 2 1 4 4 4 4 2 1 3 1 4 2 2 4 2 3 2 4 2 2 2
 [741] 1 4 2 4 3 3 4 3 1 3 1 3 3 2 1 2 3 2 3 2 1 3 4 2 2 3 2 1 3 3 1 4 4 1 1 1 1
 [778] 2 1 3 4 1 1 3 4 4 2 3 2 1 1 2 4 1 2 4 4 4 4 2 2 1 1 4 2 2 2 1 3 3 3 4 2 2
 [815] 1 4 1 4 3 2 2 2 1 2 3 1 3 4 4 1 1 3 3 1 3 2 1 4 4 2 2 3 3 3 2 4 4 2 3 4 2
 [852] 1 1 2 1 3 2 4 4 1 1 3 1 2 1 2 2 2 1 4 2 2 2 3 1 1 1 3 4 3 1 2 2 4 3 4 4 2
 [889] 3 3 4 1 4 1 1 4 2 4 3 3 3 3 1 1 3 1 1 4 1 2 2 1 4 2 3 2 2 3 2 1 4 2 3 2 3
 [926] 1 3 1 2 3 1 1 2 3 2 2 4 1 3 4 2 4 4 1 3 1 2 2 3 4 2 2 4 2 3 3 4 1 3 1 1 3
 [963] 4 1 1 1 3 1 2 2 1 3 2 3 3 2 4 4 2 2 3 4 4 4 1 1 3 2 3 2 3 4 3 3 3 1 4 2 3
[1000] 2 1 3 1 3 4 1 4 3 3 1 2 2 4 3 4 2 1 1 3 4 4 3 2 3 1 3 3 1 1 4 3 4 2 4 2 3
[1037] 2 2 1 4 2 1 3 4 1 3 1 1 1 2 3 2 2 3 4 2 4 2 4 1 1 1 3 2 4 2 3 1 3 4 4 3 3
[1074] 4 4 3 4 2 4 4 3 2 3 4 4 1 2 1 2 4 4 1 2 2 4 4 2 2 3 4 1 4 3 1 1 1 3 2 4 3
[1111] 4 1 3 1 2 4 3 4 3 4 4 2 3 4 4 1 4 3 2 4 2 3 3 4 3 3 4 3 4 2 1 1 3 2 4 4 1
[1148] 2 1 4 4 3 2 1 3 2 1 1 3 2 1 2 3 1 3 2 2 3 3 1 2 1 3 4 2 4 4 2 1 4 4 3 4 1
[1185] 3 3 3 3 2 3 2 4 4 1 1 4 1 3 1 3 1 4 2 3 3 3 1 3 1 1 1 1 1 2 1 2 2 1 3 4 3
[1222] 1 3 2 2 1 3 1 1 4 4 3 2 4 1 4 4 4 3 2 4 2 2 1 3 2 4 3 2 2 2 3 1 4 1 4 1 2
[1259] 3 3 3 1 4 1 1 4 1 4 1 4 3 3 1 2 3 1 3 1 4 2 4 1 1 3 3 3 4 1 3 1 2 3 4 4 1
[1296] 4 2 3 1 4 3 1 4 1 3 1 2 4 2 4 4 1 3 2 4 3 1 1 3 2 2 3 1 3 1 1 1 2 4 2 1 1
[1333] 3 1 1 3 4 1 2 1 1 4 2 2 2 2 3 3 1 1 1 2 3 1 2 3 3 1 1 4 2 2 4 4 3 1 1 3 1
[1370] 4 4 4 3 1 1 1 3 4 1 4 2 4 3 1 3 1 3 1 2 3 4 2 4 1 4 2 4 3 1 4 2 1 2 1 1 4
[1407] 1 3 3 4 3 2 4 3 1 3 4 2 1 1 4 3 1 1 2 2 2 1 4 1 1 3 4 2 3 3 1 3 2 4 1 1 3
[1444] 1 4 2 2 1 3 1 1 2 2 4 2 3 3 3 2 1 3 3 1 1 3 4 3 1 4 4 2 4 1 3 1 3 1 1 1 3
[1481] 4 2 4 1 2 1 4 4 4 4 3 1 2 2 3 1 3 2 2 1 3 1 1 2 3 2 4 3 1 4 2 4 2 4 1 3 1
[1518] 2 3 3 4 4 1 3 1 1 2 4 3 4 2 3 2 1 3 1 1 3 2 1 1 4 2 3 1 4 2 2 2 1 2 2 2 1
[1555] 2 4 2 4 1 3 3 1 1 2 4 3 3 1 3 4 1 1 1 1 4 2 3 2 3 1 3 3 4 1 4 2 1 3 2 4 3
[1592] 1 3 3 1 4 1 2 3 2 1 2 2 1 4 2 2 4 1 1 1 1 4 1 1 2 4 4 3 3 4 2 4 2 4 1 4 2
[1629] 1 1 2 2 4 3 4 2 2 2 3 4 2 1 1 1 3 2 3 1 1 3 2 3 2 4 2 1 4 2 4 2 2 3 2 1 4
[1666] 4 4 2 2 1 1 1 1 4 1 3 4 2 3 3 2 1 3 4 4 4 4 3 1 4 1 3 3 3 1 3 1 4 4 4 3 2
[1703] 3 1 2 4 1 4 1 3 1 1 3 2 1 4 2 1 3 1 4 1 1 2 1 2 2 2 1 2 4 1 2 3 1 2 2 4 2
[1740] 4 2 1 3 1 2 2 2 2 4 4 4 2 1 1 3 2 2 4 1 3 4 4 4 3 2 3 3 3 1 4 2 3 2 1 1 1
[1777] 3 1 3 4 3 4 3 2 1 2 2 1 2 2 2 3 1 3 2 2 2 2 1 4 4 4 3 3 4 4 3 4 3 3 2 4 3
[1814] 1 1 3 1 1 2 3 4 2 3 3 2 4 4 4 4 4 3 3 2 1 2 3 2 1 1 4 4 1 3 4 2 3 2 3 4 4
[1851] 4 1 3 1 4 3 2 3 1 2 1 1 2 4 1 3 1 2 4 1 3 3 3 2 2 3 2 3 1 2 1 2 3 4 1 4 4
[1888] 2 3 2 1 3 1 1 4 1 2 3 3 4 3 3 1 2 4 1 1 3 1 3 1 3 1 2 4 3 1 4 4 1 3 2 1 2
[1925] 4 2 3 1 1 2 2 2 4 3 1 4 3 1 2 2 3 3 2 4 4 1 2 2 2 3 3 4 3 1 1 3 2 3 4 1 3
[1962] 4 1 2 4 3 3 1 3 2 1 2 2 1 1 1 4 4 1 3 3 3 4 3 4 1 2 2 3 4 1 1 3 3 1 3 2 1
[1999] 1 3 1 1 1 3 1 4 3 1 2 3 1 3 1 3 2 3 2 2 3 1 2 2 2 3 2 2 4 4 1 4 2 1 1 2 2
[2036] 3 4 1 3 4 2 2 4 2 1 4 2 3 4 2 1 3 2 1 2 4 2 2 1 2 1 1 2 3 1 1 3 2 3 1 3 3
[2073] 1 1 4 4 2 2 2 1 1 4 3 2 4 2 3 3 4 4 3 1 2 1 2 1 4 1 2 4 2 2 1 1 3 2 2 3 1
[2110] 2 3 1 1 2 1 3 2 1 2 2 3 4 4 3 3 3 2 2 2 1 4 1 1 1 2 1 3 1 2 3 3 4 2 4 2 4
[2147] 2 1 1 1 2 2 4 3 3 4 4 4 1 4 3 1 2 4 4 4 4 4 4 4 4 3 1 4 1 2 4 1 4 3 4 4 3
[2184] 1 1 2 2 1 1 4 3 4 1 1 2 1 4 4 3 4 3 1 2 3 1 2 2 2 1 4 4 3 3 3 3 4 1 2 3 1
[2221] 4 4 4 1 4 1 4 4 1 3 2 1 3 4 4 4 1 2 3 3 3 1 1 2 1 3 3 1 3 4 3 1 3 2 4 4 4
[2258] 1 4 3 3 3 2 4 3 1 4 4 2 2 1 4 4 3 2 1 4 1 2 2 4 4 1 4 1 4 2 2 4 3 1 1 2 1
[2295] 3 2 4 3 1 2 4 2 4 3 1 2 1 4 3 3 1 1 1 2 3 3 1 2 2 2 1 2 3 4 2 4 2 1 2 3 2
[2332] 3 1 1 3 1 1 1 3 1 2 2 1 2 1 1 4 4 3 2 2 4 2 3 3 1 2 3 3 4 3 4 1 3 3 3 4 3
[2369] 1 1 3 2 2 1 3 2 1 3 4 3 4 2 4 3 4 1 1 1 1 1 3 3 4 3 2 3 1 2 3 2 3 3 3 2 1
[2406] 3 3 2 4 4 4 3 1 3 1 4 3 4 4 1 3 1 4 1 3 2 2 4 2 3 4 4 2 3 4 4 2 4 2 2 4 1
[2443] 3 1 1 3 1 2 2 4 3 4 3 1 4 4 3 2 3 2 2 1 3 2 1 1 4 4 2 3 3 1 4 3 1 2 2 4 1
[2480] 3 3 3 3 1 3 4 3 2 3 2 3 2 3 1 2 2 3 4 4 1 3 3 1 3 3 4 3 2 1 1 4 2 3 2 4 4
[2517] 3 2 4 3 2 1 1 2 2 1 2 4 2 4 4 1 3 2 2 3 4 4 4 1 1 1 2 4 4 1 2 3 4 1 2 4 2
[2554] 2 4 1 1 2 2 3 2 2 3 3 3 1 4 1 3 1 1 2 2 3 4 3 1 2 1 2 2 3 1 3 1 2 1 2 2 3
[2591] 3 4 1 1 3 1 3 2 3 3 1 2 2 2 1 3 3 2 4 3 3 1 2 3 4 1 2 4 3 2 4 2 3 3 1 4 2
[2628] 2 4 2 1 2 1 3 1 3 1 1 4 4 4 1 4 2 1 4 1 2 3 1 4 2 4 2 1 1 3 1 2 4 4 3 4 2
[2665] 4 3 3 2 3 2 4 4 2 2 1 4 1 1 4 1 2 1 3 2 4 2 4 3 2 4 2 2 3 2 2 3 2 4 2 4 4
[2702] 2 2 2 2 3 4 1 3 1 3 4 1 1 2 4 2 1 1 3 2 1 1 2 3 3 1 4 1 4 4 2 4 4 3 1 4 3
[2739] 3 4 4 3 4 3 4 4 2 1 1 2 2 4 3 2 3 3 2 3 1 3 4 1 2 4 2 3 3 4 2 1 2 2 1 4 2
[2776] 1 1 2 2 3 4 2 2 4 1 3 2 1 3 4 4 1 2 4 1 4 3 2 2 1 3 2 4 2 3 4 2 3 4 3 1 3
[2813] 3 4 1 4 2 1 3 2 1 4 2 4 4 3 1 1 4 3 3 1 4 1 1 1 3 3 1 3 4 4 4 2 4 4 2 2 4
[2850] 2 3 3 4 1 2 4 2 3 4 4 4 2 3 1 2 4 3 4 2 3 4 2 2 1 1 1 3 4 3 3 4 1 2 1 2 1
[2887] 2 1 2 2 1 1 4 2 4 3 1 1 4 3 1 4 1 2 4 3 2 4 1 4 4 4 2 1 1 4 2 2 4 3 1 1 1
[2924] 1 4 3 3 2 1 4 1 4 3 4 4 2 4 1 1 4 3 3 2 4 3 1 4 4 3 1 4 3 1 3 1 4 3 3 3 1
[2961] 2 1 2 3 2 2 2 4 4 1 4 1 1 1 3 3 4 1 4 1 3 4 1 2 2 2 3 2 3 1 3 3 1 1 3 4 3
[2998] 1 4 1 3 4 2 2 3 1 3 4 3 3 2 1 1 1 4 2 4 3 2 1 4 3 2 2 3 1 1 2 3 3 2 3 1 1
[3035] 2 3 1 1 2 2 1 3 2 3 1 1 2 1 3 4 4 4 1 1 4 1 3 2 1 4 1 1 3 1 4 1 2 2 1 3 2
[3072] 1 4 3 4 3 2 3 1 1 2 2 3 4 2 1 3 3 4 2 1 3 2 1 1 2 3 2 2 3 3 1 3 4 4 2 3 2
[3109] 1 3 1 4 4 1 4 1 1 1 3 3 3 2 4 3 2 1 3 3 2 2 2 1 3 3 4 3 2 1 3 1 4 4 1 2 1
[3146] 2 1 3 1 1 2 4 3 3 4 4 1 1 4 3 4 3 3 2 2 3 4 1 1 1 2 2 2 2 4 1 4 2 2 3 4 4
[3183] 3 1 2 3 4 3 4 4 1 3 1 3 1 3 1 4 3 2 2 2 2 2 3 4 4 2 2 2 4 3 1 4 1 1 1 4 4
[3220] 2 1 4 3 3 1 3 3 4 3 2 2 3 2 1 3 1 3 2 4 2 2 3 1 3 3 3 3 3 4 4 1 4 2 1 1 2
[3257] 2 3 1 3 1 4 2 3 4 3 3 4 1 4 2 4 3 2 2 1 4 3 3 2 1 4 1 2 3 2 1 4 3 1 1 1 2
[3294] 4 3 2 4 3 3 2 4 4 4 1 4 4 2 1 2 2 2 1 3 2 3 1 1 4 1 1 2 1 3 3 4 1 3 1 1 1
[3331] 4 2 1 2 2 4 1 4 4 4 4 2 3 1 2 1 4 4 1 4 1 1 3 1 1 1 1 4 2 3 4 2 4 2 2 4 4
[3368] 1 4 4 4 3 2 2 4 3 1 1 3 3 1 3 1 4 1 3 4 1 1 4 4 1 3 3 1 2 1 1 4 4 1 4 1 1
[3405] 2 4 3 2 3 1 3 4 3 1 1 1 1 2 2 1 4 2 1 1 1 1 2 2 1 4 3 1 4 3 1 3 3 4 4 3 1
[3442] 3 1 2 3 1 3 3 4 2 4 1 1 4 3 3 1 3 2 2 1 2 3 4 1 4 4 1 4 1 4 4 1 2 3 3 3 3
[3479] 4 4 4 3 3 1 1 2 3 4 2 2 3 1 4 3 2 1 1 1 1 1 4 3 4 4 2 2 1 3 4 2 3 3 4 4 4
[3516] 1 4 4 3 1 4 2 1 2 3 4 1 1 4 2 2 3 3 3 3 3 2 3 3 1 1 3 2 3 2 2 3 2 2 1 3 2
[3553] 1 3 1 4 3 1 3 1 1 2 1 3 2 2 1 4 1 1 4 2 4 3 4 3 1 2 2 1 1 4 1 3 4 1 1 4 4
[3590] 4 1 3 3 3 4 1 4 1 1 1 3 1 2 1 3 2 3 3 1 4 4 3 2 2 2 1 2 2 4 4 3 1 1 1 1 3
[3627] 3 4 3 2 3 2 1 1 2 2 2 4 4 4 2 2 1 3 1 3 3 2 4 3 1 1 1 2 1 1 1 3 1 4 1 2 3
[3664] 3 3 1 2 2 3 4 1 3 3 4 4 3 1 4 2 3 4 4 4 1 4 2 3 4 3 1 1 2 2 2 2 1 2 2 1 2
[3701] 1 4 2 1 3 1 1 1 3 4 2 2 3 3 4 2 2 4 4 1 1 3 1 1 1 1 3 1 2 4 1 2 3 1 4 2 1
[3738] 4 4 4 3 3 3 2 1 2 3 4 1 4 1 1 4 2 1 3 3 2 2 4 3 2 3 4 2 1 3 2 2 3 4 4 2 4
[3775] 3 4 1 1 4 3 3 3 4 1 1 3 1 4 4 3 4 1 1 2 3 1 4 2 3 2 1 4 3 1 4 2 4 2 1 2 3
[3812] 2 1 3 3 1 4 3 2 4 4 4 2 2 2 2 2 3 1 2 4 1 2 3 1 2 3 3 2 2 1 3 4 3 4 3 3 2
[3849] 4 4 4 3 3 3 2 4 1 2 4 3 3 3 2 2 3 4 2 2 1 4 2 3 1 1 2 2 3 4 2 1 2 2 1 1 1
[3886] 4 4 1 1 3 4 1 1 4 3 2 4 2 3 3

Within cluster sum of squares by cluster:
[1] 2606.771 2178.679 2352.826 2219.745
 (between_SS / total_SS =  40.0 %)

Available components:

[1] "cluster"      "centers"      "totss"        "withinss"     "tot.withinss"
[6] "betweenss"    "size"         "iter"         "ifault"      

1.2.1 Determinar y visulizar el número óptimo de clusters

Una de las decisiones más importantes en clustering particional es escoger el número de grupos. No existe una única regla universal, por lo que habitualmente se contrastan varios criterios.

1.2.1.1 Método del codo

Este criterio observa cómo disminuye la variabilidad interna al aumentar (k). El punto donde la mejora deja de ser pronunciada sugiere un valor razonable del número de clusters.

fviz_nbclust(data, kmeans, method = "wss") +  
  labs(subtitle = "Elbow method")

1.2.1.2 Método de la silhueta

La silueta compara cohesión interna y separación externa. Valores altos indican que las observaciones están bien asignadas a su grupo y suficientemente alejadas de los demás.

fviz_nbclust(data, kmeans, method = "silhouette") + 
  labs(subtitle = "Silhouette method")

sil <- silhouette(km_clusters[["cluster"]], dist(data))
fviz_silhouette(sil)

  cluster size ave.sil.width
1       1 1047          0.18
2       2  958          0.21
3       3  972          0.19
4       4  923          0.19

1.2.1.2.1 Interpretación del gráfico de Silhouette

El coeficiente de Silhouette mide cómo de bien está asignada cada observación a su cluster en comparación con los demás clusters.

Para cada observación se calcula:

[ s(i) = ]

donde:

• a(i): distancia media entre la observación i y los elementos de su mismo cluster.
• b(i): distancia media entre la observación i y los elementos del cluster más cercano.

El valor de silhouette está acotado entre -1 y 1.

Interpretación práctica:

Valor aproximado	Interpretación
s ≈ 1	La observación está muy bien asignada a su cluster
s ≈ 0.5	Buena asignación
s ≈ 0	La observación está entre dos clusters
s < 0	Probablemente está mal asignada

En el gráfico:

• Cada barra representa una observación.
• Las barras se agrupan por cluster.
• La longitud de la barra indica la calidad de la asignación.

Un buen clustering presenta:

• valores de silhouette positivos
• clusters con barras largas
• pocas observaciones con valores negativos.

Además, el promedio del índice de silhouette suele utilizarse para comparar distintos valores de k y elegir el número óptimo de clusters.

1.2.1.3 Método de Calinski - Harabasz

El índice de Calinski-Harabasz evalúa la relación entre dispersión entre grupos y dispersión dentro de los grupos. Cuanto mayor sea su valor, mejor separación relativa existe entre clusters.

(CH4 <- calinhara(data, km_clusters[["cluster"]]))

[1] 865.6804

1.2.2 Representación gráfica

La representación bidimensional ayuda a inspeccionar visualmente la separación entre grupos. Aunque haya pérdida de información al proyectar, suele ser una herramienta muy útil para interpretación docente.

fviz_cluster(
  list(data = data, cluster = km_clusters[["cluster"]]), 
  ellipse.type = "norm",
  geom = "point",
  stand = FALSE,
  palette = "jco", 
  ggtheme = theme_classic()
) 

1.3 KMEDOIDS

PAM (Partitioning Around Medoids) es una alternativa a K-means más robusta frente a valores atípicos. En lugar de usar centroides teóricos, representa cada cluster mediante una observación real del conjunto de datos: el medoide.

Diferencia conceptual

Mientras que K-means resume cada grupo mediante una media, PAM lo hace mediante un individuo real. Esto lo vuelve más interpretable y menos sensible a extremos.

## Declaramos la semilla correspondiente
set.seed(123)

## Ejecutamos el proceso
(pam_clusters <- pam(x = data, k = 4, metric = "manhattan"))

Medoids:
       ID          Age Purchase.Amount..USD. Review.Rating Previous.Purchases
[1,] 2681 -0.004501801            -0.9611139    -0.6282245         -0.3012045
[2,] 3443 -1.056608079             0.7699109     0.7679891         -0.9241658
[3,] 3900  0.521551338             0.8965712    -0.9074672          0.5294106
[4,]   48  0.718821265            -0.2433719     1.0472318          0.7370644
Clustering vector:
   [1] 1 2 3 3 1 1 3 1 2 4 1 2 4 4 4 3 4 4 4 3 1 2 1 2 1 1 1 4 4 2 4 2 4 1 4 4 4
  [38] 1 1 4 4 4 2 2 4 1 3 4 3 4 1 4 1 1 3 1 4 2 4 2 1 4 1 3 4 4 2 4 1 2 1 1 1 3
  [75] 4 3 4 1 4 3 2 3 1 4 4 2 1 4 1 3 1 2 2 4 4 3 3 2 1 1 3 2 4 3 4 3 1 3 3 3 1
 [112] 2 2 1 3 3 3 4 4 4 3 2 4 3 3 4 1 2 2 2 1 1 4 3 2 2 2 4 4 3 4 4 3 1 1 2 1 3
 [149] 3 2 2 2 2 1 3 4 1 2 2 4 4 3 3 3 3 1 1 1 2 1 1 1 4 1 1 3 3 1 4 4 3 2 3 1 1
 [186] 4 3 2 1 2 3 3 1 3 3 4 3 3 4 3 1 4 1 1 2 3 2 3 1 3 1 4 2 2 4 3 1 1 1 2 4 2
 [223] 2 4 3 1 2 3 2 4 4 1 4 2 1 3 3 3 1 3 1 2 4 2 4 3 3 2 4 4 1 1 1 2 1 1 4 2 3
 [260] 1 1 2 1 2 2 1 3 4 1 1 2 4 4 4 1 2 1 1 3 2 2 1 2 1 1 2 1 1 3 4 4 1 4 1 4 1
 [297] 2 1 4 3 2 3 1 3 3 3 2 1 4 4 4 4 2 3 1 4 1 4 1 3 4 4 3 3 4 4 1 3 1 1 4 3 2
 [334] 2 1 3 2 2 3 1 1 4 1 2 2 4 4 1 1 2 3 2 2 4 3 2 3 2 1 3 1 3 1 3 3 3 1 1 4 1
 [371] 1 3 2 2 4 4 4 4 4 4 1 1 3 3 4 3 1 4 2 2 2 2 3 2 1 2 3 1 2 1 2 2 3 2 2 2 4
 [408] 3 3 1 2 1 2 4 3 1 1 2 3 3 2 1 3 1 4 2 2 2 2 2 1 3 3 3 4 1 4 1 1 4 3 3 3 2
 [445] 4 1 2 3 1 1 1 4 1 1 2 3 3 2 3 1 3 2 3 3 4 3 1 4 2 2 2 4 2 1 3 2 2 4 1 3 4
 [482] 3 1 2 4 1 3 2 4 3 4 3 2 2 4 1 3 4 3 2 4 1 1 1 1 4 1 4 1 2 2 1 1 3 4 2 1 3
 [519] 2 2 3 1 3 1 4 1 4 4 3 2 1 4 2 4 2 1 2 1 1 4 1 1 2 2 3 1 3 1 4 1 1 3 2 1 3
 [556] 4 2 3 3 1 1 3 3 2 3 4 3 1 3 4 3 3 4 3 4 4 2 4 4 4 2 2 2 2 4 1 1 2 1 3 4 1
 [593] 1 4 2 3 4 3 3 4 2 2 2 1 2 1 2 1 1 4 3 1 4 3 3 3 2 1 3 2 2 4 4 2 3 2 2 1 3
 [630] 2 3 4 1 1 4 2 1 1 1 4 4 3 1 2 4 4 4 3 4 3 1 1 1 3 2 1 1 2 4 1 4 4 3 4 4 4
 [667] 1 3 3 3 4 4 3 2 4 3 3 3 2 3 1 2 1 1 4 3 1 1 4 2 2 1 3 1 1 2 1 4 4 1 2 3 2
 [704] 3 1 2 4 1 1 4 2 1 3 3 2 3 1 2 2 1 1 4 4 1 4 3 2 4 2 3 1 1 1 1 3 4 3 1 1 1
 [741] 2 2 1 2 4 2 1 2 1 2 2 2 2 1 1 1 4 1 4 1 1 3 4 1 1 3 1 2 3 2 1 3 1 2 1 1 4
 [778] 1 1 4 1 1 2 4 3 4 4 3 1 2 2 3 4 1 4 4 3 3 1 3 1 2 1 1 1 1 3 2 4 4 4 1 3 1
 [815] 2 3 1 4 4 4 1 4 1 1 3 2 3 4 2 1 2 4 3 1 3 1 2 4 4 1 1 3 3 3 4 1 3 4 3 2 1
 [852] 3 2 4 2 3 1 3 1 2 2 3 2 4 1 4 3 1 3 3 3 1 1 3 2 1 1 4 2 2 3 3 4 2 3 4 4 3
 [889] 3 3 4 1 3 2 1 4 4 3 3 4 3 4 1 1 3 1 1 4 2 3 1 3 1 1 4 1 1 1 4 3 2 1 4 1 3
 [926] 2 4 2 1 4 2 1 1 3 1 1 3 1 2 2 1 4 3 2 4 1 1 1 2 1 4 3 3 4 3 3 3 2 4 2 2 3
 [963] 2 2 1 2 4 1 3 1 2 2 3 3 3 1 3 4 3 1 3 1 3 1 2 2 4 3 4 1 4 3 4 4 3 3 2 1 3
[1000] 1 1 1 1 2 2 2 2 4 3 1 4 1 1 3 3 4 1 1 4 3 2 4 4 3 2 2 3 2 1 1 3 1 4 4 4 3
[1037] 1 1 3 4 1 2 4 3 1 3 1 2 2 1 1 3 1 3 2 1 3 4 1 1 1 2 3 1 1 1 2 1 3 2 3 3 3
[1074] 2 3 4 3 1 4 4 4 4 3 3 4 3 3 1 1 4 4 2 4 4 2 1 3 1 3 3 1 3 3 2 1 2 3 3 1 2
[1111] 3 2 4 2 1 4 4 2 2 1 2 3 4 3 4 2 1 4 4 4 4 3 3 1 2 3 2 3 4 4 1 1 3 4 4 3 1
[1148] 4 2 1 1 2 4 2 3 3 2 2 3 4 1 3 2 1 4 3 1 3 3 2 3 1 4 3 1 2 4 4 1 1 4 3 1 2
[1185] 3 4 4 3 1 4 4 4 4 4 1 2 2 3 1 2 2 3 1 3 3 3 1 4 2 1 2 2 2 1 2 1 1 3 3 1 4
[1222] 2 3 1 1 2 3 2 4 4 2 3 1 3 2 1 4 2 2 4 3 3 1 1 2 1 1 3 1 4 1 4 2 4 1 2 1 3
[1259] 3 4 3 1 4 2 3 3 2 3 3 3 3 4 2 1 3 4 4 2 3 1 2 2 2 3 3 3 4 1 3 1 1 3 4 2 2
[1296] 3 1 4 2 1 4 4 1 1 4 2 4 1 4 4 3 2 3 1 3 4 2 1 3 4 1 3 2 4 2 2 4 3 3 3 1 2
[1333] 4 2 2 4 2 3 3 2 2 1 1 3 4 1 3 3 1 1 2 1 4 2 1 3 4 2 1 2 1 1 4 3 2 2 1 4 2
[1370] 3 3 3 4 1 2 1 4 3 1 3 4 3 4 1 2 1 4 2 4 3 4 1 4 1 4 1 1 4 1 3 1 2 1 1 1 3
[1407] 1 4 4 4 3 1 3 3 2 3 3 4 2 3 4 3 1 1 1 4 4 2 2 2 1 3 4 3 4 3 2 2 1 2 2 1 3
[1444] 4 1 1 1 1 3 1 1 1 4 3 1 2 3 4 1 2 4 4 2 4 2 3 2 2 1 2 1 3 1 4 2 1 2 2 2 2
[1481] 3 1 2 2 4 2 2 4 4 4 4 1 4 3 3 1 2 1 1 2 4 1 1 4 2 1 1 3 2 4 1 3 1 1 2 3 2
[1518] 1 2 4 2 3 2 3 2 1 1 2 4 3 1 2 4 1 3 2 2 3 3 2 2 3 4 3 1 4 1 1 4 1 1 1 1 2
[1555] 1 4 1 1 2 2 2 1 3 4 4 4 3 2 2 3 2 2 2 1 1 1 3 1 2 2 3 4 1 2 3 1 2 3 1 3 3
[1592] 3 3 4 1 1 1 1 2 1 2 3 1 2 2 1 4 3 2 2 1 1 2 2 1 3 1 4 4 3 1 4 4 4 1 1 1 1
[1629] 1 2 3 1 4 4 1 1 4 1 4 3 4 1 2 2 3 1 3 2 1 4 1 3 1 3 1 2 1 1 4 4 4 3 4 1 4
[1666] 1 3 1 4 1 2 1 2 3 1 2 1 1 4 4 1 2 4 1 2 4 2 2 1 2 1 1 3 4 1 2 2 3 4 2 4 4
[1703] 4 1 1 1 3 2 1 3 2 2 2 4 2 3 4 1 3 1 3 1 1 1 1 1 1 1 2 1 1 2 1 3 2 1 3 3 3
[1740] 2 1 1 2 2 3 1 3 1 3 3 3 1 1 2 3 4 1 3 2 4 1 2 1 2 3 4 4 3 2 2 4 2 1 2 2 1
[1777] 1 2 2 4 4 1 3 1 2 1 1 2 1 1 1 3 1 3 1 1 1 1 2 4 3 4 3 3 4 4 4 1 2 3 1 3 4
[1814] 1 2 4 2 1 4 4 2 3 2 4 4 2 4 4 3 2 2 3 4 2 4 3 4 2 1 3 3 1 2 2 1 3 1 4 3 4
[1851] 3 2 3 2 4 2 3 3 2 1 2 2 4 4 2 4 2 1 4 2 2 3 4 3 1 2 1 1 1 1 1 4 4 4 2 4 2
[1888] 1 3 3 1 3 1 1 3 2 1 3 3 4 3 3 1 3 2 1 2 4 2 2 1 4 2 1 3 4 1 3 4 1 3 1 2 4
[1925] 4 1 3 1 2 4 1 1 4 4 1 2 4 2 1 1 3 3 1 4 1 1 4 1 1 2 2 1 4 2 2 4 4 4 3 3 3
[1962] 3 1 1 4 4 3 2 4 1 2 1 1 2 2 3 1 1 2 3 4 4 3 3 1 2 1 1 3 4 2 1 2 2 1 3 1 1
[1999] 1 2 1 3 1 3 1 3 2 1 1 2 2 3 1 2 4 2 1 4 4 2 1 4 1 4 4 1 1 4 2 4 3 2 1 4 1
[2036] 4 3 2 4 1 1 1 4 1 3 1 1 3 4 1 2 3 1 2 1 1 4 1 2 4 1 1 3 3 2 1 4 1 3 2 3 4
[2073] 1 1 3 4 4 1 1 1 1 2 3 1 2 4 4 2 3 4 3 3 1 2 1 2 2 2 1 3 4 1 2 2 3 4 4 3 4
[2110] 1 3 3 2 1 1 3 1 1 4 4 3 3 1 3 4 4 4 4 1 1 2 2 2 1 3 2 3 2 3 3 3 2 1 4 1 4
[2147] 4 4 2 1 1 1 4 2 3 4 3 4 2 3 3 2 3 4 4 4 3 4 2 1 1 2 2 2 1 4 3 2 2 3 4 3 3
[2184] 2 1 1 4 2 2 3 4 2 1 2 1 1 4 3 3 4 4 1 1 3 1 3 1 1 1 4 1 3 3 3 2 3 1 1 3 2
[2221] 4 3 2 2 4 2 2 4 1 3 1 2 4 4 2 4 2 1 2 3 4 2 2 1 1 4 4 1 3 4 2 2 3 1 2 4 4
[2258] 1 2 3 2 2 1 1 3 2 4 4 1 4 2 3 1 2 4 2 2 2 1 3 1 1 2 4 2 2 1 1 2 4 1 2 1 1
[2295] 4 1 3 2 3 4 2 1 1 4 2 3 2 3 3 2 2 2 1 4 2 3 2 4 1 4 2 1 2 4 1 4 3 2 1 4 3
[2332] 2 1 2 2 1 2 2 4 1 1 4 2 4 2 1 3 4 2 4 1 4 1 4 4 2 3 4 3 3 4 4 1 4 4 3 3 3
[2369] 1 2 3 1 1 1 4 3 2 2 3 2 3 4 4 4 1 1 1 2 2 2 4 4 3 4 1 3 2 1 4 1 2 2 3 4 1
[2406] 2 4 1 4 1 4 3 4 3 1 2 3 1 2 1 2 2 2 3 4 3 4 1 4 4 2 3 3 3 4 4 1 3 1 3 2 1
[2443] 4 1 1 4 1 1 1 2 2 1 4 2 2 2 3 1 4 1 4 2 4 1 3 2 3 2 1 4 3 2 2 3 2 4 4 1 2
[2480] 2 3 3 4 2 4 4 4 1 4 4 2 1 3 2 1 1 3 1 1 3 3 4 1 3 3 3 4 1 2 2 4 1 4 4 4 2
[2517] 4 1 2 2 1 2 1 1 4 2 1 1 4 4 2 1 3 3 1 3 4 4 4 2 2 1 1 1 3 2 1 3 4 1 3 4 1
[2554] 4 4 2 2 1 1 2 3 1 4 2 3 1 1 2 3 2 1 1 4 2 2 2 2 4 1 4 1 4 2 3 1 4 2 1 1 4
[2591] 4 3 2 2 3 2 3 4 3 3 2 1 1 1 1 3 4 1 4 3 3 2 1 3 2 1 4 2 2 4 1 1 4 4 1 1 4
[2628] 4 4 1 2 1 2 4 1 3 1 1 4 1 2 1 3 1 2 2 2 1 2 1 4 4 1 4 2 2 3 3 3 4 2 2 3 1
[2665] 3 3 2 4 2 1 4 4 1 1 1 1 2 1 3 2 1 2 2 1 4 1 3 3 3 1 1 1 2 3 4 3 4 1 4 3 3
[2702] 1 4 4 3 2 1 2 3 1 4 1 2 2 1 2 1 2 2 2 3 2 3 1 3 3 2 3 1 2 4 1 2 2 3 1 4 4
[2739] 4 3 2 4 2 2 3 2 1 1 2 1 3 1 4 4 1 3 4 2 2 4 4 2 1 1 1 4 3 2 1 2 1 1 2 4 4
[2776] 1 1 4 1 4 2 4 1 2 2 3 4 2 3 2 2 1 1 1 1 1 3 1 4 2 3 3 3 1 3 2 1 2 4 3 2 3
[2813] 2 1 1 4 1 2 2 1 2 4 4 4 3 4 1 2 3 3 3 2 4 1 1 2 4 4 1 3 1 1 2 1 2 2 1 1 2
[2850] 4 3 3 3 1 1 2 4 3 3 1 1 1 2 1 4 2 3 4 1 4 4 1 1 1 1 2 3 1 2 4 4 2 1 1 4 2
[2887] 1 1 4 1 1 3 1 1 1 4 2 1 4 4 2 1 2 1 4 4 1 3 3 3 1 1 1 2 2 4 3 3 2 4 2 2 1
[2924] 2 4 3 2 1 2 4 2 4 2 1 4 4 1 2 1 4 2 3 3 1 2 2 3 4 3 2 2 2 1 2 1 3 3 4 4 2
[2961] 4 1 4 3 1 4 3 1 2 2 3 2 2 2 3 4 3 1 4 2 2 4 1 1 4 1 3 1 4 1 3 2 1 1 3 3 3
[2998] 1 4 2 2 4 1 1 3 2 2 3 2 2 1 2 1 2 4 1 4 3 1 2 3 4 1 1 3 1 3 1 3 3 1 4 1 2
[3035] 1 4 2 4 4 3 2 3 1 3 2 1 1 2 3 3 2 4 1 3 4 2 4 1 2 3 2 2 3 1 3 1 4 1 2 4 1
[3072] 1 3 1 4 3 1 3 3 1 1 4 3 1 1 1 3 3 3 4 2 3 1 2 2 1 1 1 3 3 2 2 3 1 4 1 4 4
[3109] 3 4 2 2 2 3 4 2 2 1 4 4 3 1 1 3 1 1 3 3 4 4 4 1 2 4 4 4 1 1 4 2 4 4 2 1 2
[3146] 4 2 2 1 2 1 3 3 3 4 2 1 1 2 3 2 4 3 3 1 3 3 2 1 2 4 1 4 4 4 1 4 3 1 2 2 4
[3183] 3 1 4 2 4 3 3 2 2 4 2 3 2 4 1 3 3 4 4 1 4 1 4 4 1 1 1 4 3 4 1 1 3 2 3 1 1
[3220] 4 1 3 2 4 3 3 3 3 2 3 3 2 1 2 3 2 2 1 3 1 4 4 3 2 4 3 3 3 2 3 2 1 1 1 2 3
[3257] 4 3 2 3 1 1 1 4 4 3 4 1 2 2 4 4 3 3 1 3 3 2 3 1 1 3 2 1 4 4 2 2 4 2 3 1 4
[3294] 3 4 1 4 4 3 1 2 3 2 2 2 4 1 2 3 1 1 2 4 4 3 3 1 2 1 2 4 2 4 2 1 2 2 2 1 2
[3331] 3 4 1 1 1 3 1 4 3 3 4 4 3 1 4 2 3 2 2 3 1 1 3 2 1 1 1 3 3 3 3 4 3 1 1 4 3
[3368] 1 4 4 1 3 4 1 1 2 2 1 2 4 1 4 1 1 1 3 3 3 2 4 3 1 2 3 2 1 2 1 4 1 4 3 2 2
[3405] 4 2 3 1 2 2 4 4 3 3 2 1 1 1 1 1 3 1 2 2 1 2 4 1 1 2 2 1 4 4 2 3 3 3 3 2 2
[3442] 2 2 4 2 2 4 4 1 4 2 2 1 4 4 2 4 3 1 1 3 4 4 1 1 1 4 2 3 2 2 3 2 1 2 2 3 3
[3479] 4 4 3 3 4 1 2 1 2 1 4 4 3 2 4 4 4 1 1 2 1 1 4 4 2 2 4 1 2 4 4 4 2 3 1 2 4
[3516] 2 4 3 3 2 3 4 2 3 3 1 2 2 4 4 4 4 4 4 3 4 4 3 4 1 2 4 1 2 4 1 3 1 1 1 4 1
[3553] 2 4 2 4 4 4 2 1 2 1 1 2 4 4 2 2 2 2 2 1 2 4 2 3 1 1 1 2 3 2 1 3 4 1 2 2 1
[3590] 2 2 3 2 4 3 1 2 2 2 2 3 1 1 1 3 4 4 3 2 1 2 3 1 1 1 2 1 4 2 4 3 1 1 3 2 4
[3627] 3 1 3 4 4 1 2 1 1 1 4 3 4 1 1 3 2 3 1 3 4 1 4 4 1 1 1 4 2 1 2 3 2 2 2 1 2
[3664] 4 2 2 3 1 3 4 2 4 2 1 3 2 2 1 1 3 1 2 4 2 2 1 4 1 3 1 1 4 4 4 1 1 1 3 2 1
[3701] 2 4 3 3 4 2 2 2 4 1 1 3 3 3 1 1 4 3 1 2 2 4 2 1 2 2 4 3 1 2 3 3 3 2 3 1 2
[3738] 4 1 4 3 3 4 4 1 4 3 4 1 3 3 2 2 1 1 3 4 4 1 1 3 1 3 4 1 2 4 1 4 3 4 3 1 3
[3775] 3 3 2 2 3 4 4 3 1 1 4 2 1 3 1 3 4 1 1 4 3 3 3 1 3 1 2 2 3 1 3 3 3 1 2 1 3
[3812] 1 3 3 2 2 2 3 4 3 4 4 1 1 4 4 1 4 2 1 1 2 4 2 1 3 3 4 1 1 1 4 2 4 2 4 4 1
[3849] 3 3 2 3 3 4 1 4 2 1 2 3 4 4 1 1 2 2 1 1 1 2 1 3 2 1 4 1 3 2 1 2 1 1 3 1 1
[3886] 3 3 1 1 3 3 2 2 1 3 1 4 1 3 3
Objective function:
   build     swap 
2.637066 2.527524 

Available components:
 [1] "medoids"    "id.med"     "clustering" "objective"  "isolation" 
 [6] "clusinfo"   "silinfo"    "diss"       "call"       "data"      

## Calculamos la distancia de Manhattan
distance2 <- dist(data, "manhattan")

## Calculamos el valor de contraste de Silhouette
sil <- silhouette(pam_clusters[["clustering"]], distance2)
windows() # En algunos entornos RStudio no muestra correctamente la figura
plot(sil)

## Calculamos el valor óptimo de clústers a partir de la inercia intra-cluster
fviz_nbclust(
  x = data,
  FUNcluster = pam,
  method = "wss",
  k.max = 10,
  diss = dist(data, method = "manhattan")
)

## Visualizamos los clusterings obtenidos a partir del método PAM
fviz_cluster(
  object = pam_clusters,
  data = data,
  ellipse.type = "t",
  repel = TRUE
) + 
  theme_bw() +  
  labs(title = "Resultados clustering PAM") +
  theme(legend.position = "none")

1.4 KMEANS para datos mixtos

Cuando el conjunto de datos contiene variables numéricas y categóricas, una opción útil es kproto, que extiende la lógica de K-means a datos mixtos combinando distancias para ambos tipos de variables.

Atención

Aplicar K-means clásico sobre datos mixtos sin transformación previa suele producir resultados poco fiables, porque las variables categóricas no pueden tratarse correctamente con distancia euclídea.

clusteringKMeans <- clustMixType::kproto(x = dades, type = "gower", k = 3)

# NAs in variables:
           Customer.ID                    Age                 Gender 
                     0                      0                      0 
        Item.Purchased               Category  Purchase.Amount..USD. 
                     0                      0                      0 
              Location                   Size                  Color 
                     0                      0                      0 
                Season          Review.Rating    Subscription.Status 
                     0                      0                      0 
         Shipping.Type       Discount.Applied        Promo.Code.Used 
                     0                      0                      0 
    Previous.Purchases         Payment.Method Frequency.of.Purchases 
                     0                      0                      0 
0 observation(s) with NAs.

plot(clusteringKMeans)

1.5 CLARA:Clustering Large Applications

En comparación con otros métodos de partición como PAM, CLARA puede gestionar conjuntos de datos mucho más grandes. Internamente, esto se logra considerando subconjuntos de tamaño fijo, de modo que los requisitos de tiempo y memoria pasan a ser aproximadamente lineales en (n), en lugar de cuadráticos.

clara(x, k, metric = c("euclidean", "manhattan", "jaccard"),
    stand = FALSE, cluster.only = FALSE, samples = 5,
    sampsize = min(n, 40 + 2 * k), trace = 0, medoids.x = TRUE,
    keep.data = medoids.x, rngR = FALSE, pamLike = FALSE, correct.d = TRUE)

1.6 fanny: Fuzzy Analysis Clustering

A diferencia de los métodos “duros”, en el clustering difuso una observación puede pertenecer parcialmente a varios grupos. Esto es útil cuando las fronteras entre clusters no están claramente delimitadas.

fanny(x, k, diss = inherits(x, "dist"), memb.exp = 2,
  metric = c("euclidean", "manhattan", "SqEuclidean"),
  stand = FALSE, iniMem.p = NULL, cluster.only = FALSE,
  keep.diss = !diss && !cluster.only && n < 100,
  keep.data = !diss && !cluster.only,
  maxit = 500, tol = 1e-15, trace.lev = 0)

1.7 Automatización de la detección del número de clusters

Cuando se quieren contrastar muchos criterios a la vez, NbClust resume diferentes índices y propone un número de grupos apoyándose en el consenso entre ellos.

NbClust::NbClust(data, diss = NULL, distance = "euclidean", min.nc = 2, 
                 max.nc = 15, method = "kmeans")

2 Métodos Jerárquicos

Los métodos jerárquicos construyen una estructura anidada de agrupaciones. En un enfoque aglomerativo, cada observación empieza como un cluster individual y se van fusionando grupos hasta obtener un único conjunto. El resultado se resume mediante un dendrograma.

Lectura del dendrograma

La altura de las fusiones refleja el nivel de disimilitud entre grupos. Saltos grandes suelen sugerir cortes naturales del árbol.

2.1 Sólo datos numéricos

En esta primera parte se trabaja únicamente con variables numéricas para ilustrar el comportamiento de los principales criterios de enlace jerárquico.

2.1.1 Cálculo de distáncias

2.1.1.1 Euclidean

dataNum <- dades[, varNum]
distancia <- dist(dataNum, method = "euclidean")

2.1.2 Generamos la agrupación

2.1.2.1 Single

El criterio single une grupos a partir de la menor distancia entre elementos de ambos clusters. Suele producir el conocido efecto de encadenamiento.

agrSingle <- hclust(distancia, method = "single")

2.1.2.2 Complete

El criterio complete utiliza la mayor distancia entre elementos de dos grupos. Tiende a formar clusters más compactos.

agrComplete <- hclust(distancia, method = "complete")

2.1.2.3 Average

El enlace promedio toma la distancia media entre todos los pares de observaciones de dos clusters. Es un compromiso habitual entre single y complete.

agrAverage <- hclust(distancia, method = "average")

2.1.2.4 Mcquitty

McQuitty actualiza las distancias entre clusters promediando de forma recursiva según las fusiones previas.

agrMcquitty <- hclust(distancia, method = "mcquitty")

2.1.2.5 Median

El criterio median calcula distancias a partir de centroides corregidos y puede verse afectado por inversiones en el dendrograma.

agrMedian <- hclust(distancia, method = "median")

2.1.2.6 Centroid

En este caso la fusión depende de la distancia entre centroides de clusters. Es intuitivo, aunque no siempre conserva bien la estructura jerárquica.

agrCentroid <- hclust(distancia, method = "centroid")

2.1.2.7 Ward.D o Ward.D2

Ward minimiza el incremento de variabilidad interna en cada fusión. Suele producir grupos compactos y bien separados, por eso es uno de los métodos más utilizados.

agrWard <- hclust(distancia, method = "ward.D2")

Realizamos la representación del dendrograma de Ward para inspeccionar visualmente posibles cortes del árbol.

plot(agrWard, main = "H.Clustering with euclidean distance and method WARD")
rect.hclust(agrWard, k = 3, border = 3)

Si queremos realizar la representación de todos los dendrogramas en una imagen, podemos transformar cada objeto hclust en un gráfico ggplot.

### Función para convertir hclust a ggplot
plot_dendrogram <- function(hclust_obj, method_name) {
  dendro_data <- ggdendro::dendro_data(hclust_obj)
  
  ggplot(ggdendro::segment(dendro_data)) +
    geom_segment(aes(x = x, y = y, xend = xend, yend = yend)) +
    theme_minimal() +
    ggtitle(method_name) +
    theme(
      axis.text = element_blank(),
      axis.ticks = element_blank(),
      axis.title = element_blank(),
      panel.grid = element_blank()
    )
}

### Lista de dendrogramas con nombres
dendrograms <- list(
  plot_dendrogram(agrSingle, "Single"),
  plot_dendrogram(agrComplete, "Complete"),
  plot_dendrogram(agrAverage, "Average"),
  plot_dendrogram(agrMcquitty, "McQuitty"),
  plot_dendrogram(agrMedian, "Median"),
  plot_dendrogram(agrCentroid, "Centroid"),
  plot_dendrogram(agrWard, "Ward.D2")
)

### Mostrar todos los dendrogramas en una cuadrícula
gridExtra::grid.arrange(grobs = dendrograms, ncol = 3)

2.2 Datos mixtos

Cuando coexisten variables numéricas y categóricas, la distancia euclídea deja de ser apropiada. En estos casos conviene recurrir a medidas mixtas como la distancia de Gower, que combina adecuadamente ambos tipos de información.

Error frecuente

Si las variables categóricas siguen siendo character, muchas funciones no las tratarán correctamente. Lo más seguro es convertirlas explícitamente a factor.

Para poder analizar datos mixtos es importante usar una distancia que permita calcular la proximidad entre individuos. Nosotros vamos a hacer uso de la distancia de Gower.

dissimMatrix <- daisy(dades[, c(varNum, varCat)], metric = "gower", stand = TRUE)

Un error muy frecuente es considerar las variables categóricas como character. En ese caso, deben transformarse a factor para que la función pueda tratarlas correctamente.

for (vC in varCat) {
  dades[, vC] <- as.factor(as.character(dades[, vC]))
}

dissimMatrix <- daisy(dades[, c(varNum, varCat)], metric = "gower", stand = TRUE)

A continuación elevamos la matriz al cuadrado para transformar la disimilitud de Gower en una forma operativa más adecuada para aplicar ciertos métodos jerárquicos, en particular Ward.

distMatrix <- dissimMatrix^2

A continuación, creamos los dendrogramas para cada uno de los métodos de agrupación.

## Generamos la agrupación
### single
agrSingle <- hclust(distMatrix, method = "single")
### complete
agrComplete <- hclust(distMatrix, method = "complete")
### average
agrAverage <- hclust(distMatrix, method = "average")
### mcquitty
agrMcquitty <- hclust(distMatrix, method = "mcquitty")
### median
agrMedian <- hclust(distMatrix, method = "median")
### centroid
agrCentroid <- hclust(distMatrix, method = "centroid")
### ward.D o ward.D2
agrWard <- hclust(distMatrix, method = "ward.D2")

### Lista de dendrogramas con nombres
dendrograms <- list(
  plot_dendrogram(agrSingle, "Single"),
  plot_dendrogram(agrComplete, "Complete"),
  plot_dendrogram(agrAverage, "Average"),
  plot_dendrogram(agrMcquitty, "McQuitty"),
  plot_dendrogram(agrMedian, "Median"),
  plot_dendrogram(agrCentroid, "Centroid"),
  plot_dendrogram(agrWard, "Ward.D2")
)

### Mostrar todos los dendrogramas en una cuadrícula
gridExtra::grid.arrange(grobs = dendrograms, ncol = 3)

2.2.1 Calculo de correlaciones

Una buena práctica adicional es estudiar la correlación cophenética entre la matriz de distancias original y las distancias inducidas por el dendrograma. Cuanto mayor sea esta correlación, mejor refleja el árbol la estructura de proximidades de los datos.

info <- data.frame(metricas = c("Single", "Complete", "Average", "McQuitty", "Median", 
                        "Centroid", "Ward"), 
           correlaciones = c(cor(distMatrix, cophenetic(agrSingle)), 
                             cor(distMatrix, cophenetic(agrComplete)), 
                             cor(distMatrix, cophenetic(agrAverage)), 
                             cor(distMatrix, cophenetic(agrMcquitty)), 
                             cor(distMatrix, cophenetic(agrMedian)), 
                             cor(distMatrix, cophenetic(agrCentroid)), 
                             cor(distMatrix, cophenetic(agrWard))))

(info <- info[order(info$correlaciones, decreasing = TRUE), ])

2.2.2 Cortar Dendogramas

Una vez construido el dendrograma, el siguiente paso consiste en decidir dónde cortar el árbol. Ese corte determina el número final de clusters.

Recomendación práctica

No conviene decidir el corte únicamente “a ojo”. Lo ideal es combinar inspección visual, heurísticas y métricas de validación.

d <- daisy(dades[, c(varNum, varCat)], metric = "gower", stand = TRUE)^2
h1 <- hclust(d, method = "ward.D2")
plot(h1)

2.2.2.1 Mediante la visualización del árbol

El método más directo consiste en inspeccionar visualmente los saltos en altura y fijar un umbral razonable.

d <- daisy(dades[, c(varNum, varCat)], metric = "gower", stand = TRUE)^2
h1 <- hclust(d, method = "ward.D2")
plot(h1)
abline(h = 4.7, col = "red", lty = 2)

2.2.2.2 Heurística

También puede apoyarse la decisión con una heurística basada en los incrementos de altura de las fusiones.

head(h1[["height"]], n = 20)

 [1] 0.01727705 0.01785237 0.01866476 0.01931276 0.02005713 0.02140997
 [7] 0.02326695 0.02346719 0.02408358 0.02508672 0.02552131 0.02574270
[13] 0.02680231 0.02746482 0.02764893 0.02832588 0.02860312 0.02903139
[19] 0.02964946 0.02983467

barplot(h1[["height"]])

plot(h1); rect.hclust(h1, h = 22.070799, border = "red")

plot(h1); rect.hclust(h1, h = 92.200018, border = "blue")

plot(h1); rect.hclust(h1, h = 133.131532 ,border = "orange")

suggested.level <- function(hc, min = 3, max = 10){
  if(min < 2) stop("Min should be equal or higher than 2")
  intra <- rev(cumsum(hc[["height"]]))
  quot <- intra[min:(max)]/intra[(min - 1):(max - 1)]
  nb.clust <- which.min(quot) + min - 1
  return(nb.clust)
}

suggested.level(h1)

[1] 3

2.2.3 Etiquetado de los resultados del clustering

Una vez fijado el número de grupos, puede etiquetarse el dendrograma y extraerse la asignación final de cluster para cada observación.

as.dendrogram(h1) %>% set("branches_k_color", k = 3) %>% plot()

k <- 3
cut_k <- cutree(h1, k)
head(cut_k, n = 40)

 [1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
[39] 1 1

2.2.4 Validación de los cortes realizados

Finalmente, es posible validar el corte escogido con métricas internas de cohesión, separación y estructura del clustering.

fpc::cluster.stats(d, clustering = as.numeric(cut_k))

$n
[1] 3900

$cluster.number
[1] 3

$cluster.size
[1] 1675  995 1230

$min.cluster.size
[1] 995

$noisen
[1] 0

$diameter
[1] 0.7782282 0.7772257 0.6291662

$average.distance
[1] 0.3087167 0.2745693 0.3045038

$median.distance
[1] 0.3071344 0.2715715 0.3028046

$separation
[1] 0.07960016 0.04798513 0.04798513

$average.toother
[1] 0.510188 0.426618 0.447194

$separation.matrix
           [,1]       [,2]       [,3]
[1,] 0.00000000 0.08023544 0.07960016
[2,] 0.08023544 0.00000000 0.04798513
[3,] 0.07960016 0.04798513 0.00000000

$ave.between.matrix
          [,1]      [,2]     [,3]
[1,] 0.0000000 0.4997843 0.518604
[2,] 0.4997843 0.0000000 0.326981
[3,] 0.5186040 0.3269810 0.000000

$average.between
[1] 0.4648981

$average.within
[1] 0.298676

$n.between
[1] 4950725

$n.within
[1] 2652325

$max.diameter
[1] 0.7782282

$min.separation
[1] 0.04798513

$within.cluster.ss
[1] 187.0525

$clus.avg.silwidths
        1         2         3 
0.3540593 0.1588915 0.0678654 

$avg.silwidth
[1] 0.2140054

$g2
NULL

$g3
NULL

$pearsongamma
[1] 0.5549685

$dunn
[1] 0.06165946

$dunn2
[1] 1.059162

$entropy
[1] 1.075431

$wb.ratio
[1] 0.6424548

$ch
[1] 1829.863

$cwidegap
[1] 0.1258597 0.1269368 0.1227951

$widestgap
[1] 0.1269368

$sindex
[1] 0.07710294

$corrected.rand
NULL

$vi
NULL

2.3 Other HIERARCHICAL methods

2.3.1 Agnes:Agglomerative Nesting

agnes implementa clustering jerárquico aglomerativo y proporciona información adicional sobre la calidad de la estructura jerárquica.

agnes(x, diss = inherits(x, "dist"), metric = "euclidean",
  stand = FALSE, method = "average", par.method,
  keep.diss = n < 100, keep.data = !diss, trace.lev = 0)

2.3.2 mona: MONothetic Analysis Clustering of Binary Variables

mona está pensado para variables binarias y construye una jerarquía divisiva basada en particiones monotéticas.

mona(x, trace.lev = 0)  

3 Métricas de validación

Después de construir un clustering, conviene contrastar su calidad con varios índices. Ninguna métrica resume por sí sola toda la estructura, así que lo más recomendable es analizarlas de manera complementaria.

Criterio general

• Algunos índices se maximizan, como Silhouette o Calinski-Harabasz.
• Otros se minimizan, como Davies-Bouldin.
• Por eso es importante interpretar cada uno en su propia escala.

3.1 SSE (Sum of Squared Errors)

Esta métrica mide la varianza total dentro de cada cluster y se define como la suma de las distancias al cuadrado de cada punto al centroide de su cluster.

El objetivo de K-means es minimizar el SSE, por lo que es una métrica útil para evaluar la compactación interna de los grupos.

(sse <- clustering$tot.withinss)

[1] 1928452

3.2 Método del codo (Elbow method)

Este método representa la relación entre la suma de errores intra-cluster y el número de grupos. A medida que aumenta (k), el SSE disminuye. El “codo” aparece cuando esa mejora empieza a ser claramente marginal.

sse <- c()
for (k in 1:10) {
  kmeans_model <- kmeans(dades[, varNum], k)
  sse[k] <- kmeans_model$tot.withinss
}

plot <- ggplot(data.frame(x = 1:10, y = sse), aes(x, y)) +
        geom_line() +
        geom_point() +
        labs(x = "Number of clusters", y = "SSE", title = "Método del codo") 

print(plot)

3.3 Método de gap estadístico (Gap statistic method)

Este método compara el clustering observado con particiones obtenidas sobre datos de referencia aleatorios. Un mayor gap indica que la estructura detectada es más fuerte que la esperable por azar.

gap_stat <- clusGap(dades[, varNum], FUN = kmeans, nstart = 10, K.max = 10, B = 10)
plot(gap_stat, main="Gap statistic plot")

3.4 Coeficiente de Silhouette

Mide la similitud de cada objeto con su propio grupo frente a otros grupos. Su rango va de -1 a 1: valores altos indican buena asignación, valores cercanos a 0 sugieren frontera difusa y valores negativos apuntan a mala clasificación.

sil <- cluster::silhouette(clustering$cluster, dist(dades[, varNum]))
avg_sil <- mean(sil[, 3])
summary(sil)

Silhouette of 3900 units in 3 clusters from silhouette.default(x = clustering$cluster, dist = dist(dades[, varNum])) :
 Cluster sizes and average silhouette widths:
     1049      1794      1057 
0.2450539 0.3259984 0.2406909 
Individual silhouette widths:
   Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
-0.0556  0.1641  0.3025  0.2811  0.3986  0.5568 

Silhouetteplot(as.matrix(dades[, varNum]), Cls = sil[, "cluster"], main='Silhouetteplot')

sil <- c()
for (k in 2:10) {
  kmeans_model <- kmeans(dades[, varNum], k)
  sil[k] <- mean(silhouette(kmeans_model$cluster, dist(dades[, varNum]))[, 3])
}

plot <- ggplot(data.frame(x=1:10, y=sil), aes(x, y)) +
        geom_line() +
        geom_point() +
        labs(x="Number of clusters", y="Silhouette coefficient", 
             title = "Método de la silhouette")

### El número óptimo de clusters es aquel que maximiza el promedio del índice de silueta
print(plot)

3.5 Índice de Davies-Bouldin

Compara la dispersión dentro de los grupos con la separación entre grupos. A diferencia de otros índices, aquí un valor más bajo indica un mejor clustering.

DB_index <- clusterSim::index.DB(dades[, varNum], clustering$cluster)
DB_index

$DB
[1] 1.44675

$r
[1] 1.644086 1.052079 1.644086

$R
         [,1]     [,2]     [,3]
[1,]      Inf 1.052079 1.644086
[2,] 1.052079      Inf 1.024064
[3,] 1.644086 1.024064      Inf

$d
         1        2        3
1  0.00000 42.29705 25.61027
2 42.29705  0.00000 43.65562
3 25.61027 43.65562  0.00000

$S
[1] 20.94957 23.55025 21.15591

$centers
         [,1]     [,2]     [,3]     [,4]
[1,] 48.18208 41.71973 3.717541 37.65682
[2,] 43.72352 81.91918 3.782219 25.28094
[3,] 40.57143 40.07001 3.727342 13.25922

DB_indexes <- vector()
for (k in 1:10) {
  kmeans_result <- kmeans(dades[, varNum], centers = k)
  DB_index <- clusterSim::index.DB(dades[, varNum], kmeans_result$cluster)
  DB_indexes[k] <- DB_index$DB
}

DB_df <- data.frame(k = 1:10, DB = DB_indexes)
ggplot(DB_df, aes(x = k, y = DB)) + geom_point() + geom_line()

En el gráfico, interesa buscar valores pequeños del índice. Si además se observa un cambio de pendiente claro, ese punto puede servir como referencia para fijar (k).

3.6 Índice de Calinski-Harabasz

Mide la relación entre dispersión intra-cluster y dispersión inter-cluster. Cuanto mayor sea el índice, mejor separación relativa existe entre grupos.

CH_index <- fpc::calinhara(dades[, varNum], clustering$cluster)
CH_index

[1] 1996.947

CH_indexes <- vector()
for (k in 1:10) {
  kmeans_result <- kmeans(dades[, varNum], centers = k)
  CH_index <- calinhara(dades[, varNum], kmeans_result$cluster)
  CH_indexes[k] <- CH_index
}

CH_df <- data.frame(k = 1:10, CH = CH_indexes)
ggplot(CH_df, aes(x = k, y = CH)) + geom_point() + geom_line()

En este caso, el valor óptimo de (k) suele asociarse al máximo del índice o a una zona claramente dominante frente a los valores vecinos.

3.7 Entropía

La entropía puede interpretarse como una medida de pureza o heterogeneidad de la partición. Valores medios bajos sugieren grupos más homogéneos.

cluster_labels <- clustering$cluster

cluster_entropy <- entropy::entropy(table(cluster_labels))
cluster_entropy <- sapply(unique(cluster_labels), function(i) entropy::entropy(cluster_labels == i))

Un clustering con una entropía media baja indica que los clusters son más homogéneos y distintos entre sí.

mean_entropy <- mean(cluster_entropy)
mean_entropy

[1] 7.136995

entropy_values <- vector()
for (k in 1:10) {
  kmeans_result <- kmeans(dades[, varNum], centers = k)
  cluster_labels <- kmeans_result$cluster
  cluster_entropy <- sapply(unique(cluster_labels), function(i) 
                                entropy::entropy(cluster_labels == i))
  entropy_values[k] <- mean(cluster_entropy)
}

entropy_df <- data.frame(k = 1:10, entropy = entropy_values)
ggplot(entropy_df, aes(x = k, y = entropy)) + geom_point() + geom_line()

Puedes buscar una zona donde la entropía disminuya y luego se estabilice, lo que indicaría que aumentar (k) deja de aportar una mejora clara en pureza.

3.8 Cophenetic Correlation Coefficient

Mide hasta qué punto el dendrograma reproduce las distancias originales entre observaciones. Un valor cercano a 1 indica una representación jerárquica fiel.

hc_result <- hclust(dist(dades[, varNum]), method = "complete")
cor_coph <- cor(cophenetic(hc_result), dist(dades[, varNum]))
cor_coph

[1] 0.6083644

cophen_corr <- c()

metodos <- c("ward.D", "ward.D2", "single", "complete", "average", "mcquitty", 
             "median", "centroid")

for (met in metodos) {
  hc_result <- hclust(dist(dades[, varNum]), method = met)
  cophen_corr[met] <- cor(cophenetic(hc_result), dist(dades[, varNum]))
}

df <- data.frame(Nombre = names(cophen_corr), Correlación = cophen_corr)

ggplot(df, aes(x = Nombre, y = Correlación, fill = Correlación)) +
  geom_col() +
  scale_fill_gradient2(low = "red", mid = "white", high = "blue", midpoint = 0) + 
  theme_minimal() + 
  labs(title = "Valores de Correlación", x = "Variables", y = "Correlación") +
  theme(axis.text.x = element_text(angle = 45, hjust = 1))

3.9 Coeficiente de correlación ajustado Rand (Adjusted Rand Index)

El ARI mide la similitud entre dos particiones. Es especialmente útil cuando se dispone de etiquetas verdaderas o de una partición de referencia.

Limitación

Si no existen etiquetas verdaderas, ARI y AFM no sirven como métricas internas puras. En ese caso deben interpretarse como ejemplos metodológicos o emplearse frente a una partición de referencia externa.

true_labels <- # Etiquetas verdaderas, si las tienes
kmeans_labels <- kmeans_result$cluster
ARI <- mclust::adjustedRandIndex(true_labels, kmeans_labels)

Si no tienes etiquetas verdaderas para tus datos, puedes usar la técnica de validación cruzada conocida como “ARI dentro de grupos” (ARI within-cluster).

Para hacerlo, primero debes dividir tus datos en un conjunto de entrenamiento y un conjunto de prueba. Luego, realiza el clustering K-means en el conjunto de entrenamiento y calcula el ARI entre los clusters y las etiquetas verdaderas del conjunto de prueba.

set.seed(123)
training_index <- caret::createDataPartition(datos$clase, p = 0.8, list = FALSE)
training_data <- datos[training_index, ]
test_data <- datos[-training_index, ]

kmeans_result <- kmeans(training_data, centers = 4)
true_labels <- test_data$clase
kmeans_labels <- predict(kmeans_result, test_data)
ARI <- adjustedRandIndex(true_labels, kmeans_labels)

El ARI varía entre -1 y 1, donde -1 indica una asignación completamente diferente de los clusters y 1 indica una asignación perfectamente igual de los clusters.

Puedes interpretar el valor del ARI como sigue:

ARI ~ 1: el clustering de alta calidad y se ajusta bien a las etiquetas verdaderas

ARI ~ 0: el clustering de baja calidad y no se ajusta bien a las etiquetas verdaderas

ARI ~ -1: el clustering es peor que una asignación aleatoria de los clusters

ARI_values <- vector()
for (k in 1:10) {
  kmeans_result <- kmeans(datos, centers = k)
  true_labels <- # Etiquetas verdaderas, si las tienes
  kmeans_labels <- kmeans_result$cluster
  ARI <- adjustedRandIndex(true_labels, kmeans_labels)
  ARI_values <- c(ARI_values, ARI)
}

plot(ARI_values ~ 1:10, type = "b", xlab = "Número de clusters (k)", ylab = "ARI")

Para decidir el número de clusters adecuado, debemos buscar el valor de (k) que maximice el ARI.

3.10 Coeficiente de correlación ajustado Fowlkes-Mallows (Adjusted Fowlkes-Mallows Index)

El índice de Fowlkes-Mallows ajustado también mide similitud entre particiones y puede interpretarse como una alternativa al ARI cuando interesa evaluar coincidencia entre pares de observaciones agrupadas.

true_labels <- # Etiquetas verdaderas, si las tienes

# Calcula el AFM
AFM <- clevr::fowlkes_mallows(true_labels, clustering$cluster)

# Muestra el valor de AFM
print(AFM)

AFM_values <- vector()
for (k in 1:10) {
  kmeans_result <- kmeans(datos, centers = k)
  true_labels <- # Etiquetas verdaderas, si las tienes
  kmeans_labels <- kmeans_result$cluster
  AFM <- clevr::fowlkes_mallows(true_labels, kmeans_labels)
  AFM_values <- c(AFM_values, AFM)
}

plot(AFM_values ~ 1:10, type = "b", xlab = "Número de clusters (k)", ylab = "AFM")

Para decidir el número de clusters adecuado, debemos buscar el valor de (k) que maximice el AFM.

3.11 Error de reconstrucción

Esta métrica mide la diferencia entre la distancia original entre los objetos y la distancia entre los clusters en el dendrograma. Un valor cercano a 0 indica una buena representación de los datos en el árbol jerárquico.

hc_result <- hclust(dist_matrix, method = "complete")
error_reconstr <- sum((dist_matrix - as.dist(as.matrix(cophenetic(hc_result))))^2)

error_reconstr <- c()
for (k in 2:10) {
  hc_result <- hclust(dist_matrix, method = "complete")
  error_reconstr[k-1] <- sum((dist_matrix - as.dist(as.matrix(cophenetic(hc_result))))^2)
}
plot(error_reconstr, type="b", xlab="Number of clusters", ylab="Error de reconstrucción")

El número óptimo de clusters es aquel que minimiza el error de reconstrucción.

3.12 Cálculo de los estadísticos para todos los valores de K buscados

Cuando se desea una evaluación más global, puede automatizarse el cálculo de múltiples índices sobre un rango de valores de (k).

info <- NbClust::NbClust(data = dades[, varNum], distance = "euclidean", 
                         min.nc = 3, max.nc = 10, method = "ward.D2")

Otra forma seria usando la libreria fpc.

fpc::clusterbenchstats

4 Bibliografia

• https://www.datanovia.com/en/lessons/determining-the-optimal-number-of-clusters-3-must-know-methods/

Aquesta web està creada por Dante Conti y Sergi Ramírez, (c) 2026