BD <- read.csv("Clientes.csv", fileEncoding = "latin1", header = TRUE) %>%
select(-c(ClienteID, Nombre,SucursalID,UbigeoID)) %>%
filter(Género != "Otro")Segmetación de Clientes
Análisis de segmetación de clientes
Toda empresa que quiera ser competitiva dentro de su nicho de mercado debe considerar realizar una segmentación de sus clientes. Para el presente caso, se pretende realizar para un cojunto de clientes de una finaciera con la finalidad de personalizar productos, optimizar estrategias de marketing, mejorar la satisfacción del cliente y gestionar riesgos de manera más efectiva, maximizando la rentabilidad y fidelización en un mercado competitivo. En resumen, conocer de mejor manera el perfil de nuestra cartera de clientes.
Se va a optar por dos algoritmos de agrupamiento, los cuales serán comparados.
K-means: Algoritmo de agrupamiento no supervisado que divide un conjunto de datos en un número predefinido de clústeres (K).
Clustering Aglomerativo: Algoritmo de agrupamiento jerárquico que construye una jerarquía de clústeres mediante una serie de fusiones de grupos más pequeños.
OJO:
Aprendizaje No Supervisado: No se utilizan etiquetas o respuestas conocidas; el algoritmo encuentra patrones inherentes en los datos. Objetivo: Maximizar la similitud intra-cluster y minimizar la similitud inter-cluster.
1. Preprocemiento de los datos
1.1 Cargar datos y limpiar valores desconocidos
1.2 Factorización con asignación de niveles
BD$Género <- factor(BD$Género,levels = c("Masculino", "Femenino"),labels = c("Masculino", "Femenino"))
BD$EstadoCivil <- factor(BD$EstadoCivil,levels = c("Soltero","Casado","Divorciado","Viudo"),labels = c("Soltero","Casado","Divorciado","Viudo"))
BD$NivelEducacion <- factor(BD$NivelEducacion,levels = c("Terciaria","Primaria","Secundaria","Universitaria"),labels = c("Terciaria","Primaria","Secundaria","Universitaria"))
BD$Empleo <- factor(BD$Empleo, levels = c("Empleado","Desempleado","Otro"),labels = c("Empleado","Desempleado","Otro"))
BD$TipoContrato <- factor(BD$TipoContrato, levels = c("Freelance","Permanente","Temporal"),labels = c("Freelance","Permanente","Temporal"))
BD$Salud <- factor(BD$Salud,levels = c("Regular","Buena","Mala"),labels = c("Regular","Buena","Mala"))
BD$ViviendaPropia <- factor(BD$ViviendaPropia, levels = c("False", "True"), labels = c("No", "Sí"))
BD$CondicionVulnerable <- factor(BD$CondicionVulnerable,levels = c("False", "True"),labels = c("No vulnerable", "Sí vulnerable"))
BD$HistorialCrediticio <- factor(BD$HistorialCrediticio,levels = c("Malo","Regular","Bueno"),labels = c("Malo","Regular","Bueno"))1.3 Base de datos procesada para los algoritmos
BD_clust <- BD1.3 One Hot Encoding
categorical_vars <- c("Género","EstadoCivil", "NivelEducacion", "Empleo", "TipoContrato", "Salud","ViviendaPropia","HistorialCrediticio","CondicionVulnerable")
BD_encoded <- model.matrix(~ Género + EstadoCivil + NivelEducacion + Empleo + TipoContrato + Salud + ViviendaPropia + HistorialCrediticio + CondicionVulnerable - 1, data = BD_clust)
BD_clust <- BD_clust[, !(names(BD_clust) %in% categorical_vars)]
BD_clust <- cbind(BD_clust, BD_encoded)1.3 Estandarización de variables
BD_clust$Edad <- scale(BD_clust$Edad)[, 1]
BD_clust$IngresosMensuales <- scale(BD_clust$IngresosMensuales)[, 1]
BD_clust$DeudasActivas <- scale(BD_clust$DeudasActivas)[, 1]
BD_clust$SituacionFamiliar <- scale(BD_clust$SituacionFamiliar)[, 1]1.4 Reducción de dimensionalidad
Se va utilizar la técnica del PCA (Análisis de Componentes Principales), la cual es una técnica de reducción de dimensionalidad que transforma el conjunto de datos a un nuevo espacio de menor dimensión, manteniendo la mayor parte de la varianza de los datos.
# Realizar PCA
pca_result <- prcomp(BD_clust, scale. = TRUE)
# Extraer los resultados del summary
pca_summary <- summary(pca_result)
# Crear una tabla con la varianza explicada y la varianza acumulada
variance_explained <- data.frame(
Component = paste("PC", 1:ncol(pca_summary$importance), sep = ""), Variance_Explained = pca_summary$importance[2, ], Cumulative_Variance = pca_summary$importance[3, ])
# Mostrar la tabla con knitr::kable para mayor elegancia
kable(variance_explained,
caption = "Varianza Explicada por Componentes Principales (PCA)", col.names = c("Componente", "Varianza Explicada", "Varianza Acumulada"))| Componente | Varianza Explicada | Varianza Acumulada | |
|---|---|---|---|
| PC1 | PC1 | 0.09166 | 0.09166 |
| PC2 | PC2 | 0.08224 | 0.17390 |
| PC3 | PC3 | 0.08166 | 0.25556 |
| PC4 | PC4 | 0.06438 | 0.31994 |
| PC5 | PC5 | 0.06378 | 0.38372 |
| PC6 | PC6 | 0.06186 | 0.44558 |
| PC7 | PC7 | 0.06066 | 0.50624 |
| PC8 | PC8 | 0.05708 | 0.56332 |
| PC9 | PC9 | 0.04968 | 0.61299 |
| PC10 | PC10 | 0.04863 | 0.66163 |
| PC11 | PC11 | 0.04653 | 0.70816 |
| PC12 | PC12 | 0.04568 | 0.75385 |
| PC13 | PC13 | 0.04524 | 0.79909 |
| PC14 | PC14 | 0.04384 | 0.84293 |
| PC15 | PC15 | 0.04155 | 0.88447 |
| PC16 | PC16 | 0.03420 | 0.91867 |
| PC17 | PC17 | 0.02680 | 0.94547 |
| PC18 | PC18 | 0.02545 | 0.97091 |
| PC19 | PC19 | 0.01756 | 0.98847 |
| PC20 | PC20 | 0.00932 | 0.99780 |
| PC21 | PC21 | 0.00220 | 1.00000 |
| PC22 | PC22 | 0.00000 | 1.00000 |
1.4.1 Visualización del PCA
screeplot(pca_result, type = "lines", main = "Scree Plot de PCA")
1.4.2 Elección del número de componentes
datos_pca <- pca_result$x[, 1:10]2. Clustering Aglomerativo
2.1 Cálculo de la Matriz de Distancias entre las observaciones
# Matriz de distancias Euclídea
dist_matrix <- dist(datos_pca, method = "euclidean")2.2 Aplicación del Algoritmo Aglomerativo
Usamos la función hclust() para crear el dendrograma con diferentes métodos de enlace.
# Clustering aglomerativo con Complete Linkage
hc_complete <- hclust(dist_matrix, method = "complete")# Dendrograma básico con enlace completo
plot(hc_complete, main = "Dendrograma - Complete Linkage")
2.3 Definición del número de clústers y agregar a la base original
# Corte del dendrograma aglomerativo en 5 clusters
clusters_aglomerativo <- cutree(hc_complete, k = 5)
# Añadimos las asignaciones al dataset original
BD$cluster_hc <- as.factor(clusters_aglomerativo)3. K - means
3.1 Observamos el comportamieto de WSS para disitntos clústers
# Aplicar K-means
set.seed(123) # Para reproducibilidad
wss <- sapply(1:10, function(k) { # Probar con k = 1 hasta 10 clusters
kmeans(datos_pca, centers = k, nstart = 25)$tot.withinss})
# Graficar el WSS (Within Sum of Squares) para cada número de clusters
plot(1:10, wss, type = "b", pch = 19, frame = FALSE, xlab = "Número de Clusters", ylab = "WSS")
3.2 Definición del número de clústers y agregar a la base original
# Aplicar K-means con 5 clusters
kmeans_result <- kmeans(datos_pca, centers = 5, nstart = 25)# Añadir los clusters a los datos
datos_pca <- cbind(datos_pca, cluster = kmeans_result$cluster)
ggplot(datos_pca, aes(x = PC1, y = PC2, color = as.factor(cluster))) +
geom_point() +
labs(title = "Segmentación de clientes - K-Means (5 clusters)", x = "Componente Principal 1", y = "Componente Principal 2") +
scale_color_discrete(name = "Cluster") +
theme_minimal()
# Añadir el cluster asignado a la base de datos original
BD$Cluster <- as.factor(kmeans_result$cluster)4. Comparación de algoritmos
4.1 Observaciones por clúster
cluster_kmeans <- as.data.frame(table(BD$Cluster))
colnames(cluster_kmeans) <- c("Cluster", "Frecuencia_Kmeans")
cluster_hc <- as.data.frame(table(BD$cluster_hc))
colnames(cluster_hc) <- c("Cluster", "Frecuencia_HC")
combined_clusters <- merge(cluster_kmeans, cluster_hc, by = "Cluster", all = TRUE)
kable(combined_clusters, caption = "Distribución de Clientes por Cluster (K-means y Clustering Aglomerativo)", col.names = c("Cluster", "Frecuencia K-means", "Frecuencia Clustering Aglomerativo"))| Cluster | Frecuencia K-means | Frecuencia Clustering Aglomerativo |
|---|---|---|
| 1 | 1310 | 1316 |
| 2 | 2449 | 5323 |
| 3 | 2485 | 704 |
| 4 | 2403 | 1767 |
| 5 | 934 | 471 |
4.2 Distribución Salarial por clúster
4.2.1 K - means
p <- ggplot(BD, aes(x = as.factor(Cluster), y = IngresosMensuales)) +
geom_boxplot(fill = "lightblue", color = "darkblue") +
labs(title = "Distribución de Ingresos Mensuales por Cluster K-means",
x = "Cluster K-means",
y = "Ingresos Mensuales")
# Convertir a gráfico interactivo con plotly
ggplotly(p)4.2.2 Clúster Aglomerativo
p <- ggplot(BD, aes(x = as.factor(cluster_hc), y = IngresosMensuales)) +
geom_boxplot(fill = "lightblue", color = "darkblue") +
labs(title = "Distribución de Ingresos Mensuales por Cluster Aglomerativo",
x = "Cluster Aglomerativo",
y = "Ingresos Mensuales")
# Convertir a gráfico interactivo con plotly
ggplotly(p)4.3 Personas Vulnerables por Cluster
BD_vulnerables <- BD %>% filter(CondicionVulnerable == "Sí vulnerable")
cluster_kmeans <- as.data.frame(table(BD_vulnerables$Cluster))
colnames(cluster_kmeans) <- c("Cluster", "Frecuencia_Kmeans")
cluster_hc <- as.data.frame(table(BD_vulnerables$cluster_hc))
colnames(cluster_hc) <- c("Cluster", "Frecuencia_HC")
total_kmeans <- sum(cluster_kmeans$Frecuencia_Kmeans)
total_hc <- sum(cluster_hc$Frecuencia_HC)
cluster_kmeans$Porcentaje_Kmeans <- (cluster_kmeans$Frecuencia_Kmeans / total_kmeans) * 100
cluster_hc$Porcentaje_HC <- (cluster_hc$Frecuencia_HC / total_hc) * 100
combined_clusters <- merge(cluster_kmeans[, c("Cluster", "Porcentaje_Kmeans")], cluster_hc[, c("Cluster", "Porcentaje_HC")], by = "Cluster", all = TRUE)
kable(combined_clusters,
caption = "Distribución de Personas Vulnerables por Cluster (K-means y Clustering Aglomerativo)",col.names = c("Cluster", "Porcentaje K-means", "Porcentaje Clustering Aglomerativo"))| Cluster | Porcentaje K-means | Porcentaje Clustering Aglomerativo |
|---|---|---|
| 1 | 90.2203857 | 90.289256 |
| 2 | 0.3443526 | 1.446281 |
| 3 | 0.6887052 | 1.652893 |
| 4 | 0.0000000 | 2.066116 |
| 5 | 8.7465565 | 4.545454 |
4.4 Personas Desempleadas por Cluster
BD_desempleado <- BD %>% filter(Empleo == "Desempleado")
cluster_kmeans <- as.data.frame(table(BD_desempleado$Cluster))
colnames(cluster_kmeans) <- c("Cluster", "Frecuencia_Kmeans")
cluster_hc <- as.data.frame(table(BD_desempleado$cluster_hc))
colnames(cluster_hc) <- c("Cluster", "Frecuencia_HC")
total_kmeans <- sum(cluster_kmeans$Frecuencia_Kmeans)
total_hc <- sum(cluster_hc$Frecuencia_HC)
cluster_kmeans$Porcentaje_Kmeans <- (cluster_kmeans$Frecuencia_Kmeans / total_kmeans) * 100
cluster_hc$Porcentaje_HC <- (cluster_hc$Frecuencia_HC / total_hc) * 100
combined_clusters <- merge(cluster_kmeans[, c("Cluster", "Porcentaje_Kmeans")], cluster_hc[, c("Cluster", "Porcentaje_HC")], by = "Cluster", all = TRUE)
kable(combined_clusters,
caption = "Distribución de Personas Desempleadas por Cluster (K-means y Clustering Aglomerativo)",col.names = c("Cluster", "Porcentaje K-means", "Porcentaje Clustering Aglomerativo"))| Cluster | Porcentaje K-means | Porcentaje Clustering Aglomerativo |
|---|---|---|
| 1 | 31.540470 | 32.114883 |
| 2 | 20.156658 | 57.284595 |
| 3 | 20.574413 | 5.483029 |
| 4 | 18.537859 | 0.000000 |
| 5 | 9.190601 | 5.117494 |
4.5 Personas con mala salud por Cluster
BD_salud <- BD %>% filter(Salud == "Mala")
cluster_kmeans <- as.data.frame(table(BD_salud$Cluster))
colnames(cluster_kmeans) <- c("Cluster", "Frecuencia_Kmeans")
cluster_hc <- as.data.frame(table(BD_salud$cluster_hc))
colnames(cluster_hc) <- c("Cluster", "Frecuencia_HC")
total_kmeans <- sum(cluster_kmeans$Frecuencia_Kmeans)
total_hc <- sum(cluster_hc$Frecuencia_HC)
cluster_kmeans$Porcentaje_Kmeans <- (cluster_kmeans$Frecuencia_Kmeans / total_kmeans) * 100
cluster_hc$Porcentaje_HC <- (cluster_hc$Frecuencia_HC / total_hc) * 100
combined_clusters <- merge(cluster_kmeans[, c("Cluster", "Porcentaje_Kmeans")], cluster_hc[, c("Cluster", "Porcentaje_HC")], by = "Cluster", all = TRUE)
kable(combined_clusters,
caption = "Distribución de Personas con mala salud por Cluster (K-means y Clustering Aglomerativo)",col.names = c("Cluster", "Porcentaje K-means", "Porcentaje Clustering Aglomerativo"))| Cluster | Porcentaje K-means | Porcentaje Clustering Aglomerativo |
|---|---|---|
| 1 | 1.476793 | 11.9198312 |
| 2 | 0.000000 | 11.8143460 |
| 3 | 0.000000 | 70.6751055 |
| 4 | 0.000000 | 0.6329114 |
| 5 | 98.523207 | 4.9578059 |
4.6 Personas con historial crediticio malo
BD_historial <- BD %>% filter(HistorialCrediticio == "Malo")
cluster_kmeans <- as.data.frame(table(BD_historial$Cluster))
colnames(cluster_kmeans) <- c("Cluster", "Frecuencia_Kmeans")
cluster_hc <- as.data.frame(table(BD_historial$cluster_hc))
colnames(cluster_hc) <- c("Cluster", "Frecuencia_HC")
total_kmeans <- sum(cluster_kmeans$Frecuencia_Kmeans)
total_hc <- sum(cluster_hc$Frecuencia_HC)
cluster_kmeans$Porcentaje_Kmeans <- (cluster_kmeans$Frecuencia_Kmeans / total_kmeans) * 100
cluster_hc$Porcentaje_HC <- (cluster_hc$Frecuencia_HC / total_hc) * 100
combined_clusters <- merge(cluster_kmeans[, c("Cluster", "Porcentaje_Kmeans")], cluster_hc[, c("Cluster", "Porcentaje_HC")], by = "Cluster", all = TRUE)
kable(combined_clusters,
caption = "Distribución de Personas con historial crediticio malo por Cluster (K-means y Clustering Aglomerativo)",col.names = c("Cluster", "Porcentaje K-means", "Porcentaje Clustering Aglomerativo"))| Cluster | Porcentaje K-means | Porcentaje Clustering Aglomerativo |
|---|---|---|
| 1 | 88.722555 | 87.824351 |
| 2 | 0.499002 | 2.095808 |
| 3 | 0.998004 | 2.395210 |
| 4 | 0.000000 | 2.994012 |
| 5 | 9.780439 | 4.690619 |
5. Resultados
5.1 Cluster 1:
Ingresos mensuales: Este grupo tiene la menor media de ingresos mensuales.
Clientes vulnerables: El 90% de los clientes en este clúster se encuentran en condición vulnerable.
Desempleo: El porcentaje de personas desempleadas es el mayor de todos los grupos.
Salud: Solo un 1.5% de los clientes presentan mala salud.
Historial crediticio: Un 80% de los clientes tiene un mal historial crediticio.
Medidas recomendadas:
Productos financieros accesibles: Ofrecer microcréditos o préstamos de bajo interés con opciones de pago flexibles, ajustados a las dificultades económicas de los clientes.
Asesoría financiera y educación: Implementar programas de educación financiera para ayudar a los clientes a mejorar su manejo de deudas y historial crediticio.
Refinanciamiento y reestructuración de deudas: Ayudar a los clientes a gestionar sus deudas existentes de manera más eficiente.
5.2 Cluster 2 y 3 (Similares en características):
Ingresos mensuales: Estos clústeres tienen la media de ingresos más alta entre todos los grupos.
Clientes vulnerables: Menos del 1% de los clientes en estos clústeres son vulnerables.
Desempleo: El porcentaje de personas desempleadas es del 20%, casi el doble que el grupo con menor porcentaje de desempleados.
Salud: No se presentan clientes con mala salud en estos grupos.
Historial crediticio: El porcentaje de clientes con mal historial crediticio es mínimo, si bien existe, no llega al 1%.
Medidas recomendadas:
Productos financieros premium: Ofrecer productos exclusivos como tarjetas de crédito, planes de ahorro de alto rendimiento, y seguros de salud adecuados para este perfil de clientes.
Beneficios de salud: Aunque no presentan mala salud, se pueden ofrecer beneficios preventivos o seguros de salud complementarios.
Asesoría de inversión: Dado su buen poder adquisitivo, se pueden ofrecer servicios de planificación financiera y asesoría en inversiones a largo plazo.
5.3 Cluster 4:
Ingresos mensuales: Este clúster tiene la mayor media de ingresos mensuales entre los grupos.
Clientes vulnerables: Este grupo no tiene clientes vulnerables.
Desempleo: El porcentaje de personas desempleadas es bajo.
Salud: No tiene clientes con mala salud.
Historial crediticio: No tiene clientes con mal historial crediticio.
Medidas recomendadas:
Productos financieros avanzados: Ofrecer productos como fondos de inversión, seguros de vida, pensiones y planes de ahorro de alto rendimiento para satisfacer sus necesidades de inversión.
Servicios exclusivos: Crear un programa de clientes VIP con asesoría personalizada y productos exclusivos para clientes con buena salud y capacidad financiera.
Planes de inversión y jubilación: Brindar opciones para la planificación a largo plazo como pensiones privadas y otros instrumentos de inversión.
5.4 Cluster 5:
Ingresos mensuales: Este grupo tiene la media de ingresos mensuales por encima del clúster 1, pero debajo de los otros tres clústeres.
Clientes vulnerables: Es el segundo clúster con mayor número de clientes vulnerables (8% del total).
Desempleo: Tiene el menor porcentaje de desempleados de todos los grupos.
Salud: Tiene el mayor porcentaje de clientes con mala salud (98%).
Historial crediticio: Es el segundo grupo con mayor porcentaje de clientes con mal historial crediticio.
Medidas recomendadas:
Microcréditos y productos de bajo riesgo: Ofrecer créditos de bajo interés o sin interés para personas con condiciones de salud graves, con flexibilidad en el pago.
Seguro de salud y servicios médicos: Ofrecer seguros de salud accesibles y productos financieros que incluyan beneficios médicos o descuentos en consultas y tratamientos.
Educación financiera y reestructuración de deudas: Ayudar a mejorar el historial crediticio a través de programas de educación y asesoría financiera.
5.5 Conclusión:
Los clústeres presentan características y necesidades muy distintas, lo que permite a la empresa financiera implementar estrategias diferenciadas para cada uno:
Clústeres con menor poder adquisitivo y alta vulnerabilidad (Cluster 1 y 5): Se beneficiarían de productos financieros accesibles, programas de educación financiera, opciones de refinanciamiento de deudas y seguros de salud accesibles.
Clústeres con mayores ingresos y menos vulnerabilidad (Cluster 2, 3 y 4): Son más adecuados para productos financieros premium, servicios de inversión, seguros y asesoría personalizada.