Modelo Logit: Aplicación a Créditos Bancarios
Kelly Lozano Navarro
2020-07-13
1. Análisis del Modelo Logit - General
1.1. Introducción
Este conjunto de datos contiene información sobre pagos predeterminados, factores demográficos, datos crediticios, historial de pagos y estados de cuenta de clientes de tarjetas de crédito en Taiwán desde Abril del 2005 hasta Septiembre de ese mismo año. El desarrollo de este trabajo tiene como fin, identificar los 5 factores claves que determinen la probabilidad de incumplimiento en el pago de las tarjetas de crédito, así como, predecir la probabilidad del default para los clientes del Banco.
1.2. Cargando Paquetes
Para proceder con el análisis, empezamos descargando los paquetes de software que nos permitirá la ejecución de los comandos a utilizar.
options(scipen=999)
pkges<-c("mfx","pROC","tidyverse","forecast","data.table")
#install.packages(pkges)
lapply(pkges,"library",character.only=T)## Warning: package 'mfx' was built under R version 4.0.2## Loading required package: sandwich## Warning: package 'sandwich' was built under R version 4.0.2## Loading required package: lmtest## Loading required package: zoo##
## Attaching package: 'zoo'## The following objects are masked from 'package:base':
##
## as.Date, as.Date.numeric## Loading required package: MASS## Loading required package: betareg## Warning: package 'betareg' was built under R version 4.0.2## Warning: package 'pROC' was built under R version 4.0.2## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, var## Warning: package 'tidyverse' was built under R version 4.0.2## -- Attaching packages --------------------------------------------------------------------- tidyverse 1.3.0 --## v ggplot2 3.3.0 v purrr 0.3.4
## v tibble 3.0.1 v dplyr 0.8.5
## v tidyr 1.1.0 v stringr 1.4.0
## v readr 1.3.1 v forcats 0.5.0## -- Conflicts ------------------------------------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag() masks stats::lag()
## x dplyr::select() masks MASS::select()## Warning: package 'forecast' was built under R version 4.0.2## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoo##
## Attaching package: 'data.table'## The following objects are masked from 'package:dplyr':
##
## between, first, last## The following object is masked from 'package:purrr':
##
## transpose## [[1]]
## [1] "mfx" "betareg" "MASS" "lmtest" "zoo" "sandwich"
## [7] "stats" "graphics" "grDevices" "utils" "datasets" "methods"
## [13] "base"
##
## [[2]]
## [1] "pROC" "mfx" "betareg" "MASS" "lmtest" "zoo"
## [7] "sandwich" "stats" "graphics" "grDevices" "utils" "datasets"
## [13] "methods" "base"
##
## [[3]]
## [1] "forcats" "stringr" "dplyr" "purrr" "readr" "tidyr"
## [7] "tibble" "ggplot2" "tidyverse" "pROC" "mfx" "betareg"
## [13] "MASS" "lmtest" "zoo" "sandwich" "stats" "graphics"
## [19] "grDevices" "utils" "datasets" "methods" "base"
##
## [[4]]
## [1] "forecast" "forcats" "stringr" "dplyr" "purrr" "readr"
## [7] "tidyr" "tibble" "ggplot2" "tidyverse" "pROC" "mfx"
## [13] "betareg" "MASS" "lmtest" "zoo" "sandwich" "stats"
## [19] "graphics" "grDevices" "utils" "datasets" "methods" "base"
##
## [[5]]
## [1] "data.table" "forecast" "forcats" "stringr" "dplyr"
## [6] "purrr" "readr" "tidyr" "tibble" "ggplot2"
## [11] "tidyverse" "pROC" "mfx" "betareg" "MASS"
## [16] "lmtest" "zoo" "sandwich" "stats" "graphics"
## [21] "grDevices" "utils" "datasets" "methods" "base"También, vamos a direccionar esta hoja de trabajo a la carpeta de nuestra pc, donde esta la data almacenada y luego a cargarlos.
maindir <- getwd()
subdir <- c("Users/DELL/Desktop/uni 2020/RIESGOS/semana 9")
datos <- read.csv(paste0(maindir,"/UCI_Credit_Card.csv"),header = T)
datos <- datos[complete.cases(datos),]
cred <- datos[,-1]También definiremos las variables categóricas:
cred$SEX <- as.factor(cred$SEX)
cred$MARRIAGE <- as.factor(cred$MARRIAGE)
cred$EDUCATION <- as.factor(cred$EDUCATION)
cred$PAY_0 <- as.factor(cred$PAY_0)
cred$PAY_2 <- as.factor(cred$PAY_2)
cred$PAY_3 <- as.factor(cred$PAY_3)
cred$PAY_4 <- as.factor(cred$PAY_4)
cred$PAY_5 <- as.factor(cred$PAY_5)
cred$PAY_6 <- as.factor(cred$PAY_6)1.3. Análisis Exploratorio de los Datos (EDA)
Se esta trabajando con un Conjunto de datos que posee 25 variables; tales como: ID, línea de crédito, sexo, estado civil, edad y default payment next month (entre otros que tienen las características de los créditos otorgados), siendo esta última mencionada, nuestra variable dependiente.
- ID: ID of each client
- LIMIT_BAL: Amount of given credit in NT dollars (includes individual and family/supplementary credit
- SEX: Gender (1=male, 2=female)
- EDUCATION: (1=graduate school, 2=university, 3=high school, 4=others, 5=unknown, 6=unknown)
- MARRIAGE: Marital status (1=married, 2=single, 3=others)
- AGE: Age in years
- PAY_0: Repayment status in September, 2005
- PAY_2: Repayment status in August, 2005 (scale same as above)
- PAY_3: Repayment status in July, 2005 (scale same as above)
- PAY_4: Repayment status in June, 2005 (scale same as above)
- PAY_5: Repayment status in May, 2005 (scale same as above)
- PAY_6: Repayment status in April, 2005 (scale same as above)
- BILL_AMT1: Amount of bill statement in September, 2005 (NT dollar)
- BILL_AMT2: Amount of bill statement in August, 2005 (NT dollar)
- BILL_AMT3: Amount of bill statement in July, 2005 (NT dollar)
- BILL_AMT4: Amount of bill statement in June, 2005 (NT dollar)
- BILL_AMT5: Amount of bill statement in May, 2005 (NT dollar)
- BILL_AMT6: Amount of bill statement in April, 2005 (NT dollar)
- PAY_AMT1: Amount of previous payment in September, 2005 (NT dollar)
- PAY_AMT2: Amount of previous payment in August, 2005 (NT dollar)
- PAY_AMT3: Amount of previous payment in July, 2005 (NT dollar)
- PAY_AMT4: Amount of previous payment in June, 2005 (NT dollar)
- PAY_AMT5: Amount of previous payment in May, 2005 (NT dollar)
- PAY_AMT6: Amount of previous payment in April, 2005 (NT dollar)
- default.payment.next.month: Default payment (1=yes, 0=no)
De lo presentado se tiene que la variable ID no es relevante para nuestro estudio, es por ello que lo quitamos de nuestra data; también precisar que se puede hacer diferentes análisis estadísticos previos, para así tener una idea de los datos con los que se trabajará.
1.3.1. Resumen Estadístico de los Datos
## ID LIMIT_BAL SEX EDUCATION
## Min. : 1 Min. : 10000 Min. :1.000 Min. :0.000
## 1st Qu.: 7501 1st Qu.: 50000 1st Qu.:1.000 1st Qu.:1.000
## Median :15000 Median : 140000 Median :2.000 Median :2.000
## Mean :15000 Mean : 167484 Mean :1.604 Mean :1.853
## 3rd Qu.:22500 3rd Qu.: 240000 3rd Qu.:2.000 3rd Qu.:2.000
## Max. :30000 Max. :1000000 Max. :2.000 Max. :6.000
## MARRIAGE AGE PAY_0 PAY_2
## Min. :0.000 Min. :21.00 Min. :-2.0000 Min. :-2.0000
## 1st Qu.:1.000 1st Qu.:28.00 1st Qu.:-1.0000 1st Qu.:-1.0000
## Median :2.000 Median :34.00 Median : 0.0000 Median : 0.0000
## Mean :1.552 Mean :35.49 Mean :-0.0167 Mean :-0.1338
## 3rd Qu.:2.000 3rd Qu.:41.00 3rd Qu.: 0.0000 3rd Qu.: 0.0000
## Max. :3.000 Max. :79.00 Max. : 8.0000 Max. : 8.0000
## PAY_3 PAY_4 PAY_5 PAY_6
## Min. :-2.0000 Min. :-2.0000 Min. :-2.0000 Min. :-2.0000
## 1st Qu.:-1.0000 1st Qu.:-1.0000 1st Qu.:-1.0000 1st Qu.:-1.0000
## Median : 0.0000 Median : 0.0000 Median : 0.0000 Median : 0.0000
## Mean :-0.1662 Mean :-0.2207 Mean :-0.2662 Mean :-0.2911
## 3rd Qu.: 0.0000 3rd Qu.: 0.0000 3rd Qu.: 0.0000 3rd Qu.: 0.0000
## Max. : 8.0000 Max. : 8.0000 Max. : 8.0000 Max. : 8.0000
## BILL_AMT1 BILL_AMT2 BILL_AMT3 BILL_AMT4
## Min. :-165580 Min. :-69777 Min. :-157264 Min. :-170000
## 1st Qu.: 3559 1st Qu.: 2985 1st Qu.: 2666 1st Qu.: 2327
## Median : 22382 Median : 21200 Median : 20089 Median : 19052
## Mean : 51223 Mean : 49179 Mean : 47013 Mean : 43263
## 3rd Qu.: 67091 3rd Qu.: 64006 3rd Qu.: 60165 3rd Qu.: 54506
## Max. : 964511 Max. :983931 Max. :1664089 Max. : 891586
## BILL_AMT5 BILL_AMT6 PAY_AMT1 PAY_AMT2
## Min. :-81334 Min. :-339603 Min. : 0 Min. : 0
## 1st Qu.: 1763 1st Qu.: 1256 1st Qu.: 1000 1st Qu.: 833
## Median : 18105 Median : 17071 Median : 2100 Median : 2009
## Mean : 40311 Mean : 38872 Mean : 5664 Mean : 5921
## 3rd Qu.: 50191 3rd Qu.: 49198 3rd Qu.: 5006 3rd Qu.: 5000
## Max. :927171 Max. : 961664 Max. :873552 Max. :1684259
## PAY_AMT3 PAY_AMT4 PAY_AMT5 PAY_AMT6
## Min. : 0 Min. : 0 Min. : 0.0 Min. : 0.0
## 1st Qu.: 390 1st Qu.: 296 1st Qu.: 252.5 1st Qu.: 117.8
## Median : 1800 Median : 1500 Median : 1500.0 Median : 1500.0
## Mean : 5226 Mean : 4826 Mean : 4799.4 Mean : 5215.5
## 3rd Qu.: 4505 3rd Qu.: 4013 3rd Qu.: 4031.5 3rd Qu.: 4000.0
## Max. :896040 Max. :621000 Max. :426529.0 Max. :528666.0
## default.payment.next.month
## Min. :0.0000
## 1st Qu.:0.0000
## Median :0.0000
## Mean :0.2212
## 3rd Qu.:0.0000
## Max. :1.0000A simple vista, se tiene que:
- Hay 30,000 clientes que poseen tarjetas de crédito.
- El valor promedio para el monto del límite de la tarjeta de crédito es 167,484 (NT dollar).
- El nivel de educación es principalmente escuela de posgrado y universidad.
- La mayoría de los clientes son casados o solteros.
- La edad promedio es de 35.5 años.
- Como el valor ‘0’ para ‘default.payment.next.month’ significa ‘no morosidad’ y el valor ‘1’ significa ‘morosidad’, la media de 0.221 significa que hay un 22.1% de los contratos de tarjetas de crédito que incumplirán el próximo mes.
1.3.2. Relación entre las Variables
- Por ejemplo de esta gráfica se puede interpretar como que las mujeres (female) tienen más probabilidad de caer en morosidad (default=1) que en comparación que los hombres (male), esto se podría entender dada la dimensión de créditos otorgados a las mujeres.
plot1 <- ggplot(data = datos, aes(x=factor(SEX), fill =factor(default.payment.next.month))) +
geom_bar() +
ylab("count of credit cards") +
scale_x_discrete(labels = c('Male','Female')) +
xlab("")
plot1
De esta gráfica, podemos deducir que las mujeres son las que tienen un nivel educativo mas bajo que en comparación a los hombres. Es por ello, que hoy en día esta metodología es muy usada en temas de inclusión financiera, para cerrar brechas de género de acceso a créditos y su correlación con el nivel educativo de los usuarios.
Como se mencionó lineas arriba, a mayor estudio se tenga, menor será la probabilidad de caer en default, como lo demuestra el segundo gráfico de este apartado.
plot2 <- ggplot(data = datos, aes(x=factor(EDUCATION), fill =factor(SEX))) +
geom_bar() +
ylab("count of credit cards") +
xlab("(1=graduate school, 2=university, 3=high school, 4=others, 5=unknown, 6=unknown)")
plot2
plot3 <- ggplot(data = datos, aes(x=factor(EDUCATION), fill =factor(default.payment.next.month))) +
geom_bar() +
ylab("count of credit cards") +
xlab("(1=graduate school, 2=university, 3=high school, 4=others, 5=unknown, 6=unknown)")
plot3
- Con el siguiente gráfico, se puede ver que los clientes con mayor línea de crédito tienen menos posibilidad de incumplimiento en su pago el mes siguiente.
- También podemos analizar la relación que existe entre nuestra variable dependiente (default.payment.next.month) y la variable categórica (marriage). Al hacer esta gráfica, se observar que los solteros y casados tienen casi la misma posibilidad de caer en default.
plot5 <- ggplot(data = datos, aes(x=factor(MARRIAGE), fill =factor(default.payment.next.month))) +
geom_bar() +
ylab("count of credit cards") +
xlab("(1=married, 2=single, 3=others)")
plot5
- Ahora vamos que interpretación podemos extraer, al comparar a la variable (Age) y nuestra variable dependiente. Una vez realizado ello, se entiende que cuando una persona tiene más edad, tiene menos posibilidad de caer en default; es por ello que el valor ‘0’ de la variable default esta más concentrada entre las personas de 30 y 40 años.
- Siguiendo con la revisión de los datos, veamos la relación entre la variable PAY_0 y la variable dependiente. Al realizar esto, se tiene que el estado de pago de cuenta de la tarjeta tiene una relación directa con la variable dependiente, pues si se esta al día en los pagos, menor será la probabilidad de que el próximo mes caiga en default.
plot6 <- ggplot(data = datos, aes(x=factor(PAY_0), fill =factor(default.payment.next.month))) +
geom_bar() +
ylab("Observations count") +
xlab("(-1=pay duly, 1=payment delay for 1 month, 2=payment delay for 2 months, 3=payment delay for 3 months, 4=payment delay 4 months, 5=payment delay for 5 months, 6=payment delay for 6 months, 7=payment delay for 7 months, 8=payment delay for 8 months, 9=payment delay for 8 months and above))")
plot6
1.4. Modelo Logit
“El análisis de regresión logística se enmarca en el conjunto de Modelos Lineales Generalizados que usa como función de enlace, la función logit. La regresión logística analiza datos distribuidos binomialmente de la forma donde los números de ensayos Bernoulli son conocidos y las probabilidades de éxito son desconocidas. El modelo es entonces obtenido a base de lo que cada ensayo (valor de i) y el conjunto de variables explicativas/independientes puedan informar acerca de la probabilidad final.”
— Wikipedia
Este tipo de función nos interesa, dado que analizaremos cuando un crédito caerá o no en default, en morosidad. Es decir, modelar la probabilidad (p) con la que el crédito cae en morosidad (1-p) o con la que no; en conclusión, toma dos valores (1 ó 0). Nuestra variable dependiente (default.payment.next.month) va a tomar dos valores. Cuando corramos el modelo logit, nos dará: log(p/1-p); de lo cual, luego extraeremos el ratio de oods.
Sin embargo, no habría que olvidarnos del “beta”, pues es la velocidad a la que puede cambiar la probabilidad de éxito ante un cambio de “x”.
##
## 0 1
## 23364 6636## [1] 0.2212- Ahora, corremos el modelo general (que pertenece a la familia binomial) con todas las variables y realizamos un resumen estadístico de ellas:
modelo1 <- glm(default.payment.next.month ~ .,data = cred,
family = binomial(link = "logit"))
summary(modelo1)##
## Call:
## glm(formula = default.payment.next.month ~ ., family = binomial(link = "logit"),
## data = cred)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.2866 -0.5985 -0.5070 -0.3066 3.5280
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -14.5105926855 140.7793287463 -0.103 0.917905
## LIMIT_BAL -0.0000018797 0.0000001752 -10.728 < 0.0000000000000002 ***
## SEX2 -0.1459417669 0.0323281119 -4.514 0.00000634987 ***
## EDUCATION1 11.8346874921 140.7783255878 0.084 0.933004
## EDUCATION2 11.8606222438 140.7783260129 0.084 0.932857
## EDUCATION3 11.8115784051 140.7783293022 0.084 0.933134
## EDUCATION4 10.7342493797 140.7788867931 0.076 0.939221
## EDUCATION5 10.5588633237 140.7785597052 0.075 0.940212
## EDUCATION6 11.5629058617 140.7789477409 0.082 0.934539
## MARRIAGE1 1.4793060521 0.5222163347 2.833 0.004615 **
## MARRIAGE2 1.3290950526 0.5223722418 2.544 0.010948 *
## MARRIAGE3 1.5522780617 0.5408849369 2.870 0.004106 **
## AGE 0.0037302767 0.0019709916 1.893 0.058413 .
## PAY_0-1 0.4913138012 0.1079236899 4.552 0.00000530327 ***
## PAY_00 -0.2512757899 0.1167323560 -2.153 0.031352 *
## PAY_01 0.8074625087 0.0845436521 9.551 < 0.0000000000000002 ***
## PAY_02 2.0282255072 0.1060429935 19.126 < 0.0000000000000002 ***
## PAY_03 2.0520979518 0.1694541790 12.110 < 0.0000000000000002 ***
## PAY_04 1.7217246814 0.2982170878 5.773 0.00000000777 ***
## PAY_05 1.4265543947 0.4837314023 2.949 0.003187 **
## PAY_06 0.3601321325 0.8896572480 0.405 0.685625
## PAY_07 1.5688432425 1.4871642771 1.055 0.291461
## PAY_08 -12.2934415150 535.4113802903 -0.023 0.981682
## PAY_2-1 -0.1787935423 0.1134364127 -1.576 0.114990
## PAY_20 0.0381308018 0.1387271444 0.275 0.783422
## PAY_21 -0.6679951410 0.5746725936 -1.162 0.245076
## PAY_22 0.0343735762 0.1172444332 0.293 0.769386
## PAY_23 0.0458027878 0.1795580856 0.255 0.798657
## PAY_24 -0.7228426361 0.3222606599 -2.243 0.024894 *
## PAY_25 1.0419408518 0.7405288360 1.407 0.159421
## PAY_26 0.8975462195 1.4830596725 0.605 0.545047
## PAY_27 0.9741836504 598.9930989734 0.002 0.998702
## PAY_28 13.0193268332 641.0787228720 0.020 0.983797
## PAY_3-1 -0.0010577962 0.1084891705 -0.010 0.992221
## PAY_30 0.0578492112 0.1258709057 0.460 0.645809
## PAY_31 -11.8695717939 376.2095069580 -0.032 0.974831
## PAY_32 0.3908619132 0.1274804106 3.066 0.002169 **
## PAY_33 0.4400333291 0.2220788268 1.981 0.047543 *
## PAY_34 -0.0702030136 0.4230019666 -0.166 0.868185
## PAY_35 -0.5464619503 0.8497380211 -0.643 0.520163
## PAY_36 13.9365744363 268.5668979373 0.052 0.958614
## PAY_37 0.3072057286 0.7695085204 0.399 0.689729
## PAY_38 -1.4559314426 1.8775100175 -0.775 0.438069
## PAY_4-1 -0.1343011328 0.1089347468 -1.233 0.217629
## PAY_40 -0.0837353110 0.1216170054 -0.689 0.491128
## PAY_41 13.8460336801 376.2121344288 0.037 0.970641
## PAY_42 0.2031206694 0.1301682326 1.560 0.118654
## PAY_43 0.0273969411 0.2474118847 0.111 0.911827
## PAY_44 0.3299990460 0.4455047863 0.741 0.458857
## PAY_45 -1.5788507724 0.8160239830 -1.935 0.053014 .
## PAY_46 -27.6497335725 352.5866930976 -0.078 0.937494
## PAY_47 -23.6195124509 395.5317102995 -0.060 0.952382
## PAY_48 -39.3971369436 665.6664407023 -0.059 0.952805
## PAY_5-1 -0.0924606095 0.1064359609 -0.869 0.385013
## PAY_50 0.0097664357 0.1180584465 0.083 0.934070
## PAY_52 0.2855480867 0.1322143898 2.160 0.030793 *
## PAY_53 0.0729120032 0.2426249620 0.301 0.763786
## PAY_54 -0.2067444093 0.4556418902 -0.454 0.650014
## PAY_55 1.1747351883 0.8866034409 1.325 0.185177
## PAY_56 24.8761757680 395.5284554962 0.063 0.949851
## PAY_57 24.7316823570 395.5363166993 0.063 0.950143
## PAY_58 36.6446350617 1183.7889837744 0.031 0.975305
## PAY_6-1 -0.1189057323 0.0821214250 -1.448 0.147638
## PAY_60 -0.3224917192 0.0885666498 -3.641 0.000271 ***
## PAY_62 0.0594230290 0.1030298326 0.577 0.564105
## PAY_63 0.6324793333 0.2348838147 2.693 0.007087 **
## PAY_64 0.0680332887 0.4639619732 0.147 0.883420
## PAY_65 -0.3309484230 0.7666790361 -0.432 0.665985
## PAY_66 0.6092029760 0.9469452524 0.643 0.520007
## PAY_67 -0.6558562225 1.7548228287 -0.374 0.708594
## PAY_68 16.7842023675 680.4831364066 0.025 0.980322
## BILL_AMT1 -0.0000012503 0.0000010843 -1.153 0.248844
## BILL_AMT2 0.0000022905 0.0000014388 1.592 0.111394
## BILL_AMT3 0.0000021437 0.0000012888 1.663 0.096254 .
## BILL_AMT4 -0.0000001661 0.0000013127 -0.127 0.899326
## BILL_AMT5 -0.0000002443 0.0000015018 -0.163 0.870779
## BILL_AMT6 -0.0000005384 0.0000011877 -0.453 0.650301
## PAY_AMT1 -0.0000122932 0.0000023588 -5.212 0.00000018722 ***
## PAY_AMT2 -0.0000088951 0.0000021417 -4.153 0.00003277155 ***
## PAY_AMT3 -0.0000010271 0.0000016660 -0.617 0.537555
## PAY_AMT4 -0.0000017209 0.0000017770 -0.968 0.332840
## PAY_AMT5 -0.0000027890 0.0000017833 -1.564 0.117822
## PAY_AMT6 -0.0000028341 0.0000013321 -2.128 0.033375 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 31705 on 29999 degrees of freedom
## Residual deviance: 25998 on 29917 degrees of freedom
## AIC: 26164
##
## Number of Fisher Scoring iterations: 12- Posterior a ello, vamos a utilizar un tipo de Modelo de Selección de Variables: el STEPWISE, el cual tiene como fin ayudar a seleccionar la mejor combinación de variables para así tener el menor AIC:
## Start: AIC=26164.34
## default.payment.next.month ~ LIMIT_BAL + SEX + EDUCATION + MARRIAGE +
## AGE + PAY_0 + PAY_2 + PAY_3 + PAY_4 + PAY_5 + PAY_6 + BILL_AMT1 +
## BILL_AMT2 + BILL_AMT3 + BILL_AMT4 + BILL_AMT5 + BILL_AMT6 +
## PAY_AMT1 + PAY_AMT2 + PAY_AMT3 + PAY_AMT4 + PAY_AMT5 + PAY_AMT6## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred## Df Deviance AIC
## - BILL_AMT4 1 25998 26162
## - BILL_AMT5 1 25998 26162
## - BILL_AMT6 1 25999 26163
## - PAY_AMT3 1 25999 26163
## - PAY_AMT4 1 25999 26163
## - BILL_AMT1 1 26000 26164
## <none> 25998 26164
## - PAY_2 10 26019 26165
## - BILL_AMT2 1 26001 26165
## - PAY_AMT5 1 26001 26165
## - BILL_AMT3 1 26001 26165
## - AGE 1 26002 26166
## - PAY_AMT6 1 26003 26167
## - PAY_5 9 26023 26171
## - SEX 1 26019 26183
## - PAY_AMT2 1 26019 26183
## - PAY_4 10 26038 26184
## - MARRIAGE 3 26026 26186
## - PAY_3 10 26040 26186
## - PAY_AMT1 1 26034 26198
## - EDUCATION 6 26049 26203
## - PAY_6 9 26055 26203
## - LIMIT_BAL 1 26119 26283
## - PAY_0 10 27450 27596
##
## Step: AIC=26162.36
## default.payment.next.month ~ LIMIT_BAL + SEX + EDUCATION + MARRIAGE +
## AGE + PAY_0 + PAY_2 + PAY_3 + PAY_4 + PAY_5 + PAY_6 + BILL_AMT1 +
## BILL_AMT2 + BILL_AMT3 + BILL_AMT5 + BILL_AMT6 + PAY_AMT1 +
## PAY_AMT2 + PAY_AMT3 + PAY_AMT4 + PAY_AMT5 + PAY_AMT6## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred## Df Deviance AIC
## - BILL_AMT5 1 25998 26160
## - BILL_AMT6 1 25999 26161
## - PAY_AMT3 1 25999 26161
## - PAY_AMT4 1 25999 26161
## - BILL_AMT1 1 26000 26162
## <none> 25998 26162
## - PAY_2 10 26019 26163
## - BILL_AMT2 1 26001 26163
## - PAY_AMT5 1 26001 26163
## - BILL_AMT3 1 26002 26164
## - AGE 1 26002 26164
## - PAY_AMT6 1 26003 26165
## - PAY_5 9 26023 26169
## - SEX 1 26019 26181
## - PAY_AMT2 1 26019 26181
## - PAY_4 10 26038 26182
## - MARRIAGE 3 26026 26184
## - PAY_3 10 26040 26184
## - PAY_AMT1 1 26034 26196
## - EDUCATION 6 26049 26201
## - PAY_6 9 26055 26201
## - LIMIT_BAL 1 26119 26281
## - PAY_0 10 27450 27594
##
## Step: AIC=26160.42
## default.payment.next.month ~ LIMIT_BAL + SEX + EDUCATION + MARRIAGE +
## AGE + PAY_0 + PAY_2 + PAY_3 + PAY_4 + PAY_5 + PAY_6 + BILL_AMT1 +
## BILL_AMT2 + BILL_AMT3 + BILL_AMT6 + PAY_AMT1 + PAY_AMT2 +
## PAY_AMT3 + PAY_AMT4 + PAY_AMT5 + PAY_AMT6## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred## Df Deviance AIC
## - PAY_AMT3 1 25999 26159
## - BILL_AMT6 1 26000 26160
## - PAY_AMT4 1 26000 26160
## - BILL_AMT1 1 26000 26160
## <none> 25998 26160
## - PAY_2 10 26019 26161
## - BILL_AMT2 1 26001 26161
## - PAY_AMT5 1 26001 26161
## - BILL_AMT3 1 26002 26162
## - AGE 1 26002 26162
## - PAY_AMT6 1 26004 26164
## - PAY_5 9 26023 26167
## - SEX 1 26019 26179
## - PAY_AMT2 1 26019 26179
## - PAY_4 10 26038 26180
## - MARRIAGE 3 26026 26182
## - PAY_3 10 26040 26182
## - PAY_AMT1 1 26034 26194
## - EDUCATION 6 26049 26199
## - PAY_6 9 26055 26199
## - LIMIT_BAL 1 26120 26280
## - PAY_0 10 27450 27592
##
## Step: AIC=26159.07
## default.payment.next.month ~ LIMIT_BAL + SEX + EDUCATION + MARRIAGE +
## AGE + PAY_0 + PAY_2 + PAY_3 + PAY_4 + PAY_5 + PAY_6 + BILL_AMT1 +
## BILL_AMT2 + BILL_AMT3 + BILL_AMT6 + PAY_AMT1 + PAY_AMT2 +
## PAY_AMT4 + PAY_AMT5 + PAY_AMT6## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred## Df Deviance AIC
## - PAY_AMT4 1 26000 26158
## - BILL_AMT1 1 26001 26159
## - BILL_AMT6 1 26001 26159
## <none> 25999 26159
## - PAY_2 10 26019 26159
## - BILL_AMT2 1 26002 26160
## - PAY_AMT5 1 26002 26160
## - AGE 1 26003 26161
## - BILL_AMT3 1 26003 26161
## - PAY_AMT6 1 26005 26163
## - PAY_5 9 26024 26166
## - SEX 1 26019 26177
## - PAY_4 10 26040 26180
## - PAY_AMT2 1 26022 26180
## - PAY_3 10 26040 26180
## - MARRIAGE 3 26027 26181
## - PAY_AMT1 1 26036 26194
## - EDUCATION 6 26050 26198
## - PAY_6 9 26056 26198
## - LIMIT_BAL 1 26122 26280
## - PAY_0 10 27451 27591
##
## Step: AIC=26158.41
## default.payment.next.month ~ LIMIT_BAL + SEX + EDUCATION + MARRIAGE +
## AGE + PAY_0 + PAY_2 + PAY_3 + PAY_4 + PAY_5 + PAY_6 + BILL_AMT1 +
## BILL_AMT2 + BILL_AMT3 + BILL_AMT6 + PAY_AMT1 + PAY_AMT2 +
## PAY_AMT5 + PAY_AMT6## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred## Df Deviance AIC
## - BILL_AMT1 1 26002 26158
## <none> 26000 26158
## - PAY_2 10 26021 26159
## - BILL_AMT6 1 26003 26159
## - BILL_AMT2 1 26003 26159
## - PAY_AMT5 1 26003 26159
## - AGE 1 26004 26160
## - BILL_AMT3 1 26005 26161
## - PAY_AMT6 1 26007 26163
## - PAY_5 9 26027 26167
## - SEX 1 26021 26177
## - PAY_4 10 26041 26179
## - PAY_3 10 26042 26180
## - MARRIAGE 3 26028 26180
## - PAY_AMT2 1 26025 26181
## - PAY_AMT1 1 26039 26195
## - EDUCATION 6 26051 26197
## - PAY_6 9 26058 26198
## - LIMIT_BAL 1 26125 26281
## - PAY_0 10 27456 27594
##
## Step: AIC=26158.12
## default.payment.next.month ~ LIMIT_BAL + SEX + EDUCATION + MARRIAGE +
## AGE + PAY_0 + PAY_2 + PAY_3 + PAY_4 + PAY_5 + PAY_6 + BILL_AMT2 +
## BILL_AMT3 + BILL_AMT6 + PAY_AMT1 + PAY_AMT2 + PAY_AMT5 +
## PAY_AMT6## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred## Df Deviance AIC
## - BILL_AMT2 1 26003 26157
## <none> 26002 26158
## - PAY_2 10 26023 26159
## - BILL_AMT6 1 26005 26159
## - PAY_AMT5 1 26005 26159
## - AGE 1 26006 26160
## - BILL_AMT3 1 26007 26161
## - PAY_AMT6 1 26009 26163
## - PAY_5 9 26029 26167
## - SEX 1 26022 26176
## - PAY_4 10 26043 26179
## - MARRIAGE 3 26030 26180
## - PAY_3 10 26044 26180
## - PAY_AMT2 1 26027 26181
## - PAY_AMT1 1 26041 26195
## - EDUCATION 6 26053 26197
## - PAY_6 9 26060 26198
## - LIMIT_BAL 1 26131 26285
## - PAY_0 10 27462 27598
##
## Step: AIC=26156.99
## default.payment.next.month ~ LIMIT_BAL + SEX + EDUCATION + MARRIAGE +
## AGE + PAY_0 + PAY_2 + PAY_3 + PAY_4 + PAY_5 + PAY_6 + BILL_AMT3 +
## BILL_AMT6 + PAY_AMT1 + PAY_AMT2 + PAY_AMT5 + PAY_AMT6## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred## Df Deviance AIC
## <none> 26003 26157
## - BILL_AMT6 1 26005 26157
## - PAY_2 10 26024 26158
## - PAY_AMT5 1 26006 26158
## - AGE 1 26007 26159
## - PAY_AMT6 1 26009 26161
## - PAY_5 9 26029 26165
## - SEX 1 26023 26175
## - PAY_4 10 26044 26178
## - MARRIAGE 3 26030 26178
## - PAY_3 10 26045 26179
## - BILL_AMT3 1 26031 26183
## - PAY_AMT1 1 26041 26193
## - PAY_AMT2 1 26042 26194
## - EDUCATION 6 26054 26196
## - PAY_6 9 26060 26196
## - LIMIT_BAL 1 26131 26283
## - PAY_0 10 27465 27599
1.4.1. Capacidad Predictiva del Modelo
Esta estimación nos da que la mejor combinación de variables con menor AIC (26157) fue: default.payment.next.month ~ LIMIT_BAL + SEX + EDUCATION + MARRIAGE + AGE + PAY_0 + PAY_2 + PAY_3 + PAY_4 + PAY_5 + PAY_6 + BILL_AMT3 + BILL_AMT6 + PAY_AMT1 + PAY_AMT2 + PAY_AMT5 + PAY_AMT6
Lo cual asumiremos como cierto y procederemos a evaluarlo con el gráfico de sensibilidad y especificidad (donde el punto máximo es el punto de corte de las líneas):
c<-seq(0.01,0.3,by=0.001)
sens<-c()
spec<-c()
for (i in 1:length(c)){
y.pred<-ifelse(model.AIC$fitted.values > c[i], yes = 1, no = 0)
spec[i]<-prop.table(table(cred$default.payment.next.month,y.pred),1)[1]
sens[i]<-prop.table(table(cred$default.payment.next.month,y.pred),1)[4]
}
o.cut<-mean(c[which(round(spec,1)==round(sens,1))],na.rm = T)
plot(c,sens,type="l",col=2,main=c("Especificidad vs Sensibilidad"),ylab=c("Especificidad/Sensibilidad"))
lines(c,spec,col=3)
abline(v=o.cut)
## [1] 0.1695Se puede observar que el punto de corte ha sido: 0.1695, que es el punto donde la sensibilidad y especificidad se maximizan, con el modelo logit-general (usando todas las variables).
Procedemos a evaluar lo anterior con la matriz de confusion. Cabe mencionar que la sensibilidad es la probabilidad de éxito dado que la observación fue exitosa, es decir, si cayó en morosidad y la especificidad es la probabilida del fracaso dado que en realidad es fracaso; pues lo que nos interesa modelar son los fracasos y los éxitos:
## [1] 0.1695y.pred<-ifelse(model.AIC$fitted.values > o.cut, yes = 1, no = 0)
matriz_confusion <- table(cred$default.payment.next.month, y.pred,
dnn = c("observaciones", "predicciones"))
prop.table(matriz_confusion,1)## predicciones
## observaciones 0 1
## 0 0.7065571 0.2934429
## 1 0.3071127 0.6928873De esta matriz se puede inferir que según la sensibilidad, hay una probabilidad de 69.28% de caer en morosidad (probabilidad de éxito) y en base a la especificidad, hay una probabilidad de 70.65% de no caer en default (probabilidad de fracaso).
Ahora calcularemos el área bajo la Curva ROC; este índice nos manifiesta que tan bueno ha sido nuestro Modelo Logit-General para predecir. Donde si el valor del área bajo la curva es mayor igual a 0.7, se considerará aceptable y si es mayor a 0.9 se considerará muy bueno:
## Setting levels: control = 0, case = 1## Setting direction: controls < cases##
## Call:
## roc.default(response = cred$default.payment.next.month, predictor = yhat1)
##
## Data: yhat1 in 23364 controls (cred$default.payment.next.month 0) < 6636 cases (cred$default.payment.next.month 1).
## Area under the curve: 0.7724## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
Cabe mencionar que si la curva de color negro, estuviese más pegada a la esquina, a 1, nuestro modelo tendría una muy buena predicción, dado que su área sería 0.9 La curva de ROC, junto a la sensibilidad y especificidad, forman parte de los Tests de Predicción. De la gráfica anterior se observa, que nuestro modelo es aceptable, pues el área bajo la curva de ROC nos dió: 0.7724
Sin embargo, más adelante solo se trabajará con un modelo logit de 5 covariables.
1.5. Mecanismo para la Selección de Variables
Para escoger las 5 variables independientes del total de nuestra data, procederemos a evaluar las covariables que formaron parte del menor AIC en el modelo 1, que fueron: LIMIT_BAL + SEX + EDUCATION + MARRIAGE + AGE + PAY_0 + PAY_2 + PAY_3 + PAY_4 + PAY_5 + PAY_6 + BILL_AMT3 + BILL_AMT6 + PAY_AMT1 + PAY_AMT2 + PAY_AMT5 + PAY_AMT6
Con esas variables “construiremos” distintos modelos, donde el óptimo, será aquel que tenga menor AIC y que todas ellas sean significativas.
1.5.1. Modelo 2
En este caso, vamos a probar con las covariables: LIMIT_BAL+factor(SEX)+factor(MARRIAGE)+AGE+factor(PAY_0); para saber cuanto de AIC nos arroja el software. Cabe mencionar que ponemos la etiqueta de factor a las variables: sex, marriage y pay_0, para que el modelo reconozca que son variables categóricas, discretas o dicotómicas, porque sino lo tomaría como variables continuas.
XB2 <- as.formula("default.payment.next.month ~ LIMIT_BAL+factor(SEX)+factor(MARRIAGE)+AGE+factor(PAY_0)")
modelo2 <- glm(XB2,data = cred,
family = binomial(link = "logit"))
summary(modelo2)##
## Call:
## glm(formula = XB2, family = binomial(link = "logit"), data = cred)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8542 -0.6007 -0.5229 -0.3822 2.6178
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.5557838607 0.5096535423 -5.015 0.000000531 ***
## LIMIT_BAL -0.0000024360 0.0000001394 -17.472 < 0.0000000000000002 ***
## factor(SEX)2 -0.1640098183 0.0316783093 -5.177 0.000000225 ***
## factor(MARRIAGE)1 1.3137179600 0.5008704154 2.623 0.008719 **
## factor(MARRIAGE)2 1.1475750333 0.5009249990 2.291 0.021969 *
## factor(MARRIAGE)3 1.2800289699 0.5199734152 2.462 0.013827 *
## AGE 0.0035686388 0.0018858892 1.892 0.058453 .
## factor(PAY_0)-1 0.1707829911 0.0671281018 2.544 0.010955 *
## factor(PAY_0)0 -0.2716845104 0.0631980938 -4.299 0.000017162 ***
## factor(PAY_0)1 0.9819739258 0.0676945212 14.506 < 0.0000000000000002 ***
## factor(PAY_0)2 2.3876867637 0.0721052737 33.114 < 0.0000000000000002 ***
## factor(PAY_0)3 2.6427615721 0.1437645007 18.383 < 0.0000000000000002 ***
## factor(PAY_0)4 2.2509696394 0.2564252015 8.778 < 0.0000000000000002 ***
## factor(PAY_0)5 1.4966403943 0.4014377991 3.728 0.000193 ***
## factor(PAY_0)6 1.7184416162 0.6115196627 2.810 0.004952 **
## factor(PAY_0)7 2.8574025540 0.8091907275 3.531 0.000414 ***
## factor(PAY_0)8 1.8528967666 0.4754105085 3.897 0.000097204 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 31705 on 29999 degrees of freedom
## Residual deviance: 26757 on 29983 degrees of freedom
## AIC: 26791
##
## Number of Fisher Scoring iterations: 4El modelo2 nos da un AIC de 26791, a compración del AIC del modelo1 que nos dió 26157. Por lo tanto, seguimos probando con otras variables, hasta lograr tener un AIC mucho menor. También, se puede ver que la variable “Age”, no es significativa.
1.5.2. Modelo 3
En este caso, vamos a probar con las covariables: LIMIT_BAL+factor(SEX)+factor(MARRIAGE)+factor(PAY_0)+factor(PAY_4); para saber cuanto de AIC nos arroja el software. Cabe mencionar que ponemos la etiqueta de factor a las variables: sex, marriage, pay_0 y pay_4, para que el modelo reconozca que son variables categóricas, discretas o dicotómicas, porque sino lo tomaría como variables continuas.
XB3 <- as.formula("default.payment.next.month ~ LIMIT_BAL+factor(SEX)+factor(MARRIAGE)+factor(PAY_0)+factor(PAY_4)")
modelo3 <- glm(XB3,data = cred,
family = binomial(link = "logit"))
summary(modelo3)##
## Call:
## glm(formula = XB3, family = binomial(link = "logit"), data = cred)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.9568 -0.5904 -0.5145 -0.3848 2.6448
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.5490242995 0.5142772800 -4.957 0.0000007176793384 ***
## LIMIT_BAL -0.0000021075 0.0000001407 -14.978 < 0.0000000000000002 ***
## factor(SEX)2 -0.1601634232 0.0316889494 -5.054 0.0000004321174375 ***
## factor(MARRIAGE)1 1.4038392946 0.5105288024 2.750 0.005964 **
## factor(MARRIAGE)2 1.2136540962 0.5104691279 2.378 0.017429 *
## factor(MARRIAGE)3 1.4032104897 0.5295130999 2.650 0.008049 **
## factor(PAY_0)-1 0.3619455468 0.0797418632 4.539 0.0000056530947992 ***
## factor(PAY_0)0 -0.1901296456 0.0787921654 -2.413 0.015820 *
## factor(PAY_0)1 0.9411585282 0.0752220926 12.512 < 0.0000000000000002 ***
## factor(PAY_0)2 2.2399976274 0.0859448749 26.063 < 0.0000000000000002 ***
## factor(PAY_0)3 2.3638115162 0.1552969620 15.221 < 0.0000000000000002 ***
## factor(PAY_0)4 1.9887206182 0.2660137596 7.476 0.0000000000000766 ***
## factor(PAY_0)5 0.9255252773 0.4056154431 2.282 0.022502 *
## factor(PAY_0)6 1.1200579834 0.6337112552 1.767 0.077152 .
## factor(PAY_0)7 2.2987705591 0.8627685465 2.664 0.007712 **
## factor(PAY_0)8 2.2570461601 0.7106944443 3.176 0.001494 **
## factor(PAY_4)-1 -0.3480307649 0.0645024463 -5.396 0.0000000682868881 ***
## factor(PAY_4)0 -0.1432251648 0.0591007235 -2.423 0.015376 *
## factor(PAY_4)1 0.9943219633 1.4280080623 0.696 0.486241
## factor(PAY_4)2 0.5987338771 0.0669508000 8.943 < 0.0000000000000002 ***
## factor(PAY_4)3 0.6209371488 0.1847260183 3.361 0.000775 ***
## factor(PAY_4)4 0.5552437792 0.3045056453 1.823 0.068239 .
## factor(PAY_4)5 -0.3958041474 0.5303499880 -0.746 0.455482
## factor(PAY_4)6 -0.2528507914 1.0035677002 -0.252 0.801078
## factor(PAY_4)7 0.8019120599 0.3637023361 2.205 0.027464 *
## factor(PAY_4)8 -0.2660022884 1.5203152647 -0.175 0.861107
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 31705 on 29999 degrees of freedom
## Residual deviance: 26454 on 29974 degrees of freedom
## AIC: 26506
##
## Number of Fisher Scoring iterations: 4El modelo3 nos da un AIC de 26506, a compración del AIC del modelo2 que nos dió un AIC de 26791. Por lo tanto, seguimos probando con otras variables, hasta lograr tener un AIC mucho menor. Sin embargo, en este modelo se aprecia que las variables PAY_0 y PAY_4, se vuelven no significativas, en algunas de sus categorías.
1.5.3. Modelo 4
En este caso, vamos a probar con las covariables: LIMIT_BAL+factor(SEX)+factor(MARRIAGE)+factor(PAY_0)+PAY_AMT1; para saber cuanto de AIC nos arroja el software. Cabe mencionar que ponemos la etiqueta de factor a las variables: sex, marriage y pay_0, para que el modelo reconozca que son variables categóricas, discretas o dicotómicas, porque sino lo tomaría como variables continuas.
XB4 <- as.formula("default.payment.next.month ~ LIMIT_BAL+factor(SEX)+factor(MARRIAGE)+factor(PAY_0)+PAY_AMT1")
modelo4 <- glm(XB4,data = cred,
family = binomial(link = "logit"))
summary(modelo4)##
## Call:
## glm(formula = XB4, family = binomial(link = "logit"), data = cred)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8495 -0.6053 -0.5246 -0.3675 3.5435
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.3944957030 0.5062596901 -4.730 0.000002247660 ***
## LIMIT_BAL -0.0000021996 0.0000001418 -15.514 < 0.0000000000000002 ***
## factor(SEX)2 -0.1733886722 0.0314545392 -5.512 0.000000035406 ***
## factor(MARRIAGE)1 1.3071471404 0.5026145881 2.601 0.009304 **
## factor(MARRIAGE)2 1.1129380148 0.5025446475 2.215 0.026787 *
## factor(MARRIAGE)3 1.2934727245 0.5215580904 2.480 0.013138 *
## factor(PAY_0)-1 0.1879547439 0.0672411173 2.795 0.005186 **
## factor(PAY_0)0 -0.2537881941 0.0633482979 -4.006 0.000061694163 ***
## factor(PAY_0)1 0.9666478109 0.0677371367 14.271 < 0.0000000000000002 ***
## factor(PAY_0)2 2.3949873627 0.0721996645 33.172 < 0.0000000000000002 ***
## factor(PAY_0)3 2.6247753917 0.1437397092 18.261 < 0.0000000000000002 ***
## factor(PAY_0)4 2.2284265770 0.2562036769 8.698 < 0.0000000000000002 ***
## factor(PAY_0)5 1.4805535753 0.4012057666 3.690 0.000224 ***
## factor(PAY_0)6 1.6952362640 0.6112067211 2.774 0.005544 **
## factor(PAY_0)7 2.8181540928 0.8082293756 3.487 0.000489 ***
## factor(PAY_0)8 1.8214213703 0.4746660784 3.837 0.000124 ***
## PAY_AMT1 -0.0000117789 0.0000019160 -6.148 0.000000000786 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 31705 on 29999 degrees of freedom
## Residual deviance: 26707 on 29983 degrees of freedom
## AIC: 26741
##
## Number of Fisher Scoring iterations: 5Entonces hasta el momentos tenemos lo siguiente:
| MODELO 2 | MODELO 3 | MODELO 4 |
|---|---|---|
| AIC=26791 | AIC=26506 | AIC=26741 |
A simple vista nos quedaríamos con el Modelo3; sin embargo, el Modelo4 tiene todas las variables significativas.
2. Análisis del Modelo 4 - Óptimo
Realizamos nuevamente un resumen estadístico del modelo4:
##
## Call:
## glm(formula = XB4, family = binomial(link = "logit"), data = cred)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8495 -0.6053 -0.5246 -0.3675 3.5435
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.3944957030 0.5062596901 -4.730 0.000002247660 ***
## LIMIT_BAL -0.0000021996 0.0000001418 -15.514 < 0.0000000000000002 ***
## factor(SEX)2 -0.1733886722 0.0314545392 -5.512 0.000000035406 ***
## factor(MARRIAGE)1 1.3071471404 0.5026145881 2.601 0.009304 **
## factor(MARRIAGE)2 1.1129380148 0.5025446475 2.215 0.026787 *
## factor(MARRIAGE)3 1.2934727245 0.5215580904 2.480 0.013138 *
## factor(PAY_0)-1 0.1879547439 0.0672411173 2.795 0.005186 **
## factor(PAY_0)0 -0.2537881941 0.0633482979 -4.006 0.000061694163 ***
## factor(PAY_0)1 0.9666478109 0.0677371367 14.271 < 0.0000000000000002 ***
## factor(PAY_0)2 2.3949873627 0.0721996645 33.172 < 0.0000000000000002 ***
## factor(PAY_0)3 2.6247753917 0.1437397092 18.261 < 0.0000000000000002 ***
## factor(PAY_0)4 2.2284265770 0.2562036769 8.698 < 0.0000000000000002 ***
## factor(PAY_0)5 1.4805535753 0.4012057666 3.690 0.000224 ***
## factor(PAY_0)6 1.6952362640 0.6112067211 2.774 0.005544 **
## factor(PAY_0)7 2.8181540928 0.8082293756 3.487 0.000489 ***
## factor(PAY_0)8 1.8214213703 0.4746660784 3.837 0.000124 ***
## PAY_AMT1 -0.0000117789 0.0000019160 -6.148 0.000000000786 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 31705 on 29999 degrees of freedom
## Residual deviance: 26707 on 29983 degrees of freedom
## AIC: 26741
##
## Number of Fisher Scoring iterations: 52.1. Ratio de Odds
Es la proporción de la probabilidad de éxito sobre la probabilidad de fracaso. Se entiende como las chances de éxito, es decir, si es dos veces más probables o tres más probables que el fracaso. Estimación para las variables: LIMIT_BAL, SEX, MARRIAGE,PAY_0, PAY_AMT1.
## [1] 0## [1] -15.92## [1] 269.56## [1] 204.33## [1] 996.81## [1] 0De lo cual, podemos concluir lo siguiente:
La chances de caer en morosidad, cuando el límite de crédito aumente, se reduce en menos del 0.02%
Las chances de caer en morosidad se reduce en 15.92% cuando la cliente es mujer.
Las chances de caer en morosidad aumenta en 269.56% cuando el cliente es casado; sin embargo, en los solteros, las chances de caer en morosidad aumenta en 204.33%
También, las chances de caer en morosidad aumenta en 996.81%% para la variable Age.
La chances de caer en morosidad se reduce en menos del 0.01%, cuando el monto del pago anterior fue en setiembre.
2.2. Probabilidad de Caer en Morosidad
#mujer + soltera + 2 mese de retraso en pago + limite de crédito de 50,000 + monto del pago anterior fue 21,818
XB5 <- -2.3944957030 -0.1733886722*(1) + 1.1129380148*(1) + 0.9666478109*(2) - 0.0000021996*(50000) - 0.0000117789*(21818)
round(exp(XB5)/(1+exp(XB5))*100,2)## [1] 52.78#hombre + soltero + 5 meses de retraso en pago + limite de crédito de 630,000 + monto del pago anterior fue 10,908
XB6 <- -2.3944957030 -0.1733886722*(0) + 1.1129380148*(1) + 0.9666478109*(5) - 0.0000021996*(630000) - 0.0000117789*(10908)
round(exp(XB6)/(1+exp(XB6))*100,2)## [1] 88.47#hombre + casado + 1 meses de retraso en pago + limite de crédito de 20,000 + monto del pago anterior fue 10,212
XB7 <- -2.3944957030 -0.1733886722*(0) + 1.1129380148*(0) + 0.9666478109*(1) - 0.0000021996*(20000) - 0.0000117789*(10212)
round(exp(XB7)/(1+exp(XB7))*100,2)## [1] 16.91#mujer + casado + pago correcto + limite de crédito de 180,000 + monto del pago anterior fue 30,500
XB8 <- -2.3944957030 -0.1733886722*(1) + 1.1129380148*(0) + 0.9666478109*(0) - 0.0000021996*(180000) - 0.0000117789*(30500)
round(exp(XB8)/(1+exp(XB8))*100,2)## [1] 3.48#hombre + casado + pago correcto + limite de crédito de 30,000 + monto del pago anterior fue 55,000
XB9 <- -2.3944957030 -0.1733886722*(0) + 1.1129380148*(0) + 0.9666478109*(0) - 0.0000021996*(30000) - 0.0000117789*(55000)
round(exp(XB9)/(1+exp(XB9))*100,2)## [1] 4.28De lo cual, podemos concluir lo siguiente:
Si el cliente fuese mujer, soltera, que en setiembre del 2005 haya estado con 2 meses de retraso en el pago de su tarjeta, además que tenga un límite de crédito de 50,000 (NT dollar) y que el monto del pago anterior en setiembre fue de 21,818 (NT dollar); tendría una probabilidad del 52.78%, de caer en default.
Cuando el cliente es hombre, soltero, con 5 meses de retraso en el pago de su tarjeta, además que tenga un límite de crédito de 630,000 (NT dollar) y que el monto del pago anterior en setiembre fue de 10,908 (NT dollar); la probabilidad de caer en default sería de 88.47%.
Un cliente hombre, que es casado, que en setiembre del 2005 haya estado con 1 meses de retraso en el pago de su tarjeta, además que tenga un límite de crédito de 20,000 (NT dollar) y que el monto del pago anterior en setiembre fue de 10,212 (NT dollar); tendría una probabilidad del 16.91%, de caer en default.
Una cliente mujer, que es casada, que no presenta morosidad en el pago de su tarjeta en el mes de setiembre, además que tenga un límite de crédito de 180,000 (NT dollar) y que el monto del pago anterior en setiembre fue de 30,500 (NT dollar); tendría una probabilidad de 3.48%, de caer en default.
- Si el cliente fuese hombre, casado, que no presente morosidad en el mes de setiembre, además que tenga un límite de crédito de 30,000 (NT dollar) y que el monto del pago anterior en setiembre fue de 55,000 (NT dollar); tendría una probabilidad de 4.28%, de caer en default.
2.3. Punto de Corte, Sensibilidad y Especificidad
- Punto de Corte:
## Start: AIC=26741.3
## default.payment.next.month ~ LIMIT_BAL + factor(SEX) + factor(MARRIAGE) +
## factor(PAY_0) + PAY_AMT1
##
## Df Deviance AIC
## <none> 26707 26741
## - factor(SEX) 1 26738 26770
## - factor(MARRIAGE) 3 26753 26781
## - PAY_AMT1 1 26760 26792
## - LIMIT_BAL 1 26962 26994
## - factor(PAY_0) 10 30678 30692
c1<-seq(0.01,0.4,by=0.001)
sens1<-c()
spec1<-c()
for (i in 1:length(c1)){
y.pred1<-ifelse(model.AIC1$fitted.values > c1[i], yes = 1, no = 0)
spec1[i]<-prop.table(table(cred$default.payment.next.month,y.pred1),1)[1]
sens1[i]<-prop.table(table(cred$default.payment.next.month,y.pred1),1)[4]
}
o.cut1<-mean(c1[which(round(spec1,1)==round(sens1,1))],na.rm = T)
plot(c1,sens1,type="l",col=2,main=c("Especificidad vs Sensibilidad"),ylab=c("Especificidad/Sensibilidad"))
lines(c1,spec1,col=3)
abline(v=o.cut1)
## [1] 0.1675Como se puede apreciar, el punto de corte es 0.1675, el cual maximiza la sensibilidad y especificidad.
- Matriz de Confusión:
y.pred1<-ifelse(model.AIC1$fitted.values > o.cut1, yes = 1, no = 0)
matriz_confusion1 <- table(cred$default.payment.next.month, y.pred1,
dnn = c("observaciones", "predicciones"))
prop.table(matriz_confusion1,1)## predicciones
## observaciones 0 1
## 0 0.6799349 0.3200651
## 1 0.3169078 0.6830922Se puede entender lo siguiente:
La especificidad, nos indica que con el modelo elegido hay una probabilidad de 67.99% de no default (de fracaso)
La sensibilidad, nos indica que con el modelo elegido hay una probabilidad de 68.30% de default (de éxito)
2.4. Curva de ROC
## Setting levels: control = 0, case = 1## Setting direction: controls < cases##
## Call:
## roc.default(response = cred$default.payment.next.month, predictor = yhat2)
##
## Data: yhat2 in 23364 controls (cred$default.payment.next.month 0) < 6636 cases (cred$default.payment.next.month 1).
## Area under the curve: 0.7495## Setting levels: control = 0, case = 1
## Setting direction: controls < cases
El área bajo la curva es de 0.7495 (75%), por lo cual, se puede decir que nuestro modelo es aceptable; sin embargo, lo óptimo, hubiese sido que sea casi 0.9 (90%), para que tenga mayor aceptibilidad en cuanto a la predicción.