Segmentation
Yader Alexander Ramirez
2025-07-24
Librerias base a utilizar
library(tidyverse)## Warning: package 'ggplot2' was built under R version 4.4.3## Warning: package 'tibble' was built under R version 4.4.3## Warning: package 'purrr' was built under R version 4.4.3## Warning: package 'lubridate' was built under R version 4.4.3## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.2 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.0.4
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(tidymodels)## Warning: package 'tidymodels' was built under R version 4.4.3## ── Attaching packages ────────────────────────────────────── tidymodels 1.3.0 ──
## ✔ broom 1.0.8 ✔ rsample 1.3.0
## ✔ dials 1.4.0 ✔ tune 1.3.0
## ✔ infer 1.0.9 ✔ workflows 1.2.0
## ✔ modeldata 1.4.0 ✔ workflowsets 1.1.1
## ✔ parsnip 1.3.2 ✔ yardstick 1.3.2
## ✔ recipes 1.3.1## Warning: package 'broom' was built under R version 4.4.3## Warning: package 'dials' was built under R version 4.4.3## Warning: package 'scales' was built under R version 4.4.3## Warning: package 'infer' was built under R version 4.4.3## Warning: package 'modeldata' was built under R version 4.4.3## Warning: package 'parsnip' was built under R version 4.4.3## Warning: package 'recipes' was built under R version 4.4.3## Warning: package 'rsample' was built under R version 4.4.3## Warning: package 'tune' was built under R version 4.4.3## Warning: package 'workflows' was built under R version 4.4.3## Warning: package 'workflowsets' was built under R version 4.4.3## Warning: package 'yardstick' was built under R version 4.4.3## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ scales::discard() masks purrr::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ recipes::fixed() masks stringr::fixed()
## ✖ dplyr::lag() masks stats::lag()
## ✖ yardstick::spec() masks readr::spec()
## ✖ recipes::step() masks stats::step()Se llama a la base de datos con la que se trabajara el proyecto de knn.
clientes_segmentacion <- read_delim("clientes segmentacion.csv",
delim = ";", escape_double = FALSE, col_types = cols(Age = col_integer(),
`Annual_Income_(k$)` = col_number(), `Spending_Score)` = col_number()), trim_ws = TRUE)Se verifica las dimensiones del data frame clientes_segmentación
dim(clientes_segmentacion)## [1] 200 5Se tiene 200 filas y 5 columnas (variables), verificar el tipo de variables
glimpse(clientes_segmentacion)## Rows: 200
## Columns: 5
## $ CustomerID <dbl> 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15…
## $ Genre <chr> "Male", "Male", "Female", "Female", "Female", "Fe…
## $ Age <int> 19, 21, 20, 23, 31, 22, 35, 23, 64, 30, 67, 35, 5…
## $ `Annual_Income_(k$)` <dbl> 15, 15, 16, 16, 17, 17, 18, 18, 19, 19, 19, 19, 2…
## $ `Spending_Score)` <dbl> 39, 81, 6, 77, 40, 76, 6, 94, 3, 72, 14, 99, 15, …CustomerID Tipo: dbl (numérico/decimal). Descripción: Identificador único del cliente. Genre Tipo: chr (cadena de texto/categórica). Descripción: Género del individuo con dos categorías: “Male” (masculino) y “Female” (femenino). Age Tipo: int (entero). Descripción: Edad del individuo en años. Annual_Income_(k$) Tipo: dbl (numérico/decimal). Descripción: Ingreso anual del individuo en miles de dólares (ejemplo: 15 = 15,000 USD). Correción del nombre de la columan
names(clientes_segmentacion)[4] <- "Annual_Income_USD_k"Spending_Score) Tipo: dbl (numérico/decimal). Descripción: Puntuación de gasto del individuo (normalmente escalada entre 0-100, donde valores altos indican mayor gasto). se corrige el nombre la variable
names(clientes_segmentacion)[5]<-"Spending_Score"Verificando si existen NAs
colSums(is.na(clientes_segmentacion))## CustomerID Genre Age Annual_Income_USD_k
## 0 0 0 0
## Spending_Score
## 0No existen NAs en el data frame. se procede a verificar si existen duplicados
sum(duplicated(clientes_segmentacion))## [1] 0La única salida es cero, no tenemos filas dulicadas. Análisis descriptivo de la variable Genre (genero)
clientes_segmentacion%>%select(Genre)%>%ggplot(aes(Genre,fill=Genre))+
geom_bar()+geom_text(aes(label = after_stat(count)),stat = "count",vjust=-0.1,
size = 5,color="black")+
labs(title = "Distribución del Genero",x="Genero",y="número de clientes")+
scale_fill_manual(values = c("Male" = "#1f77b4", "Female" = "#ff7f0e"))+theme_minimal()
En la muestra se tiene 112 Mujeres (female), lo que representa el 56% y
88 varones (male), el cual representa el 44% de la muestra. Analisis
descriptivo de las variable Age (edad)
summary(clientes_segmentacion$Age)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 18.00 28.75 36.00 38.85 49.00 70.00la variable Age (edad), tiene como minino 18, este valor indica la edad en la cual los individuos empiezan su vida financiera, un maximo de 70, personas probablemente jubiladas, con relación al sesgo, este es positvo, la media cuyo es de 38.85 es mayor que la median 36, la población de estudio es mayoritariamente adulto joven, esto se comprueba con los cuartiles, el rango intercurtilico es de 20.25, el primer cuartil 28.75 indica que el 25% de los individuos tiene una edad menor a 29 años, en cambio el cuartil 3 es de 49, indica que el 75% de las individuos es menor a 49 años, por ende, el 50% de la muestra es una población adulta joven.
library(gridExtra)##
## Adjuntando el paquete: 'gridExtra'## The following object is masked from 'package:dplyr':
##
## combineclientes<-clientes_segmentacionboxplot_age<-ggplot(clientes, aes(y = Age)) +
geom_boxplot(fill = "#4E79A7", color = "black", alpha = 0.7, outlier.color = "red") +
labs(title = "Distribución de Edades - Boxplot",
y = "Edad (años)") +
theme_minimal(base_size = 12) +
theme(plot.title = element_text(hjust = 0.5, face = "bold"),
axis.text.x = element_blank(),
axis.ticks.x = element_blank()) +
scale_y_continuous(limits = c(10, 80), breaks = seq(10, 80, by = 10))
#histograma
hist_age<-ggplot(clientes, aes(x = Age)) +
geom_histogram(aes(y = ..density..),
bins = 20,
fill = "#E15759",
color = "white",
alpha = 0.8) +
geom_density(color = "#76B7B2", size = 1.2) +
stat_function(fun = dnorm,
args = list(mean = mean(clientes$Age), sd = sd(clientes$Age)),
color = "black", size = 1, linetype = "dashed") +
labs(title = "Distribución de Edades - Histograma",
x = "Edad (años)",
y = "Densidad") +
theme_minimal(base_size = 12) +
theme(plot.title = element_text(hjust = 0.5, face = "bold")) +
annotate("text", x = 60, y = 0.025,
label = sprintf("N(μ = %.1f, σ = %.1f)", mean(clientes$Age), sd(clientes$Age)),
color = "black", size = 4) +
scale_x_continuous(limits = c(10, 80), breaks = seq(10, 80, by = 10))## 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.# Combinar gráficos
grid.arrange(boxplot_age, hist_age, ncol = 2)## Warning: The dot-dot notation (`..density..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(density)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## Warning: Removed 2 rows containing missing values or values outside the scale range
## (`geom_bar()`).
El gráfico de caja, muestra la ausencia de valores atipicos en la
muestra, mientras, el histograma muestra un ligero sesgo hacia la
izquierda, tambien muestra que la varibale edad esta segmentada en
grupos que comprende las edades de 18 a 29, de 30 a 39, de 40 a 49 y
mayores de 50 años. Se construye la variable GrupoEdad.
clientes$GrupoEdad <- c("18-29", "30-39", "40-49", "50+")[
findInterval(clientes$Age, c(-Inf, 30, 40, 50, Inf))]round(prop.table(table(clientes$Genre,clientes$GrupoEdad),margin = 1)*100,digits = 2)##
## 18-29 30-39 40-49 50+
## Female 25.89 33.04 21.43 19.64
## Male 29.55 27.27 17.05 26.14La tabla muestra la distribución del genero en los distinto segmentos de edad, en los segmentos de 18-29 y 50+ se aprecia poca diferencia entre generos, caso contrario en los grupos de edad laborales, se aprecia una predominancia del sexo femenino, esto nos hace pensar que el mercado laboral esta dominado por mujeres y que su edad promedio podria ser mayor.
ggplot(clientes, aes(x = GrupoEdad, fill = Genre)) +
geom_bar(position = "dodge") +
geom_text(
aes(label = after_stat(count)),
stat = "count",
position = position_dodge(width = 0.9),
vjust = -0.5
) +
labs(
title = "Brecha de Género por Grupo de Edad",
x = "Grupo de Edad",
y = "Número de Individuos"
) +
scale_fill_manual(values = c("Female" = "#FF6B6B", "Male" = "#4ECDC4")) +
theme_minimal()
Este Gráfico, contribuye a la interpretación anterior, donde existe
predominancia del sexo femenino en el mercado laboral.
clientes%>%group_by(Genre)%>%summarise(Promedio_edad=mean(Age),Mediana_edad=median(Age),
Desviacion_estandar=sd(Age))Analisis descriptivo de la variable ingreso Anual (Annual_Income_USD_k)
summary(clientes$Annual_Income_USD_k)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 15.00 41.50 61.50 60.56 78.00 137.00La Variable ingreso anual. Estadístico Valor (k$) Interpretación Mínimo 15 Ingreso anual mínimo: $15,000 USD ($1,250/mes). 1er Cuartil (Q1) 41.5 25% gana ≤ $41,500 USD ($3,458/mes). Mediana 61.5 50% gana ≤ $61,500 USD ($5,125/mes). Media 60.56 Similar a la mediana sugiera una distribución simétrica. 3er Cuartil (Q3) 78 75% gana ≤ $78,000 USD ($6,500/mes). Máximo 137 Ingreso anual máximo: $137,000 USD ($11,417/mes). Brecha significativa: Ratio máximo/mínimo = 9.13x (137/15), indicando alta desigualdad económica.
ggplot(clientes, aes(x =Annual_Income_USD_k)) +
geom_histogram(aes(y = ..density..), bins = 15, fill = "#69b3a2", alpha = 0.7,col="black") +
geom_density(color = "#e9c46a", linewidth = 1) +
geom_vline(xintercept = c(41.5, 61.5, 78), linetype = "dashed", color = "red") +
labs(title = "Distribucion del Ingreso Anual", x = "Ingreso Anual (miles de USD)", y = "Densidad") +
theme_minimal()
El histograma muestra una distibución unimodal (con un solo pico),
alrededir de a mdiana, esto indica que la concentración de los datos
esta centra, lo que se verifica con la similitud con los valores de la
media y mediana, tambien, hay presencia de valores atipicos, dado que el
objetivo es la segmentacion de clientes, estos valores atipicos no seran
removidos debido que son valores reales y no derivados de errore de
tipeo. En base al histograma, se puede codificar la variable ingreso en,
Bajo, Media_Bajo, Medio-ALto, Alto
clientes <- clientes%>%
mutate(income_group = cut(Annual_Income_USD_k,
breaks = c(14, 30, 50, 80, 137),
labels = c("Bajo", "Medio-Bajo", "Medio-Alto", "Alto")))table(clientes$GrupoEdad,clientes$income_group)##
## Bajo Medio-Bajo Medio-Alto Alto
## 18-29 13 11 26 5
## 30-39 10 7 23 21
## 40-49 3 8 21 7
## 50+ 6 16 18 5La tabla revela que los adultos de 30-39 años concentran los mayores ingresos (21 en categoría “Alto”), destacándose como el grupo con mayor poder adquisitivo. Los jóvenes (18-29) y mayores (50+) predominan en ingresos bajos y medios-bajos, sugiriendo menor capacidad económica. La categoría “Medio-Alto” es dominante en todos los grupos, excepto en mayores de 50 años, donde los ingresos parecen reducirse. Esto indica que la etapa de 30-39 años es clave para estrategias premium, mientras que los extremos etarios requieren enfoques accesibles. La segmentación por edad e ingreso permite personalizar ofertas y anticipar comportamientos de consumo. Analisis descritivo de la variable Spending_Score
summary(clientes$Spending_Score)## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 1.00 34.75 50.00 50.20 73.00 99.00El análisis del Spending_Score revela tres patrones de consumo claros: el 25% inferior (≤34.75) muestra bajo gasto, el 50% central (35-73) un gasto moderado, y el 25% superior (>73) alto gasto. La simetría (media=50.2 ≈ mediana=50) sugiere una distribución equilibrada, pero el amplio rango (1-99) destaca diferencias extremas: desde consumidores muy conservadores hasta altamente dispuestos a gastar. Relación del Spending Score y el Ingreso anual
ggplot(clientes, aes(x =Annual_Income_USD_k, y = Spending_Score)) +
geom_point(alpha = 0.5,col="blue") +
labs(title = "Relacion Ingresos vs Spending Score")
El gráfico de dispersión entre Annual_Income_USD_k (Ingreso Anual) y
Spending_Score (Puntuación de Gasto) revela una clara segmentación en
3-4 grupos naturales, lo que sugiere distintos perfiles de
comportamiento del consumidor.
ggplot(clientes, aes(x = Annual_Income_USD_k, y = Spending_Score)) +
geom_point(color = "#4CAF50", alpha = 0.6, size = 3) +
labs(
title = "Segmentacion Natural: Ingresos vs. Gasto",
x = "Ingreso Anual (miles de USD)",
y = "Puntuacion de Gasto"
) +
theme_minimal() +
geom_vline(xintercept = c(50, 80), linetype = "dashed", color = "blue") +
geom_hline(yintercept = c(40, 70), linetype = "dashed", color = "black")
como ya se sugiero anteriormente hay varios grupos o cluster naturales,
el lado negativo es la cantidad de cluster dificultad su interpretación.
Una forma de definir la cantidad idonea de cluster es a tráves del
metodo del codo, primero se selecionan las variables a utilizar y su
normalización.
#receta
receta_cluster <- recipe(~ Annual_Income_USD_k+ Spending_Score,
data = clientes) %>%
step_normalize(all_numeric())%>%prep()#Preprocesar los datos
datos_preprocesados <-juice(receta_cluster)library(cluster)
library(factoextra)## Warning: package 'factoextra' was built under R version 4.4.3## Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBafviz_nbclust(datos_preprocesados ,kmeans, method = "wss") +
geom_vline(xintercept = 3, linetype = 2)
El grafico es un poco ambiguo, no define exactamente el numero de
cluster, ya que bien podria estar entre 3 y 6.
plots <- map(3:6, ~{
km <- kmeans(datos_preprocesados, centers = .x)
fviz_cluster(km, data = datos_preprocesados,
main = paste("k =", .x))
})
grid.arrange(grobs = plots, ncol= 2)
En el primer grafico se observa que co el cluster k=3. no hay
solapamiento entre los grupos, por ende se utilizara k=3.
km_tidy <- kmeans(datos_preprocesados, centers = 3)
clientes$cluster<-as.factor(km_tidy$cluster)Caracterización de clusters
head(clientes[,5:8])clientes%>%
group_by(cluster) %>%
summarise(
promedio_ingreso = mean(Annual_Income_USD_k),
promedio_spending= mean(Spending_Score),
Frecuencia = n()
)El análisis de clusters revela tres perfiles clave de clientes: 1) Conservadores de Bajos Ingresos (ingreso promedio $28k, gasto $23.3), compuesto por 26 personas con bajo consumo, ideal para ofertas económicas; 2) Gastadores Activos de Ingresos Medios (ingreso $58.3k, gasto $63.9), el grupo más grande (134 clientes) y principal target para estrategias de fidelización y productos premium; y 3) Ahorradores de Altos Ingresos (ingreso $89.2k, gasto $21.6), 40 clientes con alto poder adquisitivo pero bajo gasto, clave para servicios de inversión. Esta segmentación permite personalizar campañas según el comportamiento financiero de cada grupo, maximizando su potencial de conversión. La disparidad entre ingresos y gastos destaca la importancia de estrategias diferenciadas para cada perfil.
clientes <- clientes %>%
mutate(segmento = case_when(
cluster == 1 ~ "Conservadores",
cluster == 2 ~ "Consumidores",
cluster == 3 ~ "Ahorradores"
))table(clientes$GrupoEdad,clientes$segmento)##
## Ahorradores Conservadores Consumidores
## 18-29 7 3 45
## 30-39 11 7 43
## 40-49 14 8 17
## 50+ 8 8 29library(ggrepel)## Warning: package 'ggrepel' was built under R version 4.4.3# Datos para etiquetas
etiquetas <- clientes %>%
group_by(segmento) %>%
summarise(
x = mean(Annual_Income_USD_k),
y = mean(Spending_Score)
)
# Gráfico
ggplot() +
# Puntos con todos los datos
geom_point(
data = clientes,
aes(x = Annual_Income_USD_k, y = Spending_Score,
color = segmento, size = Age),
alpha = 0.6
) +
# Etiquetas
geom_label_repel(
data = etiquetas,
aes(x = x, y = y, label = segmento),
color = "black"
) +
labs(title = "Grafico de las distribucion de los cluster") +
theme_minimal()
El análisis combinado de clusters y grupos de edad revela tres perfiles
financieros clave con comportamientos diferenciados por etapa de vida:
Conservadores (Cluster 1): Representan solo 26 clientes (5.2% del
total), concentrados principalmente en jóvenes de 18-29 años (7 casos) y
adultos de 40-49 (14 casos), con ingresos bajos ($28k) y gasto mínimo
($23.3), ideal para productos básicos y educación financiera.
Consumidores (Cluster 2): El grupo más numeroso (134 clientes, 67%)
domina en las edades 18-39 años (88 casos combinados), con ingresos
medios ($58k) y alto gasto ($64), siendo el target principal para
créditos, promociones y productos de consumo frecuente. Ahorradores
(Cluster 3): 40 clientes (20%) destacan en mayores de 40 años (22
casos), con ingresos altos ($89k) pero bajo gasto ($22), requiriendo
estrategias de inversión y servicios patrimoniales. La segmentación por
edad refuerza estos patrones: los jóvenes (18-39 años) son
predominantemente consumidores (88 casos), mientras los mayores de 40
muestran mayor equilibrio entre ahorro (22) y consumo (46). Esta
dualidad sugiere que las estrategias comerciales deben combinar impulsos
al gasto para jóvenes con opciones de acumulación de patrimonio para
adultos maduros. La presencia de conservadores en todos los grupos
etarios (3-14 casos) indica un nicho constante de clientes
ultra-prudentes que valoran seguridad sobre rentabilidad.
Analisis de clasificación. En el ámbito del aprendizaje automático, las técnicas de clasificación supervisada son fundamentales cuando el objetivo es predecir la pertenencia de una observación a una categoría o grupo predefinido. Esto se logra a partir de un conjunto de datos donde las etiquetas de los grupos ya son conocidas. Entre los algoritmos más robustos y ampliamente utilizados para estas tareas de clasificación se encuentran las Máquinas de Vectores de Soporte (SVM), los Bosques Aleatorios (Random Forest) y la Regresión Logística Multinomial. Cada uno de estos modelos posee características distintivas, ofreciendo ventajas y desventajas específicas que los hacen más o menos adecuados dependiendo de la naturaleza del problema y los datos.
Comparación de Modelos Supervisados (SVM, Random Forest y Regresión Logística Multinomial): A continuación, se presenta una comparación de los tres modelos supervisados, destacando sus características clave, ventajas y desventajas:
- Máquinas de Vectores de Soporte (SVM - Support Vector Machine) Concepto: Las SVM buscan encontrar el hiperplano óptimo que mejor separe las clases en un espacio de características. Utilizan funciones de kernel para transformar los datos a dimensiones superiores, permitiendo la separación de clases no lineal.
Ventajas: Efectividad en Espacios de Alta Dimensión: Son muy efectivas en espacios con un alto número de dimensiones. Manejo de Casos No Lineales: Gracias a las funciones de kernel, pueden modelar relaciones complejas y no lineales entre las características. Robustez a Overfitting (con margen amplio): Si se elige un buen margen de separación, pueden generalizar bien. Menos Sensibles a Outliers: Los vectores de soporte son los únicos que influyen en la definición del hiperplano, lo que las hace menos sensibles a puntos alejados.
Desventajas: Sensibilidad a la Elección del Kernel y Parámetros: El rendimiento depende en gran medida de la correcta elección del kernel y el ajuste de sus parámetros (e.g., C, gamma). Lento para Grandes Conjuntos de Datos: El tiempo de entrenamiento puede ser considerablemente alto con grandes volúmenes de datos. Dificultad de Interpretación: El “por qué” de una clasificación puede ser difícil de interpretar, especialmente con kernels complejos. Problemas con Datos Ruidosos: Si el conjunto de datos es muy ruidoso y con clases superpuestas, el rendimiento puede ser bajo.
- Bosques Aleatorios (RF - Random Forest) Concepto: Es un método de aprendizaje conjunto (ensemble learning) que construye múltiples árboles de decisión durante el entrenamiento y genera la salida de la clase que es la moda de las clases (clasificación) o el promedio de las predicciones (regresión) de los árboles individuales. Reduce el overfitting presente en árboles de decisión únicos.
Ventajas:
Alta Precisión y Robustez: Generalmente ofrece una alta precisión y es menos propenso al overfitting que un solo árbol de decisión. Manejo de Datos Faltantes: Puede manejar datos faltantes sin imputación explícita (aunque esto depende de la implementación). Selección de Características Implícita: Proporciona una medida de la importancia de las características, lo que ayuda en la selección. Menos Sensible a Escala de Características: No requiere escalado de características. Versátil: Adecuado tanto para tareas de clasificación como de regresión.
Desventajas: Menos Interpretable que un Árbol Individual: Aunque sus componentes (árboles) son interpretables, el conjunto completo (bosque) es más como una “caja negra”. Computacionalmente Intensivo: Puede ser costoso computacionalmente, tanto en tiempo de entrenamiento como en memoria, para un gran número de árboles o características. Puede Ser Lento en Producción: La predicción puede ser más lenta que con modelos más simples debido a la necesidad de evaluar múltiples árboles.
- Regresión Logística Multinomial (Multinomial Logistic Regression) Concepto: Es una extensión de la regresión logística binaria que permite predecir la probabilidad de que una observación pertenezca a una de varias categorías nominales (más de dos) no ordenadas. Modela la relación entre las variables predictoras y la probabilidad de cada categoría de la variable de respuesta.
Ventajas: Simple y Fácil de Interpretar: Los coeficientes del modelo pueden interpretarse como el cambio en el log-odds de una categoría con respecto a una categoría de referencia. Rápido y Eficiente: Es computacionalmente eficiente y rápido de entrenar, incluso con grandes conjuntos de datos. Proporciona Probabilidades: Genera probabilidades de pertenencia a cada clase, lo cual es útil para la toma de decisiones. Buen Punto de Partida: A menudo sirve como un buen modelo de referencia (baseline) debido a su simplicidad.
Desventajas: Asunción de Linealidad: Asume una relación lineal entre las variables predictoras y el log-odds de la variable de respuesta, lo que puede limitar su rendimiento en relaciones complejas. Sensibilidad a Outliers y Multicolinealidad: Puede ser sensible a valores atípicos y a la multicolinealidad entre las variables predictoras. No Maneja Relaciones Complejas: Su rendimiento puede ser inferior en problemas donde las fronteras de decisión son altamente no lineales. Requiere Preprocesamiento: A menudo requiere preprocesamiento de datos (escalado de características, manejo de valores atípicos, etc.) para un rendimiento óptimo.
Selección de variables. Tenemos 3 variables numéricas, se hara un analisis con el fin de determinar si las 3 variables discriminan de manera eficiente a los distintos segmentos. Variable Edad
ggplot(clientes, aes(x = Age, fill = segmento, color = segmento))+geom_density(alpha = 0.5) +labs(title = "Distribución de la Edad por Segmento (Densidad)",x = "Edad")+theme_minimal()
En el gráfico de densidad se observa que las distribuciones estan
solapadas, esto indica que la variable Age (edad) no discrimina de
manera efectiva a los segmetos. Variables Ingreso Anual
ggplot(clientes, aes(x = Annual_Income_USD_k, fill = segmento, color = segmento))+geom_density(alpha = 0.5) +labs(title = "Distribución Ingreso Anual por Segmento (Densidad)",x = "Ingreso Anual")+theme_minimal()
Este gráfico mustra como los diferentes colores (segmentos) tienden a
concentrarse en rangos distintos de ingreso anual, esto significa que
Annual_Income_USD_k es una variable que discrimina bien entre las
clases. Variable Spending Score
ggplot(clientes,aes(Spending_Score,fill = segmento,col=segmento))+geom_density(alpha=0.6)+
labs(title = "Distribucion del Spending Score por segmento",x="Spending_Score")+theme_minimal()
Al igual que variable Ingreso Anual, este grafico muestra como los colores tienden agruparse, esto indica que la variable Spending_Score discimina de manera eficiente a los distintos segmentos, cabe resaltar que si se compara con Ingreso Anual, esta ultima discrimina de manera mas eficiente. Division del Data Frame se seleccionan las variables a utilizar en nuestro analisis, el nuevo data frame se llamara cliente_comparacion, este tendra las variables Ingreso anual (Annual_Income_USD_k),el Spending_Score, Segmento, la variable segmento se convertira a factor.
clientes_comparacion<-clientes%>%select(Annual_Income_USD_k,Spending_Score,segmento)%>%
mutate(segmento=as.factor(segmento))Se divida el data set en dos, una para entrenar al modelo (Entrenamiento) con el 60% de las observaciones, y otro para probar el modelo (Prueba) con el 40% de las observaciones, el muestreo se hara por estratificacion con la variable segmento.
set.seed(123)
division<-initial_split(clientes_comparacion,prop = 0.6,strata = segmento)Se extrae el data set para Entrenamiento con training, para prueba con testing.
Entrenamiento<-training(division)
prueba<-testing(division)Suport vector Machine
library(e1071)## Warning: package 'e1071' was built under R version 4.4.1##
## Adjuntando el paquete: 'e1071'## The following object is masked from 'package:tune':
##
## tune## The following object is masked from 'package:rsample':
##
## permutations## The following object is masked from 'package:parsnip':
##
## tunelibrary(doParallel)## Warning: package 'doParallel' was built under R version 4.4.3## Cargando paquete requerido: foreach## Warning: package 'foreach' was built under R version 4.4.1##
## Adjuntando el paquete: 'foreach'## The following objects are masked from 'package:purrr':
##
## accumulate, when## Cargando paquete requerido: iterators## Warning: package 'iterators' was built under R version 4.4.1## Cargando paquete requerido: parallelConfiguracion del paralelo para optimizar recurso computacional
all_cores <- parallel::detectCores(logical = FALSE)
registerDoParallel(cores = all_cores)Definición del Resampling (Validación Cruzada)
datos_fold <- vfold_cv(Entrenamiento, v = 10, strata = segmento)Creación de la Receta (Recipe): Aquí se define los pasos de preprocesamiento que se aplicarán a tus datos. Para SVM.
receta <-recipe(segmento ~ ., data = Entrenamiento) %>%step_normalize(all_numeric_predictors())Especificación del Modelo SVM
svm_especificacion <-svm_rbf(cost = tune(), rbf_sigma = tune())%>% set_mode("classification") %>%
set_engine("kernlab")Creación del workflow
svm_workflow <-workflow()%>%add_recipe(receta)%>%add_model(svm_especificacion)Ajuste de los hiperparametro.
library(kernlab)## Warning: package 'kernlab' was built under R version 4.4.1##
## Adjuntando el paquete: 'kernlab'## The following object is masked from 'package:dials':
##
## buffer## The following object is masked from 'package:scales':
##
## alpha## The following object is masked from 'package:purrr':
##
## cross## The following object is masked from 'package:ggplot2':
##
## alphasvm_grid <- grid_regular(cost(),rbf_sigma(), levels = c(cost = 6,rbf_sigma = 6))
set.seed(123)
svm_tune_results <-
tune_grid(
svm_workflow,
resamples = datos_fold,
grid = svm_grid,
metrics = metric_set(roc_auc, accuracy, sens,yardstick::spec),
control = control_grid(save_pred = TRUE, verbose = TRUE))## Warning: ! tune detected a parallel backend registered with foreach but no backend
## registered with future.
## ℹ Support for parallel processing with foreach was soft-deprecated in tune
## 1.2.1.
## ℹ See ?parallelism (`?tune::parallelism()`) to learn more.Evaluación de los resultados del Tuning
show_best(svm_tune_results, metric = "roc_auc")Seleccion del conjunto final de hiperparametro
best_svm_params <- select_best(svm_tune_results, metric = "roc_auc")Finalizar el workflow con los mejores hiperparámetros.
final_svm_workflow <-svm_workflow %>%finalize_workflow(best_svm_params)Entrenamiento del modelo y Evaluacion final. Entrenar el modelo final en todo el conjunto de entrenamiento
final_svm_fit <- fit(final_svm_workflow, data = Entrenamiento)## maximum number of iterations reached 0.0003540845 -0.0003538131Hacer predicciones en el conjunto de prueba
svm_predictions <-predict(final_svm_fit, new_data = prueba) %>%bind_cols(predict(final_svm_fit, new_data = prueba, type = "prob")) %>%bind_cols(prueba %>% select(segmento))Evaluar las metricas en el conjunto prueba
metrics_svm <-svm_predictions %>%metrics(truth = segmento, estimate = .pred_class)
print(metrics_svm)## # A tibble: 2 × 3
## .metric .estimator .estimate
## <chr> <chr> <dbl>
## 1 accuracy multiclass 0.667
## 2 kap multiclass 0Matriz de confusión
conf_mat(svm_predictions, truth = segmento, estimate = .pred_class)## Truth
## Prediction Ahorradores Conservadores Consumidores
## Ahorradores 0 0 0
## Conservadores 0 0 0
## Consumidores 16 11 54metricas <- function(actual, predicted) {
cm <- table(actual, predicted)
total <- sum(cm)
# Accuracy (suma diagonal / total)
accuracy <- sum(diag(cm)) / total
# Prevalencia por clase (proporción real de cada clase)
prevalence <- rowSums(cm) / total
# Precision por clase (TP / (TP + FP))
precision <- diag(cm) / colSums(cm)
# Recall (Sensibilidad) por clase (TP / (TP + FN))
recall <- diag(cm) / rowSums(cm)
# F1-score por clase
f1 <- 2 * (precision * recall) / (precision + recall)
specificity <- sapply(1:nrow(cm), function(i) {
tn <- sum(cm[-i, -i])
fp <- sum(cm[-i, i])
tn / (tn + fp)
})
metrics <- data.frame(
Class = colnames(cm),
Precision = precision,
Recall = recall,
Specificity = specificity,
F1 = f1,
Prevalence = prevalence
)
metrics <- rbind(metrics, data.frame(
Class = "Overall",
Precision = NA,
Recall = NA,
Specificity = NA,
F1 = NA,
Prevalence = NA
))
metrics$Accuracy <- c(rep(NA, nrow(cm)), accuracy)
return(metrics)
}De la matriz de confusión se calculan las siguientes metricas.
metricas(svm_predictions$segmento,svm_predictions$.pred_class)Si bien es cierto el Acurracy es de 0.609761, es decir el modelo discrimina bien el 60% de las veces, esta metrica podria ser enganosa en este contexto, debido que la clase Consumidires al ser predominante este sesgando al modelo, los clasifica a todos de igual forma.
table(Entrenamiento$segmento)##
## Ahorradores Conservadores Consumidores
## 24 15 80En el data frame entrenamiento, el 68% pertenece a la clase consumidores.
table(prueba$segmento)##
## Ahorradores Conservadores Consumidores
## 16 11 54De manera similar ocurre con el date frame prueba, para poder solucionar este problema se hara una sobre muestreo con el fin de equilibrar los clases. Para ello se utiliza la libreria themis y la función step_smote().
library(themis)## Warning: package 'themis' was built under R version 4.4.3# En la receta, se anexara step_smote(), para equilibrar las clases
receta_nueva<-recipe(segmento ~ ., data=Entrenamiento)%>%step_normalize(all_numeric_predictors()) %>%step_dummy(all_nominal_predictors()) %>%
step_smote(segmento, skip = TRUE)EL proceso se realiza nuevamente.
svm_rbf_workflow_balanceado <-workflow() %>%add_recipe(receta_nueva)%>%add_model(svm_especificacion)Se tunea nuevamente los hiperparámetros.
svm_grid <- grid_regular(cost(),rbf_sigma(), levels = c(cost = 6,rbf_sigma = 6))
set.seed(123)
svm_tune_resultado_balanceado<-
tune_grid(
svm_rbf_workflow_balanceado,
resamples = datos_fold,
grid = svm_grid,
metrics = metric_set(roc_auc, accuracy, sens,yardstick::spec),
control = control_grid(save_pred = TRUE, verbose = TRUE))## Warning: ! tune detected a parallel backend registered with foreach but no backend
## registered with future.
## ℹ Support for parallel processing with foreach was soft-deprecated in tune
## 1.2.1.
## ℹ See ?parallelism (`?tune::parallelism()`) to learn more.mejores resultado
show_best(svm_tune_resultado_balanceado,metric = "roc_auc")Selección del mejor hiperparámetro.
mejor_parametro<-select_best(svm_tune_resultado_balanceado,metric = "roc_auc")
final_svm_mejor<-svm_rbf_workflow_balanceado%>%finalize_workflow(mejor_parametro)Entrenamiento del modelo y predicciones.
final_svm_balanceado_fit<-fit(final_svm_mejor,data=Entrenamiento)
svm_predictions_balanceado<-predict(final_svm_balanceado_fit, new_data = prueba) %>%bind_cols(predict(final_svm_balanceado_fit, new_data = prueba, type = "prob")) %>%bind_cols(prueba %>% select(segmento))Matriz de confusión.
conf_mat(svm_predictions_balanceado,truth = segmento,estimate = .pred_class)## Truth
## Prediction Ahorradores Conservadores Consumidores
## Ahorradores 14 0 0
## Conservadores 0 11 0
## Consumidores 2 0 54Metricas.
metricas(svm_predictions_balanceado$segmento,svm_predictions_balanceado$.pred_class)La disparidad inicial en las clases afectó gravemente la capacidad del SVM para aprender patrones equilibrados. Al aplicar el balanceo de clases, la capacidad predictiva del SVM mejoró significativamente en todas las métricas. Esta mejora demuestra que el balanceo es crucial para que el SVM maneje efectivamente datos desequilibrados. Así, el preprocesamiento adecuado transformó al SVM en un modelo considerablemente más robusto. Random Forest
library(randomForest)## Warning: package 'randomForest' was built under R version 4.4.3## randomForest 4.7-1.2## Type rfNews() to see new features/changes/bug fixes.##
## Adjuntando el paquete: 'randomForest'## The following object is masked from 'package:gridExtra':
##
## combine## The following object is masked from 'package:dplyr':
##
## combine## The following object is masked from 'package:ggplot2':
##
## marginlibrary(ranger)## Warning: package 'ranger' was built under R version 4.4.3##
## Adjuntando el paquete: 'ranger'## The following object is masked from 'package:randomForest':
##
## importanceEspecificacion del modelo Random Forest
rf_spec <-rand_forest(mtry = tune(), trees = tune(), min_n = tune()) %>%
set_mode("classification")%>%set_engine("ranger")Explicación de los hiperparámetros:
mtry: El número de variables seleccionadas aleatoriamente en cada división del árbol. Para clasificación, un buen punto de partida es la raíz cuadrada del número total de predictores. tune() lo explorará.
trees: El número de árboles en el bosque. Un número mayor generalmente mejora el rendimiento pero aumenta el tiempo de cómputo. tune() lo explorará.
min_n: El número mínimo de puntos de datos que deben existir en un nodo para que se intente una división. Controla la profundidad de los árboles y puede ayudar a prevenir el sobreajuste. Creacion del workflow
rf_workflow <-workflow() %>%add_recipe(receta) %>% add_model(rf_spec)Ajuste de hiperparametros
rf_grid <- grid_regular(
mtry(range = c(2, ncol(Entrenamiento) - 1)), # Rango de mtry, ajusta según el número real de predictores
trees(range = c(500, 1500)), # Rango de número de árboles
min_n(range = c(2, 40)), # Rango del tamaño mínimo del nodo
levels = 5 # Genera 5 niveles para cada hiperparámetro
)# Ajustar los hiperparámetros usando tune_grid
set.seed(123)
rf_tune_results <-
tune_grid(
rf_workflow,
resamples = datos_fold,
grid = rf_grid,
metrics = metric_set(roc_auc, accuracy, sens, yardstick::spec),
control = control_grid(save_pred = TRUE, verbose = TRUE)
)## Warning: ! tune detected a parallel backend registered with foreach but no backend
## registered with future.
## ℹ Support for parallel processing with foreach was soft-deprecated in tune
## 1.2.1.
## ℹ See ?parallelism (`?tune::parallelism()`) to learn more.Evaluacion de los Resultados
# Mostrar las mejores combinaciones de hiperparámetros
show_best(rf_tune_results, metric = "roc_auc")# Seleccionar el conjunto final de hiperparámetros
best_rf_params <- select_best(rf_tune_results, metric = "roc_auc")
# Finalizar el workflow con los mejores hiperparámetros
final_rf_workflow <-
rf_workflow %>%
finalize_workflow(best_rf_params)Entrenamiento del modelo
final_rf_fit <- fit(final_rf_workflow, data = Entrenamiento)Prediccion Usando el modelo
rf_predictions <-
predict(final_rf_fit, new_data = prueba) %>%
bind_cols(predict(final_rf_fit, new_data =prueba, type = "prob")) %>%
bind_cols(prueba %>% select(segmento))Matriz de Confusion.
conf_mat(rf_predictions, truth = segmento, estimate = .pred_class)## Truth
## Prediction Ahorradores Conservadores Consumidores
## Ahorradores 16 0 2
## Conservadores 0 11 0
## Consumidores 0 0 52Metricas para el Random forest.
metricas(rf_predictions$segmento,rf_predictions$.pred_class)Estas metricas muestras que el modelo de random forest es lo sufucientemente robusto para obtener resultados significativos sin necesidad de realizar un balanceo de clases a como se ha hecho con el SVM. Regresión Multimodal
library(nnet)## Warning: package 'nnet' was built under R version 4.4.3creacion de las especificaciones del modelo y workflow
log_reg_spec <-multinom_reg() %>%set_mode("classification") %>%set_engine("nnet")log_reg_workflow <-
workflow() %>%
add_recipe(receta) %>%
add_model(log_reg_spec)Entrenamiento del modelo
final_log_reg_fit <- fit(log_reg_workflow, data = Entrenamiento)Predicciones en el conjunto Prueba
log_reg_predictions <-
predict(final_log_reg_fit, new_data = prueba) %>%
bind_cols(predict(final_log_reg_fit, new_data =prueba, type = "prob")) %>%
bind_cols(prueba %>% select(segmento))Matriz de Confusion
conf_mat(log_reg_predictions, truth = segmento, estimate = .pred_class)## Truth
## Prediction Ahorradores Conservadores Consumidores
## Ahorradores 16 0 0
## Conservadores 0 11 0
## Consumidores 0 0 54Similar a la de Random Forest, esta matriz indica que la regresión logistica multimodal ha clasificado de forma correcta a todas las observaciones. metricas.
metricas(log_reg_predictions$segmento,log_reg_predictions$.pred_class)Estas metricas muestran que el modelo de regresión logistica multimodal tiene un rendimient excepcional, capaz de clasificar correctamente el total de los datos.
Conclusiones. El objetivo de este análisis ha sido identificar el modelo de clasificación supervisada más adecuado para segmentar clientes, utilizando las características disponibles y una variable segmento previamente definida. Hemos explorado y comparado tres tipos de modelos principales: Máquinas de Vectores de Soporte (SVM) con kernel lineal y RBF, Random Forest, y Regresión Logística Multinomial. Todos los modelos fueron preprocesados consistentemente con una receta que incluyó normalización de predictores numéricos, creación de variables dummy para categóricas, y la eliminación de la variable edad por su demostrada falta de poder discriminatorio.
Análisis de Rendimiento:
Regresión Logística Multinomial: Ha demostrado ser el modelo con el mejor rendimiento en este estudio. Este resultado es notable y sugiere que las fronteras de decisión entre los segmentos de clientes, basadas en características como Annual_Income_USD_k y Spending Score, son en gran medida linealmente separables o adecuadamente aproximables por un modelo lineal. La simplicidad inherente de la Regresión Logística y la interpretabilidad de sus coeficientes la convierten en una opción altamente ventajosa para la aplicación práctica en este contexto de negocio, además de generar probabilidades de predicción bien calibradas.
Random Forest: Este modelo mostró un rendimiento superior inicial al SVM sin balancear, pero fue superado por la Regresión Logística Multinomial. Aunque Random Forest es robusto y excelente para capturar no linealidades, la complejidad adicional de un modelo basado en árboles de conjunto no se tradujo en una ventaja de rendimiento superior sobre la aproximación lineal más simple en este problema específico.
Máquina de Vectores de Soporte (SVM):
Sin Balanceo de Clases: Inicialmente, el rendimiento del SVM (tanto con kernel lineal como RBF) fue catastrófico, con una precisión (accuracy) del 0%. Esto confirmó la hipótesis de que el severo desequilibrio de clases en los datos de entrenamiento impedía al modelo aprender patrones significativos, sesgándolo completamente hacia la clase mayoritaria.
Con Balanceo de Clases (Kernel Lineal y RBF): Tras la aplicación de técnicas de balanceo como SMOTE, la capacidad predictiva del SVM mejoró drásticamente, alcanzando un rendimiento comparable al de Random Forest. Este resultado valida la importancia crítica del preprocesamiento de balanceo para los SVM y demuestra que, una vez abordado el sesgo, pueden encontrar fronteras de decisión efectivas. Sin embargo, el kernel RBF no aportó una ventaja significativa sobre el lineal, sugiriendo que la no linealidad compleja no es clave aquí.
Los hallazgos de este estudio subrayan la importancia crítica del preprocesamiento, especialmente el balanceo de clases, para el éxito de los modelos de clasificación. Si bien el SVM inicialmente fracasó rotundamente debido al desequilibrio, el balanceo lo transformó en un modelo altamente competitivo, similar al Random Forest. No obstante, la Regresión Logística Multinomial se posiciona como el modelo más eficaz y eficiente, demostrando que la naturaleza lineal de las relaciones subyacentes en tus datos de cliente permite una separación clara y precisa de los segmentos, lo cual es invaluable para su interpretabilidad y aplicación práctica.