Machine Learning
Regresion Logistica Aplicada
Machine Learning
Regresion Logistica Aplicada
Desarrollado por Ing. Jonathan Tumipamba
Desarrollado por Ing. Jonathan Tumipamba
Modelos de prediccion de riesgo crediticio
Introduccion
Este proyecto tiene como objetivo demostrar el uso de R para construir un modelo de regresión logística, una técnica ampliamente utilizada en problemas de clasificación binaria. El modelo predice la probabilidad de que un sujeto de credito no sea capaza de caer en mora crediticia en función de diversas características del conjunto de datos.
La regresión logística es una herramienta clave en modelos de machine learning de aprendisaje supervisado, utilizada en aplicaciones como detección de fraudes, predicción de enfermedades, y análisis de comportamiento del cliente.
Para esta demostración, se utiliza un conjunto de datos Credito que contiene 4454 observaciones y 14 variables.
Para más información no dudes en contactarme
mail: jonatj@outlook.com
Objetivos
Construir un modelo predictivo para determinar si un cliente devolverá el crédito o incurrirá en mora..
Validar el modelo utilizando el método Leave-One-Out (LOO) para asegurar un desempeño robusto.
Evaluar el modelo mediante una matriz de confusión y métricas clave como precisión
Librerias y Datos
#Las siguientes librerias se utilizaran para el procesos de analisis de datos
library(ggplot2)
library(dplyr)
library(psych)
library(visdat)
library(gridExtra)
library(knitr)
library(plotly)
library(gt)Estructura de los Datos
El conjunto de datos ya curado, es decir que ya es una informacion
relativamente limpia con cada una de las variables ya transformada,
contiene 14 variables y 4454 observaciones (n = 4.454), cada observacion
(fila) corresponde aun sujeto de credito, puede obtener mayor
informacion sobre el conjunto de variables y su estructura corriendo la
siguiente comando en la consola de R str(credito), la
funcion permite observar su estructura para cada variable
#Estructura de datos
head(str(credito))## 'data.frame': 4454 obs. of 14 variables:
## $ Estado : Factor w/ 2 levels "malo","bueno": 2 2 1 2 2 2 2 2 2 1 ...
## $ Antiguedad : int 9 17 10 0 0 1 29 9 0 0 ...
## $ Vivienda : Factor w/ 6 levels "ignorar","otra",..: 6 6 3 6 6 3 3 4 3 4 ...
## $ Plazo : int 60 60 36 60 36 60 60 12 60 48 ...
## $ Edad : int 30 58 46 24 26 36 44 27 32 41 ...
## $ EstadoCivil: Factor w/ 5 levels "divorciado","casado",..: 2 5 2 4 4 2 2 4 2 2 ...
## $ Registros : Factor w/ 2 levels "no","sí": 1 1 2 1 1 1 1 1 1 1 ...
## $ Trabajo : Factor w/ 4 levels "fijo","freelance",..: 2 1 2 1 1 1 1 1 2 4 ...
## $ Gastos : int 73 48 90 63 46 75 75 35 90 90 ...
## $ Ingresos : int 129 131 200 182 107 214 125 80 107 80 ...
## $ Activos : int 0 0 3000 2500 0 3500 10000 0 15000 0 ...
## $ Deuda : int 0 0 0 0 0 0 0 0 0 0 ...
## $ Cantidad : int 800 1000 2000 900 310 650 1600 200 1200 1200 ...
## $ Precio : int 846 1658 2985 1325 910 1645 1800 1093 1957 1468 ...## NULLLos datos presentan cinco variables de tipo factorial y nueve
variables de tipo numerico, acontinuacion se presenta un grafico
utilizando funciones del paquete visdat donde se marca
aquellas variables de tipo numericas y de tipo factor, tambien se
destaca la precencia de NA (VAlores faltantes) y la proporcion de ellos
en el conjunto de datos por cada variable
visdat::vis_dat(credito,palette = "qual" )
colSums(is.na(credito))## Estado Antiguedad Vivienda Plazo Edad EstadoCivil
## 0 0 6 0 0 1
## Registros Trabajo Gastos Ingresos Activos Deuda
## 0 2 0 381 47 18
## Cantidad Precio
## 0 0La variable Ingreso tiende a tener la mayor cantidad de datos perdidos con un 9% en total de toda la variable, tambien se observa que el 99.3% de las observaciones de todo el conjunto de datos esta completo
Para la cosntruccion del modelo solo se tomaran los registros completo dado que los valores faltantes solo representan un porcentaje pequeño frente al total de regsistros
credito <- credito[complete.cases(credito),]
sum(is.na(credito))## [1] 0Con el comando que se corrio anteriormente ya no existen la presencia de valores faltantes dentro de la data
Breve explorancion de variables
¿Qué tan balanceada está la variable objetivo (“Buenos/Malos”)?
prob <- round(prop.table(table(credito$Estado))*100,2 )
formatted <- paste0(prob, "%")
# Asignar los nombres del vector original
names(formatted) <- names(prob)
# Ver el resultado
formatted## malo bueno
## "25.4%" "74.6%"La variable objetivo muestras que tiene un desequilibrio entre las clases “malo” y “bueno”. Esto es común en datasets de crédito, donde suele haber más clientes con buen historial crediticio que con mal historial
¿Existe una relacion entre el estado crediticio del sujeto con su trabajo?
table(
credito$Estado,
credito$Trabajo
)##
## fijo freelance otros tiempo parcial
## malo 549 165 56 256
## bueno 2202 545 91 175La tabla nos muestra que trabajo fijo: Tiene la mayor cantidad de clientes con estado crediticio “bueno” (2202), lo que sugiere que las personas con empleo fijo suelen tener un perfil crediticio más favorable.
En el otro extremo tenemos aquellos que tiene un trabajo a tiempo parcial, aunque tiene una cantidad moderada de clientes, la proporción de estados “malo” (256) es mucho más alta en relación con los estados “bueno” (175), lo que indica que este grupo tiene un riesgo crediticio relativamente alto.
library(ggplot2)
ggplot(credito, aes(x = Trabajo, fill = Estado)) +
geom_bar(position = "fill") +
labs(title = "Estado crediticio según el tipo de trabajo",
x = "Tipo de trabajo",
y = "Proporción",
fill = "Estado crediticio") +
theme_minimal()
El tipo de trabajo parece estar asociado con el estado crediticio del cliente. Las personas con empleos fijos tienen una probabilidad más alta de tener un estado crediticio “bueno”, mientras que las personas con trabajos a tiempo parcial o en la categoría “otros” presentan un mayor riesgo crediticio, dado esto se realizara una prueba estadistica para saber su significancia
tabla <- table(
credito$Estado,
credito$Trabajo
)
chisq.test(tabla)##
## Pearson's Chi-squared test
##
## data: tabla
## X-squared = 320.15, df = 3, p-value < 2.2e-16Dado que el valor p (2.2e-16) es extremadamente bajo (menor al nivel típico de significancia de 0.05), rechazamos la hipótesis nula. Esto indica que existe una relación significativa entre el tipo de trabajo y el estado crediticio.
Construccion del Modelo
Se construyó un modelo de regresión logística utilizando la función
glm() para todos los regeistros, utilizando la variable
objetivo Estado, el cual tiende a categorizar entre clientes buenos y
malos
Este modelo estimara la probabilidad de que un sujeto de credito sea considerado bueno o malo basado en las características disponibles.
Se contruye el modelo de prediccion con todas las caracterirsticas del conjunto de datos, al mismo tiempo se muestra un resumen del modelo
model_credito <- glm(Estado ~ ., data = credito, family = 'binomial')
summary(model_credito)##
## Call:
## glm(formula = Estado ~ ., family = "binomial", data = credito)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 8.120e-01 7.575e-01 1.072 0.283738
## Antiguedad 8.133e-02 8.213e-03 9.902 < 2e-16 ***
## Viviendaotra 3.441e-01 5.859e-01 0.587 0.557025
## Viviendapropietario 1.192e+00 5.678e-01 2.100 0.035724 *
## Viviendapadres 9.770e-01 5.776e-01 1.691 0.090742 .
## Viviendaprivado 4.799e-01 5.872e-01 0.817 0.413795
## Viviendaalquila 5.890e-01 5.718e-01 1.030 0.303000
## Plazo 4.233e-04 3.867e-03 0.109 0.912817
## Edad -8.831e-03 5.444e-03 -1.622 0.104750
## EstadoCivilcasado 7.436e-01 4.389e-01 1.694 0.090210 .
## EstadoCivilseparado -5.001e-01 4.879e-01 -1.025 0.305277
## EstadoCivilsoltero 3.316e-01 4.442e-01 0.746 0.455399
## EstadoCivilviudo 8.665e-02 5.519e-01 0.157 0.875243
## Registrossí -1.818e+00 1.095e-01 -16.610 < 2e-16 ***
## Trabajofreelance -3.142e-01 1.242e-01 -2.529 0.011440 *
## Trabajootros -6.661e-01 2.220e-01 -3.000 0.002700 **
## Trabajotiempo parcial -1.511e+00 1.299e-01 -11.631 < 2e-16 ***
## Gastos -1.818e-02 2.883e-03 -6.306 2.86e-10 ***
## Ingresos 7.602e-03 7.644e-04 9.946 < 2e-16 ***
## Activos 2.703e-05 7.924e-06 3.412 0.000645 ***
## Deuda -1.516e-04 4.283e-05 -3.540 0.000401 ***
## Cantidad -2.214e-03 1.954e-04 -11.331 < 2e-16 ***
## Precio 1.065e-03 1.476e-04 7.214 5.43e-13 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4577.9 on 4038 degrees of freedom
## Residual deviance: 3364.2 on 4016 degrees of freedom
## AIC: 3410.2
##
## Number of Fisher Scoring iterations: 5Existe presencia de ciertas variables que sus valores p no son significativos, lo que sugiere una eliminacion de las mismas dentro del modelo.
En la seccion de Breve exploracion de variable ya se reviso la relacion existente entre el Trabajo y Estado el caul el test chicuadro mostro que era significativa y por ende se la debe incluir como predictor en el modelo.
No obstante como base para eliminar se realizara una analisis adicional de colinealidad y verificar si algunas de estas están correlacionadas con otras variables (colinealidad)
Si existe colinealidad, podrías descartar la variable menos relevante
Breve Analisis de Colinealidad
car::vif(model_credito)## GVIF Df GVIF^(1/(2*Df))
## Antiguedad 1.365654 1 1.168612
## Vivienda 2.036618 5 1.073720
## Plazo 1.434699 1 1.197789
## Edad 1.784053 1 1.335684
## EstadoCivil 2.225151 4 1.105147
## Registros 1.094466 1 1.046167
## Trabajo 1.578307 3 1.079026
## Gastos 1.789153 1 1.337592
## Ingresos 1.264159 1 1.124348
## Activos 1.387645 1 1.177983
## Deuda 1.169670 1 1.081513
## Cantidad 4.125883 1 2.031227
## Precio 3.410177 1 1.846666De manera general los resultados del análisis de colinealidad usando el VIF del paquete car ( Variance Inflation Factor), se observa que los valores están relativamente bajos, lo que indica que no hay un problema grave de colinealidad.
Seleccion de Caracteristicas
Se considerar eliminar
EstadoCivil, Plazo, Edad, Vivienda del modelo para
simplificarlo, ya que no son varibles significativas para los procesos
de previscion que se busca, esto esta visto desde el punto de vista
practico, ademas porque sus valores P no son significativos.
Después de eliminarla, se verificara si el desempeño del modelo (AIC, Deviance Residual) mejora o se mantiene similar.
modelo_simplificado <- glm(formula = Estado ~ . - EstadoCivil - Plazo - Edad - Vivienda - Precio, family = "binomial", data = credito)
summary(modelo_simplificado)##
## Call:
## glm(formula = Estado ~ . - EstadoCivil - Plazo - Edad - Vivienda -
## Precio, family = "binomial", data = credito)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 2.123e+00 1.740e-01 12.201 < 2e-16 ***
## Antiguedad 8.019e-02 7.492e-03 10.703 < 2e-16 ***
## Registrossí -1.779e+00 1.053e-01 -16.898 < 2e-16 ***
## Trabajofreelance -2.765e-01 1.199e-01 -2.305 0.021147 *
## Trabajootros -7.639e-01 2.008e-01 -3.805 0.000142 ***
## Trabajotiempo parcial -1.508e+00 1.260e-01 -11.967 < 2e-16 ***
## Gastos -1.565e-02 2.269e-03 -6.897 5.29e-12 ***
## Ingresos 7.628e-03 7.466e-04 10.217 < 2e-16 ***
## Activos 5.237e-05 8.854e-06 5.915 3.32e-09 ***
## Deuda -1.058e-04 4.380e-05 -2.415 0.015722 *
## Cantidad -1.174e-03 9.964e-05 -11.782 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4577.9 on 4038 degrees of freedom
## Residual deviance: 3527.7 on 4028 degrees of freedom
## AIC: 3549.7
##
## Number of Fisher Scoring iterations: 5Resumen de los resultados:
Residual deviance: 3452.1 - Ha disminuido en comparación con el modelo anterior (3364.2), lo que indica un mejor ajuste.
AIC: 3476.1 - También ha bajado con respecto al modelo anterior (3410.2).
Esto sugiere que el modelo corrido es mas simple eliminado algunas vairables no “relevantes” visto esto desde el sentido practico sin perder el poder predictivo, e incluso se ha mejorado el modelo en términos de eficiencia y rendimiento
Validación externa con Leave-One-Out
El método de validación Leave-One-Out (LOO) es una técnica de validación cruzada que evalúa el desempeño del modelo utilizando cada observación del conjunto de datos como un caso de prueba único, mientras las demás observaciones se utilizan para entrenar el modelo. Este proceso se repite tantas veces como observaciones haya en el conjunto de datos.
El principal beneficio del método LOO es que proporciona una evaluación exhaustiva del modelo, y garantiza que cada dato sea evaluado como un caso independiente.
Aunque es computacionalmente más costoso que otros métodos de validación cruzada,
En este proyecto, se utilizó LOO para validar el modelo de regresión logística y obtener una estimación confiable de su capacidad predictiva.
result_Aic <- rep(0,nrow(credito))
result_reduce_deviance <- rep(0,nrow(credito))
predic_ajuste <- rep(0, nrow(credito))El método Leave-One-Out (LOO) es una alternativa al proceso tradicional de dividir los datos en conjuntos de entrenamiento y prueba.
#Funcion de prediccion del LOO
for (i in 1: nrow(credito)) {
tra <- credito[-i,] #Entrenamiento
test <- credito[i,] #Prueba
#creacion del modelo
mgl <- glm(
Estado ~ . - EstadoCivil - Plazo - Edad - Vivienda - Precio, data = tra,
family = 'binomial'
)
#Almacenamiento
result_reduce_deviance[i] <- mgl$null.deviance - mgl$deviance
result_Aic[i] <- mgl$aic
predic_ajuste[i] <- ifelse(
predict(mgl, test, type = 'response') > 0.67,
'bueno', 'malo'
) #etiquetas
}Comportamiento del AIC (Criterio de Información de Akaike) durante LOO
Durante el proceso de validación, se calculó el Criterio de Información de Akaike (AIC) para cada iteración del LOO.
data.frame(describe(result_Aic))## vars n mean sd median trimmed mad min max
## X1 1 4039 3548.87 1.148498 3549.327 3549.114 0.4438745 3537.037 3549.747
## range skew kurtosis se
## X1 12.70967 -2.757568 11.40549 0.01807146Los valores AIC fueron bastante consistentes a lo largo de las iteraciones del LOO, con un promedio de 3409 y una mediana de 3410. Esta estabilidad sugiere que el modelo está ajustando de manera constante, sin mostrar variabilidad significativa entre los diferentes subconjuntos de datos utilizados para la validación, podemos observar las distribucion de loas valroes AIC calculados durante el proceso de interaccion en el siguiente grafico
#Validacion del AIC
hist(
result_Aic,
main = 'AIC Corridos',
xlab = 'Frecuencia de AIC'
, ylab = 'Frecuencia',
col = 'orange'
)
Al parecer el AIC se mantiene constante o varía solo ligeramente, puedemos concluir que el modelo está ajustando de manera constante y no está sobreajustando ni subajustando.
Validacion de la Prediccion vs Real
#Matriz de confusion
table(
Prediccion = predic_ajuste, Observado = credito$Estado
)## Observado
## Prediccion malo bueno
## bueno 390 2536
## malo 636 477#El nivel de ajuste del modelo es del 80% en predecir bueno
mean(predic_ajuste == credito$Estado)## [1] 0.7853429caret::confusionMatrix(
factor(predic_ajuste), credito$Estado, positive = "bueno"
)## Confusion Matrix and Statistics
##
## Reference
## Prediction malo bueno
## malo 636 477
## bueno 390 2536
##
## Accuracy : 0.7853
## 95% CI : (0.7724, 0.7979)
## No Information Rate : 0.746
## P-Value [Acc > NIR] : 2.738e-09
##
## Kappa : 0.449
##
## Mcnemar's Test P-Value : 0.003492
##
## Sensitivity : 0.8417
## Specificity : 0.6199
## Pos Pred Value : 0.8667
## Neg Pred Value : 0.5714
## Prevalence : 0.7460
## Detection Rate : 0.6279
## Detection Prevalence : 0.7244
## Balanced Accuracy : 0.7308
##
## 'Positive' Class : bueno
## Exactitud general (Accuracy):
El modelo tiene un 80.02% de precisión general, es
decir, predice correctamente el estado crediticio (bueno o malo) en el
80% de los casos, de manera general se podria analizar el comportamiento
para cada proporcion de la matrix de confusion pero se cerrara hasta
aqui