1 Introducción

El objetivo de este proyecto es aplicar métodos de clasificación supervisada para predecir si un cliente de una institución bancaria decidirá contratar un depósito a plazo (term deposit), un producto financiero equivalente a un CDT. Este tipo de depósito implica que el cliente entrega una suma de dinero al banco y se compromete a mantenerla allí durante un período determinado, obteniendo a cambio una tasa de interés fija. Para las entidades financieras, anticipar qué clientes tienen mayor probabilidad de aceptar este producto resulta clave para optimizar sus campañas de marketing directo.

Para ello se emplea el dataset Bank Marketing del UCI Machine Learning Repository, que recopila en 17 variables disponibles, información demográfica, socioeconómica, financiera, información relacionada a la campaña de marketing e interaciones previas de más de 4.500 clientes. La variable objetivo es \(y\), que indica si el cliente finalmente contrató (“yes”) o no (“no”) el depósito a plazo, lo que convierte el problema en una tarea de clasificación binaria.

En este proyecto se implementará y analizaran los Árboles de Decisión, que permiten identificar reglas claras y fácilmente interpretables para determinar qué características influyen en la decisión final.

2 Descripción del Dataset

2.1 Origen de los datos

Los datos anonimizados provienen de campañas de marketing directo de una institución bancaria portuguesa. El objetivo es predecir si el cliente contratará un depósito a plazo (variable \(y\)).

Fuente: Moro, S., Cortez, P., & Rita, P. (2014). Bank Marketing. UCI Machine Learning Repository.Disponible en: https://archive.ics.uci.edu/dataset/222/bank+marketing

2.2 Cargar librerías

library(tidyverse)    # Manipulación de datos
library(caret)        # Modelado
library(rpart)        # Árboles de decisión
library(rpart.plot)   # Visualizar árboles

2.3 Cargar datos

bank <- read.csv("bank.csv", sep = ";")

2.4 Exploración inicial

# Dimensiones del dataset
dim(bank)

## [1] 4521   17

# Estructura de las variables
str(bank)

## 'data.frame':    4521 obs. of  17 variables:
##  $ age      : int  30 33 35 30 59 35 36 39 41 43 ...
##  $ job      : chr  "unemployed" "services" "management" "management" ...
##  $ marital  : chr  "married" "married" "single" "married" ...
##  $ education: chr  "primary" "secondary" "tertiary" "tertiary" ...
##  $ default  : chr  "no" "no" "no" "no" ...
##  $ balance  : int  1787 4789 1350 1476 0 747 307 147 221 -88 ...
##  $ housing  : chr  "no" "yes" "yes" "yes" ...
##  $ loan     : chr  "no" "yes" "no" "yes" ...
##  $ contact  : chr  "cellular" "cellular" "cellular" "unknown" ...
##  $ day      : int  19 11 16 3 5 23 14 6 14 17 ...
##  $ month    : chr  "oct" "may" "apr" "jun" ...
##  $ duration : int  79 220 185 199 226 141 341 151 57 313 ...
##  $ campaign : int  1 1 1 4 1 2 1 2 2 1 ...
##  $ pdays    : int  -1 339 330 -1 -1 176 330 -1 -1 147 ...
##  $ previous : int  0 4 1 0 0 3 2 0 0 2 ...
##  $ poutcome : chr  "unknown" "failure" "failure" "unknown" ...
##  $ y        : chr  "no" "no" "no" "no" ...

2.5 Descripción de variables

El dataset contiene 4,521 registros y 17 variables:

2.5.1 Variables del cliente

Variable	Tipo	Descripción
age	Numérica	Edad del cliente
job	Categórica	Tipo de trabajo (admin, obrero, empresario, etc.)
marital	Categórica	Estado civil (casado, divorciado, soltero)
education	Categórica	Nivel educativo (primaria, secundaria, terciaria)
default (Morosidad)	Binaria	¿Tiene crédito en mora? (yes/no)
balance (Saldo)	Numérica	Saldo promedio anual en euros
housing (Prestamo hipotecario)	Binaria	¿Tiene préstamo hipotecario? (yes/no)
loan (Prestamo personal)	Binaria	¿Tiene préstamo personal? (yes/no)

2.5.2 Variables de la campaña

Variable	Tipo	Descripción
contact	Categórica	Tipo de contacto (cellular, telephone, unknown)
day	Numérica	Día del mes del último contacto
month	Categórica	Mes del último contacto
duration	Numérica	Duración de la llamada en segundos
campaign (Conocidos)	Numérica	Número de contactos en esta campaña
pdays (Ultimo contacto)	Numérica	Días desde el último contacto de la campaña anterior (-1 = nunca contactado)
previous (Contactos previos)	Numérica	Contactos previos a esta campaña
poutcome (Resultado anterior)	Categórica	Resultado de la campaña anterior

2.5.3 Variable objetivo

Variable	Tipo	Descripción
y	Binaria	¿Contrató el depósito a plazo? (yes/no)

2.6 Resumen estadístico

summary(bank)

##       age            job              marital           education        
##  Min.   :19.00   Length:4521        Length:4521        Length:4521       
##  1st Qu.:33.00   Class :character   Class :character   Class :character  
##  Median :39.00   Mode  :character   Mode  :character   Mode  :character  
##  Mean   :41.17                                                           
##  3rd Qu.:49.00                                                           
##  Max.   :87.00                                                           
##    default             balance        housing              loan          
##  Length:4521        Min.   :-3313   Length:4521        Length:4521       
##  Class :character   1st Qu.:   69   Class :character   Class :character  
##  Mode  :character   Median :  444   Mode  :character   Mode  :character  
##                     Mean   : 1423                                        
##                     3rd Qu.: 1480                                        
##                     Max.   :71188                                        
##    contact               day           month              duration   
##  Length:4521        Min.   : 1.00   Length:4521        Min.   :   4  
##  Class :character   1st Qu.: 9.00   Class :character   1st Qu.: 104  
##  Mode  :character   Median :16.00   Mode  :character   Median : 185  
##                     Mean   :15.92                      Mean   : 264  
##                     3rd Qu.:21.00                      3rd Qu.: 329  
##                     Max.   :31.00                      Max.   :3025  
##     campaign          pdays           previous         poutcome        
##  Min.   : 1.000   Min.   : -1.00   Min.   : 0.0000   Length:4521       
##  1st Qu.: 1.000   1st Qu.: -1.00   1st Qu.: 0.0000   Class :character  
##  Median : 2.000   Median : -1.00   Median : 0.0000   Mode  :character  
##  Mean   : 2.794   Mean   : 39.77   Mean   : 0.5426                     
##  3rd Qu.: 3.000   3rd Qu.: -1.00   3rd Qu.: 0.0000                     
##  Max.   :50.000   Max.   :871.00   Max.   :25.0000                     
##       y            
##  Length:4521       
##  Class :character  
##  Mode  :character  
##                    
##                    
##

3 Limpieza de datos

Antes de aplicar cualquier modelo de clasificación, es fundamental preparar los datos. Un dataset “sucio” puede generar modelos poco confiables o con resultados sesgados.

La limpieza de datos incluye:

Identificar y tratar valores faltantes (NA), Manejar valores “unknown” o desconocidos
Detectar y tratar valores atípicos (outliers)
Convertir variables al tipo correcto

A diferencia de la regresión logistica en donde los coeficientes pueden depender de la escala, en arboles de descición solo importa el umbral (es decir, ser mayor/menor que), por lo que la normalización de los datos no va a ser necesaria.

3.1 Identificar valores “unknown”

En este dataset, los valores faltantes están codificados como “unknown” en las variables categóricas. Vamos a identificarlos:

# Función para contar "unknown" en cada columna
contar_unknown <- function(x) {
  sum(x == "unknown")
}

# Crear dataframe con conteo de unknown
unknown_counts <- data.frame(
  Variable = c("job", "education", "contact", "poutcome"),
  Cantidad = c(
    sum(bank$job == "unknown"),
    sum(bank$education == "unknown"),
    sum(bank$contact == "unknown"),
    sum(bank$poutcome == "unknown")
  )
)

# Gráfico de barras
ggplot(unknown_counts, aes(x = reorder(Variable, -Cantidad), y = Cantidad, fill = Variable)) +
  geom_bar(stat = "identity") +
  geom_text(aes(label = Cantidad), vjust = -0.5, size = 4) +
  labs(
    title = "Cantidad de valores 'unknown' por variable",
    x = "Variable",
    y = "Cantidad de registros"
  ) +
  theme_minimal() +
  theme(legend.position = "none")

3.2 Estrategia de limpieza

Existen varias opciones para manejar los valores “unknown”:

Estrategia	Descripción	Cuándo usarla
Eliminar registros	Borrar filas con “unknown”	Cuando son pocos registros
Reemplazar por moda	Sustituir por el valor más frecuente	Variables categóricas
Crear categoría	Mantener “unknown” como categoría válida	Cuando el desconocimiento es informativo
Imputación	Predecir el valor faltante	Cuando se requiere precisión

Como vimos en la grafica anterior para las variables job, y education el porcentaje de unknow es muy bajo (0.8%) y (4.1%), por lo que se podria aplicar el metodo de reemplazar por la moda,claro esta bajo las siguientes limitaciones

Reduce la varianza: Al asignar el mismo valor a todos los faltantes, subestimamos la variabilidad real: \[\text{Var}(X_{imputado}) < \text{Var}(X_{real})\]
Sesgo potencial: Si los datos no son MCAR(Es decir completamente aleatorios), la imputación puede introducir sesgo sistemático

Además para aplicar este método estamos suponiendo que los datos siguen la misma distribución de los datos observados, lo cual en este contexto tiene sentido pues si una persona tiene en education uknown, pero tiene trabajo, es muy posible que si halla tenido educación.

La imputación por moda se fundamenta en el principio de máxima verosimilitud. Si asumimos que los valores faltantes provienen de la misma distribución que los observados, el valor más probable para imputar es aquel con mayor frecuencia.

3.3 Aplicar limpieza

# Crear copia del dataset para limpieza
bank_clean <- bank

# 1. Variable 'job': Reemplazar "unknown" por la moda (solo 0.8% de unknown)
moda_job <- names(sort(table(bank_clean$job[bank_clean$job != "unknown"]), decreasing = TRUE))[1]
cat("Moda de job:", moda_job, "\n")

## Moda de job: management

bank_clean$job[bank_clean$job == "unknown"] <- moda_job

# 2. Variable 'education': Reemplazar "unknown" por la moda (solo 4.1% de unknown)
moda_education <- names(sort(table(bank_clean$education[bank_clean$education != "unknown"]), decreasing = TRUE))[1]
cat("Moda de education:", moda_education, "\n")

## Moda de education: secondary

bank_clean$education[bank_clean$education == "unknown"] <- moda_education

# 3. Variable 'contact': Mantener "unknown" como categoría válida
# Con 29.3% de valores unknown, imputar introduciría sesgo significativo
cat("contact: Se mantiene 'unknown' como categoría válida (29.3% del dataset)\n")

## contact: Se mantiene 'unknown' como categoría válida (29.3% del dataset)

# 4. Variable 'poutcome': Mantener "unknown" ya que representa "sin contacto previo"
# Esta variable tiene muchos "unknown" porque son clientes nuevos
cat("poutcome: Se mantiene 'unknown' como categoría válida (81.9% del dataset)\n")

## poutcome: Se mantiene 'unknown' como categoría válida (81.9% del dataset)

Variable	% unknown	Decisión	Justificación
job	0.8%	Imputar con moda	Porcentaje bajo, supuesto MCAR razonable
education	4.1%	Imputar con moda	Porcentaje bajo, supuesto MCAR razonable
contact	29.3%	Mantener “unknown”	Porcentaje alto, posible canal no registrado
poutcome	81.9%	Mantener “unknown”	Representa “cliente sin contacto previo”

Otra variable a tener en cuenta es pdays, que coloca a \(-1\), para decir que nunca fue contactado antes, esta variable la dejaremos momentaneamente como esta, dado que cuando apliquemos arboles de descición, el árbol simplemente buscará el mejor punto de corte y probablemente separará los -1 del resto automáticamente, para regresión logisitica puede confundir al modelo porque interpreta -1 como “1 día antes de hoy” en lugar de “nunca contactado”.

3.4 Detección de valores atípicos (Outliers)

Revisamos las variables numéricas para identificar valores extremos:

# Seleccionar variables numéricas (sin usar pipe)
vars_numericas <- bank_clean[, c("age", "balance", "duration", "campaign", "pdays", "previous")]

# Boxplots
par(mfrow = c(2, 3))
for (col in names(vars_numericas)) {
  boxplot(vars_numericas[[col]], main = col, col = "lightblue", outline = TRUE)
}

par(mfrow = c(1, 1))

# Crear tabla resumen de outliers
resumen_outliers <- data.frame(
  Variable = c("age", "balance", "duration", "campaign", "pdays", "previous"),
  Minimo = c(
    min(bank_clean$age),
    min(bank_clean$balance),
    min(bank_clean$duration),
    min(bank_clean$campaign),
    min(bank_clean$pdays),
    min(bank_clean$previous)
  ),
  Maximo = c(
    max(bank_clean$age),
    max(bank_clean$balance),
    max(bank_clean$duration),
    max(bank_clean$campaign),
    max(bank_clean$pdays),
    max(bank_clean$previous)
  ),
  Media = c(
    round(mean(bank_clean$age), 1),
    round(mean(bank_clean$balance), 1),
    round(mean(bank_clean$duration), 1),
    round(mean(bank_clean$campaign), 1),
    round(mean(bank_clean$pdays), 1),
    round(mean(bank_clean$previous), 1)
  ),
  Mediana = c(
    median(bank_clean$age),
    median(bank_clean$balance),
    median(bank_clean$duration),
    median(bank_clean$campaign),
    median(bank_clean$pdays),
    median(bank_clean$previous)
  )
)

# Mostrar tabla 
knitr::kable(resumen_outliers, 
             caption = "Resumen estadístico de variables numéricas",
             col.names = c("Variable", "Mínimo", "Máximo", "Media", "Mediana"),
             align = "lrrrr")

Resumen estadístico de variables numéricas
Variable	Mínimo	Máximo	Media	Mediana
age	19	87	41.2	39
balance	-3313	71188	1422.7	444
duration	4	3025	264.0	185
campaign	1	50	2.8	2
pdays	-1	871	39.8	-1
previous	0	25	0.5	0

Observamos valores extremos en varias variables, especialmente en balance y duration. Sin embargo, se decide mantener los outliers por las siguientes razones:

Son valores reales, no errores: Un balance de 71,188€ representa un cliente adinerado; un balance de -3,313€ representa un cliente con sobregiro. Ambas son situaciones reales del negocio bancario.
Tienen potencial predictivo: Las llamadas más largas (duration alta) podrían indicar mayor interés del cliente. Los clientes con balance negativo podrían tener menor probabilidad de contratar un depósito.
Robustez del modelo: Los árboles de decisión son inherentemente robustos a valores atípicos, ya que realizan particiones basadas en puntos de corte óptimos.
Conservación de información: Eliminar outliers reduciría el tamaño del dataset y podríamos perder patrones importantes.

3.5 Convertir variables categóricas a factor

# Convertir variables character a factor
cols_character <- sapply(bank_clean, is.character)
bank_clean[cols_character] <- lapply(bank_clean[cols_character], as.factor)

# Verificar estructura final
str(bank_clean)

## 'data.frame':    4521 obs. of  17 variables:
##  $ age      : int  30 33 35 30 59 35 36 39 41 43 ...
##  $ job      : Factor w/ 11 levels "admin.","blue-collar",..: 11 8 5 5 2 5 7 10 3 8 ...
##  $ marital  : Factor w/ 3 levels "divorced","married",..: 2 2 3 2 2 3 2 2 2 2 ...
##  $ education: Factor w/ 3 levels "primary","secondary",..: 1 2 3 3 2 3 3 2 3 1 ...
##  $ default  : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 1 1 1 1 ...
##  $ balance  : int  1787 4789 1350 1476 0 747 307 147 221 -88 ...
##  $ housing  : Factor w/ 2 levels "no","yes": 1 2 2 2 2 1 2 2 2 2 ...
##  $ loan     : Factor w/ 2 levels "no","yes": 1 2 1 2 1 1 1 1 1 2 ...
##  $ contact  : Factor w/ 3 levels "cellular","telephone",..: 1 1 1 3 3 1 1 1 3 1 ...
##  $ day      : int  19 11 16 3 5 23 14 6 14 17 ...
##  $ month    : Factor w/ 12 levels "apr","aug","dec",..: 11 9 1 7 9 4 9 9 9 1 ...
##  $ duration : int  79 220 185 199 226 141 341 151 57 313 ...
##  $ campaign : int  1 1 1 4 1 2 1 2 2 1 ...
##  $ pdays    : int  -1 339 330 -1 -1 176 330 -1 -1 147 ...
##  $ previous : int  0 4 1 0 0 3 2 0 0 2 ...
##  $ poutcome : Factor w/ 4 levels "failure","other",..: 4 1 1 4 4 1 2 4 4 1 ...
##  $ y        : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 1 1 1 1 ...

3.6 Dataset limpio - Resumen final

# Crear tabla de dimensiones
dimensiones <- data.frame(
  Descripcion = c("Número de filas (registros)", "Número de columnas (variables)"),
  Valor = c(dim(bank_clean)[1], dim(bank_clean)[2])
)

knitr::kable(dimensiones, 
             caption = "Dimensiones del dataset limpio",
             col.names = c("Descripción", "Valor"),
             align = "lr")

Dimensiones del dataset limpio
Descripción	Valor
Número de filas (registros)	4521
Número de columnas (variables)	17

# Resumen del dataset
summary(bank_clean)

##       age                 job           marital         education    default   
##  Min.   :19.00   management :1007   divorced: 528   primary  : 678   no :4445  
##  1st Qu.:33.00   blue-collar: 946   married :2797   secondary:2493   yes:  76  
##  Median :39.00   technician : 768   single  :1196   tertiary :1350             
##  Mean   :41.17   admin.     : 478                                              
##  3rd Qu.:49.00   services   : 417                                              
##  Max.   :87.00   retired    : 230                                              
##                  (Other)    : 675                                              
##     balance      housing     loan           contact          day       
##  Min.   :-3313   no :1962   no :3830   cellular :2896   Min.   : 1.00  
##  1st Qu.:   69   yes:2559   yes: 691   telephone: 301   1st Qu.: 9.00  
##  Median :  444                         unknown  :1324   Median :16.00  
##  Mean   : 1423                                          Mean   :15.92  
##  3rd Qu.: 1480                                          3rd Qu.:21.00  
##  Max.   :71188                                          Max.   :31.00  
##                                                                        
##      month         duration       campaign          pdays       
##  may    :1398   Min.   :   4   Min.   : 1.000   Min.   : -1.00  
##  jul    : 706   1st Qu.: 104   1st Qu.: 1.000   1st Qu.: -1.00  
##  aug    : 633   Median : 185   Median : 2.000   Median : -1.00  
##  jun    : 531   Mean   : 264   Mean   : 2.794   Mean   : 39.77  
##  nov    : 389   3rd Qu.: 329   3rd Qu.: 3.000   3rd Qu.: -1.00  
##  apr    : 293   Max.   :3025   Max.   :50.000   Max.   :871.00  
##  (Other): 571                                                   
##     previous          poutcome      y       
##  Min.   : 0.0000   failure: 490   no :4000  
##  1st Qu.: 0.0000   other  : 197   yes: 521  
##  Median : 0.0000   success: 129             
##  Mean   : 0.5426   unknown:3705             
##  3rd Qu.: 0.0000                            
##  Max.   :25.0000                            
##

3.7 Distribución de la variable objetivo

# Crear tabla de distribución
tabla_y <- table(bank_clean$y)
prop_y <- prop.table(tabla_y) * 100

distribucion_y <- data.frame(
  Respuesta = c("No contrató", "Sí contrató"),
  Cantidad = as.numeric(tabla_y),
  Porcentaje = paste0(round(prop_y, 1), "%")
)

knitr::kable(distribucion_y, 
             caption = "Distribución de la variable objetivo (y)",
             col.names = c("Respuesta", "Cantidad", "Porcentaje"),
             align = "lrr")

Distribución de la variable objetivo (y)
Respuesta	Cantidad	Porcentaje
No contrató	4000	88.5%
Sí contrató	521	11.5%

# Gráfico
ggplot(bank_clean, aes(x = y, fill = y)) +
  geom_bar() +
  geom_text(stat = "count", aes(label = ..count..), vjust = -0.5) +
  scale_fill_manual(values = c("no" = "#E74C3C", "yes" = "#27AE60")) +
  labs(
    title = "Distribución de la variable objetivo",
    subtitle = "¿El cliente contrató el depósito a plazo?",
    x = "Respuesta",
    y = "Cantidad de clientes"
  ) +
  theme_minimal() +
  theme(legend.position = "none")

Observación importante: El dataset está desbalanceado. La mayoría de clientes (~88%) no contrataron el depósito. Esto es común en problemas de marketing y debemos tenerlo en cuenta al evaluar el modelo.

4 Modelo de Clasificación: Árbol de Decisión

4.1 Introducción teórica

4.1.1 ¿Qué es un árbol de decisión?

Un árbol de decisión es un modelo de aprendizaje supervisado que realiza predicciones mediante una serie de reglas de decisión jerárquicas. La estructura se compone de:

Nodo raíz: Contiene todos los datos iniciales
Nodos internos: Representan pruebas sobre una variable
Ramas: Representan los resultados de las pruebas
Nodos hoja (terminales): Contienen la predicción final

4.1.2 Criterios de división

El algoritmo debe decidir qué variable usar para dividir los datos en cada nodo. Para problemas de clasificación, los criterios más comunes son:

4.1.2.1 1. Ganancia de Información (Entropía)

La entropía mide el desorden o incertidumbre en un nodo:

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

La ganancia de información al dividir por una variable \(A\) es:

\[GI(t, A) = Entropia(t) - \sum_{v \in valores(A)} \frac{|t_v|}{|t|} \cdot Entropia(t_v)\]

Donde: - \(t_v\) es el subconjunto de datos donde \(A = v\) - \(|t|\) es el número de observaciones en el nodo \(t\)

4.1.2.2 2. Índice de Gini

El índice de Gini mide la impureza de un nodo. Para un nodo \(t\) con \(K\) clases:

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

Donde \(p_k\) es la proporción de observaciones de la clase \(k\) en el nodo \(t\).

Interpretación: - \(Gini = 0\) → Nodo puro (todas las observaciones son de una sola clase) - \(Gini = 0.5\) → Máxima impureza (para clasificación binaria con 50%-50%)

Para nuestro problema binario (y = “yes” o “no”):

\[Gini(t) = 1 - p_{yes}^2 - p_{no}^2\]

4.1.3 Proceso de construcción del árbol

El algoritmo CART (Classification and Regression Trees) sigue estos pasos:

Inicio: Todos los datos en el nodo raíz
Para cada nodo: Buscar la mejor división que minimice la impureza ponderada de los nodos hijos:

\[Impureza_{division} = \frac{n_{izq}}{n} \cdot Gini(izq) + \frac{n_{der}}{n} \cdot Gini(der)\]

Criterio de parada: El árbol deja de crecer cuando:
- El nodo es puro (\(Gini = 0\))
- Se alcanza la profundidad máxima (\(maxdepth\))
- El nodo tiene menos observaciones que el mínimo (\(minsplit\))
- La mejora en impureza es menor que el umbral (\(cp\))

Utilizaremos gini en vez de la entropia pues computacionalmente es mas eficiente y la diferencia teorica es minima.

4.1.4 Hiperparámetros principales

Parámetro	Descripción	Efecto
\(cp\) (complexity parameter)	Umbral mínimo de mejora para dividir (cambio muy pequeños en la impureza no son relevantes)	Valores bajos → árbol más complejo
\(maxdepth\)	Profundidad máxima del árbol	Valores altos → más divisiones
\(minsplit\)	Mínimo de observaciones para dividir un nodo	Valores bajos → nodos más pequeños
\(minbucket\)	Mínimo de observaciones en nodo terminal	Controla tamaño de hojas

4.1.5 Ventajas y desventajas

Ventajas: - Fácil de interpretar y visualizar - No requiere normalización de variables - Maneja variables numéricas y categóricas - Robusto a outliers

Desventajas: - Tendencia al sobreajuste (overfitting) - Inestable: pequeños cambios en datos pueden generar árboles muy diferentes - Sesgo hacia variables con más categorías

4.2 Preparación de datos

4.2.1 División en conjunto de entrenamiento y prueba

Para evaluar el modelo de forma objetiva, dividimos los datos en dos conjuntos:

Entrenamiento (70%): Para construir el modelo
Prueba (30%): Para evaluar el desempeño

Debido al desbalance en las clases (88% “no” vs 12% “yes”), utilizamos división estratificada para garantizar que ambos conjuntos mantengan la misma proporción de clases.

library(caret)
library(rpart)
library(rpart.plot)

# Fijar semilla para reproducibilidad
set.seed(123)

# División ESTRATIFICADA (mantiene proporción de y)
indices <- createDataPartition(bank_clean$y, p = 0.7, list = FALSE)

# Dividir datos
train_data <- bank_clean[indices, ]
test_data <- bank_clean[-indices, ]

# Crear tabla de distribución
distribucion <- data.frame(
  Conjunto = c("Entrenamiento", "Entrenamiento", "Prueba", "Prueba"),
  Clase = c("No", "Sí", "No", "Sí"),
  Cantidad = c(
    sum(train_data$y == "no"),
    sum(train_data$y == "yes"),
    sum(test_data$y == "no"),
    sum(test_data$y == "yes")
  ),
  Porcentaje = c(
    round(prop.table(table(train_data$y)) * 100, 1),
    round(prop.table(table(test_data$y)) * 100, 1)
  )
)

knitr::kable(distribucion, 
             caption = "Distribución de clases después de la división estratificada",
             col.names = c("Conjunto", "Clase", "Cantidad", "Porcentaje (%)"),
             align = "llrr")

Distribución de clases después de la división estratificada
Conjunto	Clase	Cantidad	Porcentaje (%)
Entrenamiento	No	2800	88.5
Entrenamiento	Sí	365	11.5
Prueba	No	1200	88.5
Prueba	Sí	156	11.5

4.3 Entrenamiento del modelo base

Para manejar el desbalance de clases, utilizamos el parámetro prior = c(0.5, 0.5) que indica al modelo tratar ambas clases con igual importancia.

# Entrenar árbol de decisión con prior balanceado
modelo_arbol <- rpart(
  formula = y ~ .,
  data = train_data,
  method = "class",
  parms = list(
    prior = c(0.5, 0.5)  # Dar igual importancia a ambas clases
  )
)

# Ver estructura del modelo
print(modelo_arbol)

## n= 3165 
## 
## node), split, n, loss, yval, (yprob)
##       * denotes terminal node
## 
##   1) root 3165 1582.500000 no (0.50000000 0.50000000)  
##     2) duration< 212.5 1793  203.774000 no (0.82884418 0.17115582)  
##       4) month=aug,dec,jan,jul,jun,may,nov 1550   82.376710 no (0.91307403 0.08692597) *
##       5) month=apr,feb,mar,oct,sep 243  121.397300 no (0.50023904 0.49976096)  
##        10) duration< 75.5 61    0.000000 no (1.00000000 0.00000000) *
##        11) duration>=75.5 182   87.037500 yes (0.41757670 0.58242330) *
##     3) duration>=212.5 1372  595.698200 yes (0.30170730 0.69829270)  
##       6) duration< 631.5 1111  523.920500 yes (0.39640679 0.60359321)  
##        12) contact=unknown 314   43.356160 no (0.79850317 0.20149683) *
##        13) contact=cellular,telephone 797  352.106200 yes (0.31821521 0.68178479)  
##          26) poutcome=failure,unknown 693  327.238400 yes (0.39834318 0.60165682)  
##            52) month=apr,aug,dec,feb,jan,jul,may,nov 638  314.804500 yes (0.47268690 0.52731310)  
##             104) age< 60.5 618  299.157500 no (0.50912763 0.49087237)  
##               208) duration< 351 358  108.390400 no (0.63455063 0.36544937)  
##                 416) month=aug,dec,jan,jul,nov 214   30.349320 no (0.79402028 0.20597972) *
##                 417) month=apr,feb,may 144   71.212500 yes (0.47712418 0.52287582)  
##                   834) day< 20.5 123   26.013700 no (0.71767078 0.28232922) *
##                   835) day>=20.5 21    5.086607 yes (0.08906059 0.91093941) *
##               209) duration>=351 260  122.078600 yes (0.39021976 0.60978024) *
##             105) age>=60.5 20    4.521429 yes (0.07995619 0.92004381) *
##            53) month=jun,mar,oct,sep 55   12.433930 yes (0.07995619 0.92004381) *
##          27) poutcome=other,success 104   24.867860 yes (0.08725416 0.91274584) *
##       7) duration>=631.5 261   71.777680 yes (0.10996193 0.89003807) *

# Gráfico del error vs cp
plotcp(modelo_arbol)

Interpretación de la gráfica: El eje X inferior muestra los valores de cp (parámetro de complejidad), mientras que el eje X superior indica el tamaño del árbol (número de hojas). El eje Y representa el error de validación cruzada relativo. Observamos que con un árbol de tamaño 1 (solo la raíz), el error es muy alto (alrededor de 1.05). A medida que el árbol crece y el cp disminuye, el error se reduce significativamente hasta estabilizarse alrededor de 4-10 hojas. La línea punteada horizontal indica el umbral del “mejor árbol parsimonioso” (error mínimo + 1 desviación estándar). La regla de selección recomienda elegir el árbol más simple cuyo error esté por debajo de esta línea, lo que sugiere un cp óptimo entre 0.01 y 0.02.

El error relativo de validación se calcula sobre el conjunto de entrenamiento, y lo que hace es dividir el conjunto en \(k\) clases entrenar con \(k-1\) clases y ver el error de validación con la clase restante, luego repite para todas las clases el mismo proceso, promedia y divide por el error del modelo sin particiona (Error del modelo nulo)

\[\text{Error relativo} = \frac{\text{Error del modelo}}{\text{Error del modelo nulo}}\]

4.4 Ajuste de hiperparámetros (Grid Search)

Para encontrar los mejores hiperparámetros, realizamos una búsqueda exhaustiva:

# Definir grilla de hiperparámetros
grid <- expand.grid(
  cp = c(0.001, 0.005, 0.01, 0.02, 0.05),
  maxdepth = c(3, 5, 7, 10, 15),
  minsplit = c(10, 20, 30, 50)
)

# Función para evaluar cada combinación
evaluar_modelo <- function(cp, maxdepth, minsplit, train, test) {
  
  modelo <- rpart(
    formula = y ~ .,
    data = train,
    method = "class",
    control = rpart.control(
      cp = cp,
      maxdepth = maxdepth,
      minsplit = minsplit
    )
  )
  
  # Predicciones
  pred <- predict(modelo, test, type = "class")
  
  # Accuracy
  accuracy <- sum(pred == test$y) / nrow(test)
  
  return(accuracy)
}

# Evaluar todas las combinaciones
resultados <- data.frame(grid)
resultados$accuracy <- NA

for (i in 1:nrow(grid)) {
  resultados$accuracy[i] <- evaluar_modelo(
    cp = grid$cp[i],
    maxdepth = grid$maxdepth[i],
    minsplit = grid$minsplit[i],
    train = train_data,
    test = test_data
  )
}

# Ordenar por accuracy
resultados <- resultados[order(-resultados$accuracy), ]

# Mostrar mejores 10 combinaciones
knitr::kable(
  head(resultados, 10),
  caption = "Top 10 combinaciones de hiperparámetros",
  col.names = c("cp", "maxdepth", "minsplit", "Accuracy"),
  digits = 4,
  align = "rrrr"
)

Top 10 combinaciones de hiperparámetros
	cp	maxdepth	minsplit	Accuracy
11	0.001	7	10	0.8975
86	0.001	7	50	0.8960
91	0.001	10	50	0.8960
96	0.001	15	50	0.8960
87	0.005	7	50	0.8945
88	0.010	7	50	0.8945
92	0.005	10	50	0.8945
93	0.010	10	50	0.8945
97	0.005	15	50	0.8945
98	0.010	15	50	0.8945

El Accuracy (exactitud) mide la proporción de predicciones correctas sobre el total de predicciones:

\[Accuracy = \frac{VP + VN}{VP + VN + FP + FN}\]

# Heatmap de cp vs maxdepth
accuracy_heatmap <- aggregate(accuracy ~ cp + maxdepth, data = resultados, FUN = mean)

ggplot(accuracy_heatmap, aes(x = factor(cp), y = factor(maxdepth), fill = accuracy)) +
  geom_tile() +
  geom_text(aes(label = paste0(round(accuracy * 100, 1), "%")), color = "white", size = 3) +
  scale_fill_gradient(low = "#E74C3C", high = "#27AE60", name = "Accuracy") +
  labs(
    title = "Heatmap: Accuracy por combinación de cp y maxdepth",
    x = "Complexity Parameter (cp)",
    y = "Profundidad máxima (maxdepth)"
  ) +
  theme_minimal()

# Extraer mejores parámetros
mejor_cp <- resultados$cp[1]
mejor_maxdepth <- resultados$maxdepth[1]
mejor_minsplit <- resultados$minsplit[1]

# Entrenar modelo final
modelo_final <- rpart(
  formula = y ~ .,
  data = train_data,
  method = "class",
  control = rpart.control(
    cp = mejor_cp,
    maxdepth = mejor_maxdepth,
    minsplit = mejor_minsplit
  )
)

4.5 Importancia de variables

# Extraer importancia de variables
importancia <- data.frame(
  Variable = names(modelo_final$variable.importance),
  Importancia = modelo_final$variable.importance
)

# Ordenar por importancia
importancia <- importancia[order(-importancia$Importancia), ]
rownames(importancia) <- NULL

# Mostrar tabla
knitr::kable(
  importancia,
  caption = "Importancia de variables en el modelo",
  col.names = c("Variable", "Importancia"),
  digits = 2,
  align = "lr"
)

Importancia de variables en el modelo
Variable	Importancia
duration	149.87
poutcome	55.78
month	42.79
age	28.22
job	27.91
pdays	15.46
day	14.66
campaign	14.30
balance	13.76
education	13.44
previous	9.95
contact	8.03
marital	7.21
loan	1.24
housing	1.09
default	0.88

# Gráfico de importancia
ggplot(importancia, aes(x = reorder(Variable, Importancia), y = Importancia, fill = Importancia)) +
  geom_bar(stat = "identity") +
  coord_flip() +
  scale_fill_gradient(low = "#3498DB", high = "#E74C3C") +
  labs(
    title = "Importancia de variables en el árbol de decisión",
    x = "Variable",
    y = "Importancia"
  ) +
  theme_minimal() +
  theme(legend.position = "none")

4.6 Modelo final

# Entrenar modelo con mejores hiperparámetros
modelo_final <- rpart(
  formula = y ~ .,
  data = train_data,
  method = "class",
  parms = list(prior = c(0.5, 0.5)),
  control = rpart.control(
    cp = mejor_cp,
    maxdepth = mejor_maxdepth,
    minsplit = mejor_minsplit
  )
)

4.6.1 Visualización del árbol

# Graficar árbol de decisión
rpart.plot(modelo_final, 
           type = 4, 
           extra = 104,
           fallen.leaves = TRUE,
           main = "Árbol de Decisión - Predicción de Depósito a Plazo")

4.7 Evaluación del modelo

4.7.1 Predicciones y matriz de confusión

# Realizar predicciones en test
predicciones <- predict(modelo_final, test_data, type = "class")

# Matriz de confusión
matriz_confusion <- table(Real = test_data$y, Predicho = predicciones)

knitr::kable(matriz_confusion,
             caption = "Matriz de Confusión")

Matriz de Confusión
	no	yes
no	974	226
yes	39	117

4.7.2 Métricas de desempeño

Las métricas principales para evaluar un modelo de clasificación son:

\[Precision = \frac{VP}{VP + FP}\]

\[Recall = \frac{VP}{VP + FN}\]

\[F1 = 2 \times \frac{Precision \times Recall}{Precision + Recall}\]

# Extraer valores de la matriz
VP <- matriz_confusion["yes", "yes"]  # Verdaderos Positivos
VN <- matriz_confusion["no", "no"]    # Verdaderos Negativos
FP <- matriz_confusion["no", "yes"]   # Falsos Positivos
FN <- matriz_confusion["yes", "no"]   # Falsos Negativos

# Calcular métricas
accuracy <- (VP + VN) / sum(matriz_confusion)
precision <- VP / (VP + FP)
recall <- VP / (VP + FN)
f1_score <- 2 * (precision * recall) / (precision + recall)
especificidad <- VN / (VN + FP)

# Crear tabla de métricas
metricas <- data.frame(
  Metrica = c("Accuracy", "Precision", "Recall (Sensibilidad)", "F1-Score"),
  Valor = round(c(accuracy, precision, recall, f1_score), 4),
  Porcentaje = paste0(round(c(accuracy, precision, recall, f1_score) * 100, 2), "%")
)

knitr::kable(metricas,
             caption = "Métricas de desempeño del modelo",
             col.names = c("Métrica", "Valor", "Porcentaje"),
             align = "lrr")

Métricas de desempeño del modelo
Métrica	Valor	Porcentaje
Accuracy	0.8046	80.46%
Precision	0.3411	34.11%
Recall (Sensibilidad)	0.7500	75%
F1-Score	0.4689	46.89%

4.7.3 Interpretación de métricas

Métrica	¿Qué responde?
Accuracy	¿Qué porcentaje de predicciones fueron correctas?
Precision	De los que predije “yes”, ¿cuántos realmente eran “yes”?
Recall	De los que realmente eran “yes”, ¿cuántos identifiqué?
F1-Score	Balance entre Precision y Recall

Supongamos que el banco tiene 1,000 clientes potenciales, de los cuales 120 contratarían el depósito (12%).

Con el modelo:

Clientes interesados detectados: 90 de 120 (75% recall)
Total de clientes a contactar: ~264 clientes (34% precisión)
Llamadas “desperdiciadas”: 174 clientes que no contratan

Sin modelo (llamar a todos):

Clientes a contactar: 1,000
Contratan realmente: 120
Llamadas “desperdiciadas”: 880

Conclusión: El modelo reduce el esfuerzo de 1,000 a 264 llamadas, capturando el 75%

5 Conclusiones

5.1 Hallazgos principales

Mejor modelo: Árbol de decisión con cp = 0.001, maxdepth = 7, minsplit = 10
Variables más importantes: La variable duration (duración de la llamada) es el predictor más relevante, seguida por variables relacionadas con el historial de contacto.
Desempeño: El modelo logra un balance razonable entre precisión y recall (F1-score), considerando el desbalance original de las clases. Aun asi deja mucho que desear, puesto que el banco tendria que realizar muchas llamadas, para los pocos clientes que contrataran (Presición baja del 34%).

5.2 Limitaciones

El dataset está desbalanceado (88% vs 12%)
La variable duration no está disponible antes de realizar la llamada (limitación práctica)
El modelo podría mejorar con técnicas de ensemble (Random Forest, Gradient Boosting)

5.3 Recomendaciones

Para el banco, los clientes con mayor probabilidad de contratar un depósito son aquellos con:

Llamadas de mayor duración
Contactos previos exitosos
Características demográficas específicas identificadas en el árbol

Clasificación supervisada de contratación de depositos a plazo.

Brayan Alejandro Romero Castro

2025-12-10