El análisis de datos constituye una herramienta importante para estudiar el comportamiento de los clientes y evaluar la capacidad de diferentes métodos estadísticos y computacionales para realizar predicciones. En el sector financiero, las campañas de marketing telefónico permiten ofrecer productos como los depósitos bancarios a plazo fijo, cuya contratación puede variar según las características de los clientes y las condiciones en las que se realizan los contactos.
Para esta investigación se utiliza la base de datos Bank Marketing,
publicada en el repositorio de la Universidad de California en Irvine
(UCI), que contiene información sobre campañas de marketing telefónico
realizadas por una institución bancaria portuguesa. Para el análisis se
utiliza el archivo bank.csv, correspondiente a la versión
de la base que contiene 4.521 observaciones y 17 variables. El objetivo
es estudiar si la información disponible sobre cada cliente y los
contactos previos permite distinguir entre quienes contrataron el
depósito y quienes no lo hicieron.
El estudio se enmarca en el aprendizaje supervisado y tiene como
variable dependiente y, que registra si el cliente contrató
(yes) o no contrató (no) un depósito bancario
a plazo fijo. Para analizar esta variable, se implementan dos métodos de
clasificación: K-Nearest Neighbors (KNN), que clasifica las
observaciones a partir de la proximidad entre ellas, y regresión
logística (Logit), que permite estimar la probabilidad de que un cliente
contrate el producto financiero.
Finalmente, se comparará el desempeño de ambos modelos mediante métricas como la exactitud (accuracy), la sensibilidad, la precisión y el área bajo la curva ROC (AUC), con el propósito de evaluar su capacidad de clasificación e identificar sus diferencias de desempeño.
¿En qué medida los modelos (KNN) y (Logit) permiten predecir la contratación de un depósito bancario a plazo fijo a partir de las características de los clientes y las condiciones de contacto?
Evaluar y comparar el desempeño de los modelos K-Nearest Neighbors
(KNN) y regresión logística (Logit) en la predicción de la contratación
de un depósito bancario a plazo fijo, utilizando las variables
seleccionadas de las 4.521 observaciones del archivo
bank.csv y métricas de evaluación como la exactitud
(accuracy), la sensibilidad, la precisión y el área bajo la curva ROC
(AUC).
Para el desarrollo de esta investigación se utilizó la base de datos Bank Marketing, publicada en el repositorio de la Universidad de California en Irvine (UCI). Esta contiene información de clientes de una institución bancaria portuguesa y de campañas de marketing telefónico orientadas a promover la contratación de depósitos bancarios a plazo fijo. Debido al tamaño de la base de datos original, se realizó una reducción del número de observaciones para trabajar con 4.521 registros y 17 variables. Posteriormente, se revisó la calidad de los datos y se preparó la información para construir los modelos de clasificación KNN y regresión logística. Finalmente, los datos se dividieron en conjuntos de entrenamiento y prueba, con el propósito de evaluar la capacidad de los modelos para predecir si un cliente contrata o no el depósito bancario.
A continuación, se realizó una revisión de la calidad de los datos para identificar valores faltantes, registros duplicados, rangos de edad y posibles valores extremos.
bank <- read.csv2("bank.csv", stringsAsFactors = TRUE) # separador ";"
bank$y <- factor(bank$y, levels = c("no", "yes"))
calidad <- data.frame(
Revisión = c("Clientes (filas)", "Variables (columnas)", "Valores faltantes (NA)",
"Filas duplicadas", "Edad mínima y máxima", "Clientes con saldo negativo"),
Resultado = c(nrow(bank), ncol(bank), sum(is.na(bank)), sum(duplicated(bank)),
paste(min(bank$age), "a", max(bank$age)), sum(bank$balance < 0))
)
tabla_morada(calidad, caption = "Tabla 1. Revisión de calidad de la base")| Revisión | Resultado |
|---|---|
| Clientes (filas) | 4521 |
| Variables (columnas) | 17 |
| Valores faltantes (NA) | 0 |
| Filas duplicadas | 0 |
| Edad mínima y máxima | 19 a 87 |
| Clientes con saldo negativo | 366 |
La base de datos no presenta valores faltantes ni registros duplicados, y las edades se encuentran dentro de un rango plausible. Los saldos negativos de la variable balance se interpretan como posibles cuentas sobregiradas, por lo que no se consideran necesariamente errores de captura. En la variable poutcome, la categoría unknown, que representa el 82,0 % de los clientes, indica que el resultado de una campaña de marketing anterior no está registrado o no se conoce. Esta categoría no significa necesariamente que el cliente no haya participado en una campaña previa; por esta razón, se conservó como una categoría independiente.
Por otra parte, las variables balance (con un valor máximo de 71.188 €) y campaign (con un máximo de 50 contactos durante la campaña actual) presentan valores extremos. Estos registros se conservaron porque pueden corresponder a situaciones reales y no se identificaron, por ese solo hecho, como errores de captura. Sin embargo, estos valores pueden influir en el comportamiento de los modelos. En particular, KNN es sensible a las diferencias de escala entre variables, por lo que se estandarizaron las variables numéricas antes de ajustar el modelo. Esta estandarización ayuda a que las diferencias de escala no dominen el cálculo de distancias, aunque no elimina la influencia de los valores extremos.
vars_x <- c("age", "balance", "campaign", "default", "housing", "loan", "poutcome")
numv <- c("age", "balance", "campaign")
variables <- data.frame(
Variable = c("y", vars_x),
Descripción = c("Contrató el depósito a plazo fijo", "Edad en años", "Saldo promedio anual (€)",
"Contactos realizados en la campaña actual", "Incumplimiento crediticio",
"Crédito hipotecario", "Préstamo personal", "Resultado de la campaña anterior"),
Tipo = c("Binaria (Y)", "Cuantitativa", "Cuantitativa", "Cuantitativa",
"Binaria", "Binaria", "Binaria", "Categórica (4 niveles)"),
Justificación = c("Resultado que se quiere predecir.",
"Las necesidades de ahorro cambian con la etapa de vida.",
"Aproxima la capacidad de ahorro del cliente.",
"Mide la insistencia comercial, que puede generar rechazo.",
"Señal de riesgo financiero.",
"Compromiso financiero que reduce el flujo disponible para ahorrar.",
"Compromiso financiero que reduce el flujo disponible para ahorrar.",
"La respuesta a una oferta anterior anticipa la respuesta a la actual.")
)
tabla_morada(variables, caption = " Tabla 2. Variables del modelo")| Variable | Descripción | Tipo | Justificación |
|---|---|---|---|
| y | Contrató el depósito a plazo fijo | Binaria (Y) | Resultado que se quiere predecir. |
| age | Edad en años | Cuantitativa | Las necesidades de ahorro cambian con la etapa de vida. |
| balance | Saldo promedio anual (€) | Cuantitativa | Aproxima la capacidad de ahorro del cliente. |
| campaign | Contactos realizados en la campaña actual | Cuantitativa | Mide la insistencia comercial, que puede generar rechazo. |
| default | Incumplimiento crediticio | Binaria | Señal de riesgo financiero. |
| housing | Crédito hipotecario | Binaria | Compromiso financiero que reduce el flujo disponible para ahorrar. |
| loan | Préstamo personal | Binaria | Compromiso financiero que reduce el flujo disponible para ahorrar. |
| poutcome | Resultado de la campaña anterior | Categórica (4 niveles) | La respuesta a una oferta anterior anticipa la respuesta a la actual. |
Se excluyó duration (duración de la llamada): solo se
conoce después de contactar al cliente y determina casi por completo el
resultado, así que incluirla produciría una filtración de información
(data leakage) y un modelo inútil para decidir a quién llamar
(Moro et al., 2014).
Para la selección de las variables del modelo, se tuvieron en cuenta características personales, financieras y comerciales de los clientes que podrían estar relacionadas con la contratación de un depósito bancario a plazo fijo. Estas variables se eligieron considerando su utilidad para comprender el comportamiento de los clientes y cumplir con el objetivo de comparar el desempeño de los modelos de clasificación KNN y regresión logística. A continuación, se presenta la justificación de cada una de las variables seleccionadas.
-La variable dependiente y corresponde a la contratación del depósito bancario a plazo fijo y se seleccionó porque representa el resultado que se desea predecir mediante los modelos de clasificación.
-La variable age representa la edad del
cliente en años. Se eligió porque las necesidades financieras y los
hábitos de ahorro pueden variar según la etapa de vida de cada
persona.
-La variable balance corresponde al
saldo bancario promedio anual del cliente. Se incluyó porque permite
analizar si la cantidad de dinero disponible en su cuenta está
relacionada con la decisión de contratar un depósito a plazo fijo.
-La variable campaign indica el número
de contactos realizados al cliente durante la campaña de marketing
actual. Se seleccionó porque permite evaluar si la frecuencia de los
contactos comerciales está relacionada con la probabilidad de contratar
el depósito.
-La variable default indica si el
cliente presenta incumplimiento crediticio. Se incluyó porque esta
información puede ayudar a analizar si los antecedentes financieros del
cliente están asociados con su decisión de contratar el producto
bancario.
-La variable housing señala si el
cliente tiene un crédito hipotecario. Se eligió porque permite estudiar
si tener este tipo de compromiso financiero está relacionado con la
contratación de un depósito a plazo fijo.
-La variable loan indica si el cliente
tiene un préstamo personal. Se incluyó porque las obligaciones
financieras del cliente podrían estar relacionadas con sus decisiones de
ahorro e inversión.
Finalmente, la variable poutcome
representa el resultado de la campaña de marketing anterior. Se
seleccionó porque conocer si el cliente tuvo una respuesta exitosa,
fallida, diferente o desconocida en campañas previas puede aportar
información útil para predecir su respuesta a la campaña actual.
En conjunto, estas variables permiten analizar diferentes características de los clientes e identificar patrones que ayuden a predecir la contratación del depósito bancario, comparando la capacidad de clasificación de los modelos KNN y regresión logística.
La base se dividió de forma estratificada en 70 % para entrenamiento y 30 % para prueba, de modo que ambos conjuntos conserven aproximadamente la misma proporción de clientes que contratan. El conjunto de entrenamiento se utilizó para ajustar los modelos y seleccionar k y los umbrales; el conjunto de prueba se reservó para la evaluación final y no se utilizó para ajustar los modelos. Las variables categóricas se representaron mediante variables dummy y las cuantitativas se estandarizaron porque KNN calcula distancias y es sensible a la escala. En la evaluación final, la media y la desviación estándar se calcularon con el entrenamiento. Durante la validación cruzada, esos parámetros se recalcularon dentro de cada pliegue usando solo su parte de entrenamiento, para evitar que los datos de validación influyeran en el preprocesamiento.
set.seed(123)
idx <- unlist(lapply(split(seq_len(nrow(bank)), bank $y),
function(i) sample(i, round(0.7 * length(i)))))
train <- bank[idx, ]
test <- bank[-idx, ]
X_raw_tr <- model.matrix(y ~ ., data = train[, c("y", vars_x)])[, -1]
X_raw_te <- model.matrix(y ~ ., data = test[, c("y", vars_x)])[, -1]
mu <- colMeans(X_raw_tr[, numv, drop = FALSE])
s <- apply(X_raw_tr[, numv, drop = FALSE], 2, sd)
escalar <- function(m, centro = mu, desv = s) {
m[, numv] <- scale(m[, numv, drop = FALSE], center = centro, scale = desv)
m
}
X_tr <- escalar(X_raw_tr)
X_te <- escalar(X_raw_te)
prev_train <- mean(train $y == "yes")KNN asigna a cada cliente la clase más frecuente entre sus k vecinos más cercanos (distancia euclidiana). El valor de k se eligió por validación cruzada de 5 particiones sobre el conjunto de entrenamiento, maximizando el AUC.
Logit modela la probabilidad de contratar mediante
\[\ln\left(\frac{p}{1-p}\right)=\beta_0+\beta_1x_1+\dots+\beta_kx_k,\]
y sus coeficientes se interpretan mediante odds ratios (\(e^{\beta}\)): el factor por el que se multiplican las odds de contratar cuando la variable aumenta una unidad (o cambia de categoría), manteniendo constantes las demás variables.
Umbral de clasificación. Un cliente se clasifica
como yes si su probabilidad estimada supera un umbral. Se
evaluaron dos: el estándar de 0,5 y el umbral de Youden
(Youden, 1950), que maximiza sensibilidad + especificidad − 1.
Para evitar favorecer a un modelo, los umbrales de ambos modelos se
calcularon con predicciones fuera de muestra obtenidas mediante la misma
validación cruzada de cinco particiones dentro del conjunto de
entrenamiento. El conjunto de prueba se reservó para la evaluación
final.
Métricas. Se reportan exactitud, sensibilidad
(proporción de contratantes detectados), especificidad, precisión
(proporción de aciertos entre los clasificados como yes),
F1 y AUC.
tab_y <- bank %>% count(y) %>% mutate(porcentaje = round(100 * n / sum(n), 1))
p <- ggplot(tab_y, aes(y, n, fill = y,
text = paste0("y = ", y, "<br>Clientes: ", n, "<br>", porcentaje, " %"))) +
geom_col(width = 0.6, show.legend = FALSE) +
scale_fill_manual(values = c(no = lila, yes = morado)) +
labs(title = "Figura 1. Contratación del depósito a plazo fijo", x = "¿Contrató el depósito?", y = "Clientes")
# Forzamos la fuente directamente en la conversión interactiva
ggplotly(p, tooltip = "text") %>%
layout(
font = list(family = "Times New Roman"),
title = list(font = list(family = "Times New Roman")),
hoverlabel = list(font = list(family = "Times New Roman"))
)De los 4,521 clientes, 521 (11.5 %) contrataron el depósito y 4000
(88.5 %) no. La base está fuertemente desbalanceada, y esto condiciona
todo el análisis: un clasificador que respondiera “no” a todos los
clientes alcanzaría una exactitud de 88.5 % sin identificar a un solo
contratante. Por eso la exactitud no sirve como único criterio y se
complementa con sensibilidad, precisión y AUC. El desbalance también
explica que el umbral de 0,5 sea inadecuado: como pocos clientes superan
una probabilidad de 0,5, los modelos casi nunca predicen
yes, y de ahí el uso del umbral de Youden. La tasa de
contratación de 11.5 % es además la referencia para medir cuánto mejora
un modelo la selección de clientes frente a llamar al azar.
desc <- bank %>%
select(all_of(numv)) %>%
pivot_longer(everything(), names_to = "Variable", values_to = "value") %>%
group_by(Variable) %>%
summarise(
Media = mean(value, na.rm = TRUE),
Mediana = median(value, na.rm = TRUE),
`Desv. est.` = sd(value, na.rm = TRUE),
Mínimo = min(value, na.rm = TRUE),
Q1 = quantile(value, 0.25, na.rm = TRUE),
Q3 = quantile(value, 0.75, na.rm = TRUE),
Máximo = max(value, na.rm = TRUE),
.groups = "drop"
) %>%
mutate(across(where(is.numeric), ~ round(.x, 1)))
tabla_morada(desc, caption = "Tabla 3. Estadísticas descriptivas de las variables cuantitativas")| Variable | Media | Mediana | Desv. est. | Mínimo | Q1 | Q3 | Máximo |
|---|---|---|---|---|---|---|---|
| age | 41.2 | 39 | 10.6 | 19 | 33 | 49 | 87 |
| balance | 1422.7 | 444 | 3009.6 | -3313 | 69 | 1480 | 71188 |
| campaign | 2.8 | 2 | 3.1 | 1 | 1 | 3 | 50 |
datos_box <- bank %>%
select(y, all_of(numv)) %>%
pivot_longer(cols = -y, names_to = "variable", values_to = "valor") %>%
group_by(variable) %>%
filter(
valor >= quantile(valor, 0.01, na.rm = TRUE),
valor <= quantile(valor, 0.99, na.rm = TRUE)
) %>%
ungroup()
p <- ggplot(datos_box, aes(x = y, y = valor, fill = y)) +
geom_boxplot(outlier.alpha = 0.25, outlier.color = morado, show.legend = FALSE) +
scale_fill_manual(values = c("no" = lila, "yes" = morado_medio)) +
facet_wrap(~ variable, scales = "free_y") +
labs(
title = "Figura 2. Variables cuantitativas según contratación",
subtitle = "Se muestran los valores entre los percentiles 1 y 99",
x = "¿Contrató el depósito?",
y = NULL
) +
theme_minimal(base_family = "Times New Roman") +
theme(
plot.title = element_text(face = "bold"),
plot.subtitle = element_text(size = 9),
strip.text = element_text(face = "bold")
)
ggplotly(p) %>%
layout(font = list(family = "Times New Roman"))La edad tiene una media de 41.2 años y una mediana de 39 años. Su desviación estándar es de 10.6 años. En el gráfico se puede comparar la distribución de la edad entre los clientes que contrataron el depósito y los que no. Si las cajas se superponen bastante, significa que esta variable no permite diferenciar claramente a los dos grupos por sí sola.
El saldo bancario (balance) tiene una media de 1.422,7 € y una mediana de 444 €. La diferencia entre estos valores puede indicar que algunos clientes tienen saldos bastante superiores al de la mayoría. Su desviación estándar es de 3.009,6 €, lo que permite observar la dispersión de los datos. En el diagrama de cajas se puede revisar si hay diferencias entre los clientes que contrataron y los que no.
Por su parte, campaign registra el número de contactos realizados durante la campaña. La media es de 2.8 contactos, mientras que la mediana es de 2. El máximo registrado es de 50 contactos. Estos resultados permiten observar si algunos clientes recibieron muchas más llamadas que otros y comparar el número de contactos según el resultado de la campaña.
En general, los gráficos permiten explorar las diferencias entre los dos grupos, pero no son suficientes para determinar qué variables predicen mejor la contratación. Para observar con más detalle estas diferencias, se comparan las tasas de contratación por grupos de edad y número de contactos.
tasa_edad <- bank %>%
mutate(
nivel = cut(
age,
breaks = c(-Inf, 30, 40, 50, 60, Inf),
labels = c("30 o menos", "31-40", "41-50", "51-60", "Más de 60")
)
) %>%
group_by(nivel) %>%
summarise(
n = n(),
tasa = mean(y == "yes", na.rm = TRUE),
.groups = "drop"
) %>%
mutate(variable = "Grupo de edad")
tasa_camp <- bank %>%
mutate(
nivel = cut(
campaign,
breaks = c(0, 1, 2, 3, 5, Inf),
labels = c("1", "2", "3", "4-5", "6 o más")
)
) %>%
group_by(nivel) %>%
summarise(
n = n(),
tasa = mean(y == "yes", na.rm = TRUE),
.groups = "drop"
) %>%
mutate(variable = "Contactos en la campaña")
p <- bind_rows(tasa_edad, tasa_camp) %>%
ggplot(aes(
x = nivel,
y = tasa,
text = paste0(
"Grupo: ", nivel,
"<br>Clientes: ", n,
"<br>Tasa de contratación: ", pct(tasa)
)
)) +
geom_col(fill = morado, width = 0.65) +
facet_wrap(~ variable, scales = "free_x") +
scale_y_continuous(labels = scales::percent) +
labs(
title = "Figura 3. Tasa de contratación por grupo de edad y número de contactos",
x = NULL,
y = "Tasa de contratación"
) +
theme_minimal(base_family = "Times New Roman")
ggplotly(p, tooltip = "text") %>%
layout(font = list(family = "Times New Roman"))En los grupos de edad, la tasa de contratación para los clientes de 30 años o menos es de 14.2 %, mientras que para los mayores de 60 años es de 37.8 %. En este último grupo hay 127 clientes, de los cuales 48 contrataron el depósito. Esta comparación permite identificar posibles diferencias en las tasas de contratación según la edad. Sin embargo, también es importante considerar la cantidad de clientes que conforman cada grupo.
En cuanto al número de contactos, la tasa de contratación para los clientes que recibieron una sola llamada es de 13.8 %, mientras que para aquellos que recibieron seis o más contactos es de 7.2 %. Los grupos intermedios permiten observar cómo varía la tasa de contratación a medida que aumenta el número de llamadas. No obstante, estos resultados no permiten afirmar que el número de contactos sea la causa de una mayor o menor contratación, ya que también pueden influir otras características de los clientes.
En conjunto, estos resultados descriptivos permiten comprender mejor las características de los clientes y explorar posibles diferencias relacionadas con la contratación del depósito. En la siguiente sección se construirán y compararán los modelos KNN y de regresión logística para evaluar su capacidad de clasificar correctamente a los clientes.
tasa_cat <- bank %>%
select(y, default, housing, loan, poutcome) %>%
pivot_longer(-y, names_to = "variable", values_to = "nivel") %>%
group_by(variable, nivel) %>%
summarise(n = n(), tasa = mean(y == "yes"), .groups = "drop")
p <- ggplot(tasa_cat, aes(nivel, tasa,
text = paste0(variable, " = ", nivel, "<br>Clientes: ", n,
"<br>Tasa de contratación: ", pct(tasa)))) +
geom_col(fill = morado, width = 0.65) +
facet_wrap(~ variable, scales = "free_x", nrow = 1) +
scale_y_continuous(labels = scales::percent) +
labs(title = "Figura 4. Tasa de contratación por categoría", x = NULL, y = "Tasa de contratación")
ggplotly(p) %>%
layout(font = list(family = "Times New Roman")) %>%
style(font = list(family = "Times New Roman"))La variable poutcome parece ser una de las más
informativas para explicar la contratación del depósito. Los clientes
que obtuvieron un resultado exitoso en una campaña anterior presentan
una tasa de contratación de 64.3 %, frente a 9.1 % entre aquellos cuyo
resultado anterior es desconocido. Aunque la categoría
success comprende solo 129 clientes (2.9 % de la base),
representa 15.9 % de todas las contrataciones. Por su parte, los
clientes con un resultado anterior desfavorable (failure)
presentan una tasa de contratación de 12.9 %. Estas diferencias sugieren
que el resultado de campañas anteriores puede estar asociado con la
contratación actual. Sin embargo, es necesario evaluar esta relación
mediante los modelos de clasificación, considerando simultáneamente las
demás variables.
Las variables housing y loan también
presentan diferencias en las tasas de contratación. Entre los clientes
sin crédito hipotecario, la tasa es de 15.3 %, mientras que entre
quienes tienen este tipo de crédito es de 8.6 %. De manera similar, la
tasa de contratación es de 12.5 % para los clientes sin préstamo
personal y de 6.2 % para quienes sí lo tienen. Estas diferencias
muestran una posible asociación entre las obligaciones crediticias y la
contratación del depósito. No obstante, el análisis descriptivo no
permite concluir que los créditos sean la causa de las diferencias
observadas ni establecer si estas se mantienen al considerar otras
características de los clientes.
En cuanto a la variable default, solo 76 clientes
presentan la categoría de incumplimiento. Su tasa de contratación es de
11.8 %. Debido a la baja cantidad de observaciones en esta categoría,
las comparaciones deben interpretarse con cautela, pues las estimaciones
pueden ser poco precisas. La importancia de esta variable se evaluará
posteriormente a través de los modelos de clasificación y sus métricas
de desempeño.
p_yes_knn <- function(Xa, ya, Xb, k) {
cl <- knn(Xa, Xb, cl = ya, k = k, prob = TRUE)
pr <- attr(cl, "prob")
ifelse(cl == "yes", pr, 1 - pr)
}
auc_y <- function(y, p) as.numeric(auc(roc(y, p, levels = c("no", "yes"), direction = "<", quiet = TRUE)))
set.seed(123)
# Asignar folds dentro de cada clase para mantener el desbalance en cada partición.
folds <- integer(nrow(train))
for (clase in levels(train$y)) {
id_clase <- which(train$y == clase)
folds[id_clase] <- sample(rep(1:5, length.out = length(id_clase)))
}
ks <- seq(5, 151, by = 2)
cv_auc <- sapply(ks, function(k) {
mean(sapply(1:5, function(f) {
tr <- folds != f
va <- !tr
# La estandarización se estima solo con el pliegue de entrenamiento.
centro_f <- colMeans(X_raw_tr[tr, numv, drop = FALSE])
desv_f <- apply(X_raw_tr[tr, numv, drop = FALSE], 2, sd)
xtr_f <- escalar(X_raw_tr[tr, , drop = FALSE], centro_f, desv_f)
xva_f <- escalar(X_raw_tr[va, , drop = FALSE], centro_f, desv_f)
auc_y(train$y[va], p_yes_knn(xtr_f, train$y[tr], xva_f, k))
}))
})
k_opt <- ks[which.max(cv_auc)]
p <- ggplot(data.frame(k = ks, AUC = cv_auc), aes(k, AUC)) +
geom_line(color = morado, linewidth = 1) +
geom_point(color = morado_medio, size = 1.6) +
geom_point(data = data.frame(k = k_opt, AUC = max(cv_auc)), color = morado_oscuro, size = 4) +
labs(title = paste0("Figura 5. AUC en validación cruzada según k (óptimo: k = ", k_opt, ")"), x = "Número de vecinos (k)")
ggplotly(p) %>%
layout(font = list(family = "Times New Roman")) %>%
style(font = list(family = "Times New Roman"))El AUC medio máximo en la validación cruzada es 0.663 y se alcanza con k = 149. Para valores pequeños de k, la clasificación depende de un vecindario reducido; al aumentar k, la predicción se basa en un conjunto más amplio de clientes. La curva permite observar cómo cambia la capacidad de discriminación según el número de vecinos. El valor elegido corresponde al que obtuvo el mayor AUC medio entre los valores evaluados; esta selección se realizó únicamente con el conjunto de entrenamiento.
library(car)
logit <- glm(y ~ ., data = train[, c("y", vars_x)], family = binomial)
vif_logit <- vif(logit)
print(vif_logit)## GVIF Df GVIF^(1/(2*Df))
## age 1.053039 1 1.026177
## balance 1.016028 1 1.007982
## campaign 1.017676 1 1.008800
## default 1.018566 1 1.009240
## housing 1.069894 1 1.034357
## loan 1.014475 1 1.007212
## poutcome 1.049329 3 1.008058coefs <- summary(logit)$coefficients
ic <- exp(confint.default(logit))
tab_logit <- data.frame(
variable = rownames(coefs),
coef = coefs[, 1],
OR = exp(coefs[, 1]),
IC95_inf = ic[, 1],
IC95_sup = ic[, 2],
p_num = coefs[, 4],
row.names = NULL
)
tab_mostrar <- tab_logit %>%
mutate(p_valor = ifelse(p_num < 0.001, "<0.001", sprintf("%.3f", p_num)),
Significativa = ifelse(p_num < 0.05, "Sí", "No")) %>%
mutate(across(c(coef, OR, IC95_inf, IC95_sup), ~ round(.x, 3))) %>%
select(Variable = variable, Coeficiente = coef, OR, `IC 95 % inf.` = IC95_inf,
`IC 95 % sup.` = IC95_sup, `p-valor` = p_valor, Significativa)
tabla_morada(tab_mostrar, caption = "Tabla 4. Coeficientes y odds ratios del modelo Logit (conjunto de entrenamiento)")| Variable | Coeficiente | OR | IC 95 % inf. | IC 95 % sup. | p-valor | Significativa |
|---|---|---|---|---|---|---|
| (Intercept) | -1.914 | 0.147 | 0.080 | 0.272 | <0.001 | Sí |
| age | 0.010 | 1.010 | 0.999 | 1.020 | 0.064 | No |
| balance | 0.000 | 1.000 | 1.000 | 1.000 | 0.860 | No |
| campaign | -0.073 | 0.929 | 0.879 | 0.983 | 0.010 | Sí |
| defaultyes | 0.533 | 1.703 | 0.745 | 3.893 | 0.207 | No |
| housingyes | -0.535 | 0.585 | 0.462 | 0.742 | <0.001 | Sí |
| loanyes | -0.588 | 0.556 | 0.378 | 0.817 | 0.003 | Sí |
| poutcomeother | 0.638 | 1.893 | 1.093 | 3.277 | 0.023 | Sí |
| poutcomesuccess | 2.350 | 10.487 | 6.011 | 18.296 | <0.001 | Sí |
| poutcomeunknown | -0.226 | 0.798 | 0.553 | 1.150 | 0.226 | No |
bosque <- tab_logit %>%
filter(variable != "(Intercept)") %>%
mutate(variable = reorder(variable, OR))
p <- ggplot(bosque, aes(y = variable,
text = paste0(variable, "<br>OR = ", round(OR, 2),
"<br>IC 95 %: ", round(IC95_inf, 2), " a ", round(IC95_sup, 2)))) +
geom_vline(xintercept = 1, linetype = "dashed", color = "grey50") +
geom_segment(aes(x = IC95_inf, xend = IC95_sup, yend = variable), color = morado_medio, linewidth = 1) +
geom_point(aes(x = OR), color = morado_oscuro, size = 3) +
scale_x_log10() +
labs(title = "Figura 6. Odds ratios con intervalo de confianza del 95 % (escala logarítmica)",
x = "Odds ratio (1 = sin efecto)", y = NULL) +
theme_minimal(base_family = "Times New Roman")
ggplotly(p, tooltip = "text") %>%
layout(font = list(family = "Times New Roman"))Con un nivel de significancia del 5 %, las variables estadísticamente significativas son: campaign, housingyes, loanyes, poutcomeother, poutcomesuccess. Por su parte, las variables que no presentan significancia estadística son: age, balance, defaultyes, poutcomeunknown. En el gráfico de odds ratios, se considera que una asociación es estadísticamente significativa cuando el intervalo de confianza del 95 % no incluye el valor OR = 1.
El resultado más destacado corresponde a
poutcomesuccess. En comparación con la categoría de
referencia del modelo, los clientes cuyo resultado en una campaña
anterior fue exitoso presentan unas odds de contratación 10.49
veces las de los clientes de la categoría de referencia, manteniendo
constantes las demás variables. Por otra parte, tener un crédito
hipotecario (housingyes, OR = 0.59) o un préstamo personal
(loanyes, OR = 0.56) se asocia con menores odds de
contratación. Asimismo, cada contacto adicional durante la campaña
actual (campaign, OR = 0.93) se asocia con un cambio en las
odds de contratación, cuya dirección y magnitud se reflejan en
su odds ratio. Estas asociaciones no deben interpretarse automáticamente
como relaciones causales.
La interpretación de age, balance y
default debe considerar sus respectivos odds ratios,
intervalos de confianza y valores p. Si alguna de estas variables no
resulta estadísticamente significativa al nivel del 5 %, no existe
evidencia suficiente para afirmar que su asociación con la contratación
sea distinta de cero dentro del modelo estimado. En particular, la
relación entre la edad y la contratación podría no estar representada
completamente por un término lineal. Aunque el análisis descriptivo de
la sección 3.2 permite identificar diferencias entre grupos etarios,
sería necesario evaluar términos no lineales o categorías de edad para
determinar si esta relación mejora la capacidad explicativa del
modelo.
p_knn <- p_yes_knn(X_tr, train$y, X_te, k_opt)
p_logit <- predict(logit, newdata = test, type = "response")
umbral_youden <- function(y, p) {
r <- roc(y, p, levels = c("no", "yes"), direction = "<", quiet = TRUE)
as.numeric(coords(r, "best", best.method = "youden", ret = "threshold"))[1]
}
oof_knn <- numeric(nrow(train))
oof_logit <- numeric(nrow(train))
for (f in 1:5) {
tr <- folds != f
va <- !tr
centro_f <- colMeans(X_raw_tr[tr, numv, drop = FALSE])
desv_f <- apply(X_raw_tr[tr, numv, drop = FALSE], 2, sd)
xtr_f <- escalar(X_raw_tr[tr, , drop = FALSE], centro_f, desv_f)
xva_f <- escalar(X_raw_tr[va, , drop = FALSE], centro_f, desv_f)
oof_knn[va] <- p_yes_knn(xtr_f, train$y[tr], xva_f, k_opt)
logit_cv <- glm(y ~ ., data = train[tr, c("y", vars_x), drop = FALSE],
family = binomial)
oof_logit[va] <- predict(logit_cv, newdata = train[va, , drop = FALSE],
type = "response")
}
thr_knn <- umbral_youden(train$y, oof_knn)
thr_logit <- umbral_youden(train$y, oof_logit)
metricas <- function(modelo, criterio, p, umbral) {
pred <- ifelse(p >= umbral, "yes", "no")
tp <- sum(pred == "yes" & test$y == "yes"); fn <- sum(pred == "no" & test$y == "yes")
fp <- sum(pred == "yes" & test$y == "no"); tn <- sum(pred == "no" & test$y == "no")
prec <- ifelse(tp + fp == 0, NA, tp / (tp + fp))
sens <- tp / (tp + fn)
data.frame(Modelo = modelo, Criterio = criterio, Umbral = umbral,
Accuracy = (tp + tn) / (tp + tn + fp + fn),
Sensibilidad = sens, Especificidad = tn / (tn + fp), Precision = prec,
F1 = ifelse(is.na(prec) || (prec + sens) == 0, 0, 2 * prec * sens / (prec + sens)),
AUC = auc_y(test$y, p), TP = tp, FN = fn, FP = fp, TN = tn)
}
res <- bind_rows(metricas("KNN", "Umbral 0.5", p_knn, 0.5),
metricas("Logit", "Umbral 0.5", p_logit, 0.5),
metricas("KNN", "Umbral Youden", p_knn, thr_knn),
metricas("Logit", "Umbral Youden", p_logit, thr_logit))
v <- function(m, c, col) res[res$Modelo == m & res$Criterio == c, col]
auc_knn <- v("KNN", "Umbral 0.5", "AUC"); auc_logit <- v("Logit", "Umbral 0.5", "AUC")
prev_test <- mean(test$y == "yes")
res %>%
select(-c(TP, FN, FP, TN)) %>%
mutate(across(where(is.numeric), ~ round(.x, 3))) %>%
tabla_morada(caption = "Tabla 5. Métricas en el conjunto de prueba")| Modelo | Criterio | Umbral | Accuracy | Sensibilidad | Especificidad | Precision | F1 | AUC |
|---|---|---|---|---|---|---|---|---|
| KNN | Umbral 0.5 | 0.500 | 0.885 | 0.000 | 1.000 | NA | 0.000 | 0.703 |
| Logit | Umbral 0.5 | 0.500 | 0.896 | 0.179 | 0.989 | 0.683 | 0.284 | 0.687 |
| KNN | Umbral Youden | 0.114 | 0.706 | 0.526 | 0.730 | 0.202 | 0.292 | 0.703 |
| Logit | Umbral Youden | 0.106 | 0.641 | 0.667 | 0.637 | 0.193 | 0.299 | 0.687 |
Con el umbral estándar de 0,5, ambos modelos presentan limitaciones
para identificar a los clientes que contrataron el depósito. La
sensibilidad es de 0.0 % para KNN y de 17.9 % para Logit. Aunque la
exactitud (accuracy) se aproxima al 89 % en ambos modelos, este
resultado debe interpretarse con cautela debido al predominio de la
clase no en el conjunto de datos. Por tanto, una exactitud
elevada no garantiza que el modelo identifique adecuadamente a los
clientes que contrataron el producto.
Al utilizar el umbral de Youden, la sensibilidad aumenta a 52.6 % para KNN y a 66.7 % para Logit. Esto significa que KNN identifica aproximadamente la mitad de los clientes que contrataron el depósito, mientras que Logit detecta cerca de dos tercios. Este aumento en la detección se acompaña de una reducción de la exactitud, que pasa a 70.6 % en KNN y a 64.1 % en Logit. Asimismo, disminuye la especificidad, porque los modelos clasifican como posibles contratantes a más clientes que finalmente no contrataron. En consecuencia, la selección del umbral implica un equilibrio entre identificar a más clientes interesados y evitar falsas alarmas.
cmy <- res %>% filter(Criterio == "Umbral Youden")
cm <- bind_rows(lapply(seq_len(nrow(cmy)), function(i)
data.frame(Modelo = cmy$Modelo[i],
Real = c("yes", "yes", "no", "no"), Predicho = c("yes", "no", "yes", "no"),
n = c(cmy$TP[i], cmy$FN[i], cmy$FP[i], cmy$TN[i])))) %>%
mutate(Real = factor(Real, levels = c("no", "yes")), Predicho = factor(Predicho, levels = c("no", "yes")))
p <- ggplot(cm, aes(Predicho, Real, fill = n)) +
geom_tile(aes(text = paste0("Modelo: ", Modelo, "<br>Real: ", Real, "<br>Predicho: ", Predicho,
"<br>Clientes: ", n)), color = "white", linewidth = 1.5) +
geom_text(aes(label = n), color = "white", size = 6, fontface = "bold", family = "Times New Roman") +
scale_fill_gradient(low = morado_medio, high = "#311B92", guide = "none") +
facet_wrap(~ Modelo) +
labs(title = "Figura 7. Matrices de confusión con umbral de Youden (conjunto de prueba)",
x = "Clase predicha", y = "Clase real") +
theme_minimal(base_family = "Times New Roman")
ggplotly(p, tooltip = "text") %>%
layout(font = list(family = "Times New Roman")) %>%
style(font = list(family = "Times New Roman"))La matriz de confusión permite observar este comportamiento con mayor claridad. Con el umbral de Youden, KNN identifica 82 de los 156 clientes que contrataron el depósito en el conjunto de prueba, mientras que Logit identifica 104 de ellos. Sin embargo, ambos modelos generan una cantidad considerable de falsos positivos: 324 para KNN y 435 para Logit. Esto se refleja en precisiones de 20.2 % y 19.3 %, respectivamente. En términos prácticos, por cada contratante identificado, se clasifican aproximadamente 5 clientes como posibles contratantes con KNN y 5 con Logit. Frente a la tasa de contratación del conjunto de prueba, de 11.5 %, esto representa un lift de 1.8 veces para KNN y de 1.7 veces para Logit. Por tanto, los modelos ayudan a priorizar clientes, aunque todavía producen numerosos falsos positivos.
roc_knn <- roc(test$y, p_knn, levels = c("no", "yes"), direction = "<", quiet = TRUE)
roc_logit <- roc(test$y, p_logit, levels = c("no", "yes"), direction = "<", quiet = TRUE)
et_knn <- sprintf("KNN (AUC = %.3f)", auc_knn)
et_logit <- sprintf("Logit (AUC = %.3f)", auc_logit)
roc_df <- bind_rows(
data.frame(Modelo = et_knn, FPR = 1 - roc_knn$specificities, TPR = roc_knn$sensitivities),
data.frame(Modelo = et_logit, FPR = 1 - roc_logit$specificities, TPR = roc_logit$sensitivities))
p <- ggplot(roc_df, aes(FPR, TPR, color = Modelo, linetype = Modelo)) +
geom_line(linewidth = 1) +
geom_abline(linetype = "dotted", color = "grey50") +
scale_color_manual(values = setNames(c(morado_medio, morado_oscuro), c(et_knn, et_logit))) +
scale_linetype_manual(values = setNames(c("dashed", "solid"), c(et_knn, et_logit))) +
labs(title = "Figura 8. Curvas ROC en el conjunto de prueba", x = "1 − Especificidad", y = "Sensibilidad")
ggplotly(p) %>%
layout(font = list(family = "Times New Roman")) %>%
style(font = list(family = "Times New Roman"))Las curvas ROC se encuentran por encima de la diagonal de referencia, correspondiente a un AUC de 0,5. El AUC es de 0.703 para KNN y de 0.687 para Logit. Estos resultados indican una capacidad de discriminación limitada, aunque superior a la esperada por azar. KNN obtiene el mayor AUC, con una diferencia absoluta de 0.015. Sin embargo, esta diferencia, calculada sobre una sola partición de los datos, no basta para afirmar que un modelo sea estadísticamente superior al otro. El AUC mide la capacidad del modelo para asignar puntuaciones de probabilidad más altas a los clientes que contrataron que a los que no contrataron. En este caso, ambos modelos distinguen las dos clases, pero todavía tienen dificultades para separarlas con precisión. A diferencia de la exactitud, la sensibilidad y la precisión, el AUC no cambia al modificar el umbral de clasificación, porque se calcula a partir de las probabilidades estimadas.
Modelo recomendado. La elección del modelo depende del objetivo principal de la clasificación. Si se busca identificar a la mayor cantidad posible de clientes que podrían contratar el depósito, se recomienda Logit con el umbral de Youden, ya que alcanza una sensibilidad de 66.7 % y un F1 de 0.299, ligeramente superior al 0.292 obtenido por KNN. Además, la regresión logística permite interpretar la asociación entre las variables explicativas y la probabilidad de contratación. Por otro lado, KNN presenta un AUC de 0.703, superior al 0.687 de Logit, y obtiene mejores valores de exactitud y precisión con el umbral de Youden. Por ello, KNN también constituye una alternativa válida si se prioriza la discriminación global o se busca una mayor exactitud. En conclusión, se prefiere Logit cuando la prioridad es detectar más contratantes y contar con un modelo interpretable, reconociendo que ninguno de los dos modelos presenta una precisión alta. Antes de implementar cualquiera de ellos en una campaña real, sería conveniente evaluar su estabilidad con otras particiones de los datos y considerar los costos de los falsos positivos y los beneficios de las contrataciones.
Sobre los modelos.
Sobre el negocio.
success
presenta una tasa de contratación mayor. Esta relación es predictiva y
no garantiza una contratación futura.housing y loan se asocian
con menores odds de contratación en el modelo estimado. Antes
de cambiar la estrategia comercial, conviene evaluar el costo de
contacto y la respuesta real de cada segmento.campaign muestra una asociación negativa
con la contratación; se puede evaluar un límite de intentos por cliente
mediante pruebas controladas, sin asumir que un número específico sea
óptimo a partir de este modelo.¿El modelo logró responder al objetivo de la
investigación? Parcialmente. El objetivo era clasificar a los
clientes según contraten o no el depósito, y el análisis sí permite
identificar los factores asociados a la contratación (historial de
campañas, créditos vigentes e intensidad de contacto) y ordenar a los
clientes por probabilidad para priorizar llamadas, con una mejora de 1.7
veces sobre llamar al azar. Sin embargo, no logra clasificar con
precisión: con el umbral que mejora la detección, la mayoría de los
clientes marcados como yes no contrata, y con el umbral
estándar casi no detecta a nadie. Es una herramienta útil de apoyo a la
decisión, pero no un clasificador que pueda reemplazar el criterio
comercial.
Limitaciones y mejoras.
no o el sobremuestreo de yes podrían
mejorar la sensibilidad.default casi no varía y balance está
dominada por valores extremos; una transformación logarítmica del saldo
o su categorización reduciría ese problema.bank-additional del mismo repositorio incluye
indicadores económicos (como la tasa Euribor a 3 meses), que son
candidatos naturales para aumentar el poder predictivo.