Regresion_Credito
Will Castaño
2022-10-04
Credito
Con base en los datos de créditos proponga un modelo de regresión logístico múltiple que permita predecir el riesgo de default en función de las covariables que considere importantes y seleccionándolas de acuerdo con un proceso adecuado. Tenga en cuenta realizar una evaluación de la significancia de los parámetros, interpretación y proponga un método de evaluación por medio de validación cruzada. Presente métricas apropiadas como el AUC y la curva ROC.
library(readxl)
Creditos <- read_excel("E:/Data Science/Estadistica/Mod3/Datos_Creditos.xlsx")
head(Creditos)## # A tibble: 6 x 5
## DEFAULT ANTIUEDAD EDAD CUOTA_TOTAL INGRESOS
## <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 1 37.3 77.0 3020519 8155593
## 2 1 37.3 73.8 1766552 6181263
## 3 1 31.0 78.9 1673786 4328075
## 4 1 9.73 51.5 668479 5290910
## 5 1 8.44 39.0 1223559 5333818
## 6 1 6.61 44.9 3517756 2710736** Analisis exploratorio**
## Antiguedad_promedio Antiguedad_mediana Antiguedad_min Antiguedad_max
## 1 18.03525 15.11918 0.2547945 37.31781
## Edad_promedio Edad_mediana Edad_min Edad_max
## 1 56.98502 57.91918 26.6137 92.43288
## Cuota_promedio Cuota_mediana Cuota_min Cuota_max
## 1 885205.9 694460.5 387 6664588
## Ingresos_promedio Ingresos_mediana Ingresos_min Ingresos_max
## 1 5366430 5038962 633825 22197021
Analisis Bivariado
require(PerformanceAnalytics)
chart.Correlation(Creditos, histogram=TRUE, pch="+")
Creditos$DEFAULT=as.factor(Creditos$DEFAULT)
require(plotly)
#Antiguedad
g1=ggplot(Creditos,aes(x=DEFAULT, y=ANTIUEDAD,fill=DEFAULT))+geom_boxplot()+theme_bw()
ggplotly(g1)#Edad
g2=ggplot(Creditos,aes(x=DEFAULT, y=EDAD,fill=DEFAULT))+geom_boxplot()+theme_bw()
ggplotly(g2)#Cuota
g3=ggplot(Creditos,aes(x=DEFAULT, y=CUOTA_TOTAL,fill=DEFAULT))+geom_boxplot()+theme_bw()
ggplotly(g3)#Ingresos
g4=ggplot(Creditos,aes(x=DEFAULT, y=INGRESOS,fill=DEFAULT))+geom_boxplot()+theme_bw()
ggplotly(g4)con base en los graficos bivariados se puede ver que el default se presenta en promedio para: Menores ingresos, Mayores cuotas, Menor edad y menor antiguedad
con base en el analisis de correlación se encuentra que la unica correlacion significativa del Default se presenta con el valor de Cuota, con las variables antiguedad e ingresos la correlacion es menor. Por otro lado las demas variables tienen alta correlación positiva entre si. En este sentido no se considerara la variable Edad en el modelo
Modelo
mod_creditos=glm(DEFAULT~INGRESOS+ANTIUEDAD+CUOTA_TOTAL,
data = Creditos,family = "binomial")
summary(mod_creditos)##
## Call:
## glm(formula = DEFAULT ~ INGRESOS + ANTIUEDAD + CUOTA_TOTAL, family = "binomial",
## data = Creditos)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.8147 -0.3724 -0.2868 -0.1938 3.1088
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.244e+00 3.933e-01 -5.707 1.15e-08 ***
## INGRESOS -2.542e-07 1.059e-07 -2.400 0.0164 *
## ANTIUEDAD -2.817e-02 1.803e-02 -1.562 0.1183
## CUOTA_TOTAL 9.860e-07 2.456e-07 4.014 5.96e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 309.68 on 779 degrees of freedom
## Residual deviance: 288.78 on 776 degrees of freedom
## AIC: 296.78
##
## Number of Fisher Scoring iterations: 6se encuentra que la Antiguedad tampoco presenta significancia por tanto procedemos a simplificar el modelo
mod_creditos2 = glm(DEFAULT~INGRESOS+CUOTA_TOTAL,
data = Creditos,family = "binomial")
summary(mod_creditos2)##
## Call:
## glm(formula = DEFAULT ~ INGRESOS + CUOTA_TOTAL, family = "binomial",
## data = Creditos)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.6901 -0.3648 -0.2928 -0.2113 2.9753
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.353e+00 3.966e-01 -5.933 2.97e-09 ***
## INGRESOS -3.134e-07 1.005e-07 -3.119 0.001817 **
## CUOTA_TOTAL 9.341e-07 2.404e-07 3.885 0.000102 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 309.68 on 779 degrees of freedom
## Residual deviance: 291.37 on 777 degrees of freedom
## AIC: 297.37
##
## Number of Fisher Scoring iterations: 6Validación cruzada
library(vcd)
prediccion= predict.glm(mod_creditos2, newdata = Creditos, type = "response")
resultado=table(Creditos$DEFAULT, ifelse(prediccion>0.2,1,0),dnn = c("observaciones", "predicciones"))
resultado## predicciones
## observaciones 0 1
## 0 738 3
## 1 38 1mosaic(resultado, shade = T, colorize = T,
gp = gpar(fill = matrix(c("blue", "black", "black", "blue"), 2, 2)))
sum(diag(resultado)/sum(resultado))## [1] 0.9474359se encuentra que entre los resultados se presentan 3 falsos negativos (se predice falsamente que entra en default), y 38 falsos positivos (se predice que no entra en default cuando en realidad si lo hace)
el modelo clasifica de manera adecuada el 94,7% de las observaciones
Metricas
library(ROCR)
prediccion_rot= ROCR::prediction(prediccion,Creditos$DEFAULT)
perf= performance(prediction.obj = prediccion_rot, "tpr", "fpr")
plot(perf)
abline(a=0, b=1, col="red")
grid()
AUClog= performance(prediccion_rot, measure = "auc")@y.values[[1]]
cat("AUC: ", AUClog, "n")## AUC: 0.6791238 nEl area bajo la curva de 0,68 nos indica que el modelo no es lo suficientemente bueno para realizar predicciones.