Analítica de negocios usando redes neuronales
Importamos datos y librerías
Primero, importamos librerias
library(readr) # Leer datos csv
library(dplyr) # Manipulación de datos
library(ggcorrplot) # Grafico de correlaciones
library(caret) # Entrenamiento y evaluacion del modelo
library(plotly) # Graficos dinamicos
library(ggplot2) # Graficos generales
library(skimr) # Resumenes estadisticos
library(neuralnet) # Modelado redes neuronales
library(knitr) # Tabla de resultado mas elegantes
library(tidyverse) # Incluye dplyr, tidyr (pivot_wider), etc.
library(gt) # Para crear tablas bonitas
library(scales) # Para formatear porcentajesSegundo, importamos base de datos
CrediCars <- read_delim("~/Library/Mobile Documents/com~apple~CloudDocs/Cursos/Decision Tree, Random Forest and Gradient Busting in R/Seccion 7 (Neural Networks)/CrediCars.csv",
delim = ";", escape_double = FALSE, trim_ws = TRUE)En el presente cuaderno se busca reproducir de forma clara y explicativa tanto la teoría como el código necesario para implementar una red neuronal en R. El objetivo es brindar una guía práctica que combine fundamentos conceptuales con una ejecución paso a paso del modelo, de manera que sea comprensible tanto para quienes inician en el tema como para quienes desean profundizar en el uso de redes neuronales dentro del entorno de R.
Para estructurar este proceso se utilizará la metodología CRISP-DM (Cross Industry Standard Process for Data Mining), un enfoque ampliamente adoptado para proyectos de análisis de datos. Esta metodología consta de seis fases:
Comprensión del negocio: se define el objetivo del modelo, en este caso, predecir el comportamiento de clientes (por ejemplo, probabilidad de incumplimiento).
Comprensión de los datos: se exploran las variables disponibles y su relación con el problema de negocio.
Preparación de los datos: se limpian, transforman y normalizan los datos para que sean adecuados para el modelo.
Modelado: se construye y entrena la red neuronal utilizando funciones específicas de R.
Evaluación: se analizan métricas de desempeño para validar la calidad del modelo.
Despliegue: se explican posibles usos del modelo una vez validado, ya sea en entorno de producción o análisis estratégico.
1) Comprensión del negocio
Los datos disponibles corresponden a solicitudes de crédito de
clientes de una entidad llamada CrediCars. Cada fila representa
a un cliente y contiene información tanto demográfica como financiera,
así como indicadores sobre el estado de pago de sus créditos. El
objetivo del modelo es predecir el riesgo de incumplimiento de
pagos, utilizando como variable dependiente el
campo DefaulterFlag, que indica si el
cliente ha caído en mora alguna vez (1) o no (0). Adicionalmente, existe
una versión categorizada más
detallada: Defaulter Type, que clasifica
el tipo de incumplimiento en tres niveles de gravedad.
Las variables predictoras incluyen:
Demográficas y educativas: edad (
AGE), sexo (SEXCODE), número de dependientes (NOOFDEPE), nivel educativo (QUALHSC,QUAL_PG).Financieras: ingreso mensual (
MTHINCTH), plazo del crédito en años (TENORYR), fracción de cuota inicial (DWNPMFR), y sincronización entre fecha de pago y fecha de salario (SALDATFR).Indicadores de activos y comportamiento: si posee electrodomésticos (
FRICODE,WASHCODE), si entregó cheques posfechados (FULLPDC), tipo de ocupación (PROFBUS).Variables de localización: región (
REGION) y sucursal (BRANCH) donde se aprobó el crédito.
Esta base de datos permite entender patrones que podrían influir en el comportamiento de pago, facilitando la creación de un modelo de red neuronal que anticipe la probabilidad de incumplimiento de un cliente al momento de aprobar un crédito.
| Variable | Descripción |
|---|---|
| ID | ID Number of the Client |
| Contract_Status | Contract Status |
| Start_Date | Contract Start Date |
| AGE | Age of Borrower |
| NOOFDEPE | Number of Dependents |
| MTHINCTH | Monthly Income |
| SALDATFR | Salary date fraction (1 = 31st, 0.5 = 15th) |
| TENORYR | Tenor in Years |
| DWNPMFR | Fraction of loan in down payment |
| PROFBUS | Business = 1, Professional = 0 |
| QUALHSC | High school qualification (flag) |
| QUAL_PG | Post-graduate qualification (flag) |
| SEXCODE | Male = 1, Female = 0 |
| FULLPDC | Gave post-dated checks in full (flag) |
| FRICODE | Owns refrigerator (flag) |
| WASHCODE | Owns washing machine (flag) |
| REGION | Region where loan is approved |
| BRANCH | Branch where loan is approved |
| DefaulterFlag | 1 if customer delayed at least once, 0 otherwise |
| Defaulter_Type | 0 = no delay, 1 = delay <90 days, 2 = delay >90 days |
Así mismo, es importante mencionar que la perdida par el negocio en los errores del modelo son:
- Falsos positivos $4.200
- Falsos negativos $3.500
2) Comprensión de los datos
Primero, vemos un resumen descriptivo de como están los datos
# Renombramos datos como buena practica para la minipulación
df <- CrediCars
# Resumen general
skim(df)── Data Summary ────────────────────────
Values
Name df
Number of rows 28906
Number of columns 20
_______________________
Column type frequency:
character 4
numeric 16
________________________
Group variables None Segundo convertimos tipo de datos para la visualización de los datos
# Convertir variables categóricas
df <- df %>%
mutate(
DefaulterFlag = as.factor(DefaulterFlag),
PROFBUS = as.factor(PROFBUS),
SEXCODE = as.factor(SEXCODE),
QUALHSC = as.factor(QUALHSC),
QUAL_PG = as.factor(QUAL_PG),
FULLPDC = as.factor(FULLPDC),
FRICODE = as.factor(FRICODE),
WASHCODE = as.factor(WASHCODE)
)Vemos distribución de las edad
# 📊 Histograma de edad
ggplot(df, aes(x = AGE)) +
geom_histogram(binwidth = 5, fill = "steelblue", color = "white") +
labs(title = "Distribución de Edad", x = "Edad", y = "Frecuencia") +
theme_minimal()
Vemos distribución del ingreso según el incumplimiento
# 📦 Boxplot ingreso mensual por estado de mora
ggplot(df, aes(x = DefaulterFlag, y = MTHINCTH, fill = DefaulterFlag)) +
geom_boxplot() +
labs(title = "Ingreso mensual según incumplimiento", x = "Incumplimiento", y = "Ingreso mensual") +
scale_fill_manual(values = c("lightgreen", "salmon")) +
theme_minimal()
Vemos numero de dependientes en un gráfico de barras
# 📊 Gráfico de barras: número de dependientes
ggplot(df, aes(x = as.factor(NOOFDEPE))) +
geom_bar(fill = "darkorange") +
labs(title = "Número de Dependientes", x = "Dependientes", y = "Cantidad") +
theme_minimal()
Vemos gráfico dinámico de la relación entre edad e ingreso mensual, separando por incumplimiento
# ⚡ Gráfico dinámico: Edad vs Ingreso mensual según mora
ggplot(df, aes(x = AGE, y = MTHINCTH, color = DefaulterFlag)) +
geom_point(alpha = 0.6) +
labs(title = "Edad vs Ingreso mensual", x = "Edad", y = "Ingreso mensual", color = "Incumplimiento") +
theme_minimal()
Vemos una tabla cruzada (tabla de contingencia) de incumplimiento según el tipo de cliente
# Crear tabla cruzada con proporciones
tabla_etiquetada <- df %>%
mutate(PROFBUS = factor(PROFBUS, labels = c("Profesional", "Empresario")),
DefaulterFlag = factor(DefaulterFlag, labels = c("No Incumple", "Incumple"))) %>%
count(PROFBUS, DefaulterFlag) %>%
group_by(PROFBUS) %>%
mutate(Proporcion = n / sum(n)) %>%
ungroup() %>%
select(PROFBUS, DefaulterFlag, Proporcion) %>%
pivot_wider(names_from = DefaulterFlag, values_from = Proporcion) %>%
mutate(across(where(is.numeric), ~ scales::percent(.x, accuracy = 0.1)))
# Mostrar con gt
tabla_etiquetada %>%
gt() %>%
tab_header(title = "Proporción de Incumplimiento por Tipo de Ocupación") %>%
cols_label(
PROFBUS = "Tipo de Cliente",
`No Incumple` = "No Incumple (%)",
`Incumple` = "Incumple (%)"
)| Proporción de Incumplimiento por Tipo de Ocupación | ||
| Tipo de Cliente | No Incumple (%) | Incumple (%) |
|---|---|---|
| Profesional | 28.6% | 71.4% |
| Empresario | 29.9% | 70.1% |
3) Preparación de los datos
3.1) Limpieza de datos
Primero, ajustamos el tipo de datos garantizando que
Start_Date este en formato fecha
Segundo, creamos funcion para el manejo de datos faltantes:
# Create the function FillNAs
# Assign a "fill" value according to the data type
FillNAs<-function(data_frame){
fill_number<-0
fill_factor<-"NA_filled"
fill_character<-"NA_filled"
fill_date<-as.Date("1900-01-01")
# Make a loop in the columns of the data frame and according to the
# data type, fill the respective value and create a surrogate column
for (i in 1 : ncol(data_frame)){
if (class(data_frame[,i]) %in% c("numeric","integer")) {
if (any(is.na(data_frame[,i]))){
data_frame[,paste0(colnames(data_frame)[i],"_filledNA")]<- as.factor(ifelse(is.na(data_frame[,i]),"1","0"))
data_frame[is.na(data_frame[,i]),i]<-fill_number
}
} else
if (class(data_frame[,i]) %in% c("factor")) {
if (any(is.na(data_frame[,i]))){
data_frame[,i]<-as.character(data_frame[,i])
data_frame[,paste0(colnames(data_frame)[i],"_filledNA")]<-as.factor(ifelse(is.na(data_frame[,i]),"1","0"))
data_frame[is.na(data_frame[,i]),i]<-fill_factor
data_frame[,i]<-as.factor(data_frame[,i])
}
} else {
if (class(data_frame[,i]) %in% c("character")) {
if (any(is.na(data_frame[,i]))){
data_frame[,paste0(colnames(data_frame)[i],"_filledNA")]<- as.factor(ifelse(is.na(data_frame[,i]),"1","0"))
data_frame[is.na(data_frame[,i]),i]<-afill_character
}
} else {
if (class(data_frame[,i]) %in% c("Date")) {
if (any(is.na(data_frame[,i]))){
data_frame[,paste0(colnames(data_frame)[i],"_filledNA")]<-as.factor(ifelse(is.na(data_frame[,i]),"1","0"))
data_frame[is.na(data_frame[,i]),i]<-fill_date
}
}
}
}
}
return(data_frame)
}Este código en R define una función llamada FillNAs cuyo
propósito es llenar los valores faltantes (NA) de
un data.frame con un valor predeterminado según el
tipo de dato de cada columna. Además, genera una columna
adicional para cada variable con NA, que indica con “1” dónde
hubo un valor faltante y con “0” dónde no lo hubo. Esto es útil para
mantener trazabilidad de los datos imputados (técnica conocida como
creación de indicadores de imputación).
Paso a paso:
Inicialización de valores por defecto:
Se definen los valores con los que se reemplazarán los
NA:Números (numéricos e enteros): se reemplazarán por
0.Factores y caracteres: se reemplazan con la cadena
"NA_filled".Fechas (
Date): se reemplazan por la fecha"1900-01-01".
Iteración sobre las columnas:
- La función recorre cada columna del
data.frameusando un buclefor.
- La función recorre cada columna del
Revisión del tipo de datos:
Utiliza
class(data_frame[, i])para verificar el tipo de dato de la columna:Si es numérico o entero, y contiene valores
NA, los reemplaza con0y crea una nueva columna con el mismo nombre más el sufijo"_filledNA"que indica con"1"dónde habíaNA.Si es factor, convierte la columna a carácter temporalmente, realiza el mismo procedimiento de imputación y luego la convierte de nuevo a factor.
Si es carácter, hace lo mismo que con los factores, pero usando directamente el valor de texto
"NA_filled"(aunque aquí hay un error que se menciona abajo).Si es fecha, los
NAse reemplazan por"1900-01-01"y también se crea la columna indicadora.
Retorno del resultado:
- La función devuelve el
data.framecon losNAreemplazados y las columnas indicadoras añadidas.
- La función devuelve el
Tercero, aplicamos la función al conjunto de datos previamente cargado
# apply the function FillNAs to the CrediCars dataframe
CrediCarsNA <-FillNAs(as.data.frame(CrediCars))Cuarto, eliminamos las columnas que no son de nuestro interes
Quinto, cambiamos datos categoricos a numericos
Para ello, visualizamos los valores categoricos que desemos cambiar por valores numericos:
[1] "BB" "DD" "EE" "GG" "FF" "CC" "AA" "HH" [1] "N" "M" "A" "D" "C" "E" "B" "FFF" "G" "H" "I" "K" "L"
[14] "J" Aplicamos case_when de para la modificacion
# Para las variables de region
CrediCars <- CrediCars %>%
mutate(Region = case_when(
Region == "BB" ~ 1,
Region == "DD" ~ 2,
Region == "EE" ~ 3,
Region == "GG" ~ 4,
Region == "FF" ~ 5,
Region == "CC" ~ 6,
Region == "AA" ~ 7,
Region == "HH" ~ 8,
TRUE ~ NA_real_ # por si hay valores que no están en la lista
))
# Para las variables de marca
CrediCars <- CrediCars %>%
mutate(Branch = case_when(
Branch == "N" ~ 1,
Branch == "M" ~ 2,
Branch == "A" ~ 3,
Branch == "D" ~ 4,
Branch == "C" ~ 5,
Branch == "E" ~ 6,
Branch == "B" ~ 7,
Branch == "FFF" ~ 8,
Branch == "G" ~ 9,
Branch == "H" ~ 10,
Branch == "I" ~ 11,
Branch == "K" ~ 12,
Branch == "L" ~ 13,
Branch == "J" ~ 14,
TRUE ~ NA_real_ # opcional: para valores no contemplados
))Finalmente nos asegurmaos de que esten en tipo numerico
# Transformamos tipo de variables
CrediCars <- CrediCars %>%
mutate(
Region = as.numeric(Region),
Branch = as.numeric(Branch)
)
# Validamos
typeof(CrediCars$Branch)[1] "double"[1] "double"3.2) Preparación de los datos
Primero, analizamos matriz de correlación con el fin de determinar si tenemos multicolinealidad en nuestros datos
# Calcular matriz de correlación
correlation <- cor(CrediCars, use = "complete.obs")
# Graficar
ggcorrplot(correlation,
hc.order = TRUE,
type = "lower",
lab = TRUE,
lab_size = 3,
method = "circle",
colors = c("red", "white", "blue"),
title = "Matriz de Correlación")
Las variables que presentan una correlación mayor a 0.4 o menor a -0.4 podrían ser candidatas para ser eliminadas del modelo, pero esta decisión no debe basarse únicamente en criterios cuantitativos. Es necesario hacer un análisis cualitativo para determinar si realmente tiene sentido excluirlas, evaluando su relevancia y función dentro del contexto del problema.
En el análisis realizado se identificó que las variables TENORYR y DWNPMFR están altamente correlacionadas con un valor de -0.56. Al comprobar que ambas son relevantes respecto a la variable dependiente, se consideró si existía una razón cualitativa que explicara la multicolinealidad entre ellas (por ejemplo, si una depende de la otra). Como no se encontró tal relación y ambas aportan valor al modelo, se decidió conservarlas en la versión preliminar del mismo.
Segundo, normalizamos los datos ya que es mejor para redes neuronales porque ayuda a que todas las entradas estén en un mismo rango (como 0 a 1), lo que mejora la velocidad de aprendizaje, evita que algunas neuronas dominen a otras y reduce el riesgo de que el modelo se quede atascado durante el entrenamiento.
Formula de la normalización:
\[ x_{\text{norm}} = \frac{x - \min(x)}{\max(x) - \min(x)} \]
La decisión entre normalizar o escalar depende del tipo de algoritmo que se esté utilizando y de la naturaleza de los datos. La normalización (o Min-Max scaling) transforma las variables para que todas estén dentro de un rango fijo, usualmente entre 0 y 1. Este método es ideal cuando se usan algoritmos que se basan en distancias absolutas, como K-means, K-Nearest Neighbors (KNN), redes neuronales o métodos de clustering, ya que evita que variables con mayores magnitudes dominen el análisis. Además, es útil cuando los datos no siguen una distribución normal y se desea conservar la forma original de la distribución.
Formula de la estandarización:
\[ x_{\text{std}} = \frac{x - \mu}{\sigma} \]
Por otro lado, la escalación o estandarización transforma las variables para que tengan una media de 0 y una desviación estándar de 1, lo que es particularmente útil en modelos que asumen normalidad o linealidad, como la regresión lineal, la regresión logística, el análisis de componentes principales (PCA) o los modelos SVM lineales. Este enfoque es preferido cuando se busca comparar variables con diferentes unidades o rangos, y también ayuda a mitigar la influencia de valores extremos moderados. En resumen, se recomienda escalar para modelos estadísticos clásicos y normalizar para modelos basados en distancias o redes neuronales.
Aplicamos normalizacion de rangos con la libreria caret
:
# Crear el modelo de normalización (Min-Max)
modelo_norm <- preProcess(CrediCars, method = "range")
# Aplicar la normalización a todo el dataset
CrediCars_normalizado <- predict(modelo_norm, CrediCars)
# Visualizamos los primeros 5
head(CrediCars_normalizado,5)Tercero, separamos en datos de entrenamientos y de
prueba. Para ello usamos el paquete caret que facilita esta
separación:
# Establecer semilla para reproducibilidad
set.seed(2021)
# Crear partición estratificada (80% entrenamiento, 20% prueba)
partition_index <- createDataPartition(y = CrediCars_normalizado$DefaulterFlag,
p = 0.8, list = FALSE)En el código se usa set.seed(2021) para fijar la semilla
del generador aleatorio, lo que asegura que los resultados de la
partición sean reproducibles cada vez que se ejecute el código. Luego,
con createDataPartition(), se crea una
partición estratificada de los datos, es decir, manteniendo la
proporción de clases de la variable DefaulterFlag, que es
la variable objetivo del modelo. El
parámetro p = 0.8 indica que el 80 % de los datos se usará
para entrenamiento, mientras que el 20 % restante quedará para prueba.
Finalmente, list = FALSE hace que la salida sea un vector
plano de índices en lugar de una lista, lo cual facilita su uso
con slice() o subsetting.
Ya con los datos separados ahora indicamos cuales observaciones son de entrenamiento y cuales son de prueba:
# Dividir el dataset usando dplyr::slice
# Separar datos de entrenamients
training <- CrediCars_normalizado %>%
slice(partition_index)
# Separar datos de prueba
testing <- CrediCars_normalizado %>%
slice(-partition_index)En esta parte del código, la
función slice() de dplyr se utiliza
para extraer filas específicas de un data frame según sus índices.
Primero, CrediCars.normal %>% slice(partition_index) selecciona
las filas cuyos números de fila están en partition_index,
es decir, el 80 % de los datos elegidos aleatoriamente para
entrenamiento.
Luego, slice(-partition_index) selecciona todas las filas
que no están en esa partición, es decir, el 20 % restante, que se
destina al conjunto de prueba. Así, slice() permite dividir
el conjunto de datos de forma clara y controlada, usando los índices
generados previamente.
4) Modelado
Para el modelado de redes neuronales usamos el paquete neuralnet. Este paquete es una herramienta de R diseñada para entrenar redes neuronales artificiales mediante algoritmos como backpropagation, resilient backpropagation (con o sin retroceso de pesos) y una versión globalmente convergente modificada. Permite una configuración flexible mediante la elección personalizada de funciones de error y activación, e incluye funcionalidades como el cálculo de pesos generalizados y la estimación de intervalos de confianza para los pesos. Además, ofrece métodos para visualizar la red y sus pesos, realizar predicciones y evaluar el rendimiento del modelo, siendo útil tanto para clasificación binaria como multiclase, y adaptable a funciones de activación personalizadas.
4.1) Creamos modelo
model1 = neuralnet(DefaulterFlag~.-DefaulterType, data=training,
hidden=2, err.fct = "sse", threshold = 0.05,
linear.output = TRUE)Este código en R entrena una red neuronal utilizando el paquete
neuralnet para predecir la variable
DefaulterFlag a partir de todas las demás variables del
conjunto de datos training, excepto
DefaulterType. La red tiene una sola capa oculta con 2
neuronas (hidden=2), utiliza la suma de errores cuadrados
como función de error (err.fct = "sse"), y detiene el
entrenamiento cuando el gradiente del error cae por debajo de 0.05
(threshold = 0.05). Además, se especifica que la salida
debe ser lineal (linear.output = TRUE), lo cual es común en
problemas de regresión. En resumen, este modelo busca predecir una
variable continua o binaria sin aplicar una función de activación en la
capa de salida
# Convertir la matriz a data.frame
result_df <- as.data.frame(model1$result.matrix)
# Mostrar como tabla
kable(result_df, caption = "Resumen de Resultados del Modelo")| V1 | |
|---|---|
| error | 2033.8313283 |
| reached.threshold | 0.0490273 |
| steps | 44374.0000000 |
| Intercept.to.1layhid1 | 1.4232370 |
| AGE.to.1layhid1 | -0.9780690 |
| NOOFDEPE.to.1layhid1 | 0.3295564 |
| MTHINCTH.to.1layhid1 | -0.0176417 |
| SALDATFR.to.1layhid1 | -0.0774310 |
| TENORYR.to.1layhid1 | 4.9622208 |
| DWNPMFR.to.1layhid1 | -1.5818042 |
| PROFBUS.to.1layhid1 | 0.3770548 |
| QUALHSC.to.1layhid1 | 0.0908092 |
| QUAL_PG.to.1layhid1 | -0.4115170 |
| SEXCODE.to.1layhid1 | 0.3285056 |
| FULLPDC.to.1layhid1 | -1.7139877 |
| FRICODE.to.1layhid1 | -0.2364627 |
| WASHCODE.to.1layhid1 | -0.1344690 |
| Region.to.1layhid1 | -0.9702726 |
| Branch.to.1layhid1 | 0.8087999 |
| Intercept.to.1layhid2 | 93.7919507 |
| AGE.to.1layhid2 | -4.6278093 |
| NOOFDEPE.to.1layhid2 | 12.2001037 |
| MTHINCTH.to.1layhid2 | 3.4027806 |
| SALDATFR.to.1layhid2 | -50.2386063 |
| TENORYR.to.1layhid2 | -3.3219125 |
| DWNPMFR.to.1layhid2 | 2.4514990 |
| PROFBUS.to.1layhid2 | -4.0501572 |
| QUALHSC.to.1layhid2 | 1.5697012 |
| QUAL_PG.to.1layhid2 | -2.0938727 |
| SEXCODE.to.1layhid2 | 1.4829946 |
| FULLPDC.to.1layhid2 | -5.8699206 |
| FRICODE.to.1layhid2 | -0.1702011 |
| WASHCODE.to.1layhid2 | -2.1323500 |
| Region.to.1layhid2 | -73.7419229 |
| Branch.to.1layhid2 | -7.4387363 |
| Intercept.to.DefaulterFlag | -0.0287451 |
| 1layhid1.to.DefaulterFlag | 0.8000771 |
| 1layhid2.to.DefaulterFlag | 0.1727926 |
🧠 Estructura general
error: el valor del error final del modelo después del entrenamiento. En este caso es
2033.83, lo que indica qué tan lejos están las predicciones del modelo respecto a los valores reales.reached.threshold: el valor mínimo del gradiente del error alcanzado. Si es menor al umbral que se definio (
threshold = 0.05), el entrenamiento se detienesteps: número de iteraciones que tomó entrenar la red. Aquí fueron
44374pasos.
🔗 Pesos de la red neuronal
Los siguientes valores representan los pesos aprendidos por la red entre las capas:
Intercept.to.1layhid1: peso del sesgo (bias) hacia la primera neurona oculta.AGE.to.1layhid1: peso de la variableAGEhacia la primera neurona oculta....to.1layhid2: pesos hacia la segunda neurona oculta.1layhid1.to.DefaulterFlag: peso de la primera neurona oculta hacia la neurona de salida (DefaulterFlag).Intercept.to.DefaulterFlag: sesgo hacia la neurona de salida.
🧾 ¿Cómo interpretarlo?
Cada peso indica la influencia de una variable sobre una neurona. Por ejemplo:
Un peso positivo como
TENORYR.to.1layhid1 = 3.87sugiere que a mayorTENORYR, mayor activación en esa neurona.Un peso negativo como
PROFBUS.to.1layhid1 = -0.63indica una relación inversa.sos hacia la segunda neurona oculta. 1layhid1.to.DefaulterFlag: peso de la primera neurona oculta hacia la neurona de salida (DefaulterFlag). Intercept.to.DefaulterFlag: sesgo hacia la neurona de salida.
🧠 Resumen del Gráfico de la Red Neuronal
El gráfico representa visualmente cómo tu modelo de red neuronal
procesa la información para predecir la variable objetivo
DefaulterFlag.
🔹 Entradas (Input Layer)
Cada nodo de entrada representa una variable del conjunto de datos,
como AGE, NOOFDEPDE, MTHINCTH,
etc. Estas son las características que el modelo utiliza para hacer
predicciones.
🔹 Sesgos (Bias)
Los valores constantes como 1 conectados a las neuronas
ocultas y de salida representan los términos de sesgo.
Estos permiten que las neuronas se activen incluso si todas las entradas
son cero, mejorando la flexibilidad del modelo.
🔹 Capa Oculta (Hidden Layer)
Contiene neuronas que combinan las entradas con sus respectivos pesos. Cada conexión tiene un peso que indica la influencia de una variable sobre esa neurona. Pesos positivos refuerzan la señal; negativos la reducen.
🔹 Salida (Output Layer)
La neurona de salida produce el valor final de predicción
(DefaulterFlag), combinando las señales de las neuronas
ocultas.
🔹 Pesos
Los números en las conexiones (como 2.1224,
-0.3680, etc.) son los pesos aprendidos
durante el entrenamiento. Indican la fuerza y dirección de la influencia
entre nodos.
4.2) Predecimos con el modelo creado
Primero, usamos el modelo entrenado
(model1) para predecir los valores de la variable objetivo
(DefaulterFlag) sobre el conjunto de datos de prueba
(testing):
Segundo, obtener los valores reales desde el conjunto original :
real.defaulter <- CrediCars %>%
slice(-partition_index,) %>% # Excluimos el indice de las filas de entramientos y solo tomamos las de prubea (la "," indica que son filas)
pull(DefaulterFlag) # Extraer variable como vectorTercero, extraer las predicciones normalizadas
[,1]
[1,] 0.7366943
[2,] 0.4415514
[3,] 0.9274547
[4,] 0.7971660
[5,] 0.8857299
[6,] 0.8295557Cuarto, Denormalizar (opcional, ilustrativo). Dado que los valores ya están entre 0 y 1, no necesitas desnormalizar. Sin embaergo, de forma ilustrativa se convierte el vector de predicciones normalizadas pred.defaulter.norm en un vector numérico y lo multiplica por el valor máximo de real.defaulter. Intenta reescalar las predicciones, pero lo hace incorrectamente al usar una fórmula equivocada.
pred.defaulter <- pred.defaulter.norm %>%
as.vector() %>%
`*`(diff(range(real.defaulter)) + min(real.defaulter))
head(pred.defaulter)[1] 0.7366943 0.4415514 0.9274547 0.7971660 0.8857299 0.8295557Quinto, Crear un data frame con los resultados
Sexto, establecemos un umbral que de la probabilidad de la predicción que minimice las perdidas de falsos positivos y falsos negativos, teniendo en cuenta los costos asociados de $4.200 para falsos positivos y $3.500 para falsos negativos. Para ello calculamos el umbral que minimice la opción de falsos negativo y falsos positivos, que a su vez minimices los costos que tendría el error del modelo
# Costos definidos
cost_fp <- 4200 # Costo de falso positivo
cost_fn <- 3500 # Costo de falso negativo
# Función para calcular el costo total dado un umbral
calcular_costo <- function(umbral, data) {
pred_clasificada <- ifelse(data$prediction >= umbral, 1, 0)
fp <- sum(pred_clasificada == 1 & data$real == 0)
fn <- sum(pred_clasificada == 0 & data$real == 1)
return(fp * cost_fp + fn * cost_fn)
}
# Secuencia de umbrales
umbrales <- seq(0, 1, by = 0.001)
# Calcular el costo para cada umbral
costos <- sapply(umbrales, calcular_costo, data = DefaulterFlag)
# Crear un dataframe para graficar
df_costos <- data.frame(umbral = umbrales, costo = costos)
# Encontrar el umbral óptimo
umbral_optimo <- df_costos$umbral[which.min(df_costos$costo)]
costo_minimo <- min(df_costos$costo)
# Mostrar resultados
cat("Umbral óptimo:", round(umbral_optimo, 3), "\n")Umbral óptimo: 0.527 Costo mínimo total: 6112400 # Graficar con ggplot2
ggplot(df_costos, aes(x = umbral, y = costo)) +
geom_line(color = "steelblue", size = 1) +
geom_vline(xintercept = umbral_optimo, color = "red", linetype = "dashed") +
geom_hline(yintercept = costo_minimo, color = "darkgreen", linetype = "dotted") +
annotate("text", x = umbral_optimo, y = costo_minimo + 10000,
label = paste0("Umbral óptimo = ", round(umbral_optimo, 3)),
color = "red", hjust = -0.1) +
annotate("text", x = 0.05, y = costo_minimo,
label = paste0("Costo mínimo = $", format(costo_minimo, big.mark = ",")),
color = "darkgreen", vjust = -1) +
labs(title = "Costo total vs. Umbral de predicción",
x = "Umbral de clasificación",
y = "Costo total") +
theme_minimal()
5) Evaluación
Calculamos la matriz de confusión
📌 Interpretación de métricas de clasificación
| Métrica | ¿Qué evalúa? | Valor agregado |
|---|---|---|
| Accuracy | Proporción de predicciones correctas sobre el total. | Útil como visión general del desempeño, pero puede ser engañosa si hay desbalance entre clases. |
| Kappa | Acuerdo entre predicción y realidad, ajustado por el azar. | Evalúa si el modelo realmente aporta valor más allá de una clasificación aleatoria. |
| Precision | De los casos predichos como positivos, ¿cuántos lo eran realmente? | Minimiza falsos positivos. Clave si actuar sobre un falso positivo tiene un costo (ej. rechazar crédito). |
| Recall (Sensibilidad) | De los casos realmente positivos, ¿cuántos fueron detectados por el modelo? | Minimiza falsos negativos. Fundamental si omitir un caso positivo es riesgoso (ej. no detectar fraude). |
| F1 Score | Promedio armónico entre precisión y recall. | Resume el balance entre precisión y recall. Ideal cuando hay desbalance de clases. |
| Specificity | De los casos negativos reales, ¿cuántos fueron correctamente clasificados? | Evalúa la capacidad del modelo para no etiquetar erróneamente a los negativos. |
| Balanced Accuracy | Promedio entre sensibilidad y especificidad. | Corrige el sesgo de accuracy en datasets desbalanceados. |
# Clasificar según el umbral
DefaulterFlag <- DefaulterFlag %>%
mutate(predicted_class = ifelse(prediction >= umbral_optimo, 1, 0),
real = as.factor(real),
predicted_class = as.factor(predicted_class))
# Crear matriz de confusión
matriz <- confusionMatrix(data = DefaulterFlag$predicted_class, reference = DefaulterFlag$real, positive = "1")
# Mostrar métricas
print(matriz)Confusion Matrix and Statistics
Reference
Prediction 0 1
0 589 454
1 1077 3661
Accuracy : 0.7352
95% CI : (0.7236, 0.7465)
No Information Rate : 0.7118
P-Value [Acc > NIR] : 4.135e-05
Kappa : 0.2737
Mcnemar's Test P-Value : < 2.2e-16
Sensitivity : 0.8897
Specificity : 0.3535
Pos Pred Value : 0.7727
Neg Pred Value : 0.5647
Prevalence : 0.7118
Detection Rate : 0.6333
Detection Prevalence : 0.8196
Balanced Accuracy : 0.6216
'Positive' Class : 1
# Extraer tabla para graficar
tabla <- as.data.frame(matriz$table)
colnames(tabla) <- c("Real", "Predicho", "Frecuencia")
# Graficar matriz de confusión
ggplot(tabla, aes(x = Predicho, y = Real, fill = Frecuencia)) +
geom_tile(color = "white") +
geom_text(aes(label = Frecuencia), size = 6) +
scale_fill_gradient(low = "lightblue", high = "steelblue") +
labs(title = "Matriz de Confusión", x = "Predicción", y = "Valor Real") +
theme_minimal()
Ahora vemos las métricas de forma explicita
# Accuracy
accuracy <- matriz$overall["Accuracy"]
# Kappa (medida de concordancia)
kappa <- matriz$overall["Kappa"]
# Métricas por clase
precision <- matriz$byClass["Precision"]
recall <- matriz$byClass["Recall"] # también conocido como Sensitivity
f1 <- matriz$byClass["F1"]
# También podemos extraer otras métricas útiles:
specificity <- matriz$byClass["Specificity"]
balanced_accuracy <- matriz$byClass["Balanced Accuracy"]
metricas <- data.frame(
Accuracy = accuracy,
Kappa = kappa,
Precision = precision,
Recall = recall,
F1_Score = f1,
Specificity = specificity,
Balanced_Accuracy = balanced_accuracy
)
print(metricas)📊 Evaluación del Modelo de Clasificación
Se evaluó el desempeño del modelo utilizando métricas estándar de clasificación binaria. A continuación se presentan los resultados obtenidos:
| Métrica | Valor | Interpretación |
|---|---|---|
| Accuracy | 0.735 | El 73.5% de las predicciones totales fueron correctas. Útil si las clases están balanceadas. |
| Kappa | 0.274 | Mide el acuerdo entre predicción y realidad, ajustado por azar. Un valor bajo indica que el modelo no mejora mucho sobre el azar. |
| Precision | 0.773 | De todas las veces que el modelo predijo “defaulter” (1), acertó el 77.3%. Importante si los falsos positivos son costosos. |
| Recall (Sensibilidad) | 0.890 | De todos los verdaderos “defaulters”, el modelo identificó correctamente el 89%. Ideal si es más grave no detectar un defaulter. |
| F1 Score | 0.827 | Promedio armónico entre precisión y recall. Buen resumen cuando hay desbalance de clases. |
| Specificity | 0.354 | Solo el 35.4% de los “no defaulters” fueron correctamente identificados. El modelo tiene dificultad para detectar correctamente los negativos. |
| Balanced Accuracy | 0.622 | Promedio entre sensibilidad y especificidad. Útil cuando las clases están desbalanceadas. |
🧠 Conclusiones
El modelo muestra alta capacidad para identificar correctamente a los clientes con riesgo de incumplimiento (recall alto), lo cual es deseable en contextos de riesgo crediticio o cumplimiento normativo.
Sin embargo, la baja especificidad indica una alta tasa de falsos positivos, lo que podría llevar a rechazar clientes que en realidad no representan riesgo.
El F1 Score de 0.827 refleja un buen equilibrio entre precisión y sensibilidad.
El índice Kappa de 0.274 sugiere que el modelo tiene margen de mejora respecto a una clasificación aleatoria.
6) Despliegue
El modelo de clasificación evaluado muestra un desempeño aceptable en términos generales, con una precisión (accuracy) del 73.5% y un F1 Score de 0.827, lo que indica un buen equilibrio entre la capacidad de identificar correctamente los casos positivos (defaulters) y evitar falsos positivos. La sensibilidad (recall) es particularmente alta (0.89), lo que sugiere que el modelo es eficaz para detectar la mayoría de los casos relevantes, un aspecto crítico en contextos como el análisis de riesgo o cumplimiento normativo.
Sin embargo, la especificidad es baja (0.35), lo que implica que el modelo tiene dificultades para identificar correctamente los casos negativos (no defaulters). Esto puede traducirse en una tasa elevada de falsos positivos, lo cual podría impactar negativamente en decisiones operativas, como rechazar solicitudes de clientes que en realidad no representan riesgo. El índice Kappa (0.27) también sugiere que el modelo tiene margen de mejora respecto a una clasificación aleatoria.
En cuanto al uso de redes neuronales, estas son recomendables cuando se trabaja con grandes volúmenes de datos, relaciones no lineales complejas o múltiples variables altamente correlacionadas. Son especialmente útiles en tareas como procesamiento de lenguaje natural, visión por computadora o series temporales complejas. En el contexto de modelos de riesgo o clasificación de clientes, pueden ser útiles si se dispone de datos históricos ricos y variados, como transacciones, comportamiento digital o interacciones multicanal.
No obstante, las redes neuronales no siempre son la mejor opción. Si el conjunto de datos es pequeño, si se requiere interpretabilidad clara para auditorías o reguladores, o si el modelo debe ser fácilmente explicable para usuarios de negocio, entonces modelos más simples como árboles de decisión, regresión logística o modelos basados en reglas pueden ser preferibles. En estos casos, la transparencia y la facilidad de implementación pueden pesar más que una ligera mejora en la precisión.