Informe Regresión Generalizada Múltiple
CASO RIESGO DE CRÉDITO
MAESTRÍA EN CIENCIA DE DATOS UNIVERSIDAD JAVERIANA DE CALI
MÉTODOS ESTADÍSTICOS PARA LA TOMA DE DECISIONES
Carolina Galindres Bernal, Adrian Rodriguez Amaya
SELECCIÓN DE VARIABLES
Para el desarrollo de la presente simulación utilizaremos los datos relacionados con el riesgo de dafault de una compañía con base en algunas varibles definidas, a saber:
## 'data.frame': 780 obs. of 5 variables:
## $ Riesgo : Factor w/ 2 levels "0","1": 2 2 2 2 2 2 2 2 2 2 ...
## $ Antiguedad: num 37.3 37.3 31 9.7 8.4 6.6 10.7 12.8 7.2 19.9 ...
## $ Edad : int 77 74 79 52 39 45 58 57 54 51 ...
## $ Cuota : num 3.02 1.77 1.67 0.67 1.22 3.52 1.3 2.1 0.2 1.67 ...
## $ Ingresos : num 8.16 6.18 4.33 5.29 5.33 2.71 3.17 4.8 2.24 5.63 ...ANÁLISIS UNIVARIADO
Ahora, realizaremos un análisis univariado del dataset para identificar cuáles son las variables más relevantes a tener en cuenta para la construcción del modelo de regresión logístico. Incluiremos dentro del análisis una varible calculada con respecto a la relación del valor de la cuota y el valor de los ingresos.
Del análisis de los años de antigüedad, podemos identificar que el promedio se ubica alrededor los 18 años; además que la distribución de la población en años de antigüedad se encuentra dentro los 7 a 31 años.
La edad promedio de las personas analizadas, se encuentra alrededor de 58 años, en donde el mayor rango de estas personas se ubica dentro de los 48 a 66 años de edad.
Para la cuota observamos que esta está en un promedio de 1 millón, mientras que los ingresos promedios se ubican alrededor de los 5 millones y la proporción cuota-ingreso promedio es del 16% aproximadamente.
ANÁLISIS BIVARIADO
En este punto, realizaremos un análisis bivariado de todas las variables del dataset para observar su comportamiento con respecto al riesgo de default.
De acuerdo con la gráfica anterior podemos identificar con respecto a la antigüedad, que los que tienen una antigüedad superior a los veinte años tienen menor riesgo de default frente a los que tienen menos de este valor.
En cuanto a la edad, observamos que esta variable no representaría mayor relevancia ya que su proporción observada cerca de 50-50 de riesgo de default.
De la cuota podemos apreciar que a medida que la cuota aumenta sobre aproximadamente 1.3 millones, el riesgo de default es mayor. Mientras que con los ingresos mayores a 6 millones representan menor riesgo de crédito.
Ahora, con respecto a la variable calculada de la cuota vs ingresos, observamos que, cuando esta proporción es superior a apoximadamente el 25% el riesgo de default es mayor.
Luego de este análisis considereamos que las variables más relevantes a tener en cuenta son la Antiguedad, Cuota e Ingresos.
MODELO DE REGRESIÓN LOGÍSTICO
En este punto realizaremos la construcción del modelo de regresión logístico a partir de las variables seleccionadas.
modelo_glm = glm(data = training_set,
formula = Riesgo ~ Antiguedad + Cuota + Ingresos,
family = 'binomial')
summary(modelo_glm)##
## Call:
## glm(formula = Riesgo ~ Antiguedad + Cuota + Ingresos, family = "binomial",
## data = training_set)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.8545 -0.3933 -0.3062 -0.2066 3.0606
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.14031 0.41362 -5.175 2.28e-07 ***
## Antiguedad -0.03216 0.01908 -1.686 0.091847 .
## Cuota 0.94406 0.25375 3.720 0.000199 ***
## Ingresos -0.22813 0.10941 -2.085 0.037054 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 269.66 on 623 degrees of freedom
## Residual deviance: 251.26 on 620 degrees of freedom
## AIC: 259.26
##
## Number of Fisher Scoring iterations: 6De acuerdo con los resultados del modelo, podemos evidenciar que las variables más significativas son: Cuota e Ingresos. Podemos destacar que la variable que más disminuye la probabilidad de riesgo de default, es la de ingreso. Por el contrario, la variable Cuota es la que más aumenta la probabilidad de riesgo de default.
CURVA ROC Y AUC
Ahora evaluaremos el punto óptimo para trigger que utilizaremos para identificar la bondad del modelo.
par(pty = 's')
roc(training_set$Riesgo, modelo_glm$fitted.values, plot = TRUE,
legacy.axes = TRUE,
percent = TRUE,
xlab = 'False Positive Percentage',
ylab = 'True Positive Percentage',
col = '#ff9aa2',
lwd = 4,
print.auc = TRUE,
print.thres = 'best')
##
## Call:
## roc.default(response = training_set$Riesgo, predictor = modelo_glm$fitted.values, percent = TRUE, plot = TRUE, legacy.axes = TRUE, xlab = "False Positive Percentage", ylab = "True Positive Percentage", col = "#ff9aa2", lwd = 4, print.auc = TRUE, print.thres = "best")
##
## Data: modelo_glm$fitted.values in 589 controls (training_set$Riesgo 0) < 35 cases (training_set$Riesgo 1).
## Area under the curve: 68.93%Como podemos observar en la gráfica anterior, el punto óptimo más cercano a una sensibilidad igual al 100% y especificidad igual al 100% corresponde a un valor de 0. Este, será el valor que se seleccionará como threshold para evaluar la matriz de confusión.
PRUEBA DE PREDICCÓN DEL MODELO
Con toda la información anteriormente recopilada, evaluaremos el poder predictivo del modelo calculado, para tal fin debemos identificar la bondad del modelo.
predicciones = ifelse(modelo_glm$fitted.values > 0, yes = 1, no = 0)
matriz_confusion = table(modelo_glm$model$Riesgo, predicciones,
dnn = c('observaciones', 'predicciones'))
matriz_confusion## predicciones
## observaciones 1
## 0 589
## 1 35mosaic(matriz_confusion, shade = TRUE, colorize = TRUE,
gp = gpar(fill = matrix(c('#b5ead7', '#fbb4ae', '#fbb4ae', '#b5ead7'), 2, 2)))
sum(diag(matriz_confusion))/sum(matriz_confusion)## [1] 0.9439103Conforme a los resultados podemos identificar que de 593 observaciones identificó que todas correspondian a no riesgo de default, mientras que de las 31 observaciones con riesgo de default, identificó que todas ellas efectivamente positivas indicando.
En general podemos estimar una bondad del ajuste del modelo de regresión logístico de aproximadamente 95% entre el conjunto de datos observados.
Ahora, confirmaremos la veracidad de los resultados obtenidos realizando una validación cruzada con una muestra de datos utilizados para prueba. Así:
predict_eval = predict(object = modelo_glm, newdata = test_set, type = 'response')
predicciones = ifelse(predict_eval > 0.1, yes = 1, no = 0)
matriz_confusion = table(test_set$Riesgo, predicciones,
dnn = c('observaciones', 'predicciones'))
matriz_confusion## predicciones
## observaciones 0 1
## 0 138 14
## 1 3 1mosaic(matriz_confusion, shade = TRUE, colorize = TRUE,
gp = gpar(fill = matrix(c('#b5ead7', '#fbb4ae', '#fbb4ae', '#b5ead7'), 2, 2)))
sum(diag(matriz_confusion))/sum(matriz_confusion)## [1] 0.8910256A partir de la validación cruzada realizada, es posible estimar que el modelo propuesto permite identificar el riesgo de default en un 91% aproximadamente.
*** Fin del documento ***