Las campañas de telemercadeo son una de las herramientas más utilizadas por los bancos para colocar productos de ahorro, como los depósitos a plazo. Estos productos son importantes para la entidad porque le permiten captar recursos a un plazo definido y financiar su operación de crédito. Sin embargo, cada llamada tiene un costo en tiempo de los asesores, en infraestructura y en desgaste de la relación con el cliente, y solo una pequeña parte de las personas contactadas termina aceptando la oferta.
En la práctica, la selección de los clientes a contactar suele hacerse con reglas generales, como llamar a toda la base o a segmentos definidos por edad o por producto. Este enfoque es sencillo, pero desaprovecha la información que el banco ya tiene sobre cada cliente: su perfil, su historial en campañas anteriores y el momento económico en que se realiza el contacto. Los modelos de clasificación permiten usar esa información para estimar, antes de la llamada, qué tan probable es que cada cliente acepte.
En la base analizada, de 38.234 clientes contactados, solo el 11,1 % aceptó abrir el depósito. Esto quiere decir que, sin ningún criterio de selección, de cada diez llamadas aproximadamente nueve no generan una venta. Desde la ingeniería industrial este es un problema de asignación eficiente de recursos: si el banco pudiera identificar con anticipación a los clientes con mayor probabilidad de aceptar, podría concentrar sus llamadas en ellos y reducir el número de contactos necesarios para lograr el mismo resultado.
Clasificar correctamente a los clientes es importante por tres razones. La primera es económica, ya que hacer menos llamadas para obtener el mismo número de depósitos reduce el costo por venta. La segunda tiene que ver con la experiencia del cliente, porque las llamadas repetidas a personas que no están interesadas generan rechazo hacia la entidad. La tercera es de gestión: un modelo interpretable le permite al área comercial entender qué factores influyen en la decisión y diseñar sus campañas con base en datos y no solo en la experiencia de los asesores.
La variable de interés es binaria, ya que cada cliente acepta o no acepta el depósito, por lo que el problema se aborda con modelos de clasificación supervisada. La pregunta que orienta la investigación es la siguiente: ¿qué tan bien pueden los modelos K vecinos más cercanos (KNN) y regresión logística (Logit) identificar a los clientes que aceptarán un depósito a plazo, a partir de su perfil y de la forma en que fueron contactados?
Para responderla se comparan dos enfoques diferentes. La regresión logística es un modelo paramétrico, que supone una forma matemática para la relación entre las variables y la probabilidad de aceptar, y por eso permite interpretar el efecto de cada variable. El KNN es un método no paramétrico, que no supone ninguna forma y clasifica a cada cliente según lo que hicieron los clientes más parecidos a él. Ambos se entrenan con una parte de los datos y se evalúan con clientes que no participaron en el entrenamiento.
El objetivo de modelación es construir y comparar ambos modelos para clasificar a los clientes según su probabilidad de aceptar la oferta, con el fin de determinar cuál resulta más útil para priorizar las llamadas de una campaña.
La investigación siguió un enfoque de aprendizaje supervisado para un problema de clasificación binaria. El procedimiento tuvo cinco etapas: obtención y depuración de la base, análisis descriptivo, partición de los datos en entrenamiento y prueba, ajuste de los modelos KNN y Logit, y comparación de su desempeño. El análisis se realizó en R con los paquetes dplyr y tidyr para la manipulación de los datos, ggplot2 y plotly para las gráficas interactivas, class y caret para el KNN, y pROC para las curvas ROC. Las operaciones aleatorias se realizaron con la semilla 2026, de modo que los resultados se pueden reproducir.
knitr::opts_chunk$set(echo = TRUE, message = FALSE, warning = FALSE, fig.align = "center")
library(dplyr)
library(tidyr)
library(readr)
library(knitr)
library(ggplot2)
library(plotly)
library(DT)
library(class)
library(caret)
library(pROC)
fmt <- function(x, d = 2) formatC(x, format = "f", digits = d, big.mark = ".", decimal.mark = ",")
fmt0 <- function(x) fmt(x, 0)
pct <- function(x, d = 1) paste0(fmt(100 * x, d), " %")
ptxt <- function(p) ifelse(p < 0.001, "p < 0,001", paste0("p = ", fmt(p, 3)))
eje_pct <- function(x) paste0(fmt(100 * x, 0), " %")
azul <- "#1F4E78"; gris <- "#A6A6A6"; rojo <- "#C00000"
tema <- theme_minimal(base_size = 12, base_family = "Times New Roman") +
theme(text = element_text(color = "black"), panel.grid.minor = element_blank(),
legend.position = "bottom")
interactivo <- function(g, alto = 430) {
ggplotly(g, tooltip = "text", height = alto) |>
layout(font = list(family = "Times New Roman", color = "#000000", size = 14),
separators = ",.", legend = list(orientation = "h", x = 0.25, y = -0.2)) |>
config(displaylogo = FALSE, locale = "es")
}
metricas <- function(cm, r) c(
Exactitud = unname(cm$overall["Accuracy"]),
Sensibilidad = unname(cm$byClass["Sensitivity"]),
Especificidad = unname(cm$byClass["Specificity"]),
Precision = unname(cm$byClass["Pos Pred Value"]),
F1 = unname(cm$byClass["F1"]),
Kappa = unname(cm$overall["Kappa"]),
AUC = as.numeric(auc(r)))
nombres_m <- c(Exactitud = "Exactitud", Sensibilidad = "Sensibilidad", Especificidad = "Especificidad",
Precision = "Precisión", F1 = "Puntaje F1", Kappa = "Kappa", AUC = "AUC")
vp <- function(cm) cm$table["Si", "Si"]
curva_roc <- function(y, p) roc(y, p, levels = c("No", "Si"), direction = "<", quiet = TRUE)Se utilizó la base Bank Marketing, que recoge las campañas de telemercadeo de un banco portugués realizadas entre mayo de 2008 y noviembre de 2010. Los datos fueron publicados en el repositorio de aprendizaje automático de la Universidad de California en Irvine (UCI) y son los mismos analizados por Moro et al. (2014). En estas campañas el banco llamaba a sus clientes para ofrecerles un depósito a plazo, y para cada llamada se registró la información del cliente, la forma de contacto y si finalmente aceptó o no el producto.
Tabla 1
Ficha de la fuente de datos
| Elemento | Descripción |
|---|---|
| Conjunto de datos | Bank Marketing (archivo bank-additional-full) |
| Autores | S. Moro, P. Rita y P. Cortez |
| Entidad que lo publica | UCI Machine Learning Repository |
| Enlace | https://archive.ics.uci.edu/dataset/222/bank+marketing |
| DOI | 10.24432/C5K306 |
| Período | Mayo de 2008 a noviembre de 2010 |
| Unidad de análisis | Cliente contactado en la campaña |
| Registros originales / finales | 41.188 / 38.234 |
Fuente:información del UCI Machine Learning Repository (Moro et al., 2014).
La variable dependiente es si el cliente aceptó o no el depósito a plazo. Las variables independientes se escogieron porque describen el perfil del cliente, su relación previa con el banco, la forma de contacto y el entorno económico del momento, que son los factores que un área comercial puede conocer antes de hacer la llamada.
Tabla 2
Variables del estudio
| Variable | Rol | Tipo | Descripción | Justificación |
|---|---|---|---|---|
| suscribio | Y | Binaria (Sí / No) | El cliente aceptó el depósito a plazo | Resultado que se busca predecir |
| edad | X | Numérica (años) | Edad del cliente | La etapa de vida influye en la decisión de ahorrar |
| ocupacion | X | Categórica (11 niveles) | Tipo de trabajo | Se relaciona con el ingreso y la estabilidad |
| estado_civil | X | Categórica | Casado, soltero, divorciado o viudo | Cambia las prioridades financieras del hogar |
| educacion | X | Categórica ordinal | Básica, bachillerato, técnica, universitaria | Se asocia con el conocimiento de productos financieros |
| credito_vivienda | X | Binaria | Tiene crédito de vivienda con el banco | Un crédito activo reduce la capacidad de ahorro |
| prestamo_personal | X | Binaria | Tiene préstamo personal | Mismo efecto que el anterior |
| tipo_contacto | X | Binaria | Celular o teléfono fijo | Refleja la calidad del canal de contacto |
| contactos_campana | X | Numérica (llamadas) | Llamadas en esta campaña | Insistir demasiado puede generar rechazo |
| contactos_previos | X | Numérica (llamadas) | Llamadas en campañas anteriores | Mide la relación comercial previa |
| resultado_campana_anterior | X | Categórica | Éxito, fracaso o sin campaña previa | Un cliente que ya aceptó tiende a repetir |
| euribor_3m | X | Numérica (%) | Tasa Euribor a 3 meses | Indica el atractivo de las tasas de ahorro en el mercado |
La variable dependiente suscribio refleja el resultado final de la llamada y es la medida directa del éxito de la campaña. Se codificó como un factor con dos niveles, “Si” y “No”, y se definió “Si” como la clase positiva, ya que el interés del banco está en encontrar a los clientes que aceptan.
Las variables independientes se agrupan en cuatro bloques. El primero es el perfil del cliente, formado por la edad, la ocupación, el estado civil y la educación, que describen su etapa de vida y, de forma indirecta, su capacidad de ahorro. Se espera, por ejemplo, que estudiantes y jubilados tengan un comportamiento distinto al de las personas en edad laboral con obligaciones familiares.
El segundo bloque es la relación con el banco: el crédito de vivienda, el préstamo personal, los contactos en campañas anteriores y el resultado de la campaña anterior. Estas variables indican si el cliente ya tiene compromisos con la entidad y cómo respondió en el pasado. Un cliente que ya aceptó una oferta conoce el producto y confía en el banco, mientras que uno que tiene créditos activos tiene menos dinero disponible para ahorrar.
El tercer bloque corresponde a la forma de contacto en la campaña actual, es decir, el tipo de teléfono y el número de llamadas realizadas. Estas variables son las que el banco controla directamente y por eso son las más útiles para diseñar la estrategia. El cuarto bloque es el entorno económico, representado por la tasa Euribor a tres meses, que es la tasa de referencia de los préstamos entre bancos de la zona euro e influye en la rentabilidad que el banco puede ofrecer en sus depósitos.
La base original se depuró en un script aparte (01_depuracion_base.R). De los 41.188 registros se eliminaron 12 duplicados y 2.942 registros con la categoría “desconocido” en alguna de las variables seleccionadas. Las categorías se tradujeron al español y el nivel educativo se agrupó en cuatro niveles. Se excluyó la duración de la llamada, a pesar de estar en la base original, porque solo se conoce después de terminar la llamada y no sirve para decidir a quién contactar; incluirla habría producido modelos con un desempeño muy alto pero imposible de aplicar en una campaña real.
Tabla 3
Proceso de depuración de la base de datos
| Paso | Descripción | Registros eliminados | Registros resultantes |
|---|---|---|---|
| 1 | Base original bank-additional-full | – | 41.188 |
| 2 | Eliminación de registros duplicados | 12 | 41.176 |
| 3 | Eliminación de registros con categoría “desconocido” | 2.942 | 38.234 |
| 4 | Selección de 12 variables y traducción de categorías | – | 38.234 |
Después de la depuración, cada variable categórica se convirtió en factor y se definió su categoría de referencia para el modelo logit: administrativo en ocupación, casado en estado civil, educación básica, sin créditos, contacto por celular y sin campaña previa.
base <- read_csv("base_telemercadeo_bancario.csv", show_col_types = FALSE) |>
mutate(
suscribio = factor(ifelse(suscribio == "Sí", "Si", "No"), levels = c("Si", "No")),
ocupacion = relevel(factor(ocupacion), ref = "Administrativo"),
estado_civil = relevel(factor(estado_civil), ref = "Casado"),
educacion = factor(educacion, levels = c("Básica", "Bachillerato", "Técnica", "Universitaria")),
credito_vivienda = factor(credito_vivienda, levels = c("No", "Sí")),
prestamo_personal = factor(prestamo_personal, levels = c("No", "Sí")),
tipo_contacto = factor(tipo_contacto, levels = c("Celular", "Teléfono fijo")),
resultado_campana_anterior = factor(resultado_campana_anterior,
levels = c("Sin campaña previa", "Fracaso", "Éxito"))
)
n_total <- nrow(base)
n_si <- sum(base$suscribio == "Si")
tasa <- n_si / n_total
tasa_cat <- function(var, cat) mean(base$suscribio[base[[var]] == cat] == "Si")El modelo KNN clasifica a cada cliente según la clase más frecuente entre los k clientes más parecidos del conjunto de entrenamiento, medidos con la distancia euclidiana. Como las variables tienen escalas distintas, se estandarizaron antes de calcular las distancias. El KNN se implementó de dos formas. La primera, con el paquete class, usa solo las cuatro variables numéricas y elige k entre 1 y 100 mediante validación cruzada dejando uno fuera sobre el conjunto de entrenamiento. La segunda, con el paquete caret, incluye también las variables categóricas, convertidas en variables indicadoras, y elige k entre 5 y 101 por validación cruzada de cinco grupos, escogiendo el valor que maximizó el AUC.
La regresión logística estima la probabilidad de que el cliente acepte el depósito mediante la siguiente expresión:
P(Yi = 1) = 1 / (1 + e−(β0 + β1X1i + … + βpXpi))
Donde Yi = 1 indica que el cliente aceptó. Los coeficientes se interpretan mediante la razón de probabilidades (odds ratio), eβ: un valor mayor que 1 indica que la variable aumenta la probabilidad de aceptar y un valor menor que 1 indica que la reduce. En los modelos principales se clasifica como “Sí” a los clientes con probabilidad estimada igual o mayor que 0,5. Como análisis complementario, para el logit se calculó también el umbral óptimo según el índice de Youden (sensibilidad + especificidad − 1), obtenido con los datos de entrenamiento.
Los modelos se compararon en el conjunto de prueba con la exactitud, la sensibilidad (proporción de clientes que aceptaron y que el modelo detectó), la especificidad, la precisión, el puntaje F1, el índice kappa y el área bajo la curva ROC (AUC). También se construyó una curva de ganancia acumulada, que muestra qué porcentaje de los clientes interesados se alcanza llamando solo a una parte de la base.
Tabla 4
Base de datos depurada (interactiva)
datatable(base |> mutate(suscribio = ifelse(suscribio == "Si", "Sí", "No")) |>
rename(`Suscribió` = suscribio, Edad = edad, `Ocupación` = ocupacion,
`Estado civil` = estado_civil, `Educación` = educacion,
`Crédito vivienda` = credito_vivienda, `Préstamo personal` = prestamo_personal,
`Tipo de contacto` = tipo_contacto, `Contactos campaña` = contactos_campana,
`Contactos previos` = contactos_previos,
`Campaña anterior` = resultado_campana_anterior, `Euribor 3m` = euribor_3m),
rownames = FALSE, extensions = "Buttons",
options = list(pageLength = 10, scrollX = TRUE, dom = "Blfrtip", buttons = c("csv", "excel"),
language = list(search = "Buscar:", thousands = ".", decimal = ",", lengthMenu = "Mostrar _MENU_ registros",
info = "Registros _START_ a _END_ de _TOTAL_",
paginate = list(`next` = "Siguiente", previous = "Anterior"))))La base final contiene 38.234 clientes y 12 variables: la variable dependiente, cuatro variables numéricas y siete categóricas. La tabla permite buscar, ordenar y descargar los registros, lo que facilita revisar casos puntuales y verificar los cálculos del informe.
Figura 1
Distribución de los clientes según aceptaron o no el depósito a plazo
d1 <- base |> count(suscribio) |>
mutate(etiqueta = ifelse(suscribio == "Si", "Sí aceptó", "No aceptó"), p = n / sum(n),
text = paste0(etiqueta, "<br>Clientes: ", fmt0(n), "<br>", pct(p)))
g1 <- ggplot(d1, aes(x = etiqueta, y = n, fill = etiqueta, text = text)) +
geom_col(width = 0.5) +
geom_text(aes(label = paste0(fmt0(n), " (", pct(p), ")")), vjust = -0.5, family = "Times New Roman") +
scale_fill_manual(values = c("Sí aceptó" = azul, "No aceptó" = gris), guide = "none") +
scale_y_continuous(labels = function(x) fmt0(x), expand = expansion(mult = c(0, 0.12))) +
labs(x = NULL, y = "Número de clientes") + tema
interactivo(g1, 400) |> layout(showlegend = FALSE)La Figura 1 muestra un fuerte desbalance entre las dos clases: 4.257 clientes aceptaron el depósito (11,1 %) y 33.977 no lo hicieron. Esta situación es común en campañas comerciales y justifica el balanceo del conjunto de entrenamiento, ya que un modelo que dijera “No” a todos tendría una exactitud cercana al 89 % sin aportar ningún valor al negocio.
Tabla 5
Estadísticas descriptivas de las variables cuantitativas según la respuesta del cliente
desc <- base |>
select(suscribio, Edad = edad, `Contactos en la campaña` = contactos_campana,
`Contactos previos` = contactos_previos, `Euribor 3 meses (%)` = euribor_3m) |>
pivot_longer(-suscribio, names_to = "Variable", values_to = "v") |>
mutate(Variable = factor(Variable, levels = unique(Variable)),
Grupo = ifelse(suscribio == "Si", "Aceptó", "No aceptó")) |>
group_by(Variable, Grupo) |>
summarise(Media = fmt(mean(v)), `Desv. estándar` = fmt(sd(v)), Mediana = fmt(median(v)),
`Mínimo` = fmt(min(v)), `Máximo` = fmt(max(v)), .groups = "drop")
kable(desc, align = c("l", "l", rep("r", 5)))| Variable | Grupo | Media | Desv. estándar | Mediana | Mínimo | Máximo |
|---|---|---|---|---|---|---|
| Edad | Aceptó | 40,74 | 13,47 | 37,00 | 18,00 | 98,00 |
| Edad | No aceptó | 39,75 | 9,81 | 38,00 | 17,00 | 95,00 |
| Contactos en la campaña | Aceptó | 2,06 | 1,65 | 2,00 | 1,00 | 23,00 |
| Contactos en la campaña | No aceptó | 2,63 | 2,87 | 2,00 | 1,00 | 43,00 |
| Contactos previos | Aceptó | 0,47 | 0,84 | 0,00 | 0,00 | 6,00 |
| Contactos previos | No aceptó | 0,13 | 0,41 | 0,00 | 0,00 | 7,00 |
| Euribor 3 meses (%) | Aceptó | 2,15 | 1,75 | 1,27 | 0,63 | 5,04 |
| Euribor 3 meses (%) | No aceptó | 3,81 | 1,64 | 4,86 | 0,63 | 5,04 |
med <- function(v, g) mean(base[[v]][base$suscribio == g])
tasa_edad <- base |> mutate(grupo = cut(edad, c(16, 25, 35, 45, 55, 65, 100),
labels = c("17-25", "26-35", "36-45", "46-55", "56-65", "66 o más"))) |>
group_by(grupo) |> summarise(n = n(), tasa = mean(suscribio == "Si"), .groups = "drop")
te <- function(g) tasa_edad$tasa[tasa_edad$grupo == g]
eur_bajo <- mean(base$suscribio[base$euribor_3m <= 2] == "Si")
eur_alto <- mean(base$suscribio[base$euribor_3m > 4] == "Si")
tasa_cont <- base |> mutate(grupo = cut(contactos_campana, c(0, 1, 2, 3, 5, 10, Inf),
labels = c("1", "2", "3", "4-5", "6-10", "Más de 10"))) |>
group_by(grupo) |> summarise(n = n(), tasa = mean(suscribio == "Si"), .groups = "drop")
tc <- function(g) tasa_cont$tasa[tasa_cont$grupo == g]La Tabla 5 muestra que los clientes que aceptaron tienen una edad promedio parecida a la de los que no aceptaron (40,7 frente a 39,8 años), pero recibieron en promedio menos llamadas en la campaña (2,06 frente a 2,63) y más llamadas en campañas anteriores. La diferencia más marcada está en la tasa Euribor: entre quienes aceptaron, el promedio fue de 2,15 %, mientras que entre quienes no aceptaron fue de 3,81 %.
Figura 2
Distribución de las variables cuantitativas de la base
etiquetas <- c(edad = "Edad (años)", contactos_campana = "Contactos en la campaña",
contactos_previos = "Contactos previos", euribor_3m = "Euribor 3 meses (%)")
anchos <- c(edad = 3, contactos_campana = 1, contactos_previos = 1, euribor_3m = 0.25)
d2 <- bind_rows(lapply(names(anchos), function(v) {
w <- anchos[[v]]; x <- base[[v]]
if (v == "contactos_campana") x <- x[x <= 15]
centro <- if (w == 1) x else floor(x / w) * w + w / 2
data.frame(centro = centro) |> count(centro) |>
mutate(xmin = centro - ifelse(w == 1, 0.4, w / 2), xmax = centro + ifelse(w == 1, 0.4, w / 2),
Variable = etiquetas[[v]],
rango = ifelse(w == 1, fmt0(centro), paste0(fmt(xmin, 2), " a ", fmt(xmax, 2))))
})) |> mutate(Variable = factor(Variable, levels = etiquetas))
medias <- data.frame(Variable = factor(etiquetas, levels = etiquetas),
media = sapply(names(etiquetas), function(v) mean(base[[v]])))
g2 <- ggplot(d2) +
geom_rect(aes(xmin = xmin, xmax = xmax, ymin = 0, ymax = n,
text = paste0(Variable, "<br>Valor: ", rango, "<br>Clientes: ", fmt0(n))),
fill = azul, color = "white", linewidth = 0.2) +
geom_vline(data = medias, aes(xintercept = media, text = paste0("Media: ", fmt(media))),
color = rojo, linetype = "dashed") +
facet_wrap(~ Variable, scales = "free", ncol = 2) +
scale_y_continuous(labels = function(x) fmt0(x)) +
labs(x = NULL, y = NULL) + tema
interactivo(g2, 560)El eje vertical indica el número de clientes y la línea punteada roja la media de cada variable. En contactos en la campaña se muestran los clientes con hasta 15 llamadas, que son el 99,1 % de la base.
La Figura 2 muestra que ninguna de las variables cuantitativas tiene una distribución simétrica. La edad se concentra entre los 30 y los 50 años, con una cola hacia la derecha que corresponde a los clientes jubilados. Los contactos en la campaña y los contactos previos tienen una asimetría fuerte: la mayoría de los clientes recibió una o dos llamadas y el 86,5 % no había sido contactado en campañas anteriores, por lo que en ambas variables la media queda por encima de la mediana. La tasa Euribor, en cambio, se divide en dos grupos claramente separados, uno con tasas cercanas al 5 % y otro con tasas por debajo del 1,5 %, que corresponden a los periodos antes y después de la crisis financiera de 2008.
Figura 3
Densidad de la edad y de la tasa Euribor según la respuesta del cliente
densidad <- function(v, g) {
x <- base[[v]][base$suscribio == g]
d <- density(x, adjust = 1.5, from = min(base[[v]]), to = max(base[[v]]))
data.frame(x = d$x, y = d$y, Grupo = ifelse(g == "Si", "Aceptó", "No aceptó"), Variable = etiquetas[[v]])
}
d3 <- bind_rows(lapply(c("edad", "euribor_3m"), function(v) bind_rows(densidad(v, "Si"), densidad(v, "No"))))
g3 <- ggplot(d3, aes(x = x, y = y, fill = Grupo, color = Grupo, group = Grupo,
text = paste0(Grupo, "<br>", Variable, ": ", fmt(x, 1), "<br>Densidad: ", fmt(y, 3)))) +
geom_area(position = "identity", alpha = 0.35) +
facet_wrap(~ Variable, scales = "free") +
scale_fill_manual(values = c("Aceptó" = azul, "No aceptó" = gris), name = NULL) +
scale_color_manual(values = c("Aceptó" = azul, "No aceptó" = gris), name = NULL) +
labs(x = NULL, y = "Densidad") + tema
interactivo(g3, 430)Las curvas de la edad de los dos grupos son muy parecidas en el centro, pero la de los clientes que aceptaron tiene más peso en los extremos, es decir, en los menores de 25 años y en los mayores de 60. En la tasa Euribor la diferencia es mucho más clara: los clientes que no aceptaron se concentran en el grupo de tasas cercanas al 5 %, mientras que una parte importante de los que aceptaron fue contactada cuando la tasa estaba por debajo del 1,5 %. Con el Euribor en 2 % o menos aceptó el 24,0 % de los clientes, frente al 4,9 % cuando estaba por encima del 4 %.
Figura 4
Tasa de aceptación del depósito según grupo de edad
g4 <- ggplot(tasa_edad, aes(x = grupo, y = tasa, group = 1,
text = paste0("Edad: ", grupo, "<br>Clientes: ", fmt0(n), "<br>Aceptación: ", pct(tasa)))) +
geom_line(color = azul, linewidth = 1.2) + geom_point(color = azul, size = 3) +
geom_hline(yintercept = tasa, linetype = "dashed", color = gris) +
scale_y_continuous(labels = eje_pct) +
labs(x = "Grupo de edad (años)", y = "Tasa de aceptación") + tema
interactivo(g4)La línea punteada representa la tasa general de aceptación.
La relación entre la edad y la aceptación no es lineal, sino que forma una U. Los clientes más jóvenes (17 a 25 años) aceptan en un 19,0 % y los mayores de 65 años en un 45,8 %, mientras que entre los 36 y 55 años la tasa baja a cerca del 9 %. Una posible explicación es que en las edades intermedias las personas tienen más obligaciones financieras, como créditos y gastos del hogar, que reducen su capacidad de ahorro.
Figura 5
Tasa de aceptación según el número de llamadas en la campaña
g5 <- ggplot(tasa_cont, aes(x = grupo, y = tasa,
text = paste0("Llamadas: ", grupo, "<br>Clientes: ", fmt0(n), "<br>Aceptación: ", pct(tasa)))) +
geom_col(fill = azul, width = 0.6) +
scale_y_continuous(labels = eje_pct) +
labs(x = "Número de llamadas en la campaña", y = "Tasa de aceptación") + tema
interactivo(g5)La Figura 5 muestra que insistir no mejora el resultado. Los clientes contactados una sola vez aceptan en un 12,8 %, y la tasa cae a medida que aumentan las llamadas, hasta llegar a 2,9 % en quienes recibieron más de diez. Esto sugiere que, después de unos pocos intentos, seguir llamando consume recursos sin aumentar las ventas.
Figura 6
Tasa de aceptación por decil de la tasa Euribor a 3 meses
d6 <- base |> mutate(decil = ntile(euribor_3m, 10)) |> group_by(decil) |>
summarise(minimo = min(euribor_3m), maximo = max(euribor_3m), n = n(),
tasa = mean(suscribio == "Si"), .groups = "drop")
g6 <- ggplot(d6, aes(x = factor(decil), y = tasa,
text = paste0("Decil ", decil, "<br>Euribor: ", fmt(minimo, 2), " % a ", fmt(maximo, 2), " %",
"<br>Clientes: ", fmt0(n), "<br>Aceptación: ", pct(tasa)))) +
geom_col(fill = azul, width = 0.6) +
geom_hline(yintercept = tasa, linetype = "dashed", color = rojo) +
scale_y_continuous(labels = eje_pct) +
labs(x = "Decil de la tasa Euribor (1 = tasas más bajas)", y = "Tasa de aceptación") + tema
interactivo(g6)Cada decil agrupa aproximadamente el 10 % de los clientes; la línea punteada representa la tasa general de aceptación.
Al ordenar a los clientes según la tasa Euribor del momento en que fueron contactados, el primer decil, con tasas entre 0,63 % y 1,21 %, alcanza una tasa de aceptación del 45,5 %, cerca de cuatro veces la tasa general. A partir del quinto decil, cuando el Euribor supera el 4 %, la aceptación se mantiene entre el 3,3 % y el 6,0 %. Este resultado coincide con el periodo de la crisis financiera, cuando las tasas bajaron y los clientes pudieron haber buscado productos de ahorro con un rendimiento fijo y seguro.
Tabla 6
Distribución de las variables categóricas y tasa de aceptación por categoría
nombres_cat <- c(ocupacion = "Ocupación", estado_civil = "Estado civil", educacion = "Educación",
credito_vivienda = "Crédito de vivienda", prestamo_personal = "Préstamo personal",
tipo_contacto = "Tipo de contacto", resultado_campana_anterior = "Campaña anterior")
tab_cat <- bind_rows(lapply(names(nombres_cat), function(v) {
base |> group_by(Categoria = as.character(.data[[v]])) |>
summarise(n = n(), tasa = mean(suscribio == "Si"), .groups = "drop") |>
mutate(Variable = nombres_cat[v]) |> arrange(desc(tasa))
}))
kable(tab_cat |> transmute(Variable, `Categoría` = Categoria, Clientes = fmt0(n),
`% de la base` = pct(n / n_total), `Tasa de aceptación` = pct(tasa)),
align = c("l", "l", "r", "r", "r"))| Variable | Categoría | Clientes | % de la base | Tasa de aceptación |
|---|---|---|---|---|
| Ocupación | Estudiante | 688 | 1,8 % | 30,2 % |
| Ocupación | Jubilado | 1.576 | 4,1 % | 24,7 % |
| Ocupación | Desempleado | 963 | 2,5 % | 14,3 % |
| Ocupación | Administrativo | 9.934 | 26,0 % | 12,9 % |
| Ocupación | Gerencial | 2.728 | 7,1 % | 11,1 % |
| Ocupación | Independiente | 1.349 | 3,5 % | 10,8 % |
| Ocupación | Técnico | 6.376 | 16,7 % | 10,7 % |
| Ocupación | Empleada doméstica | 987 | 2,6 % | 9,9 % |
| Ocupación | Empresario | 1.360 | 3,6 % | 8,5 % |
| Ocupación | Servicios | 3.714 | 9,7 % | 8,0 % |
| Ocupación | Obrero | 8.559 | 22,4 % | 7,0 % |
| Estado civil | Soltero | 10.756 | 28,1 % | 13,7 % |
| Estado civil | Divorciado o viudo | 4.301 | 11,2 % | 10,4 % |
| Estado civil | Casado | 23.177 | 60,6 % | 10,1 % |
| Educación | Universitaria | 11.817 | 30,9 % | 13,7 % |
| Educación | Técnica | 5.097 | 13,3 % | 11,3 % |
| Educación | Bachillerato | 9.241 | 24,2 % | 10,9 % |
| Educación | Básica | 12.079 | 31,6 % | 8,7 % |
| Crédito de vivienda | Sí | 20.573 | 53,8 % | 11,4 % |
| Crédito de vivienda | No | 17.661 | 46,2 % | 10,8 % |
| Préstamo personal | No | 32.275 | 84,4 % | 11,2 % |
| Préstamo personal | Sí | 5.959 | 15,6 % | 10,7 % |
| Tipo de contacto | Celular | 24.432 | 63,9 % | 14,5 % |
| Tipo de contacto | Teléfono fijo | 13.802 | 36,1 % | 5,2 % |
| Campaña anterior | Éxito | 1.243 | 3,3 % | 64,6 % |
| Campaña anterior | Fracaso | 3.936 | 10,3 % | 13,5 % |
| Campaña anterior | Sin campaña previa | 33.055 | 86,5 % | 8,8 % |
Figura 7
Tasa de aceptación del depósito según la ocupación del cliente
d7 <- tab_cat |> filter(Variable == "Ocupación") |> arrange(tasa)
g7 <- ggplot(d7, aes(x = factor(Categoria, levels = Categoria), y = tasa,
text = paste0(Categoria, "<br>Clientes: ", fmt0(n), "<br>Aceptación: ", pct(tasa)))) +
geom_col(fill = azul, width = 0.7) +
geom_hline(yintercept = tasa, linetype = "dashed", color = rojo) +
coord_flip() +
scale_y_continuous(labels = eje_pct) +
labs(x = NULL, y = "Tasa de aceptación") + tema
interactivo(g7, 470)Fuente:La línea punteada representa la tasa general de aceptación.
Los estudiantes (30,2 %) y los jubilados (24,7 %) son los grupos que más aceptan el depósito, lo que concuerda con la forma de U observada en la edad. En el otro extremo están los obreros (7,0 %) y los trabajadores de servicios (8,0 %), que además son grupos grandes dentro de la base.
Figura 8
Tasa de aceptación según el resultado de la campaña anterior y el tipo de contacto
d8 <- tab_cat |> filter(Variable %in% c("Campaña anterior", "Tipo de contacto"))
g8 <- ggplot(d8, aes(x = Categoria, y = tasa,
text = paste0(Categoria, "<br>Clientes: ", fmt0(n), "<br>Aceptación: ", pct(tasa)))) +
geom_col(fill = azul, width = 0.6) +
facet_wrap(~ Variable, scales = "free_x") +
scale_y_continuous(labels = eje_pct) +
labs(x = NULL, y = NULL) + tema
interactivo(g8, 430)El eje vertical indica la tasa de aceptación de cada categoría.
La Figura 8 presenta las dos variables con las diferencias más claras. Cuando el cliente había aceptado en la campaña anterior, la tasa de aceptación llega al 64,6 %, casi seis veces la tasa general, mientras que entre los clientes sin campaña previa es de apenas 8,8 %. En cuanto al canal, los clientes contactados por celular aceptan en un 14,5 %, frente al 5,2 % de los contactados por teléfono fijo.
Figura 9
Tasa de aceptación según educación, estado civil y créditos con el banco
d9 <- tab_cat |> filter(Variable %in% c("Educación", "Estado civil", "Crédito de vivienda", "Préstamo personal")) |>
mutate(Variable = factor(Variable, levels = c("Educación", "Estado civil", "Crédito de vivienda", "Préstamo personal")))
g9 <- ggplot(d9, aes(x = Categoria, y = tasa,
text = paste0(Variable, ": ", Categoria, "<br>Clientes: ", fmt0(n), "<br>Aceptación: ", pct(tasa)))) +
geom_col(fill = azul, width = 0.6) +
geom_hline(yintercept = tasa, linetype = "dashed", color = rojo) +
facet_wrap(~ Variable, scales = "free_x", ncol = 2) +
scale_y_continuous(labels = eje_pct) +
labs(x = NULL, y = NULL) + tema
interactivo(g9, 560)El eje vertical indica la tasa de aceptación de cada categoría y la línea punteada la tasa general.
Las variables de la Figura 9 generan diferencias más pequeñas. Por nivel educativo, la tasa aumenta con la formación y va del 8,7 % en educación básica al 13,7 % en universitaria. Los solteros aceptan un poco más que los casados (13,7 % frente a 10,1 %), y tener crédito de vivienda o préstamo personal casi no cambia la tasa de aceptación, lo que indica que estas variables tendrán poco peso en los modelos.
Figura 10
Tasa de aceptación según grupo de edad y nivel de la tasa Euribor
d10 <- base |>
mutate(grupo = cut(edad, c(16, 25, 35, 45, 55, 65, 100),
labels = c("17-25", "26-35", "36-45", "46-55", "56-65", "66 o más")),
tramo = cut(euribor_3m, c(0, 1, 2, 3, 4, 5.1), labels = c("0–1 %", "1–2 %", "2–3 %", "3–4 %", "4–5 %"))) |>
group_by(grupo, tramo) |> summarise(n = n(), tasa = mean(suscribio == "Si"), .groups = "drop") |>
filter(n >= 30)
g10 <- ggplot(d10, aes(x = tramo, y = grupo, fill = tasa,
text = paste0("Edad: ", grupo, "<br>Euribor: ", tramo, "<br>Clientes: ", fmt0(n),
"<br>Aceptación: ", pct(tasa)))) +
geom_tile(color = "white") +
geom_text(aes(label = pct(tasa, 0)), family = "Times New Roman", size = 4) +
scale_fill_gradient(low = "#F2F2F2", high = azul, labels = eje_pct, name = "Aceptación") +
labs(x = "Tasa Euribor a 3 meses", y = "Grupo de edad (años)") + tema
interactivo(g10, 450)Se muestran solo las combinaciones con al menos 30 clientes; entre el 2 % y el 4 % de Euribor casi no hubo contactos.
La Figura 10 cruza las dos variables que más llaman la atención en el análisis individual. Con el Euribor por debajo del 1 %, la aceptación supera el 40 % en todos los grupos de edad, lo que indica que el entorno económico pesa más que el perfil del cliente. Con tasas entre el 1 % y el 2 % vuelve a aparecer la forma de U de la edad, ya que los jóvenes y los mayores de 55 años aceptan más que los grupos intermedios. Con tasas por encima del 4 %, la aceptación es baja para todas las edades.
Figura 11
Matriz de correlaciones entre las variables numéricas y la aceptación
vars_cor <- c(edad = "Edad", contactos_campana = "Contactos campaña", contactos_previos = "Contactos previos",
euribor_3m = "Euribor 3m", acepto = "Aceptó (1 = sí)")
mat <- cor(base |> mutate(acepto = as.numeric(suscribio == "Si")) |> select(all_of(names(vars_cor))))
d11 <- as.data.frame(as.table(mat)) |>
mutate(Var1 = factor(vars_cor[as.character(Var1)], levels = vars_cor),
Var2 = factor(vars_cor[as.character(Var2)], levels = rev(vars_cor)))
g11 <- ggplot(d11, aes(x = Var1, y = Var2, fill = Freq,
text = paste0(Var1, " y ", Var2, "<br>r = ", fmt(Freq, 3)))) +
geom_tile(color = "white") +
geom_text(aes(label = fmt(Freq, 2)), family = "Times New Roman", size = 4) +
scale_fill_gradient2(low = rojo, mid = "white", high = azul, limits = c(-1, 1), name = "r") +
labs(x = NULL, y = NULL) + tema
interactivo(g11, 470)La correlación con la aceptación se calculó con la variable codificada como 1 si el cliente aceptó y 0 si no.
Las correlaciones entre las variables numéricas son bajas en general, lo que indica que cada una aporta información diferente a los modelos. La única relación moderada es la de los contactos previos con la tasa Euribor (r = -0,45), porque las campañas anteriores se concentraron en el periodo de tasas bajas. Frente a la aceptación, la variable con mayor correlación es la tasa Euribor (r = -0,30), seguida de los contactos previos (r = 0,22), mientras que la edad casi no tiene correlación lineal (r = 0,03), lo que es coherente con su relación en forma de U.
En síntesis, el análisis descriptivo indica que la historia comercial del cliente, el canal de contacto, la tasa de interés del momento y la edad son las variables que más separan a quienes aceptan de quienes no, lo que permite anticipar que serán las de mayor peso en los modelos.
La clasificación es una de las tareas principales del aprendizaje supervisado. A partir de un conjunto de observaciones cuya clase ya se conoce, el modelo aprende la relación entre las variables y la clase, y después la usa para predecir la clase de observaciones nuevas. En este caso, el modelo aprende de los clientes que ya fueron contactados para estimar qué tan probable es que un cliente nuevo acepte el depósito.
set.seed(2026)
idx <- createDataPartition(base$suscribio, p = 0.7, list = FALSE)
entrena_total <- base[idx, ]
prueba <- base[-idx, ]
si <- filter(entrena_total, suscribio == "Si")
no <- filter(entrena_total, suscribio == "No") |> slice_sample(n = nrow(si))
entrena <- bind_rows(si, no) |> slice_sample(prop = 1)
n_prueba <- nrow(prueba); si_prueba <- sum(prueba$suscribio == "Si")La base se dividió de forma estratificada en un 70 % para entrenamiento (26.764 clientes) y un 30 % para prueba (11.470 clientes), manteniendo en ambas partes la misma proporción de aceptación. Como solo el 11,1 % de los clientes acepta, un modelo entrenado con la base original tendería a predecir “No” para casi todos. Para evitarlo, el conjunto de entrenamiento se balanceó tomando todos los clientes que aceptaron y una muestra aleatoria del mismo tamaño de los que no aceptaron. El conjunto de prueba se dejó con la proporción real, para evaluar los modelos en condiciones parecidas a las de una campaña verdadera.
Tabla 7
Distribución de la variable dependiente en cada conjunto de datos
resumen_conjunto <- function(d, nombre) data.frame(Conjunto = nombre, Clientes = fmt0(nrow(d)),
`Aceptaron` = fmt0(sum(d$suscribio == "Si")), `No aceptaron` = fmt0(sum(d$suscribio == "No")),
`Tasa de aceptación` = pct(mean(d$suscribio == "Si")), check.names = FALSE)
kable(bind_rows(resumen_conjunto(base, "Base completa"),
resumen_conjunto(entrena_total, "Entrenamiento (70 %)"),
resumen_conjunto(entrena, "Entrenamiento balanceado"),
resumen_conjunto(prueba, "Prueba (30 %)")),
align = c("l", rep("r", 4)))| Conjunto | Clientes | Aceptaron | No aceptaron | Tasa de aceptación |
|---|---|---|---|---|
| Base completa | 38.234 | 4.257 | 33.977 | 11,1 % |
| Entrenamiento (70 %) | 26.764 | 2.980 | 23.784 | 11,1 % |
| Entrenamiento balanceado | 5.960 | 2.980 | 2.980 | 50,0 % |
| Prueba (30 %) | 11.470 | 1.277 | 10.193 | 11,1 % |
La Tabla 7 confirma que la partición conservó la tasa de aceptación de la base completa y que el conjunto balanceado, con 5.960 clientes, quedó con la mitad de clientes en cada clase. Todos los modelos se entrenaron con este conjunto balanceado y se evaluaron con el conjunto de prueba.
El KNN es un algoritmo no paramétrico que no construye una ecuación durante el entrenamiento, sino que guarda los datos y, al momento de predecir, busca los k clientes más parecidos al cliente nuevo. La clase que más se repite entre esos vecinos es la que se le asigna, y la proporción de vecinos que aceptaron se puede usar como una estimación de su probabilidad de aceptar. El resultado depende del valor de k: con pocos vecinos el modelo se ajusta demasiado a casos puntuales y con muchos vecinos pierde detalle.
En una primera versión se usó la función knn del paquete class, que solo trabaja con variables numéricas. Por eso se incluyeron únicamente la edad, los contactos en la campaña, los contactos previos y la tasa Euribor, estandarizadas con la media y la desviación estándar del conjunto de entrenamiento. Para escoger k se evaluaron los valores entre 1 y 100 con validación cruzada dejando uno fuera, que clasifica a cada cliente del entrenamiento usando a todos los demás. De esta forma el valor de k se elige sin usar el conjunto de prueba, que se reserva solo para la evaluación final.
vars_num <- c("edad", "contactos_campana", "contactos_previos", "euribor_3m")
knn_basico <- withr::with_seed(2026, {
escala <- preProcess(entrena[, vars_num], method = c("center", "scale"))
x_entrena <- predict(escala, entrena[, vars_num])
x_prueba <- predict(escala, prueba[, vars_num])
exactitud_k <- sapply(1:100, function(k) mean(knn.cv(x_entrena, entrena$suscribio, k = k) == entrena$suscribio))
k_mejor <- which.max(exactitud_k)
pred <- knn(x_entrena, x_prueba, entrena$suscribio, k = k_mejor, prob = TRUE)
list(exactitud_k = exactitud_k, k = k_mejor, pred = pred)
})
k_basico <- knn_basico$k
clase_basico <- knn_basico$pred
prob_basico <- ifelse(clase_basico == "Si", attr(clase_basico, "prob"), 1 - attr(clase_basico, "prob"))
cm_basico <- confusionMatrix(clase_basico, prueba$suscribio, positive = "Si")
roc_basico <- curva_roc(prueba$suscribio, prob_basico)
m_basico <- metricas(cm_basico, roc_basico)Figura 12
Exactitud del KNN básico según el número de vecinos (validación cruzada dejando uno fuera)
d12 <- data.frame(k = 1:100, exactitud = knn_basico$exactitud_k)
g12 <- ggplot(d12, aes(x = k, y = exactitud, text = paste0("k = ", k, "<br>Exactitud: ", pct(exactitud)))) +
geom_line(color = azul, linewidth = 1, aes(group = 1)) + geom_point(color = azul, size = 1.5) +
geom_vline(xintercept = k_basico, linetype = "dashed", color = rojo) +
scale_y_continuous(labels = eje_pct) +
labs(x = "Número de vecinos (k)", y = "Exactitud en validación cruzada") + tema
interactivo(g12)La línea punteada señala el valor de k seleccionado.
La exactitud en validación cruzada sube rápidamente entre k = 1 (63,7 %) y k = 20, y a partir de ese punto se mantiene casi constante. El valor seleccionado fue k = 32, con una exactitud de 71,1 % en el entrenamiento balanceado. En el conjunto de prueba, este modelo detectó 825 de los 1.277 clientes que aceptaron (sensibilidad de 64,6 %), con una exactitud de 76,6 % y un AUC de 0,755.
En la segunda versión se usó la función train del paquete caret, que permite incluir todas las variables del estudio. Las variables categóricas se convirtieron automáticamente en variables indicadoras, todas las variables se estandarizaron y el valor de k se escogió con validación cruzada de cinco grupos, probando valores entre 5 y 101 y usando el AUC como criterio de selección.
ctrl <- trainControl(method = "cv", number = 5, classProbs = TRUE, summaryFunction = twoClassSummary)
modelo_knn <- train(suscribio ~ ., data = entrena, method = "knn",
preProcess = c("center", "scale"),
tuneGrid = data.frame(k = seq(5, 101, 4)),
trControl = ctrl, metric = "ROC")
k_opt <- modelo_knn$bestTune$k
prob_knn <- predict(modelo_knn, prueba, type = "prob")$Si
clase_knn <- predict(modelo_knn, prueba)
cm_knn <- confusionMatrix(clase_knn, prueba$suscribio, positive = "Si")
roc_knn <- curva_roc(prueba$suscribio, prob_knn)
m_knn <- metricas(cm_knn, roc_knn)Figura 13
Selección del número de vecinos (k) por validación cruzada en el KNN con caret
d13 <- modelo_knn$results
g13 <- ggplot(d13, aes(x = k, y = ROC, text = paste0("k = ", k, "<br>AUC = ", fmt(ROC, 4)))) +
geom_line(color = azul, linewidth = 1, aes(group = 1)) + geom_point(color = azul, size = 2) +
geom_vline(xintercept = k_opt, linetype = "dashed", color = rojo) +
labs(x = "Número de vecinos (k)", y = "AUC en validación cruzada") + tema
interactivo(g13)La línea punteada señala el valor de k seleccionado.
El AUC en validación cruzada aumenta rápidamente con los primeros valores de k y después se estabiliza. El valor seleccionado fue k = 77, con un AUC de 0,7429 en el entrenamiento. En el conjunto de prueba, el modelo detectó 794 de los 1.277 clientes que aceptaron, lo que equivale a una sensibilidad de 62,2 %, con una exactitud de 75,5 % y un AUC de 0,753.
Tabla 8
Desempeño de las dos versiones del KNN en el conjunto de prueba
kable(data.frame(`Métrica` = nombres_m[names(m_basico)],
`KNN básico (class)` = fmt(m_basico, 3), `KNN con caret` = fmt(m_knn, 3), check.names = FALSE),
row.names = FALSE, align = c("l", "r", "r"))| Métrica | KNN básico (class) | KNN con caret |
|---|---|---|
| Exactitud | 0,766 | 0,755 |
| Sensibilidad | 0,646 | 0,622 |
| Especificidad | 0,781 | 0,772 |
| Precisión | 0,270 | 0,254 |
| Puntaje F1 | 0,380 | 0,361 |
| Kappa | 0,265 | 0,241 |
| AUC | 0,755 | 0,753 |
KNN básico con k = 32 y cuatro variables numéricas; KNN con caret con k = 77 y todas las variables.
La Tabla 8 muestra que las dos versiones del KNN tienen un desempeño muy parecido. El KNN básico es incluso ligeramente superior en todas las métricas, con diferencias menores a tres puntos, a pesar de que la versión con caret usa todas las variables. Esto indica que la mayor parte de la información útil para el KNN está en las variables numéricas, sobre todo en la tasa Euribor y los contactos previos, y que agregar las categóricas como variables indicadoras no mejora la distancia entre clientes. Para la comparación final se tomó el KNN con caret, porque usa exactamente las mismas variables que el modelo logit y así la comparación entre los dos métodos es justa.
La regresión logística es un modelo paramétrico que estima la probabilidad de que un cliente acepte a partir de una combinación lineal de las variables, transformada con la función logística para que el resultado quede entre 0 y 1. A diferencia del KNN, el logit produce una ecuación explícita, por lo que se puede saber en qué dirección y en qué magnitud influye cada variable. El modelo se estimó con la función glm y familia binomial, usando el mismo conjunto de entrenamiento balanceado.
modelo_logit <- glm(relevel(suscribio, ref = "No") ~ ., data = entrena, family = binomial)
prob_logit <- predict(modelo_logit, prueba, type = "response")
clase_logit <- factor(ifelse(prob_logit >= 0.5, "Si", "No"), levels = c("Si", "No"))
cm_logit <- confusionMatrix(clase_logit, prueba$suscribio, positive = "Si")
roc_logit <- curva_roc(prueba$suscribio, prob_logit)
m_logit <- metricas(cm_logit, roc_logit)
coefs <- summary(modelo_logit)$coefficients
or <- exp(coef(modelo_logit)); ic_or <- exp(suppressMessages(confint.default(modelo_logit)))
orv <- function(t) unname(or[t]); pvv <- function(t) unname(coefs[t, 4])
cambio <- function(t) 100 * (orv(t) - 1)
nom <- rownames(coefs)
nom <- gsub("^ocupacion", "Ocupación: ", nom); nom <- gsub("^estado_civil", "Estado civil: ", nom)
nom <- gsub("^educacion", "Educación: ", nom); nom <- gsub("^credito_vivienda", "Crédito de vivienda: ", nom)
nom <- gsub("^prestamo_personal", "Préstamo personal: ", nom); nom <- gsub("^tipo_contacto", "Contacto: ", nom)
nom <- gsub("^resultado_campana_anterior", "Campaña anterior: ", nom)
nom <- recode(nom, "(Intercept)" = "Intercepto", edad = "Edad", contactos_campana = "Contactos en la campaña",
contactos_previos = "Contactos previos", euribor_3m = "Euribor 3 meses")Tabla 9
Resultados del modelo de regresión logística
kable(data.frame(Variable = nom, Coeficiente = fmt(coefs[, 1], 3), `Error estándar` = fmt(coefs[, 2], 3),
`Valor p` = ifelse(coefs[, 4] < 0.001, "< 0,001", fmt(coefs[, 4], 3)),
`Odds ratio` = fmt(or, 3),
`IC 95 % OR` = paste0("[", fmt(ic_or[, 1], 3), "; ", fmt(ic_or[, 2], 3), "]"),
check.names = FALSE),
row.names = FALSE, align = c("l", rep("r", 5)))| Variable | Coeficiente | Error estándar | Valor p | Odds ratio | IC 95 % OR |
|---|---|---|---|---|---|
| Intercepto | 1,301 | 0,199 | < 0,001 | 3,673 | [2,488; 5,421] |
| Edad | -0,003 | 0,003 | 0,432 | 0,997 | [0,991; 1,004] |
| Ocupación: Desempleado | 0,182 | 0,198 | 0,359 | 1,199 | [0,813; 1,768] |
| Ocupación: Empleada doméstica | 0,032 | 0,206 | 0,875 | 1,033 | [0,690; 1,546] |
| Ocupación: Empresario | -0,057 | 0,170 | 0,737 | 0,944 | [0,676; 1,319] |
| Ocupación: Estudiante | 0,358 | 0,198 | 0,070 | 1,431 | [0,971; 2,108] |
| Ocupación: Gerencial | -0,094 | 0,124 | 0,448 | 0,910 | [0,714; 1,161] |
| Ocupación: Independiente | 0,007 | 0,173 | 0,969 | 1,007 | [0,718; 1,412] |
| Ocupación: Jubilado | 0,718 | 0,168 | < 0,001 | 2,051 | [1,474; 2,854] |
| Ocupación: Obrero | -0,203 | 0,113 | 0,074 | 0,817 | [0,654; 1,020] |
| Ocupación: Servicios | -0,230 | 0,122 | 0,060 | 0,795 | [0,625; 1,010] |
| Ocupación: Técnico | -0,098 | 0,101 | 0,334 | 0,907 | [0,743; 1,106] |
| Estado civil: Divorciado o viudo | 0,041 | 0,098 | 0,674 | 1,042 | [0,860; 1,263] |
| Estado civil: Soltero | 0,017 | 0,075 | 0,823 | 1,017 | [0,879; 1,177] |
| Educación: Bachillerato | 0,178 | 0,099 | 0,074 | 1,195 | [0,983; 1,452] |
| Educación: Técnica | 0,223 | 0,118 | 0,058 | 1,250 | [0,993; 1,573] |
| Educación: Universitaria | 0,275 | 0,102 | 0,007 | 1,317 | [1,079; 1,608] |
| Crédito de vivienda: Sí | -0,084 | 0,060 | 0,158 | 0,919 | [0,818; 1,033] |
| Préstamo personal: Sí | -0,123 | 0,081 | 0,131 | 0,885 | [0,754; 1,037] |
| Contacto: Teléfono fijo | -0,254 | 0,073 | < 0,001 | 0,776 | [0,672; 0,895] |
| Contactos en la campaña | -0,042 | 0,014 | 0,003 | 0,959 | [0,932; 0,986] |
| Contactos previos | 0,297 | 0,130 | 0,022 | 1,346 | [1,044; 1,737] |
| Campaña anterior: Fracaso | -0,818 | 0,180 | < 0,001 | 0,441 | [0,310; 0,629] |
| Campaña anterior: Éxito | 1,400 | 0,259 | < 0,001 | 4,056 | [2,440; 6,741] |
| Euribor 3 meses | -0,393 | 0,019 | < 0,001 | 0,675 | [0,650; 0,701] |
Categorías de referencia: Administrativo, Casado, educación básica, sin crédito de vivienda, sin préstamo personal, celular y sin campaña previa. Modelo estimado con el conjunto de entrenamiento balanceado.
El historial con el banco es la variable con mayor efecto. Haber aceptado en la campaña anterior multiplica por 4,06 las probabilidades de aceptar frente a un cliente sin campaña previa (p < 0,001), mientras que haber rechazado la campaña anterior las reduce en 56 %. Cada llamada adicional en campañas anteriores aumenta las probabilidades en un 35 %.
En cuanto al entorno económico, cada punto porcentual adicional en la tasa Euribor reduce las probabilidades de aceptar en un 33 % (p < 0,001). Ser contactado por teléfono fijo en lugar de celular las reduce en un 22 %, y cada llamada adicional en la campaña actual las reduce en un 4,1 %, lo que confirma que insistir no mejora el resultado.
Entre las variables del perfil, los jubilados tienen 2,05 veces las probabilidades de aceptar de un empleado administrativo (p < 0,001) y los clientes con educación universitaria 1,32 veces las de uno con educación básica (p = 0,007). El estado civil, el crédito de vivienda y el préstamo personal no resultaron significativos, y la edad tampoco lo fue (p = 0,432). Esto último se explica porque su relación con la aceptación tiene forma de U (Figura 4) y el modelo logit la representa como una línea; además, parte de su efecto ya lo recogen las categorías de estudiante y jubilado.
Figura 14
Razones de probabilidades (odds ratios) del modelo logit con su intervalo de confianza del 95 %
d14 <- data.frame(Variable = nom, or = or, li = ic_or[, 1], ls = ic_or[, 2], p = coefs[, 4]) |>
filter(Variable != "Intercepto") |>
mutate(Efecto = case_when(p >= 0.05 ~ "No significativo", or > 1 ~ "Aumenta la aceptación", TRUE ~ "Reduce la aceptación"),
Variable = reorder(Variable, or))
g14 <- ggplot(d14, aes(y = Variable, color = Efecto,
text = paste0(Variable, "<br>Odds ratio: ", fmt(or, 3), "<br>IC 95 %: [", fmt(li, 3), "; ", fmt(ls, 3), "]",
"<br>", ptxt(p)))) +
geom_vline(xintercept = 1, linetype = "dashed", color = gris) +
geom_segment(aes(x = li, xend = ls, yend = Variable), linewidth = 0.8) +
geom_point(aes(x = or), size = 2.5) +
scale_x_log10() +
scale_color_manual(values = c("Aumenta la aceptación" = azul, "Reduce la aceptación" = rojo, "No significativo" = gris), name = NULL) +
labs(x = "Odds ratio (escala logarítmica)", y = NULL) + tema
interactivo(g14, 620)La línea punteada en 1 indica ausencia de efecto; se consideran significativas las variables con p < 0,05.
La Figura 14 resume visualmente la Tabla 9. Las variables a la derecha de la línea punteada aumentan la probabilidad de aceptar y las de la izquierda la reducen. Del lado positivo se destacan el éxito en la campaña anterior, la ocupación de jubilado, los contactos previos y la educación universitaria; del lado negativo, el fracaso en la campaña anterior, la tasa Euribor, el contacto por teléfono fijo y el número de llamadas en la campaña. Las variables en gris tienen intervalos que cruzan el valor 1, por lo que no se puede afirmar que tengan un efecto distinto de cero.
En el conjunto de prueba, con el umbral de 0,5, el modelo logit detectó 886 de los 1.277 clientes que aceptaron, con una sensibilidad de 69,4 %, una exactitud de 74,5 % y un AUC de 0,769.
El umbral de 0,5 es el más usado, pero no es necesariamente el mejor para todos los problemas. Al bajarlo, el modelo señala a más clientes como interesados y aumenta la sensibilidad, a costa de más llamadas a clientes que no aceptan; al subirlo ocurre lo contrario. Para analizar este efecto se calcularon las métricas del logit en el conjunto de prueba con umbrales entre 0,05 y 0,95, y se obtuvo el umbral que maximiza el índice de Youden con las probabilidades del conjunto de entrenamiento.
prob_entrena <- predict(modelo_logit, type = "response")
roc_entrena <- curva_roc(entrena$suscribio, prob_entrena)
umbral_youden <- coords(roc_entrena, "best", best.method = "youden", ret = "threshold")$threshold[1]
d15 <- bind_rows(lapply(seq(0.05, 0.95, 0.01), function(u) {
cm <- confusionMatrix(factor(ifelse(prob_logit >= u, "Si", "No"), levels = c("Si", "No")),
prueba$suscribio, positive = "Si")
data.frame(umbral = u, Metrica = c("Exactitud", "Sensibilidad", "Especificidad", "Precisión"),
Valor = c(cm$overall["Accuracy"], cm$byClass[c("Sensitivity", "Specificity", "Pos Pred Value")]))
})) |> filter(!is.na(Valor))
clase_youden <- factor(ifelse(prob_logit >= umbral_youden, "Si", "No"), levels = c("Si", "No"))
cm_youden <- confusionMatrix(clase_youden, prueba$suscribio, positive = "Si")
m_youden <- metricas(cm_youden, roc_logit)Figura 15
Métricas del modelo logit en el conjunto de prueba según el umbral de clasificación
g15 <- ggplot(d15, aes(x = umbral, y = Valor, color = Metrica, group = Metrica,
text = paste0(Metrica, "<br>Umbral: ", fmt(umbral, 2), "<br>Valor: ", fmt(Valor, 3)))) +
geom_line(linewidth = 1.1) +
geom_vline(xintercept = 0.5, linetype = "dotted", color = gris) +
geom_vline(xintercept = umbral_youden, linetype = "dashed", color = rojo) +
scale_color_manual(values = c("Exactitud" = "#000000", "Sensibilidad" = azul, "Especificidad" = gris, "Precisión" = "#7F9FBF"), name = NULL) +
scale_y_continuous(limits = c(0, 1)) +
labs(x = "Umbral de clasificación", y = "Valor de la métrica") + tema
interactivo(g15, 450)La línea punteada gris marca el umbral de 0,5 y la línea discontinua roja el umbral de Youden (0,567).
Tabla 10
Desempeño del modelo logit con el umbral de 0,5 y con el umbral de Youden
sel <- c("Exactitud", "Sensibilidad", "Especificidad", "Precision", "F1", "Kappa")
kable(data.frame(`Métrica` = c(nombres_m[sel], "Interesados detectados", "Clientes señalados como Sí"),
`Umbral 0,5` = c(fmt(m_logit[sel], 3), fmt0(vp(cm_logit)), fmt0(sum(clase_logit == "Si"))),
`Umbral de Youden` = c(fmt(m_youden[sel], 3), fmt0(vp(cm_youden)), fmt0(sum(clase_youden == "Si"))),
check.names = FALSE),
row.names = FALSE, align = c("l", "r", "r"))| Métrica | Umbral 0,5 | Umbral de Youden |
|---|---|---|
| Exactitud | 0,745 | 0,781 |
| Sensibilidad | 0,694 | 0,658 |
| Especificidad | 0,751 | 0,796 |
| Precisión | 0,259 | 0,288 |
| Puntaje F1 | 0,377 | 0,400 |
| Kappa | 0,257 | 0,290 |
| Interesados detectados | 886 | 840 |
| Clientes señalados como Sí | 3.422 | 2.920 |
El AUC no cambia con el umbral (0,769).
El umbral de Youden obtenido fue de 0,567, un poco mayor que 0,5. Con este valor el modelo señala a menos clientes como interesados, por lo que la exactitud sube a 78,1 % y la precisión a 28,8 %, pero la sensibilidad baja a 65,8 %, es decir, se dejan de detectar 46 clientes interesados. La Figura 15 muestra que no existe un umbral que mejore todas las métricas al tiempo, por lo que su elección es una decisión de negocio: si el costo de una llamada es bajo frente a la ganancia de un depósito, conviene un umbral bajo que priorice la sensibilidad. Por esta razón, y para mantener la comparación en igualdad de condiciones con el KNN, en la comparación final se conservó el umbral de 0,5.
Tabla 11
Matrices de confusión de los modelos en el conjunto de prueba
mejor <- function(m) ifelse(m_knn[m] > m_logit[m], "KNN", "Logit")
mc <- function(cm, nombre) data.frame(Modelo = nombre,
`Predicción` = c("Sí", "No"),
`Real: Sí` = fmt0(c(cm$table["Si", "Si"], cm$table["No", "Si"])),
`Real: No` = fmt0(c(cm$table["Si", "No"], cm$table["No", "No"])), check.names = FALSE)
kable(bind_rows(mc(cm_knn, paste0("KNN (k = ", k_opt, ")")), mc(cm_logit, "Logit")), align = c("l", "l", "r", "r"))| Modelo | Predicción | Real: Sí | Real: No |
|---|---|---|---|
| KNN (k = 77) | Sí | 794 | 2.326 |
| KNN (k = 77) | No | 483 | 7.867 |
| Logit | Sí | 886 | 2.536 |
| Logit | No | 391 | 7.657 |
n = 11.470 clientes del conjunto de prueba.
Tabla 12
Métricas de desempeño de los modelos en el conjunto de prueba
kable(data.frame(`Métrica` = nombres_m[names(m_knn)], KNN = fmt(m_knn, 3), Logit = fmt(m_logit, 3),
`Mejor modelo` = sapply(names(m_knn), mejor), check.names = FALSE),
row.names = FALSE, align = c("l", "r", "r", "c"))| Métrica | KNN | Logit | Mejor modelo |
|---|---|---|---|
| Exactitud | 0,755 | 0,745 | KNN |
| Sensibilidad | 0,622 | 0,694 | Logit |
| Especificidad | 0,772 | 0,751 | KNN |
| Precisión | 0,254 | 0,259 | Logit |
| Puntaje F1 | 0,361 | 0,377 | Logit |
| Kappa | 0,241 | 0,257 | Logit |
| AUC | 0,753 | 0,769 | Logit |
KNN con caret y logit con umbral de 0,5.
Figura 16
Comparación de las métricas de desempeño de los modelos
d16 <- data.frame(Metrica = factor(rep(nombres_m[names(m_knn)], 2), levels = nombres_m),
Modelo = rep(c("KNN", "Logit"), each = 7), Valor = c(m_knn, m_logit))
g16 <- ggplot(d16, aes(x = Metrica, y = Valor, fill = Modelo,
text = paste0(Modelo, "<br>", Metrica, ": ", fmt(Valor, 3)))) +
geom_col(position = "dodge", width = 0.7) +
scale_fill_manual(values = c("KNN" = gris, "Logit" = azul), name = NULL) +
scale_y_continuous(limits = c(0, 1)) +
labs(x = NULL, y = "Valor de la métrica") + tema
interactivo(g16, 450)Figura 17
Curvas ROC de los modelos en el conjunto de prueba
curva <- function(r, nombre) {
d <- data.frame(fpr = 1 - r$specificities, tpr = r$sensitivities)
d <- d[order(d$fpr, d$tpr), ]
d <- d[unique(round(seq(1, nrow(d), length.out = 300))), ]
d$Modelo <- paste0(nombre, " (AUC = ", fmt(as.numeric(auc(r)), 3), ")")
d
}
d17 <- bind_rows(curva(roc_knn, "KNN"), curva(roc_logit, "Logit"))
g17 <- ggplot(d17, aes(x = fpr, y = tpr, color = Modelo, group = Modelo,
text = paste0(Modelo, "<br>Falsos positivos: ", pct(fpr), "<br>Sensibilidad: ", pct(tpr)))) +
geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = gris) +
geom_line(linewidth = 1.1) +
scale_color_manual(values = setNames(c(gris, azul), unique(d17$Modelo)), name = NULL) +
labs(x = "Tasa de falsos positivos (1 − especificidad)", y = "Sensibilidad") + tema
interactivo(g17, 470)La línea punteada representa una clasificación al azar.
Figura 18
Curva de ganancia acumulada: clientes interesados alcanzados según el porcentaje de la base contactada
ganancia <- function(p) {
o <- order(p, decreasing = TRUE)
y <- prueba$suscribio[o] == "Si"
data.frame(contactados = seq_along(y) / length(y), capturados = cumsum(y) / sum(y))
}
g_knn <- ganancia(prob_knn); g_logit <- ganancia(prob_logit)
cap20 <- function(g) g$capturados[round(0.2 * nrow(g))]
fino <- function(g, nombre) { g <- g[unique(round(seq(1, nrow(g), length.out = 200))), ]; g$Modelo <- nombre; g }
d18 <- bind_rows(fino(g_knn, "KNN"), fino(g_logit, "Logit"))
g18 <- ggplot(d18, aes(x = contactados, y = capturados, color = Modelo, group = Modelo,
text = paste0(Modelo, "<br>Base contactada: ", pct(contactados, 0),
"<br>Interesados alcanzados: ", pct(capturados)))) +
geom_abline(intercept = 0, slope = 1, linetype = "dashed", color = gris) +
geom_vline(xintercept = 0.2, linetype = "dotted", color = rojo) +
geom_line(linewidth = 1.1) +
scale_color_manual(values = c("KNN" = gris, "Logit" = azul), name = NULL) +
scale_x_continuous(labels = eje_pct) +
scale_y_continuous(labels = eje_pct) +
labs(x = "Porcentaje de clientes contactados (ordenados por probabilidad)",
y = "Porcentaje de interesados alcanzados") + tema
interactivo(g18, 470)La línea punteada diagonal representa llamar a los clientes al azar; la línea vertical marca el 20 % de la base.
En exactitud, el mejor modelo fue KNN (75,5 % frente a 74,5 %). Sin embargo, en un problema con clases desbalanceadas esta métrica no es la más importante, porque está dominada por los clientes que no aceptan. Para el banco lo relevante es encontrar a los clientes interesados, y en esa tarea el modelo con mayor sensibilidad fue Logit: el logit detectó 886 clientes interesados frente a 794 del KNN, es decir, 92 ventas potenciales de diferencia en el conjunto de prueba.
La especificidad fue mayor en KNN, lo que significa que este modelo genera menos llamadas a clientes que no van a aceptar. En precisión, puntaje F1 y kappa el mejor fue Logit, aunque en ambos modelos la precisión es baja (25,4 % y 25,9 %): de cada cuatro clientes que el modelo señala como interesados, aproximadamente uno acepta. Esto es esperable cuando solo el 11,1 % de la población acepta, y aun así representa más del doble de la tasa que se obtendría llamando al azar.
El AUC, que mide la capacidad de ordenar a los clientes de mayor a menor probabilidad sin depender del umbral, fue mayor en Logit (0,769 frente a 0,753). Las curvas ROC de la Figura 17 muestran que la curva del logit queda por encima de la del KNN en casi todo el recorrido. La curva de ganancia (Figura 18) traduce esta diferencia a términos de negocio: si el banco llamara solo al 20 % de los clientes con mayor probabilidad según el logit, alcanzaría el 59,4 % de todos los interesados; con el KNN alcanzaría el 53,2 %, y llamando al azar solo el 20 %.
El KNN básico de la Tabla 8 obtuvo resultados cercanos a los del KNN con caret, con un AUC de 0,755 y una sensibilidad de 64,6 %, pero tampoco supera al logit en estas dos métricas, que son las más importantes para el objetivo del estudio; solo lo supera por un margen pequeño en exactitud, F1 y kappa. Por lo tanto, la conclusión de la comparación no depende de la versión del KNN que se utilice.
De acuerdo con estos resultados, el modelo recomendado para este problema es la regresión logística. Aunque el KNN obtuvo una exactitud ligeramente mayor, el logit detecta más clientes interesados, ordena mejor a los clientes según su probabilidad de aceptar y permite explicar qué variables influyen en la decisión y en qué magnitud, algo que el KNN no ofrece. Para un área comercial esta interpretación es tan importante como la predicción, porque permite diseñar la campaña y no solo seleccionar a quién llamar.
Los dos modelos lograron clasificar a los clientes con una capacidad claramente superior al azar, con valores de AUC de 0,753 para el KNN y 0,769 para el logit. La regresión logística resultó más adecuada para el objetivo planteado, porque identifica una mayor proporción de los clientes que aceptan el depósito y sus coeficientes permiten entender el comportamiento del cliente.
Los factores más asociados con la aceptación son el resultado de la campaña anterior, la tasa de interés del mercado, el canal de contacto y el número de llamadas. Los clientes que ya habían aceptado antes, los contactados por celular, los estudiantes y jubilados y los contactados en momentos de tasas bajas tienen una probabilidad mucho mayor de aceptar. En cambio, insistir con muchas llamadas reduce la probabilidad de éxito, y variables como el estado civil o tener créditos con el banco casi no influyen en la decisión.
El análisis de las dos versiones del KNN mostró que las variables numéricas, en especial la tasa Euribor y los contactos previos, concentran la mayor parte de la información útil, y el análisis del umbral mostró que el punto de corte del logit se puede ajustar según lo que el banco quiera priorizar, ya sea detectar más interesados o hacer menos llamadas innecesarias.
Sí. El objetivo era construir y comparar dos modelos para identificar a los clientes con mayor probabilidad de aceptar el depósito y determinar cuál es más útil para priorizar las llamadas. Ambos modelos superan ampliamente la selección al azar, la comparación permitió identificar al logit como la mejor alternativa con argumentos medibles (sensibilidad, AUC y ganancia acumulada) y sus resultados son coherentes con lo observado en el análisis descriptivo. No obstante, la precisión de ambos modelos es moderada, por lo que deben entenderse como una herramienta para ordenar y priorizar la base de clientes y no como una predicción exacta de quién va a aceptar.
A partir de estos hallazgos se proponen las siguientes estrategias: priorizar a los clientes que aceptaron campañas anteriores y a los segmentos de estudiantes y jubilados; preferir el contacto por celular; establecer un límite de dos o tres llamadas por cliente en cada campaña; y usar el modelo logit para ordenar la base y llamar primero al grupo de mayor probabilidad, ya que con solo el 20 % de las llamadas se alcanzaría cerca del 59 % de los clientes interesados. Además, como la tasa de aceptación depende del entorno económico, la intensidad de las campañas debería ajustarse según el nivel de las tasas de interés.
Los datos corresponden a un banco portugués entre 2008 y 2010, un periodo marcado por la crisis financiera, por lo que los resultados no necesariamente se pueden trasladar a otro país o momento. Además, el umbral de clasificación se definió sin conocer el costo real de cada llamada ni la ganancia de cada depósito, información que permitiría escoger un punto de corte óptimo para el negocio. Como extensiones se propone incluir la edad con una forma no lineal en el modelo logit, probar otros modelos de clasificación y validar los resultados con datos de campañas más recientes.
Cover, T., y Hart, P. (1967). Nearest neighbor pattern classification. IEEE Transactions on Information Theory, 13(1), 21–27.
Fawcett, T. (2006). An introduction to ROC analysis. Pattern Recognition Letters, 27(8), 861–874.
Hosmer, D. W., Lemeshow, S., y Sturdivant, R. X. (2013). Applied logistic regression (3.ª ed.). Wiley.
James, G., Witten, D., Hastie, T., y Tibshirani, R. (2021). An introduction to statistical learning: With applications in R (2.ª ed.). Springer.
Kuhn, M. (2008). Building predictive models in R using the caret package. Journal of Statistical Software, 28(5), 1–26.
Moro, S., Cortez, P., y Rita, P. (2014). A data-driven approach to predict the success of bank telemarketing. Decision Support Systems, 62, 22–31.
Moro, S., Rita, P., y Cortez, P. (2014). Bank Marketing [Conjunto de datos]. UCI Machine Learning Repository. https://doi.org/10.24432/C5K306
Robin, X., Turck, N., Hainard, A., Tiberti, N., Lisacek, F., Sanchez, J.-C., y Müller, M. (2011). pROC: An open-source package for R and S+ to analyze and compare ROC curves. BMC Bioinformatics, 12, 77.
Sievert, C. (2020). Interactive web-based data visualization with R, plotly, and shiny. Chapman and Hall/CRC.
Venables, W. N., y Ripley, B. D. (2002). Modern applied statistics with S (4.ª ed.). Springer.
Youden, W. J. (1950). Index for rating diagnostic tests. Cancer, 3(1), 32–35.