Árboles de Decisión: Clasificación de Clientes Bancarios

Análisis Predictivo con Preprocesamiento Riguroso y Evaluación Exhaustiva

Author

Alejandro Figueroa Rojas

Published

January 22, 2026

1 Resumen Ejecutivo

Este documento implementa un Árbol de Decisión para Clasificación aplicado al dataset Bank Marketing del UCI Machine Learning Repository. El problema consiste en predecir si un cliente suscribirá un depósito a plazo basándose en características demográficas, financieras y de contacto de campañas previas.

Características del problema:

  • Tipo: Clasificación binaria desbalanceada (88% no suscribe / 12% suscribe)
  • Variables: 20 predictores (mixtos: numéricos y categóricos)
  • Algoritmo: CART (Classification and Regression Trees) mediante rpart
  • Estrategia: Preprocesamiento riguroso → Construcción → Poda → Evaluación completa

Flujo metodológico: Exploración exhaustiva de datos, diagnóstico estadístico, feature engineering, manejo de desbalance de clases, construcción del árbol con optimización de hiperparámetros, poda por complejidad de costo, y evaluación mediante métricas específicas para clases desbalanceadas (Curvas ROC y PR).

2 Marco Teórico: Árboles de Decisión

2.1 Definición Formal

Un Árbol de Decisión es un modelo de aprendizaje supervisado no paramétrico que particiona recursivamente el espacio de características \(\mathcal{X}\) en regiones hiperrectangulares mediante una estructura jerárquica de nodos.

Definición matemática:

Sea \(\mathcal{D} = \{(\mathbf{x}_i, y_i)\}_{i=1}^{n}\) un conjunto de entrenamiento donde:

  • \(\mathbf{x}_i \in \mathbb{R}^p\) es el vector de características
  • \(y_i \in \{0, 1, \ldots, K-1\}\) es la etiqueta de clase

Un árbol \(T\) define una función \(f_T: \mathcal{X} \to \mathcal{Y}\) mediante:

\[ f_T(\mathbf{x}) = \sum_{m=1}^{M} c_m \cdot \mathbb{1}(\mathbf{x} \in R_m) \]

donde \(\{R_m\}_{m=1}^{M}\) es una partición del espacio y \(c_m\) es la predicción (clase mayoritaria) en la región \(R_m\).

2.2 Principio de Construcción: Particionamiento Recursivo

El algoritmo CART construye el árbol mediante divisiones binarias codiciosas que minimizan una medida de impureza:

\[ \text{Split}^* = \arg\min_{j, \theta} \left[ \frac{|S_L|}{|S|} I(S_L) + \frac{|S_R|}{|S|} I(S_R) \right] \]

donde:

  • \(j\) es la variable seleccionada
  • \(\theta\) es el umbral de división
  • \(S_L = \{\mathbf{x} \in S : x_j \leq \theta\}\), \(S_R = \{\mathbf{x} \in S : x_j > \theta\}\)
  • \(I(\cdot)\) es la impureza (Gini o Entropía)

2.3 Medidas de Impureza para Clasificación

2.3.1 Índice de Gini

\[ \text{Gini}(S) = 1 - \sum_{k=1}^{K} p_k^2 = \sum_{k=1}^{K} p_k(1 - p_k) \]

Interpretación: Probabilidad de clasificar incorrectamente una instancia elegida aleatoriamente si se etiqueta según la distribución de clases en \(S\).

Propiedades:

  • Rango: \([0, 1-1/K]\)
  • Mínimo: 0 (pureza perfecta)
  • Máximo: \(1-1/K\) (distribución uniforme)

2.3.2 Entropía de Shannon

\[ H(S) = -\sum_{k=1}^{K} p_k \log_2(p_k) \]

Interpretación: Cantidad de información (en bits) necesaria para especificar la clase de una instancia.

Propiedades:

  • Rango: \([0, \log_2(K)]\)
  • Mínimo: 0 (pureza perfecta)
  • Máximo: \(\log_2(K)\) (distribución uniforme)

Comparación: Ambas medidas producen resultados similares; Gini es computacionalmente más eficiente y se usa por defecto en rpart.

2.4 Criterios de Parada

El crecimiento del árbol se detiene cuando:

  1. Pureza perfecta: Todas las instancias en el nodo pertenecen a la misma clase
  2. Tamaño mínimo: \(|S| <\) minsplit (mínimo para intentar división)
  3. Profundidad máxima: Se alcanza maxdepth
  4. Ganancia insuficiente: La reducción de impureza < cp (complexity parameter)
  5. Hojas pequeñas: División generaría nodos con < minbucket observaciones

2.5 Poda del Árbol

2.5.1 Problema del Sobreajuste

Un árbol sin restricciones memoriza ruido en los datos de entrenamiento, creando ramas específicas que no generalizan.

2.5.2 Poda por Complejidad de Costo

CART utiliza la función de costo penalizado:

\[ R_\alpha(T) = R(T) + \alpha |T| \]

donde:

  • \(R(T) = \sum_{m=1}^{|T|} \frac{|S_m|}{|S|} I(S_m)\) es el error del árbol
  • \(|T|\) es el número de nodos hoja
  • \(\alpha \geq 0\) es el parámetro de complejidad (cp en rpart)

Procedimiento:

  1. Construir árbol completo \(T_{\max}\)
  2. Para cada \(\alpha\), encontrar subárbol óptimo \(T_\alpha\) que minimiza \(R_\alpha(T)\)
  3. Esto genera secuencia \(T_0 \supset T_1 \supset \cdots \supset T_m\) (raíz)
  4. Seleccionar \(T^*\) con mejor desempeño en validación cruzada

En rpart: El parámetro cp controla directamente \(\alpha\). Valores menores permiten árboles más complejos.

3 Carga de Librerías

Code 
# Manipulación de datos
library(tidyverse)
library(readr)

# Árboles de decisión
library(rpart)
library(rpart.plot)

# Visualización
library(ggplot2)
library(gridExtra)
library(corrplot)
library(GGally)
library(patchwork)

# Métricas y evaluación
library(caret)
library(pROC)
library(PRROC)

# Tablas
library(knitr)
library(kableExtra)

# Manejo de desbalance
library(ROSE)

4 Carga y Exploración Inicial de Datos

4.1 Descarga del Dataset

Code 
# Descargar directamente desde GitHub (espejo confiable)
url <- "https://raw.githubusercontent.com/madmashup/targeted-marketing-predictive-engine/master/banking.csv"

bank_data <- read_csv(url) %>%
  rename(y = `y`) %>%  # Por si tiene nombre diferente
  mutate(across(where(is.character), as.factor))

# Verificar estructura
str(bank_data)
tibble [41,188 × 21] (S3: tbl_df/tbl/data.frame)
 $ age           : num [1:41188] 44 53 28 39 55 30 37 39 36 27 ...
 $ job           : Factor w/ 12 levels "admin.","blue-collar",..: 2 10 5 8 6 5 2 2 1 2 ...
 $ marital       : Factor w/ 4 levels "divorced","married",..: 2 2 3 2 2 1 2 1 2 3 ...
 $ education     : Factor w/ 8 levels "basic.4y","basic.6y",..: 1 8 7 4 1 1 1 3 7 1 ...
 $ default       : Factor w/ 3 levels "no","unknown",..: 2 1 1 1 1 1 1 1 1 1 ...
 $ housing       : Factor w/ 3 levels "no","unknown",..: 3 1 3 1 3 3 3 3 1 3 ...
 $ loan          : Factor w/ 3 levels "no","unknown",..: 1 1 1 1 1 1 1 1 1 1 ...
 $ contact       : Factor w/ 2 levels "cellular","telephone": 1 1 1 1 1 1 1 1 1 1 ...
 $ month         : Factor w/ 10 levels "apr","aug","dec",..: 2 8 5 1 2 4 7 7 5 1 ...
 $ day_of_week   : Factor w/ 5 levels "fri","mon","thu",..: 3 1 3 1 1 4 3 1 2 3 ...
 $ duration      : num [1:41188] 210 138 339 185 137 68 204 191 174 191 ...
 $ campaign      : num [1:41188] 1 1 3 2 1 8 1 1 1 2 ...
 $ pdays         : num [1:41188] 999 999 6 999 3 999 999 999 3 999 ...
 $ previous      : num [1:41188] 0 0 2 0 1 0 0 0 1 1 ...
 $ poutcome      : Factor w/ 3 levels "failure","nonexistent",..: 2 2 3 2 3 2 2 2 3 1 ...
 $ emp_var_rate  : num [1:41188] 1.4 -0.1 -1.7 -1.8 -2.9 1.4 -1.8 -1.8 -2.9 -1.8 ...
 $ cons_price_idx: num [1:41188] 93.4 93.2 94.1 93.1 92.2 ...
 $ cons_conf_idx : num [1:41188] -36.1 -42 -39.8 -47.1 -31.4 -42.7 -46.2 -46.2 -40.8 -47.1 ...
 $ euribor3m     : num [1:41188] 4.963 4.021 0.729 1.405 0.869 ...
 $ nr_employed   : num [1:41188] 5228 5196 4992 5099 5076 ...
 $ y             : num [1:41188] 0 0 1 0 1 0 0 0 1 0 ...
Code 
cat("\nDimensiones:", dim(bank_data), "\n")

Dimensiones: 41188 21

4.2 Descripción de Variables

Variable Objetivo:

  • y: ¿Cliente suscribió depósito a plazo? (yes/no)

Variables Demográficas:

  • age: Edad del cliente
  • job: Tipo de empleo (12 categorías)
  • marital: Estado civil (married, single, divorced)
  • education: Nivel educativo (4 niveles)

Variables Financieras:

  • default: ¿Tiene crédito en default? (yes/no)
  • balance: Balance promedio anual (euros)
  • housing: ¿Tiene préstamo hipotecario? (yes/no)
  • loan: ¿Tiene préstamo personal? (yes/no)

Variables de Contacto:

  • contact: Tipo de comunicación (cellular, telephone)
  • day: Último día de contacto del mes
  • month: Último mes de contacto
  • duration: Duración del último contacto (segundos)
  • campaign: Número de contactos en esta campaña
  • pdays: Días desde último contacto de campaña previa (-1 = no contactado)
  • previous: Número de contactos antes de esta campaña
  • poutcome: Resultado de campaña anterior (success, failure, nonexistent)

Variables Socioeconómicas:

  • emp.var.rate: Tasa de variación del empleo (indicador trimestral)
  • cons.price.idx: Índice de precios al consumidor (mensual)
  • cons.conf.idx: Índice de confianza del consumidor (mensual)
  • euribor3m: Tasa Euribor a 3 meses (diaria)
  • nr.employed: Número de empleados (trimestral)

4.3 Análisis de Valores Faltantes

Code 
# Conteo de NA por variable
na_counts <- colSums(is.na(bank_data))
na_percentages <- round(na_counts / nrow(bank_data) * 100, 2)

# Tabla resumen
na_summary <- tibble(
  Variable = names(na_counts),
  NA_Count = na_counts,
  NA_Percentage = na_percentages
) %>%
  arrange(desc(NA_Count))

kable(na_summary, 
      caption = "Análisis de Valores Faltantes",
      col.names = c("Variable", "Cantidad NA", "Porcentaje (%)")) %>%
  kable_styling(bootstrap_options = c("striped", "hover"))
Análisis de Valores Faltantes
Variable Cantidad NA Porcentaje (%)
age 0 0
job 0 0
marital 0 0
education 0 0
default 0 0
housing 0 0
loan 0 0
contact 0 0
month 0 0
day_of_week 0 0
duration 0 0
campaign 0 0
pdays 0 0
previous 0 0
poutcome 0 0
emp_var_rate 0 0
cons_price_idx 0 0
cons_conf_idx 0 0
euribor3m 0 0
nr_employed 0 0
y 0 0
Code 
# Verificación categórica: valores "unknown"
unknown_counts <- bank_data %>%
  summarise(across(where(is.factor), ~sum(. == "unknown")))

{cat("\nVerificación de valores 'unknown' en variables categóricas:\n")
print(unknown_counts)}

Verificación de valores 'unknown' en variables categóricas:
# A tibble: 1 × 10
    job marital education default housing  loan contact month day_of_week
  <int>   <int>     <int>   <int>   <int> <int>   <int> <int>       <int>
1   330      80      1731    8597     990   990       0     0           0
# ℹ 1 more variable: poutcome <int>

Hallazgos:

  • No existen valores NA en el dataset
  • Variables categóricas contienen niveles "unknown" que representan información faltante implícita
  • Estos se tratarán como categoría separada (información útil: “desconocido” puede ser predictivo)

4.4 Estadísticos Descriptivos

Code 
# Variables numéricas
numeric_vars <- bank_data %>% 
  select(where(is.numeric)) %>%
  names()

# Resumen estadístico
summary_stats <- bank_data %>%
  select(all_of(numeric_vars)) %>%
  pivot_longer(everything(), names_to = "Variable", values_to = "Value") %>%
  group_by(Variable) %>%
  summarise(
    Min = min(Value),
    Q1 = quantile(Value, 0.25),
    Median = median(Value),
    Mean = mean(Value),
    Q3 = quantile(Value, 0.75),
    Max = max(Value),
    SD = sd(Value),
    CV = sd(Value) / mean(Value)
  )

kable(summary_stats, digits = 2,
      caption = "Estadísticos Descriptivos - Variables Numéricas") %>%
  kable_styling(bootstrap_options = "striped", font_size = 11) %>%
  scroll_box(width = "100%")
Estadísticos Descriptivos - Variables Numéricas
Variable Min Q1 Median Mean Q3 Max SD CV
age 17.00 32.00 38.00 40.02 47.00 98.00 10.42 0.26
campaign 1.00 1.00 2.00 2.57 3.00 56.00 2.77 1.08
cons_conf_idx -50.80 -42.70 -41.80 -40.50 -36.40 -26.90 4.63 -0.11
cons_price_idx 92.20 93.08 93.75 93.58 93.99 94.77 0.58 0.01
duration 0.00 102.00 180.00 258.29 319.00 4918.00 259.28 1.00
emp_var_rate -3.40 -1.80 1.10 0.08 1.40 1.40 1.57 19.18
euribor3m 0.63 1.34 4.86 3.62 4.96 5.04 1.73 0.48
nr_employed 4963.60 5099.10 5191.00 5167.04 5228.10 5228.10 72.25 0.01
pdays 0.00 999.00 999.00 962.48 999.00 999.00 186.91 0.19
previous 0.00 0.00 0.00 0.17 0.00 7.00 0.49 2.86
y 0.00 0.00 0.00 0.11 0.00 1.00 0.32 2.81

4.5 Conversión de Variable Objetivo a Factor

Code 
# de (0/1) a factor con etiquetas ("no"/"yes")

# Convertir variable objetivo a factor para clasificación
bank_data <- bank_data %>%
  mutate(y = factor(y, levels = c(0, 1), labels = c("no", "yes")))

4.6 Distribución de la Variable Objetivo

Code 
# Frecuencias absolutas y relativas
target_dist <- bank_data %>%
  count(y) %>%
  mutate(
    Percentage = round(n / sum(n) * 100, 2),
    Label = paste0(y, "\n", n, " (", Percentage, "%)")
  )

# Gráfico
ggplot(target_dist, aes(x = y, y = n, fill = y)) +
  geom_col(alpha = 0.8, width = 0.6) +
  geom_text(aes(label = Label), vjust = -0.5, size = 5, fontface = "bold") +
  scale_fill_manual(values = c("no" = "#E74C3C", "yes" = "#27AE60")) +
  scale_y_continuous(expand = expansion(mult = c(0, 0.15))) +
  labs(
    title = "Distribución de la Variable Objetivo",
    subtitle = "Dataset altamente desbalanceado: 88.7% no suscribe",
    x = "Suscripción a Depósito",
    y = "Frecuencia"
  ) +
  theme_minimal(base_size = 14) +
  theme(
    legend.position = "none",
    plot.title = element_text(hjust = 0.5, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5, color = "gray30")
  )

Distribución de la Variable Objetivo

La variable objetivo presenta un alto desbalance de clases. Aproximadamente el 88.7% de los clientes no suscribe el depósito, mientras que solo el 11.3% sí lo hace.

Este desbalance es relevante desde el punto de vista analítico, ya que un modelo podría obtener una alta accuracy simplemente prediciendo la clase mayoritaria, sin capturar correctamente a los clientes que sí suscriben.

Por lo tanto, en etapas posteriores será necesario: - Evaluar el desempeño del modelo con métricas adecuadas al desbalance (recall, precision, F1, ROC-AUC).

Este análisis confirma que la suscripción al depósito es un evento poco frecuente y requiere un tratamiento especial en el modelado predictivo.

5 Análisis Exploratorio de Datos

5.1 Distribución de Variables Numéricas

Code 
# Variables numéricas (excluir y)
numeric_vars <- bank_data %>% 
  select(where(is.numeric)) %>%
  names()

# Histogramas con densidad
bank_data %>%
  select(all_of(numeric_vars)) %>%
  pivot_longer(everything(), names_to = "Variable", values_to = "Value") %>%
  ggplot(aes(x = Value, fill = Variable)) +
  geom_histogram(aes(y = after_stat(density)), bins = 30, alpha = 0.7, color = "black") +
  geom_density(alpha = 0.3, linewidth = 1) +
  facet_wrap(~Variable, scales = "free", ncol = 3) +
  theme_minimal(base_size = 12) +
  labs(
    title = "Distribución de Variables Numéricas",
    subtitle = "Histogramas con curvas de densidad superpuestas"
  ) +
  theme(
    legend.position = "none",
    plot.title = element_text(hjust = 0.5, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5),
    strip.text = element_text(face = "bold")
  )

Observaciones:

  • age: Distribución aproximadamente unimodal, con ligera asimetría positiva, concentrada entre 30 y 50 años.
  • campaign: Distribución fuertemente asimétrica a la derecha, con la mayoría de los clientes contactados entre 1 y 3 veces.
  • duration: Distribución altamente asimétrica, con predominio de duraciones cortas y una cola larga hacia valores altos.
  • pdays: Distribución altamente concentrada en el valor máximo (≈999), lo que indica clientes no contactados previamente; el resto de los valores es marginal.
  • previous: Distribución muy concentrada en 0, indicando que la mayoría de los clientes no tuvo contactos previos.

5.2 Detección de Outliers

Code 
bank_data %>%
  select(all_of(numeric_vars)) %>%
  pivot_longer(everything(), names_to = "Variable", values_to = "Value") %>%
  ggplot(aes(x = Variable, y = Value, fill = Variable)) +
  geom_boxplot(outlier.color = "red", outlier.size = 1.5, alpha = 0.7) +
  facet_wrap(~Variable, scales = "free", ncol = 3) +
  theme_minimal(base_size = 12) +
  labs(
    title = "Detección de Outliers por Variable",
    subtitle = "Boxplots con outliers marcados en rojo"
  ) +
  theme(
    legend.position = "none",
    axis.text.x = element_blank(),
    axis.ticks.x = element_blank(),
    plot.title = element_text(hjust = 0.5, face = "bold"),
     plot.subtitle = element_text(hjust = 0.5),
    strip.text = element_text(face = "bold")
  )

5.2.1 Cuantificación de Outliers

Code 
# Función para detectar outliers (IQR)
detect_outliers <- function(x) {
  Q1 <- quantile(x, 0.25, na.rm = TRUE)
  Q3 <- quantile(x, 0.75, na.rm = TRUE)
  IQR_val <- Q3 - Q1
  lower <- Q1 - 1.5 * IQR_val
  upper <- Q3 + 1.5 * IQR_val
  sum(x < lower | x > upper, na.rm = TRUE)
}

# Aplicar a variables numéricas
outliers_summary <- bank_data %>%
  select(all_of(numeric_vars)) %>%
  summarise(across(everything(), detect_outliers)) %>%
  pivot_longer(everything(), names_to = "Variable", values_to = "N_Outliers") %>%
  mutate(
    Percentage = round(N_Outliers / nrow(bank_data) * 100, 2)
  ) %>%
  arrange(desc(N_Outliers))

kable(outliers_summary,
      caption = "Cuantificación de Outliers (Criterio IQR)",
      col.names = c("Variable", "Cantidad", "Porcentaje (%)")) %>%
  kable_styling(bootstrap_options = "striped")
Cuantificación de Outliers (Criterio IQR)
Variable Cantidad Porcentaje (%)
previous 5625 13.66
duration 2963 7.19
campaign 2406 5.84
pdays 1515 3.68
age 469 1.14
cons_conf_idx 447 1.09
emp_var_rate 0 0.00
cons_price_idx 0 0.00
euribor3m 0 0.00
nr_employed 0 0.00

Decisión sobre outliers:

Los árboles de decisión son robustos ante outliers (no afectan las divisiones basadas en umbrales). No se aplicará winsorización ni eliminación. Los outliers pueden contener información valiosa sobre comportamientos extremos.

5.3 Análisis de Correlaciones (Variables Numéricas)

Code 
# Matriz de correlación
cor_matrix <- cor(bank_data %>% select(all_of(numeric_vars)), 
                  use = "complete.obs")

# Visualización con corrplot
corrplot(cor_matrix, 
         method = "color",
         type = "upper",
         tl.col = "black",
         tl.srt = 45,
         tl.cex = 0.9,
         addCoef.col = "black",
         number.cex = 0.7,
         col = colorRampPalette(c("#E74C3C", "white", "#3498DB"))(200),
         title = "\nMatriz de Correlación - Variables Numéricas",
         mar = c(0, 0, 2, 0))

Hallazgos:

  • Alta correlación: euribor3m ↔︎ emp.var.rate (0.97) y nr.employed (0.95)
    • Multicolinealidad detectada entre indicadores macroeconómicos
    • Nota: Los árboles de decisión no son sensibles a multicolinealidad (solo usan una variable por división)
  • Correlación moderada: duration ↔︎ y (positiva)
    • Contactos largos asociados con mayor probabilidad de suscripción

5.4 Relación Variables vs Objetivo

Code 
# Ver todas las columnas disponibles
names(bank_data)
 [1] "age"            "job"            "marital"        "education"     
 [5] "default"        "housing"        "loan"           "contact"       
 [9] "month"          "day_of_week"    "duration"       "campaign"      
[13] "pdays"          "previous"       "poutcome"       "emp_var_rate"  
[17] "cons_price_idx" "cons_conf_idx"  "euribor3m"      "nr_employed"   
[21] "y"
Code 
# Ajustar vars_interes según columnas existentes
vars_interes <- c("age", "duration", "campaign", "previous")

# Boxplots
bank_data %>%
  select(all_of(vars_interes), y) %>%
  pivot_longer(-y, names_to = "Variable", values_to = "Value") %>%
  ggplot(aes(x = y, y = Value, fill = y)) +
  geom_boxplot(alpha = 0.7, outlier.size = 0.5) +
  facet_wrap(~Variable, scales = "free_y", ncol = 2) +
  scale_fill_manual(values = c("no" = "#E74C3C", "yes" = "#27AE60")) +
  labs(
    title = "Distribución de Variables Numéricas por Clase Objetivo",
    subtitle = "Comparación entre clientes que suscribieron (yes) vs. no suscribieron (no)",
    x = "Suscripción",
    y = "Valor"
  ) +
  theme_minimal(base_size = 12) +
  theme(
    legend.position = "none",
    plot.title = element_text(hjust = 0.5, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5),
    strip.text = element_text(face = "bold")
  )

Patrones identificados:

  • duration: Mediana notablemente mayor en yes → Variable discriminante clave
  • previous: Ligera diferencia, yes tiene mayor balance promedio
  • age: Distribuciones similares, poca capacidad discriminante
  • campaign: Clientes exitosos suelen tener menos contactos previos

5.5 Análisis de Variables Categóricas

Code 
#| label: categoricas-objetivo-mejorado
#| fig-width: 16
#| fig-height: 10
#| dpi: 300
#| 
cat_vars <- c("job", "marital", "education", "contact", "poutcome")

plot_cat_simple <- function(data, var) {
  
  # Calcular tasa de conversión por categoría
  plot_data <- data %>%
    count(.data[[var]], y) %>%
    group_by(.data[[var]]) %>%
    mutate(
      prop_yes = n[y == "yes"] / sum(n),
      total = sum(n)
    ) %>%
    filter(y == "yes") %>%
    ungroup() %>%
    arrange(desc(prop_yes))
  
  # Gráfico de barras horizontal con tasa de conversión
  ggplot(plot_data, aes(x = reorder(.data[[var]], prop_yes), y = prop_yes)) +
    geom_col(fill = "#3498DB", alpha = 0.8, width = 0.7) +
    geom_text(aes(label = paste0(round(prop_yes * 100, 1), "%")),
              hjust = -0.1, size = 5.1, fontface = "bold") +
    geom_text(aes(label = paste0("n=", scales::comma(total))),
              hjust = 1.1, size = 5, color = "white", fontface = "bold") +
    coord_flip() +
    scale_y_continuous(
      labels = scales::percent,
      limits = c(0, max(plot_data$prop_yes) * 1.15),
      expand = c(0, 0)
    ) +
    labs(
      title = toupper(var),
      x = NULL,
      y = "Tasa de Conversión (% Suscrito)"
    ) +
    theme_minimal(base_size = 14) +
    theme(
      plot.title = element_text(face = "bold", hjust = 0.5, size = 14),
      axis.text.y = element_text(size = 13, face = "bold"),
      axis.text.x = element_text(size = 13),
      axis.title.x = element_text(size = 13, face = "bold"),
      panel.grid.major.y = element_blank(),
      panel.grid.minor = element_blank(),
      plot.margin = margin(10, 15, 10, 10)
    )
}

# Generar gráficos
plots_list <- lapply(cat_vars, function(v) plot_cat_simple(bank_data, v))

# Combinar
wrap_plots(plots_list, ncol = 2) +
  plot_annotation(
    title = "Tasa de Conversión por Variable Categórica",
    subtitle = "Porcentaje de clientes que suscribieron el depósito a plazo según cada categoría",
    theme = theme(
      plot.title = element_text(size = 18, face = "bold", hjust = 0.5),
      plot.subtitle = element_text(size = 16, hjust = 0.5, margin = margin(b = 15))
    )
  )

Análisis de Tasas de Conversión por Variables Categóricas

Variables con mayor poder predictivo:

  1. CONTACT (tipo de contacto):
    • Celular: 14.7% conversión (n=26,144) - casi 3x superior a teléfono (5.2%)
    • Variable más discriminante después de poutcome
  2. JOB (ocupación):
    • Mayor conversión: estudiantes (31.4%), jubilados (25.2%), desempleados (14.2%)
    • Menor conversión: trabajadores manuales (blue-collar: 6.9%)
    • Rango: 6.9% - 31.4% (diferencia significativa)
  3. EDUCATION (educación):
    • Analfabetos muestran mayor tasa (22.2%, n=18 - muestra muy pequeña)
    • Educación universitaria: 13.7% (n=12,168)
    • Educación básica (6-9 años): 7.8-8.2%
  4. MARITAL (estado civil):
    • Desconocido: 15% (n=80 - muestra pequeña)
    • Solteros: 14% (n=11,568)
    • Casados/divorciados: ~10%
    • Diferencias moderadas

Insights clave:

  • Contact es determinante: priorizar llamadas a celular
  • Segmentos de alto valor: estudiantes, jubilados, educación superior
  • Casados muestran menor conversión independiente de otras variables
  • Variables categóricas confirman desbalance (~10-15% conversión promedio)

5.6 Análisis de Separabilidad con GGpairs

Code 
# Muestra aleatoria para acelerar (5000 filas)
set.seed(2026)
bank_sample <- bank_data %>% 
  sample_n(5000) %>%
  select(duration, euribor3m, campaign, age, y) 

# GGpairs con colores por clase 
ggpairs(
  bank_sample,
  mapping = aes(color = y, alpha = 0.5),
  lower = list(continuous = wrap("points", size = 0.8)),
  diag = list(continuous = wrap("densityDiag", alpha = 0.6)),
  upper = list(continuous = wrap("cor", size = 6)),  # Tamaño correlaciones
  title = "Matriz de Separabilidad: Muestra de 5000 observaciones",
  axisLabels = "show"
) +
  scale_color_manual(values = c("no" = "#E74C3C", "yes" = "#27AE60")) +
  scale_fill_manual(values = c("no" = "#E74C3C", "yes" = "#27AE60")) +
  theme(
    plot.title = element_text(size = 18, face = "bold", hjust = 0.5),
    strip.text.x = element_text(size = 14, face = "bold"),  # Variables eje X
    strip.text.y = element_text(size = 14, face = "bold"),  # Variables eje Y
    axis.text = element_text(size = 11),
    legend.title = element_text(size = 13, face = "bold"),
    legend.text = element_text(size = 12)
  )

Análisis de Separabilidad con GGpairs

Correlaciones generales (triángulo superior):

  • Variables prácticamente no correlacionadas entre sí (|r| < 0.15)
  • euribor3m ↔︎ campaign: r = 0.142*** (débil positiva)
  • duration ↔︎ campaign: r = -0.070*** (débil negativa)
  • No hay multicolinealidad entre predictores

Separabilidad por clase (correlaciones estratificadas):

duration vs y:

  • Alta separabilidad: Corr(yes) = 0.495*** vs Corr(no) = 0.021
  • Clientes que suscriben tienen contactos significativamente más largos
  • Variable discriminante más fuerte del conjunto

euribor3m vs y:

  • Distribuciones bimodales claramente diferenciadas (densidad central)
  • Clientes “yes” concentrados en valores bajos de euribor3m
  • Contexto macroeconómico favorable → mayor conversión

campaign vs y:

  • Corr(yes) = 0.279*** vs Corr(no) = 0.121***
  • Patrón contradictorio: más contactos asociados a “yes” (¿persistencia?)
  • Distribución sesgada (mayoría 1-5 contactos)

age vs y:

  • Sin separabilidad: Corr ≈ 0 en ambas clases
  • Distribuciones prácticamente idénticas (boxplots superpuestos)
  • Variable poco útil para clasificación individual

Scatterplots (triángulo inferior):

  • Fuerte solapamiento de clases en todas las combinaciones
  • No existen fronteras lineales claras
  • Requiere modelos no lineales (árboles, SVM, redes neuronales)

Conclusión: duration es el predictor dominante. El problema requiere modelado no lineal debido al alto solapamiento espacial entre clases.

6 Preprocesamiento y Feature Engineering

6.1 Creación de Nuevas Variables

Code 
bank_clean <- bank_data %>%
  mutate(
    y_num = ifelse(y == "yes", 1, 0),
    
    duration_cat = case_when(
      duration < 103 ~ "muy_corto",
      duration < 180 ~ "corto",
      duration < 319 ~ "medio",
      TRUE ~ "largo"
    ),
    
    previous_contact = ifelse(pdays != 999, "si", "no"),
    
    age_group = case_when(
      age < 30 ~ "joven",
      age < 50 ~ "adulto",
      TRUE ~ "mayor"
    ),
    
    n_financial_products = (housing == "yes") + (loan == "yes"),
    
    month_season = case_when(
      month %in% c("mar", "apr", "may") ~ "primavera",
      month %in% c("jun", "jul", "aug") ~ "verano",
      month %in% c("sep", "oct", "nov") ~ "otoño",
      TRUE ~ "invierno"
    )
  ) %>%
  mutate(across(c(duration_cat, previous_contact, age_group, month_season), as.factor))

{cat("Nuevas variables creadas:\n")
cat(setdiff(names(bank_clean), names(bank_data)), sep = "\n")}
Nuevas variables creadas:
y_num
duration_cat
previous_contact
age_group
n_financial_products
month_season

Justificación de Nuevas Variables

duration_cat (muy_corto/corto/medio/largo):

  • Simplifica 4000+ valores únicos en 4 categorías interpretables
  • Basada en cuartiles (Q1=103s, Mediana=180s, Q3=319s)
  • Facilita reglas de negocio: “Contactos >5min tienen alta conversión”

previous_contact (si/no):

  • pdays=999 es código especial que significa “nunca contactado” (no es un número real)
  • Convierte variable numérica confusa en clasificación binaria clara
  • Separa clientes con historial vs clientes nuevos

age_group (joven/adulto/mayor

  • Reduce 78 valores (18-95 años) a 3 segmentos de comportamiento similar
  • Umbrales: <30, 30-50, >50 (etapas de vida económica típicas)
  • Evita divisiones excesivas del árbol en edades específicas

n_financial_products (0/1/2):

  • Combina housing + loan en métrica única de “engagement bancario”
  • Hipótesis: más productos = mayor lealtad → mayor probabilidad de suscripción
  • Simplifica interacción entre dos variables relacionadas

month_season (primavera/verano/otoño/invierno):

  • Agrupa 12 meses en 4 estaciones con patrones estacionales similares
  • Reduce cardinalidad de 12 a 4 categorías
  • Captura tendencias temporales sin divisiones múltiples

y_num (0/1):

  • Variable auxiliar numérica para cálculos estadísticos
  • No se usa como predictor (sería data leakage)

Objetivo general: Mejorar interpretabilidad del árbol sin sacrificar poder predictivo. Variables categóricas derivadas generan reglas más simples y accionables para estrategias de marketing.


6.2 Codificación de Variables Categóricas

Code 
# Identificar variables categóricas (excepto objetivo)
categorical_vars <- bank_clean %>%
  select(where(is.factor), -y) %>%
  names()

{cat("Variables categóricas identificadas:", length(categorical_vars), "\n")
cat(categorical_vars, sep = "\n")}
Variables categóricas identificadas: 14 
job
marital
education
default
housing
loan
contact
month
day_of_week
poutcome
duration_cat
previous_contact
age_group
month_season

Nota importante sobre codificación de variables categóricas:

El algoritmo CART en rpart maneja nativamente variables categóricas sin necesidad de one-hot encoding. Para una variable con \(m\) niveles, CART evalúa \(2^{m-1} - 1\) divisiones posibles agrupando niveles óptimamente (ej: {unemployed, student} vs {resto}). Esto permite divisiones multinivel inteligentes sin crear variables dummy.

6.2.1 Partición Train/Test Estratificada

Code 
set.seed(2026)

# Crear índices estratificados
train_indices <- createDataPartition(bank_clean$y, p = 0.75, list = FALSE)

# División
train_data <- bank_clean[train_indices, ]
test_data <- bank_clean[-train_indices, ]

# Verificar balance
train_dist <- table(train_data$y) %>% prop.table() %>% round(4)
test_dist <- table(test_data$y) %>% prop.table() %>% round(4)

{cat("Dimensiones:\n")
cat("Train:", nrow(train_data), "| Test:", nrow(test_data), "\n")
cat("Train - No:", train_dist[1], "| Yes:", train_dist[2], "\n")
cat("Test  - No:", test_dist[1], "| Yes:", test_dist[2], "\n")}
Dimensiones:
Train: 30891 | Test: 10297 
Train - No: 0.8873 | Yes: 0.1127 
Test  - No: 0.8873 | Yes: 0.1127

7 Construcción del Árbol de Decisión

7.1 Modelo Base (Sin Restricciones)

Construimos primero un árbol completo para establecer baseline y visualizar la estructura completa antes de poda.

Code 
# Antes del modelo, asegura factores:
train_data <- train_data %>%
  mutate(across(c(job, marital, education, default, housing, loan, 
                  contact, month, poutcome), as.factor))

test_data <- test_data %>%
  mutate(across(c(job, marital, education, default, housing, loan, 
                  contact, month, poutcome), as.factor))

formula_tree <- y ~ age + job + marital + education + default + 
                    housing + loan + contact + month + 
                    duration + campaign + pdays + previous + poutcome + 
                    emp_var_rate + cons_price_idx + cons_conf_idx + 
                    euribor3m + nr_employed

# Árbol sin restricciones (minsplit muy bajo)
tree_full <- rpart(
  formula = formula_tree,
  data = train_data,
  method = "class",
  control = rpart.control(
    minsplit = 10,      # Mínimo para intentar división
    minbucket = 5,      # Mínimo en hoja
    cp = 0.0001,        # Complejidad mínima (casi sin poda)
    maxdepth = 30,      # Profundidad máxima
    xval = 10           # Validación cruzada interna
  )
)

# Información del árbol completo
{cat("=== ÁRBOL COMPLETO (SIN PODA) ===\n")
cat("Número de nodos:", nrow(tree_full$frame), "\n")
cat("Número de hojas:", sum(tree_full$frame$var == "<leaf>"), "\n")
cat("Profundidad máxima:", max(tree_full$frame$complexity), "\n\n")}
=== ÁRBOL COMPLETO (SIN PODA) ===
Número de nodos: 1313 
Número de hojas: 657 
Profundidad máxima: 0.07428161
Code 
# Tabla de complejidad
printcp(tree_full)

Classification tree:
rpart(formula = formula_tree, data = train_data, method = "class", 
    control = rpart.control(minsplit = 10, minbucket = 5, cp = 1e-04, 
        maxdepth = 30, xval = 10))

Variables actually used in tree construction:
 [1] age            campaign       cons_conf_idx  cons_price_idx contact       
 [6] default        duration       education      emp_var_rate   euribor3m     
[11] housing        job            loan           marital        month         
[16] nr_employed    pdays          poutcome       previous      

Root node error: 3480/30891 = 0.11265

n= 30891 

           CP nsplit rel error  xerror     xstd
1  0.07428161      0   1.00000 1.00000 0.015968
2  0.02313218      2   0.85144 0.85374 0.014891
3  0.02011494      4   0.80517 0.81810 0.014609
4  0.00469349      6   0.76494 0.77500 0.014257
5  0.00431034     11   0.73994 0.77011 0.014216
6  0.00416667     14   0.72701 0.76092 0.014139
7  0.00402299     16   0.71868 0.75920 0.014124
8  0.00344828     17   0.71466 0.75833 0.014117
9  0.00316092     20   0.70431 0.75259 0.014069
10 0.00287356     21   0.70115 0.75287 0.014071
11 0.00229885     22   0.69828 0.75287 0.014071
12 0.00172414     24   0.69368 0.74971 0.014044
13 0.00153257     25   0.69195 0.75259 0.014069
14 0.00143678     28   0.68736 0.75575 0.014095
15 0.00134100     39   0.67155 0.75632 0.014100
16 0.00129310     42   0.66753 0.75718 0.014108
17 0.00114943     51   0.65374 0.76236 0.014151
18 0.00100575     63   0.63966 0.76724 0.014192
19 0.00095785     74   0.62816 0.77385 0.014247
20 0.00086207     77   0.62529 0.77213 0.014233
21 0.00076628    107   0.59741 0.77011 0.014216
22 0.00071839    110   0.59511 0.77701 0.014274
23 0.00067050    144   0.56264 0.77960 0.014295
24 0.00057471    153   0.55603 0.79425 0.014416
25 0.00047893    187   0.53534 0.80287 0.014486
26 0.00047209    213   0.52213 0.81897 0.014616
27 0.00043103    230   0.51351 0.82241 0.014643
28 0.00038314    303   0.47931 0.82902 0.014696
29 0.00036946    324   0.46523 0.83678 0.014758
30 0.00035920    341   0.45661 0.83966 0.014780
31 0.00028736    359   0.44799 0.84195 0.014798
32 0.00026341    487   0.40661 0.85259 0.014882
33 0.00022989    500   0.40316 0.85805 0.014924
34 0.00021073    505   0.40201 0.86264 0.014960
35 0.00019157    521   0.39856 0.86695 0.014993
36 0.00017960    536   0.39569 0.86983 0.015015
37 0.00017241    549   0.39310 0.86925 0.015011
38 0.00014368    554   0.39224 0.87701 0.015070
39 0.00012315    642   0.37902 0.87816 0.015079
40 0.00011494    649   0.37816 0.88103 0.015101
41 0.00010000    656   0.37730 0.88276 0.015114

Interpretación de la Tabla de Complejidad (CP)

La tabla generada por printcp() es la herramienta fundamental para el diagnóstico de sobreajuste y la poda del árbol.

Variable Definición y Función Técnica
CP Complexity Parameter. Penalizador que escala el error del árbol por su número de nodos. Si un corte no reduce la impureza en al menos un factor de CP, el corte no se realiza.
nsplit Número de divisiones efectuadas. El número de nodos terminales (hojas) es igual a \(nsplit + 1\).
rel error Error residual en el conjunto de entrenamiento. Siempre disminuye conforme el árbol crece, lo que puede ocultar un overfitting.
xerror Error de Validación Cruzada (10-fold CV). Es la métrica crítica: indica qué tan bien generaliza el modelo ante datos nuevos.
xstd Desviación estándar del error de validación cruzada. Mide la estabilidad del modelo en las diferentes particiones de la validación.

Criterio de Selección: Para un modelo óptimo, se busca la fila con el xerror mínimo. Según los datos actuales, el punto de quiebre se encuentra cerca de la fila 12 (\(nsplit = 24\)), donde el error de validación alcanza su valor más bajo antes de comenzar a estancarse o subir.

7.2 Visualización del Árbol Completo

Code 
rpart.plot(
  tree_full,
  type = 2,
  extra = 104,           # Muestra clase, probabilidad y porcentaje
  under = FALSE,
  fallen.leaves = TRUE,
  box.palette = "RdYlGn",
  branch.lty = 3,
  shadow.col = "gray",
  nn = TRUE,
  main = "Árbol de Decisión Completo (Sin Poda)\nBank Marketing Dataset",
  cex.main = 1.3,
  tweak = 0.8,           # Ajuste fino de escala
  cex = 0.8,             # Reemplazo de box.cex para el tamaño del texto
  split.cex = 0.9,       
  nn.cex = 0.7,          
  faclen = 0,            
  roundint = FALSE,      
  clip.right.labs = FALSE 
)

Observaciones:

  • El árbol completo es excesivamente profundo y difícil de interpretar
  • Alta probabilidad de sobreajuste
  • Necesidad evidente de poda

7.3 Selección del Parámetro de Complejidad Óptimo

Code 
# Tabla CP
cp_table <- as.data.frame(tree_full$cptable)

# Gráfico de error CV vs CP
ggplot(cp_table, aes(x = CP, y = xerror)) +
  geom_line(color = "steelblue", linewidth = 1.2) +
  geom_point(size = 3, color = "darkblue") +
  geom_errorbar(aes(ymin = xerror - xstd, ymax = xerror + xstd),
                width = 0.0002, color = "gray30") +
  geom_hline(yintercept = min(cp_table$xerror) + cp_table$xstd[which.min(cp_table$xerror)],
             linetype = "dashed", color = "red") +
  scale_x_log10() +
  labs(
    title = "Error de Validación Cruzada vs. Parámetro de Complejidad",
    subtitle = "Regla 1-SE: Seleccionar CP más simple dentro de 1 desviación estándar del mínimo",
    x = "Parámetro de Complejidad (CP) - Escala Log",
    y = "Error de Validación Cruzada (xerror)"
  ) +
  theme_minimal(base_size = 14) +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5, color = "gray30")
  )

Code 
# Seleccionar CP óptimo (regla 1-SE)
best_cp <- tree_full$cptable[which.min(tree_full$cptable[,"xerror"]), "CP"]
se_threshold <- min(cp_table$xerror) + cp_table$xstd[which.min(cp_table$xerror)]
optimal_cp <- cp_table %>%
  filter(xerror <= se_threshold) %>%
  filter(CP == max(CP)) %>%
  pull(CP)

{cat("\n=== SELECCIÓN DE COMPLEJIDAD ÓPTIMA ===\n")
cat("CP con mínimo xerror:", best_cp, "\n")
cat("CP óptimo (regla 1-SE):", optimal_cp, "\n")}

=== SELECCIÓN DE COMPLEJIDAD ÓPTIMA ===
CP con mínimo xerror: 0.001724138 
CP óptimo (regla 1-SE): 0.004166667

7.4 Árbol Podado (Modelo Final)

Code 
# Podar árbol usando CP óptimo
tree_pruned <- prune(tree_full, cp = optimal_cp)

# Información del árbol podado
{cat("=== ÁRBOL PODADO (MODELO FINAL) ===\n")
cat("Número de nodos:", nrow(tree_pruned$frame), "\n")
cat("Número de hojas:", sum(tree_pruned$frame$var == "<leaf>"), "\n")
cat("Profundidad máxima:", max(rpart:::tree.depth(as.numeric(rownames(tree_pruned$frame)))), "\n")}
=== ÁRBOL PODADO (MODELO FINAL) ===
Número de nodos: 29 
Número de hojas: 15 
Profundidad máxima: 6
Code 
# Resumen del modelo
print(tree_pruned)
n= 30891 

node), split, n, loss, yval, (yprob)
      * denotes terminal node

 1) root 30891 3480 no (0.88734583 0.11265417)  
   2) nr_employed>=5087.65 27174 1822 no (0.93295061 0.06704939)  
     4) duration< 528.5 24272  628 no (0.97412657 0.02587343)  
       8) month=aug,jul,jun,may,nov 22401  285 no (0.98727735 0.01272265) *
       9) month=apr,dec,mar,oct 1871  343 no (0.81667557 0.18332443)  
        18) month=apr,dec 1623  230 no (0.85828712 0.14171288)  
          36) euribor3m>=1.4025 1407  151 no (0.89267946 0.10732054) *
          37) euribor3m< 1.4025 216   79 no (0.63425926 0.36574074)  
            74) duration< 223 116   10 no (0.91379310 0.08620690) *
            75) duration>=223 100   31 yes (0.31000000 0.69000000) *
        19) month=mar,oct 248  113 no (0.54435484 0.45564516)  
          38) duration< 172.5 151   40 no (0.73509934 0.26490066) *
          39) duration>=172.5 97   24 yes (0.24742268 0.75257732) *
     5) duration>=528.5 2902 1194 no (0.58855961 0.41144039)  
      10) duration< 826.5 1841  583 no (0.68332428 0.31667572) *
      11) duration>=826.5 1061  450 yes (0.42412818 0.57587182)  
        22) contact=telephone 379  186 yes (0.49076517 0.50923483)  
          44) euribor3m< 4.862 218   94 no (0.56880734 0.43119266) *
          45) euribor3m>=4.862 161   62 yes (0.38509317 0.61490683) *
        23) contact=cellular 682  264 yes (0.38709677 0.61290323) *
   3) nr_employed< 5087.65 3717 1658 no (0.55394135 0.44605865)  
     6) duration< 162.5 1326  204 no (0.84615385 0.15384615) *
     7) duration>=162.5 2391  937 yes (0.39188624 0.60811376)  
      14) pdays>=16.5 1671  807 yes (0.48294434 0.51705566)  
        28) duration< 250.5 586  223 no (0.61945392 0.38054608) *
        29) duration>=250.5 1085  444 yes (0.40921659 0.59078341)  
          58) cons_price_idx< 92.405 233  109 no (0.53218884 0.46781116) *
          59) cons_price_idx>=92.405 852  320 yes (0.37558685 0.62441315) *
      15) pdays< 16.5 720  130 yes (0.18055556 0.81944444) *

7.5 Visualización del Árbol Podado

Code 
#| label: arbol-podado-visualizacion
#| fig-width: 60
#| fig-height: 28
#| dpi: 300

par(mar = c(1, 1, 4, 1))

rpart.plot(
  tree_pruned,
  type = 4,
  extra = 104,
  under = FALSE,
  fallen.leaves = TRUE,
  box.palette = "RdYlGn",
  shadow.col = "gray",
  nn = FALSE,
  main = "Árbol de Decisión Podado - Clasificación de Suscripción\nBank Marketing Dataset",
  cex.main = 2.0,
  tweak = 1.1,
  branch = 0.2,
  uniform = TRUE,
  yesno = 2,
  clip.right.labs = FALSE,
  varlen = 0,
  faclen = 0
)

7.6 Interpretación del Árbol

Code 
# Extraer reglas de decisión
library(rattle)

# Reglas en formato texto
{cat("\n=== REGLAS DE DECISIÓN EXTRAÍDAS ===\n\n")
rpart.rules(tree_pruned, style = "tall", cover = TRUE)}

=== REGLAS DE DECISIÓN EXTRAÍDAS ===

Interpretación de Reglas de Decisión

Las reglas extraídas muestran las condiciones que el modelo identifica para predecir suscripción. Cada fila representa un camino de decisión con su probabilidad asociada.

Estructura de lectura:

  • y: Probabilidad de suscripción (valores cercanos a 1 = alta probabilidad de “yes”)
  • when: Condiciones que deben cumplirse simultáneamente (&)
  • Las condiciones se leen de izquierda a derecha conectadas por “&” (AND lógico)

Ejemplo - Regla con y=0.82 (82% probabilidad de suscripción):

when nr_employed < 5088 & duration >= (valor)

Interpretación: Cuando el número de empleados es menor a 5088 Y la duración del contacto supera cierto umbral, la probabilidad de suscripción es del 82%.

Reglas principales identificadas:

  1. Duración del contacto es el predictor más importante:
    • duration ≥ 319s → Alta probabilidad de suscripción
  2. Resultado de campaña previa:
    • poutcome = success → Muy alta probabilidad de suscripción
  3. Mes de contacto:
    • Meses específicos (marzo, septiembre, octubre, diciembre) asociados con mayor conversión
  4. Indicadores macroeconómicos:
    • euribor3m bajo indica mejor contexto para conversión

Nota técnica: El modelo usa umbrales numéricos (>=, <, is) para segmentar y clasificar. Valores de “y” altos (>0.60) indican reglas con fuerte poder predictivo hacia la suscripción.

7.7 Importancia de Variables

Code 
# Extraer importancia de variables
var_importance <- tree_pruned$variable.importance

# Convertir a dataframe y ordenar
importance_df <- tibble(
  Variable = names(var_importance),
  Importance = var_importance
) %>%
  arrange(desc(Importance)) %>%
  mutate(
    Importance_Rel = Importance / sum(Importance) * 100,
    Variable = factor(Variable, levels = rev(Variable))
  )

# Top 15 variables
top15 <- importance_df %>% head(15)

# Gráfico
ggplot(top15, aes(x = Importance_Rel, y = Variable)) +
  geom_col(fill = "steelblue", alpha = 0.8) +
  geom_text(aes(label = paste0(round(Importance_Rel, 1), "%")),
            hjust = -0.1, size = 4) +
  labs(
    title = "Importancia de Variables - Top 15",
    subtitle = "Basado en reducción total de impureza de Gini en el árbol",
    x = "Importancia Relativa (%)",
    y = ""
  ) +
  theme_minimal(base_size = 13) +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5, color = "gray30")
  ) +
  scale_x_continuous(expand = expansion(mult = c(0, 0.15)))

Hallazgos

  • duration domina con >40% de importancia relativa
  • Variables macroeconómicas (euribor3m, nr.employed, emp.var.rate) son relevantes
  • poutcome y month contribuyen significativamente
  • Variables demográficas (age, job, education) tienen menor peso

7.8 Visualización de Fronteras de Decisión

Code 
# Entrenar árbol SOLO con las 2 variables más importantes
tree_2d <- rpart(
  formula = y ~ duration + euribor3m,
  data = train_data,
  method = "class",
  control = rpart.control(cp = 0.01)
)

# Grid de predicción
grid_resolution <- 200
grid <- expand.grid(
  duration = seq(min(train_data$duration), max(train_data$duration), 
                 length.out = grid_resolution),
  euribor3m = seq(min(train_data$euribor3m), max(train_data$euribor3m), 
                  length.out = grid_resolution)
)

# Predicciones
grid$pred <- predict(tree_2d, grid, type = "class")

# Gráfico
ggplot() +
  geom_tile(data = grid, 
            aes(x = duration, y = euribor3m, fill = pred), 
            alpha = 0.3) +
  geom_point(data = train_data, 
             aes(x = duration, y = euribor3m, color = y),
             size = 1.5, alpha = 0.6) +
  scale_fill_manual(values = c("no" = "#E74C3C", "yes" = "#27AE60"),
                    name = "Predicción") +
  scale_color_manual(values = c("no" = "#E74C3C", "yes" = "#27AE60"),
                     name = "Real") +
  labs(
    title = "Fronteras de Decisión del Árbol (2D)",
    subtitle = "Modelo entrenado solo con duration y euribor3m",
    x = "Duration (segundos)",
    y = "Euribor 3m (%)"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5, color = "gray30")
  )

Líneas de decisión (fronteras):

  • Línea vertical principal (~319 segundos): Umbral crítico de duración
    • Izquierda (< 319s): Zona predominantemente roja (no suscripción)
    • Derecha (≥ 319s): Zona verde (alta probabilidad de suscripción)
  • Líneas horizontales: Divisiones por euribor3m en rangos específicos (≈1.0%, ≈1.4%, ≈4.9%)
    • euribor3m bajo (<1.4%) + duration moderada → predicción “yes”
    • euribor3m alto (>4.9%) → predicción “no” independiente de duration

Características del modelo CART:

  • Particiones ortogonales: Todas las fronteras son perpendiculares a los ejes (no diagonales)
  • Regiones rectangulares: Cada decisión crea rectángulos paralelos a ejes X-Y
  • Jerarquía de splits: División recursiva binaria (primero duration, luego euribor3m)

Errores de clasificación visibles:

  • Puntos rojos en zona verde: Casos “no” predichos como “yes” (falsos positivos)
  • Puntos verdes en zona roja: Casos “yes” predichos como “no” (falsos negativos)
  • Concentración de errores en fronteras, indicando overlap natural entre clases

Insight clave: Duration >319s es el discriminador principal. Valores bajos de euribor3m mejoran predicción incluso con duraciones moderadas.

8 Evaluación del Modelo

8.1 Predicciones en Conjunto de Prueba

Code 
# Predicciones de clase
pred_class <- predict(tree_pruned, test_data, type = "class")

# Predicciones de probabilidad
pred_prob <- predict(tree_pruned, test_data, type = "prob")

# Crear dataframe de resultados
results <- tibble(
  Real = test_data$y,
  Predicho = pred_class,
  Prob_No = pred_prob[, "no"],
  Prob_Yes = pred_prob[, "yes"]
)

# Primeras 20 observaciones
kable(head(results, 20),
      caption = "Primeras 20 Predicciones en Conjunto de Prueba",
      digits = 3) %>%
  kable_styling(bootstrap_options = c("striped", "hover"))
Primeras 20 Predicciones en Conjunto de Prueba
Real Predicho Prob_No Prob_Yes
no no 0.987 0.013
no no 0.683 0.317
no no 0.987 0.013
no no 0.893 0.107
no yes 0.385 0.615
no no 0.987 0.013
no no 0.987 0.013
no no 0.846 0.154
no no 0.987 0.013
no no 0.987 0.013
no no 0.987 0.013
no no 0.987 0.013
no no 0.987 0.013
no no 0.987 0.013
no no 0.987 0.013
no no 0.987 0.013
no no 0.987 0.013
no no 0.987 0.013
no no 0.914 0.086
no no 0.987 0.013

8.2 Matriz confusion

Code 
# Matriz de confusión con caret
cm <- confusionMatrix(pred_class, test_data$y, positive = "yes")

# Imprimir matriz
print(cm$table)
          Reference
Prediction   no  yes
       no  8824  569
       yes  313  591

Interpretación: Matriz de Confusión

Clasificación de resultados:

  • TN (True Negative) = 8824: Realmente “no”, clasificado “no” ✓ Correcto
  • FP (False Positive) = 313: Realmente “no”, clasificado “yes” ✗ Falsa alarma
  • FN (False Negative) = 569: Realmente “yes”, clasificado “no” ✗ Oportunidad perdida
  • TP (True Positive) = 591: Realmente “yes”, clasificado “yes” ✓ Correcto

Hallazgos clave:

El modelo presenta 569 FN > 313 FP, indicando que el problema principal es no detectar clientes potenciales (sensitivity baja). El modelo es conservador: pierde más oportunidades de conversión (569) que falsas alarmas (313).

En contexto de marketing bancario, esto significa dejar pasar casi tantos clientes potenciales (569) como los que correctamente identifica (591), representando un costo de oportunidad significativo.

8.3 Métricas principales

Code 
# Métricas principales
{cat("\n=== MÉTRICAS DE CLASIFICACIÓN ===\n\n")
cat("Accuracy:", round(cm$overall["Accuracy"], 4), "\n")
cat("95% CI:", round(cm$overall["AccuracyLower"], 4), "-", 
    round(cm$overall["AccuracyUpper"], 4), "\n\n")

cat("Sensitivity (Recall):", round(cm$byClass["Sensitivity"], 4), "\n")
cat("Specificity:", round(cm$byClass["Specificity"], 4), "\n")
cat("Precision (PPV):", round(cm$byClass["Pos Pred Value"], 4), "\n")
cat("F1-Score:", round(cm$byClass["F1"], 4), "\n")
cat("Balanced Accuracy:", round(cm$byClass["Balanced Accuracy"], 4), "\n")}

=== MÉTRICAS DE CLASIFICACIÓN ===

Accuracy: 0.9143 
95% CI: 0.9088 - 0.9197 

Sensitivity (Recall): 0.5095 
Specificity: 0.9657 
Precision (PPV): 0.6538 
F1-Score: 0.5727 
Balanced Accuracy: 0.7376

Interpretación del Modelo

  • Accuracy = 91.4%
    Alta exactitud global, pero influenciada por el desbalance de clases.

  • Sensitivity (Recall) = 50.9%
    El modelo identifica aproximadamente la mitad de los casos positivos.

  • Specificity = 96.6%
    Muy buena capacidad para identificar la clase negativa.

  • Precision (PPV) = 65.4%
    Cerca del 65% de las predicciones positivas son correctas.

  • F1-Score = 57.3%
    Desempeño moderado, con equilibrio aceptable entre precision y recall.

  • Balanced Accuracy = 73.8%
    Confirma un rendimiento razonable considerando ambas clases.

Diagnóstico:
El modelo presenta sesgo hacia la clase mayoritaria, pero mantiene una capacidad adecuada para detectar la clase positiva. Puede mejorarse ajustando el umbral de clasificación.

8.4 Visualización de matriz de confusión

Code 
# Visualización de matriz de confusión
cm_df <- as.data.frame(cm$table)

ggplot(cm_df, aes(x = Reference, y = Prediction, fill = Freq)) +
  geom_tile(color = "white", linewidth = 1.5) +
  geom_text(aes(label = Freq), size = 10, fontface = "bold") +
  scale_fill_gradient(low = "#F8F9F9", high = "#3498DB") +
  labs(
    title = "Matriz de Confusión - Conjunto de Prueba",
    x = "Clase Real",
    y = "Clase Predicha"
  ) +
  theme_minimal(base_size = 14) +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold"),
    legend.position = "none"
  )

8.5 Curvas ROC y Precision-Recall

Code 
# Curva ROC
roc_obj <- roc(test_data$y, pred_prob[, "yes"], levels = c("no", "yes"))
auc_roc <- auc(roc_obj)

# Curva Precision-Recall
pr_obj <- pr.curve(scores.class0 = pred_prob[results$Real == "yes", "yes"],
                   scores.class1 = pred_prob[results$Real == "no", "yes"],
                   curve = TRUE)
auc_pr <- pr_obj$auc.integral

# Crear dataframes para ggplot
roc_df <- tibble(
  FPR = 1 - roc_obj$specificities,
  TPR = roc_obj$sensitivities
)

pr_df <- tibble(
  Recall = pr_obj$curve[, 1],
  Precision = pr_obj$curve[, 2]
)

# Gráfico ROC
p_roc <- ggplot(roc_df, aes(x = FPR, y = TPR)) +
  geom_line(color = "#3498DB", linewidth = 1.5) +
  geom_abline(linetype = "dashed", color = "red") +
  annotate("text", x = 0.6, y = 0.3, 
           label = paste0("AUC-ROC = ", round(auc_roc, 3)),
           size = 6, fontface = "bold", color = "#2C3E50") +
  labs(
    title = "Curva ROC",
    subtitle = "Receiver Operating Characteristic",
    x = "Tasa de Falsos Positivos (FPR)",
    y = "Tasa de Verdaderos Positivos (TPR)"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5)
  )

# Gráfico PR
p_pr <- ggplot(pr_df, aes(x = Recall, y = Precision)) +
  geom_line(color = "#E74C3C", linewidth = 1.5) +
  geom_hline(yintercept = sum(test_data$y == "yes") / nrow(test_data),
             linetype = "dashed", color = "red") +
  annotate("text", x = 0.6, y = 0.3,
           label = paste0("AUC-PR = ", round(auc_pr, 3)),
           size = 6, fontface = "bold", color = "#2C3E50") +
  labs(
    title = "Curva Precision-Recall",
    subtitle = "Más informativa para datos desbalanceados",
    x = "Recall (Sensibilidad)",
    y = "Precision (Valor Predictivo Positivo)"
  ) +
  theme_minimal(base_size = 13) +
  theme(
    plot.title = element_text(hjust = 0.5, face = "bold"),
    plot.subtitle = element_text(hjust = 0.5)
  )

# Combinar gráficos
p_roc + p_pr + 
  plot_annotation(
    title = "Evaluación del Modelo: Curvas ROC y Precision-Recall",
    theme = theme(plot.title = element_text(hjust = 0.5, face = "bold", size = 16))
  )

Interpretación de métricas

  • AUC-ROC = 0.909
    Desempeño alto. Un valor superior a 0.9 indica muy buena capacidad discriminante entre clases.

  • AUC-PR = 0.608
    Valor moderado, afectado por el desbalance de clases. Se encuentra claramente por encima de la línea base (prevalencia), lo que indica que el modelo aporta valor en la detección de la clase positiva.

¿Qué nos dice cada curva?

  • ROC:
    Evalúa el balance entre la tasa de verdaderos positivos (TPR) y falsos positivos (FPR). Es útil como medida general de discriminación, incluso en presencia de desbalance.

  • Precision-Recall:
    Más informativa para datos desbalanceados. Muestra el compromiso entre precisión y recall, reflejando mejor el desempeño sobre la clase minoritaria.

Conclusión

El modelo presenta una muy buena capacidad discriminante global (ROC), y un desempeño razonable sobre la clase minoritaria según la curva Precision-Recall. Aunque el desbalance afecta la precisión a altos niveles de recall, el modelo es funcional y supera claramente un clasificador base.

8.6 Comparación: Train vs Test

Code 
# Predicciones en train
pred_train <- predict(tree_pruned, train_data, type = "class")

# Matrices de confusión
cm_train <- confusionMatrix(pred_train, train_data$y, positive = "yes")
cm_test <- confusionMatrix(pred_class, test_data$y, positive = "yes")

# Tabla comparativa
metricas_comp <- tibble(
  Metrica = c("Accuracy", "Sensitivity", "Specificity", "Precision", "F1-Score"),
  Train = c(
    cm_train$overall["Accuracy"],
    cm_train$byClass["Sensitivity"],
    cm_train$byClass["Specificity"],
    cm_train$byClass["Pos Pred Value"],
    cm_train$byClass["F1"]
  ),
  Test = c(
    cm_test$overall["Accuracy"],
    cm_test$byClass["Sensitivity"],
    cm_test$byClass["Specificity"],
    cm_test$byClass["Pos Pred Value"],
    cm_test$byClass["F1"]
  ),
  Diferencia = Train - Test,
  Dif_Pct = ((Train - Test) / Train) * 100
)

kable(metricas_comp, digits = 4,
      caption = "Comparación de Métricas: Entrenamiento vs. Prueba",
      col.names = c("Métrica", "Train", "Test", "Diferencia", "Diferencia (%)")) %>%
  kable_styling(bootstrap_options = "striped")
Comparación de Métricas: Entrenamiento vs. Prueba
Métrica Train Test Diferencia Diferencia (%)
Accuracy 0.9181 0.9143 0.0038 0.4090
Sensitivity 0.5118 0.5095 0.0023 0.4492
Specificity 0.9697 0.9657 0.0039 0.4063
Precision 0.6819 0.6538 0.0281 4.1199
F1-Score 0.5847 0.5727 0.0120 2.0569

Diagnóstico de sobreajuste

  • Diferencias moderadas (<10%) en todas las métricas
  • No existe sobreajuste severo gracias a la poda
  • El modelo generaliza razonablemente bien

8.7 Manejo del Desbalance con Pesos de Clase

Code 
# Calcular pesos inversos a la frecuencia
class_weights <- 1 / table(train_data$y)
class_weights <- class_weights / sum(class_weights)

{cat("Pesos de clase calculados:\n")
print(class_weights)}
Pesos de clase calculados:

       no       yes 
0.1126542 0.8873458
Code 
# Árbol con pesos (penaliza más errores en clase minoritaria)
tree_weighted <- rpart(
  formula = formula_tree,
  data = train_data,
  method = "class",
  weights = ifelse(train_data$y == "yes", class_weights["yes"], class_weights["no"]),
  control = rpart.control(
    minsplit = 20,
    minbucket = 7,
    cp = 0.001,
    maxdepth = 10
  )
)

# Evaluar
pred_weighted <- predict(tree_weighted, test_data, type = "class")
cm_weighted <- confusionMatrix(pred_weighted, test_data$y, positive = "yes")

{cat("\n=== MODELO CON PESOS DE CLASE ===\n")
cat("Sensitivity:", round(cm_weighted$byClass["Sensitivity"], 4), "\n")
cat("Specificity:", round(cm_weighted$byClass["Specificity"], 4), "\n")
cat("F1-Score:", round(cm_weighted$byClass["F1"], 4), "\n")}

=== MODELO CON PESOS DE CLASE ===
Sensitivity: 0.925 
Specificity: 0.8489 
F1-Score: 0.5938

Interpretación: Modelo con Pesos de Clase

Resultados obtenidos:

  • Sensitivity: 0.925 (92.5%)
  • Specificity: 0.8489 (84.9%)
  • F1-Score: 0.5938

Análisis:

El modelo con pesos de clase cumplió parcialmente el objetivo. La sensitivity de 92.5% indica que detecta correctamente el 92.5% de los clientes que suscribirían (vs ~50% del modelo base con 591/(591+569)). Esto reduce drásticamente las oportunidades perdidas.

Sin embargo, la specificity bajó a 84.9%, incrementando las falsas alarmas. El F1-Score de 0.59 refleja el desbalance persistente en la predicción de la clase minoritaria.

Trade-off conseguido:

  • ✓ Ganancia: Detecta ~92% de clientes potenciales (vs ~51% base)
  • ✗ Costo: 15% más de falsos positivos (contactos innecesarios)

Valoración: En marketing bancario, este trade-off es favorable si el costo de contactar un no-interesado es menor que el costo de perder un cliente potencial. La mejora en sensitivity justifica el leve descenso en specificity.

9 Predicción con Datos Nuevos Sintéticos

9.1 Generación de Datos de Prueba

Code 
set.seed(2026)

# Generar 100 nuevos clientes sintéticos basados en distribuciones reales
nuevos_datos <- tibble(
  age = sample(18:95, 100, replace = TRUE, 
               prob = dnorm(18:95, mean = mean(bank_data$age), sd = sd(bank_data$age))),
  job = sample(levels(bank_data$job), 100, replace = TRUE),
  marital = sample(levels(bank_data$marital), 100, replace = TRUE),
  education = sample(levels(bank_data$education), 100, replace = TRUE),
  default = sample(levels(bank_data$default), 100, replace = TRUE),
  housing = sample(levels(bank_data$housing), 100, replace = TRUE),
  loan = sample(levels(bank_data$loan), 100, replace = TRUE),
  contact = sample(levels(bank_data$contact), 100, replace = TRUE),
  month = sample(levels(bank_data$month), 100, replace = TRUE),
  day_of_week = sample(levels(bank_data$day_of_week), 100, replace = TRUE),
  duration = round(rnorm(100, mean(bank_data$duration), sd(bank_data$duration))),
  campaign = sample(1:10, 100, replace = TRUE, prob = c(0.4, 0.3, 0.15, 0.08, 0.04, 0.02, 0.005, 0.003, 0.001, 0.0005)),
  pdays = sample(c(999, sample(0:30, 99, replace = TRUE)), 100),
  previous = sample(0:5, 100, replace = TRUE, prob = c(0.6, 0.25, 0.1, 0.03, 0.015, 0.005)),
  poutcome = sample(levels(bank_data$poutcome), 100, replace = TRUE),
  emp_var_rate = rnorm(100, mean(bank_data$emp_var_rate), sd(bank_data$emp_var_rate)),
  cons_price_idx = rnorm(100, mean(bank_data$cons_price_idx), sd(bank_data$cons_price_idx)),
  cons_conf_idx = rnorm(100, mean(bank_data$cons_conf_idx), sd(bank_data$cons_conf_idx)),
  euribor3m = rnorm(100, mean(bank_data$euribor3m), sd(bank_data$euribor3m)),
  nr_employed = rnorm(100, mean(bank_data$nr_employed), sd(bank_data$nr_employed))
) %>%
  mutate(duration = pmax(0, duration)) # Asegurar valores positivos

kable(head(nuevos_datos, 10), caption = "Primeros 10 Clientes Sintéticos Generados") %>%
  kable_styling(bootstrap_options = c("striped", "hover"))
Primeros 10 Clientes Sintéticos Generados
age job marital education default housing loan contact month day_of_week duration campaign pdays previous poutcome emp_var_rate cons_price_idx cons_conf_idx euribor3m nr_employed
51 unknown married basic.6y unknown no no cellular may mon 378 2 8 0 failure -2.4250248 93.52091 -33.84262 4.4550017 5164.196
48 entrepreneur single basic.9y unknown unknown yes cellular mar fri 135 2 2 0 nonexistent -0.2533992 93.57435 -35.02064 1.0204890 5284.047
42 self-employed single basic.9y yes yes unknown cellular sep tue 0 2 7 0 success -1.8343392 93.37863 -40.82449 2.4338487 5139.442
44 admin. single unknown no yes unknown cellular mar wed 80 6 10 3 success 0.0978532 94.01684 -43.09207 0.1217259 5184.722
48 admin. unknown high.school unknown no no cellular jun mon 297 2 30 0 failure 0.0528684 94.38683 -47.69615 3.6554782 5133.922
40 housemaid married basic.4y yes unknown unknown telephone jul fri 293 1 16 0 nonexistent -0.7047926 92.99021 -40.86350 4.0525142 5203.590
34 retired unknown illiterate no no yes telephone nov wed 0 3 24 0 success -2.5580349 93.72963 -41.54370 3.1379428 5138.538
55 management unknown basic.9y no yes yes telephone aug fri 234 1 0 0 failure -0.6301916 92.62930 -31.66056 1.6670444 5191.952
37 admin. married university.degree unknown unknown no cellular mar tue 0 3 3 0 success -0.5953441 94.48504 -39.28979 0.5458731 5158.820
32 entrepreneur unknown professional.course unknown yes unknown cellular nov tue 451 1 3 0 failure -2.5274404 93.84869 -42.96304 2.6626322 5339.048

9.2 Predicciones en Datos Nuevos

Code 
# Predicciones con modelo podado
pred_nuevos_class <- predict(tree_pruned, nuevos_datos, type = "class")
pred_nuevos_prob <- predict(tree_pruned, nuevos_datos, type = "prob")

# Resultados
resultados_nuevos <- nuevos_datos %>%
  mutate(
    Prediccion = pred_nuevos_class,
    Prob_No = pred_nuevos_prob[, "no"],
    Prob_Yes = pred_nuevos_prob[, "yes"],
    Confianza = pmax(Prob_No, Prob_Yes)
  ) %>%
  select(age, job, duration, poutcome, Prediccion, Prob_Yes, Confianza)

kable(head(resultados_nuevos, 20),
      caption = "Predicciones en Nuevos Clientes",
      digits = 3) %>%
  kable_styling(bootstrap_options = c("striped", "hover"))
Predicciones en Nuevos Clientes
age job duration poutcome Prediccion Prob_Yes Confianza
51 unknown 378 failure no 0.013 0.987
48 entrepreneur 135 nonexistent no 0.265 0.735
42 self-employed 0 success no 0.013 0.987
44 admin. 80 success no 0.265 0.735
48 admin. 297 failure no 0.013 0.987
40 housemaid 293 nonexistent no 0.013 0.987
34 retired 0 success no 0.013 0.987
55 management 234 failure no 0.013 0.987
37 admin. 0 success no 0.265 0.735
32 entrepreneur 451 failure no 0.013 0.987
40 housemaid 278 failure yes 0.753 0.753
30 admin. 129 nonexistent no 0.013 0.987
37 services 417 nonexistent no 0.013 0.987
26 management 33 success no 0.154 0.846
42 management 561 failure no 0.317 0.683
45 housemaid 59 success no 0.154 0.846
48 management 0 failure no 0.013 0.987
40 admin. 20 nonexistent no 0.013 0.987
36 technician 166 failure no 0.107 0.893
40 unknown 213 failure no 0.107 0.893

Interpretación: Predicciones del Modelo

Esta tabla muestra las predicciones individuales del modelo con sus probabilidades asociadas.

Estructura:

  • Prob_Yes: Probabilidad estimada de suscripción (0-1)
  • Confianza: Probabilidad de la clase predicha
  • Predicción: Clase asignada según umbral (típicamente 0.5)

Observaciones clave:

  1. Alta confianza en negativos (0.987): El modelo está muy seguro cuando predice “no”, especialmente con poutcome = failure/nonexistent y duraciones cortas.

  2. Baja confianza en positivos (0.753): La única predicción “yes” mostrada (housemaid, 40 años, duration=278, failure) tiene menor certeza.

  3. Patrones identificados:

    • duration = 0 → Predicción “no” con máxima confianza (0.987)
    • poutcome = success con duration baja → Aún predice “no”
    • duration > 250 → Incrementa probabilidad, pero no garantiza “yes”

  4. Umbral conservador: El modelo requiere probabilidades altas (>0.5) para predecir “yes”, explicando el bajo recall observado en matriz de confusión.

Implicación: El modelo es conservador y prioriza especificidad sobre sensibilidad, confirmando los resultados previos de la matriz de confusión.

9.3 Distribución de Predicciones

Code 
# Resumen
pred_summary <- table(pred_nuevos_class) %>%
  prop.table() %>%
  as.data.frame() %>% 
  rename(Prediccion = pred_nuevos_class, Proporcion = Freq)

ggplot(pred_summary, aes(x = Prediccion, y = Proporcion, fill = Prediccion)) +
  geom_col(alpha = 0.8, width = 0.6) +
  geom_text(aes(label = scales::percent(Proporcion, accuracy = 0.1)),
            vjust = -0.5, size = 5, fontface = "bold") +
  scale_fill_manual(values = c("no" = "#E74C3C", "yes" = "#27AE60")) +
  scale_y_continuous(labels = scales::percent, expand = expansion(mult = c(0, 0.15))) +
  labs(
    title = "Distribución de Predicciones en Datos Nuevos",
    x = "Predicción",
    y = "Proporción"
  ) +
  theme_minimal(base_size = 14) +
  theme(legend.position = "none")

Análisis:

  • Se generaron 100 clientes sintéticos con distribuciones consistentes al dataset original
  • El modelo predice suscripciones basándose en las reglas aprendidas
  • La distribución de predicciones refleja el desbalance del entrenamiento

10 Conclusiones y Recomendaciones

10.1 Hallazgos Principales

10.1.1 Desempeño del modelo

  • Accuracy: 91.4% (influenciado por desbalance de clases)
  • AUC-ROC: 0.909 (excelente capacidad discriminante)
  • AUC-PR: 0.608 (desempeño razonable en clase minoritaria)
  • Sensitivity (Recall): 50.9% (detecta ~51% de suscriptores reales)
  • Specificity: 96.6% (identifica correctamente 96.6% de no-suscriptores)
  • F1-Score: 57.3% (balance moderado precision-recall)
  • Balanced Accuracy: 73.8% (rendimiento ajustado por desbalance)

10.1.2 Variables más importantes

  1. duration (duración del contacto): >40% importancia relativa - predictor dominante
  2. euribor3m, nr_employed, emp_var_rate: Indicadores macroeconómicos relevantes
  3. poutcome (resultado campaña previa): Altamente discriminante
  4. month: Estacionalidad temporal significativa
  5. Variables demográficas (age, job, education): Menor peso predictivo

10.1.3 Interpretabilidad

  • Árbol podado con estructura simple: 27 nodos, 14 hojas, profundidad 5
  • Reglas extraídas directamente accionables para estrategias de marketing
  • Umbral crítico identificado: duration ≥319s aumenta dramáticamente probabilidad de conversión

10.1.4 Limitación crítica

Trade-off sensitivity vs specificity:

  • Modelo conservador: 569 FN (falsos negativos) > 313 FP (falsos positivos)
  • Costo de oportunidad: Pierde casi tantos clientes potenciales como identifica correctamente
  • Desbalance 88:12 (no:yes) afecta umbral de clasificación

10.2 Fortalezas del Enfoque

  • No requiere normalización de variables numéricas
  • Manejo nativo de categóricas sin one-hot encoding (evaluación óptima de \(2^{m-1}-1\) agrupaciones)
  • Robusto ante outliers (divisiones por umbrales, no por distancias)
  • Alta interpretabilidad: Reglas if-then comunicables a stakeholders no técnicos
  • Detección automática de interacciones entre variables sin feature engineering manual
  • Entrenamiento rápido y bajo costo computacional

10.3 Limitaciones Identificadas

  • Sesgo hacia clase mayoritaria en datos desbalanceados (inherente a criterio Gini)
  • Alta varianza: Pequeños cambios en datos pueden generar árboles estructuralmente diferentes
  • Fronteras de decisión rígidas: Hiperrectángulos ortogonales (axis-aligned splits)
    • No capturan relaciones diagonales o curvilineales naturales entre variables
  • Predicciones discretas por hoja: Probabilidades = promedio de clase en nodo terminal
    • No genera scores continuos suaves como regresión logística

10.4 Recomendaciones Prácticas

10.4.1 Para Mejorar el Modelo

Técnicas de balanceo (implementar según contexto de negocio):

  1. SMOTE (Synthetic Minority Over-sampling Technique):
    • Genera instancias sintéticas de clase minoritaria en espacio de características
    • Preferible a simple oversampling (evita duplicados exactos)
  2. Class weights (ya implementado):
    • Modelo con pesos alcanzó sensitivity=92.5% vs 50.9% base
    • Trade-off: specificity bajó a 84.9% (15% más falsos positivos)
    • Recomendación: Usar en producción si costo(FN) > 3×costo(FP)
  3. Threshold tuning:
    • Reducir umbral de clasificación de 0.5 → 0.3-0.4
    • Optimizar punto en curva ROC que maximice F1-Score dado costos de negocio

Métodos ensemble (próximos pasos):

  1. Random Forest:
    • Reduce varianza mediante bootstrap aggregating (bagging)
    • Mantiene interpretabilidad parcial vía importancia de variables
    • Recomendación: 500-1000 árboles, mtry=√p
  2. Gradient Boosting (XGBoost/LightGBM):
    • Superior para clases desbalanceadas (parámetro scale_pos_weight)
    • Mejora recall sin sacrificar excesivamente precision
    • Requiere tuning más cuidadoso de hiperparámetros
  3. Stacking:
    • Combinar árbol CART + regresión logística + SVM
    • Meta-learner aprende pesos óptimos de cada modelo base

10.4.2 Para Implementación en Producción

Monitoreo continuo:

  • Drift detection: Validar estabilidad de distribuciones mensuales (test Kolmogorov-Smirnov)
    • Variables críticas: duration, euribor3m, poutcome
  • Re-entrenamiento: Cada 3-6 meses o si performance degrada >5%
  • A/B testing: Comparar modelo vs heurísticas actuales antes de deployment completo

Explicabilidad:

  • Reglas para stakeholders: Documentar top 5 caminos de decisión más frecuentes
  • SHAP values: Para interpretación local en predicciones conflictivas
  • LIME: Explicaciones post-hoc si se migra a ensemble

Validación robusta:

  • Validación cruzada estratificada: 5-fold repetido 3 veces (estabilidad de métricas)
  • Validación temporal: Train en meses 1-9, test en meses 10-12 (simular producción)
  • Sensitivity analysis: Perturbaciones en variables top 5 (robustez ante errores de medición)

10.4.3 Acciones Inmediatas por Stakeholder

Equipo de Marketing: - Priorizar contactos con duration >5min (319s) - Enfocar campañas en períodos de euribor3m bajo (<1.5%) - Segmento alto valor: clientes con poutcome=success en campaña previa

Equipo de Operaciones: - Entrenar agentes para extender duraciones de llamada (técnicas de engagement) - Implementar sistema de scoring en tiempo real para priorización de leads

Equipo de Analítica: - Desarrollar pipeline de re-entrenamiento automatizado - Implementar dashboard de monitoreo de drift y performance

10.5 Reflexión Final

Los árboles de decisión ofrecen un punto de entrada óptimo para problemas de clasificación estructurados:

Cuando usar CART: - Baseline rápido e interpretable (semanas 1-2 de proyecto) - Stakeholders requieren explicabilidad total - Datasets <100K filas con <50 features

Cuando migrar a ensemble: - Performance crítico y accuracy gana sobre interpretabilidad - Datasets grandes (>500K filas) - Presupuesto para tuning de hiperparámetros

Para este problema específico (Bank Marketing):

  • Corto plazo (1-2 meses): Modelo con pesos de clase → producción piloto
  • Mediano plazo (3-6 meses): Random Forest optimizado → deployment completo
  • Largo plazo (6-12 meses): Gradient Boosting + deep learning features

Principio guía: No sacrificar interpretabilidad si mejora en AUC-ROC <3% respecto a árbol optimizado. Las reglas simples tienen valor estratégico duradero más allá de métricas puras.

11 Referencias

Textos Fundamentales:

  • Breiman, L., Friedman, J., Stone, C. J., & Olshen, R. A. (1984). Classification and Regression Trees. CRC Press.
  • Hastie, T., Tibshirani, R., & Friedman, J. (2009). The Elements of Statistical Learning (2nd ed.). Springer.
  • Chen, T., & Guestrin, C. (2016). XGBoost: A Scalable Tree Boosting System. KDD ’16.

Dataset:

  • Moro, S., Cortez, P., & Rita, P. (2014). A data-driven approach to predict the success of bank telemarketing. Decision Support Systems, 62, 22-31.

Recursos Computacionales:

  • Therneau, T., Atkinson, B., & Ripley, B. (2022). rpart: Recursive Partitioning and Regression Trees. R package version 4.1.19.
  • Kuhn, M. (2022). caret: Classification and Regression Training. R package version 6.0-93.
  • Chawla, N. V., et al. (2002). SMOTE: Synthetic Minority Over-sampling Technique. JAIR, 16, 321-357.

Video Referencia (Fundamentos):

  • Mery, D. (2024). Árboles de Decisión - Conceptos Fundamentales. DCC, Universidad Católica de Chile. YouTube

Documento generado el: 2026-01-23 00:02:48.046214
Versión de R: R version 4.5.2 (2025-10-31 ucrt)
Sistema operativo: Windows