TRABAJO DE FIN DE MASTER
Máster Oficial en Métodos Avanzados de Investigación e Innovación en el Análisis Social
PRIMERA PARTE CLUSTER JERÁRQUICO
Alumna: Uxía Seijas Vidal (uxia.seijas@udc.es)
En primer lugar, se cargan las librerías necesarias:
library(haven)
library(dplyr)
library(ggplot2)
library(cluster)
library(factoextra)
library(labelled)
library(tidyr)
A continuación, se cargan los datos desde un archivo SPSS y se
seleccionan las variables de interés para el análisis de clustering,
eliminando consigo valores perdidos:
datos <- read_sav("C:/Users/uxias/Downloads/investigación_def.sav")
vars_cluster <- datos %>%
select(V3_RECODE, EDAD_RECODE2, p7a_recode, p42_recode,
p17a2_recode, p17c2_recode, p17d2_recode,
p27_recode, p36.1_recode, p36.4_recode) %>%
na.omit()
Además, se convierten todas las variables a formato numérico y
se escalan para homogeneizar sus valores antes de realizar el
clustering:
vars_cluster_num <- vars_cluster %>%
mutate(across(everything(), as.numeric))
vars_cluster_scaled <- vars_cluster_num %>%
mutate(across(everything(), scale))
z_scores <- vars_cluster_scaled %>%
as.data.frame()Identificación de outliers
Posteriormente, se establece un umbral de 3 para detectar outliers mediante los valores z (z-scores). Se identifican las filas que contienen al menos una variable cuyo valor absoluto del z-score supera dicho umbral, lo que permite detectar observaciones atípicas en el conjunto de datos
umbral <- 3
outliers_logicos <- apply(abs(z_scores), 1, function(x) any(x > umbral))
outliers <- apply(z_scores, 1, function(x) any(abs(x) > umbral))
print(table(outliers))## outliers
## FALSE TRUE
## 662 11outliers_indices <- which(outliers)
print(outliers_indices)## [1] 17 154 249 289 378 391 420 467 488 496 603print(vars_cluster_num[outliers_indices, ])## # A tibble: 11 × 10
## V3_RECODE EDAD_RECODE2 p7a_recode p42_recode p17a2_recode p17c2_recode
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 6 1 2 1 3
## 2 1 5 3 3 1 4
## 3 1 5 1 1 1 3
## 4 1 4 1 4 1 4
## 5 1 5 1 1 1 3
## 6 2 1 1 3 1 2
## 7 1 5 1 3 1 3
## 8 1 3 1 1 1 1
## 9 2 2 1 3 1 2
## 10 1 1 1 1 1 1
## 11 1 3 1 1 1 1
## # ℹ 4 more variables: p17d2_recode <dbl>, p27_recode <dbl>, p36.1_recode <dbl>,
## # p36.4_recode <dbl>
Asimismo, se extraen los valores escalados correspondientes
únicamente a estas observaciones atípicas para identificar con precisión
en qué variables y filas se producen dichos outliers. Para ello, se crea
una matriz booleana que indica qué variables superan el umbral en cada
fila detectada
outliers_data <- z_scores[outliers_indices, ]
is_outlier <- function(x) abs(x) > 3
outlier_matrix <- apply(outliers_data, 2, is_outlier)
print(outlier_matrix)## V3_RECODE EDAD_RECODE2 p7a_recode p42_recode p17a2_recode p17c2_recode
## 17 FALSE FALSE FALSE FALSE FALSE FALSE
## 154 FALSE FALSE FALSE FALSE FALSE FALSE
## 249 FALSE FALSE FALSE FALSE FALSE FALSE
## 289 FALSE FALSE FALSE FALSE FALSE FALSE
## 378 FALSE FALSE FALSE FALSE FALSE FALSE
## 391 FALSE FALSE FALSE FALSE FALSE FALSE
## 420 FALSE FALSE FALSE FALSE FALSE FALSE
## 467 FALSE FALSE FALSE FALSE FALSE FALSE
## 488 FALSE FALSE FALSE FALSE FALSE FALSE
## 496 FALSE FALSE FALSE FALSE FALSE FALSE
## 603 FALSE FALSE FALSE FALSE FALSE FALSE
## p17d2_recode p27_recode p36.1_recode p36.4_recode
## 17 TRUE FALSE FALSE FALSE
## 154 TRUE FALSE FALSE FALSE
## 249 TRUE FALSE FALSE FALSE
## 289 TRUE FALSE FALSE FALSE
## 378 TRUE FALSE FALSE FALSE
## 391 TRUE FALSE FALSE FALSE
## 420 TRUE FALSE FALSE FALSE
## 467 TRUE FALSE FALSE FALSE
## 488 TRUE FALSE FALSE FALSE
## 496 TRUE FALSE FALSE FALSE
## 603 TRUE FALSE FALSE FALSEPor consiguiente, de muestran los valores originales de la variable
específica (p17d2_recode) para las observaciones detectadas
como outliers:
vars_cluster_num[outliers_indices, "p17d2_recode"]## # A tibble: 11 × 1
## p17d2_recode
## <dbl>
## 1 5
## 2 5
## 3 5
## 4 5
## 5 5
## 6 5
## 7 5
## 8 5
## 9 5
## 10 5
## 11 5Del análisis realizado, se detectaron un total de 11 observaciones
que presentan al menos un valor con un z-score absoluto mayor que 3. Sin
embargo, al observar la matriz booleana que indica en qué variables se
originan estos outliers, se aprecia que todos ellos se concentran en una
única variable: p17d2_recode.Esta concentración sugiere que
las observaciones atípicas no son producto de valores extremos dispersos
por múltiples variables, sino que responden a valores excepcionalmente
altos en dicha variable específica. Por tanto, se mantendrán dichos
valores.
Cluster Jerárquico
En primer lugar, se calcula la matriz de distancias euclídeas a partir de los datos estandarizados, que es la base para el análisis de clustering jerárquico:
dist_matrix <- dist(vars_cluster_scaled, method = "euclidean")A continuación, se realiza el clustering jerárquico utilizando el método de Ward.D2, que minimiza la varianza dentro de los grupos al fusionar clusters:
hc_ward <- hclust(dist_matrix, method = "ward.D2")Antes de decidir el número óptimo de clusters, se visualiza el dendrograma básico del resultado:
fviz_dend(hc_ward,
k = NULL,
color_labels_by_k = FALSE,
rect = FALSE,
cex = 0.5,
k_colors = "black",
main = "Dendrograma básico (Ward.D2)")
Para determinar el número adecuado de clusters, se examinan las últimas 20 distancias de fusión (siguiendo el criteriod de Méndez, s.f.), las cuales reflejan la diferencias entre los clusters en cada etapa final del proceso:
distancia <- data.frame(
etapa = 652:672,
distancia = hc_ward$height[652:672]
)
print(distancia)## etapa distancia
## 1 652 10.75399
## 2 653 10.97202
## 3 654 11.04349
## 4 655 11.27583
## 5 656 11.47081
## 6 657 11.66900
## 7 658 12.24281
## 8 659 12.38743
## 9 660 12.99444
## 10 661 13.22277
## 11 662 13.72522
## 12 663 13.97455
## 13 664 16.18405
## 14 665 16.88871
## 15 666 18.94494
## 16 667 18.99573
## 17 668 19.03364
## 18 669 23.55301
## 19 670 26.98228
## 20 671 33.72143
## 21 672 49.29030Posteriormente, se visualizan estas distancias con un gráfico de líneas y puntos, lo que facilita la identificación de posibles “saltos” significativos en la distancia que sugieren cortes naturales en el dendrograma:
ggplot(distancia, aes(x = etapa, y = distancia)) +
geom_point(color = "black") +
geom_line(color = "black") +
scale_x_continuous(breaks = distancia$etapa) +
theme_bw() +
labs(title = "Últimas 20 distancias de fusión (Ward.D2)",
x = "Número de clusters",
y = "Distancia")
Además, se incluye una versión del gráfico con líneas verticales para
marcar visualmente posibles puntos de corte, en este caso en las etapas
668 y 672, indicados con líneas roja y azul respectivamente:
ggplot(distancia, aes(x = etapa, y = distancia)) +
geom_point() + geom_line() +
scale_x_continuous(breaks = distancia$etapa) +
geom_vline(xintercept = 668, col = "red", lty = 3, size = 1.5) +
geom_vline(xintercept = 672, col = "blue", lty = 3, size = 1.5) +
theme_bw()+
labs(title = "Últimas 20 distancias de fusión (Ward.D2)",
x = "Número de clusters",
y = "Distancia")## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Tras la selección del umbral en la etapa 668, se procede a cortar el dendrograma en dicha altura para obtener los clusters:
grupos <- cutree(hc_ward, h = hc_ward$height[668])
table(grupos) # Muestra el número de observaciones por cluster## grupos
## 1 2 3 4 5
## 102 139 200 102 130Finalmente, se visualizan los clusters resultantes en el dendrograma con etiquetas coloreadas y rectángulos que delimitan cada grupo, facilitando la interpretación visual de la segmentación:
fviz_dend(hc_ward,
k = 5,
cex = 0.5,
color_labels_by_k = TRUE,
rect = TRUE,
main = "Dendrograma con 5 clústeres (Ward.D2)")## 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.