Procesos 3
Randolph Leguia
11/7/2020
#MODELO LOGIT
Se utiliza en ocasiones para describir modelos logit binarios, es decir, modelos con dos alternativas. Usar la distribución de valor extremo para los errores (y por lo tanto la distribución logística para las diferencias entre errores) es casi lo mismo que asumir que los errores se distribuyen normalmente y de forma independiente. La distribución de valor extremo tiene colas ligeramente más gruesas que una distribución normal, lo que implica que permite un comportamiento ligeramente más aberrante que la normal.
En este trabajo se utilizan los siguientes paquetes:
options(scipen=999)
pkges<-c("mfx","pROC","tidyverse","forecast","data.table")
#install.packages(pkges)
lapply(pkges,"library",character.only=T)## Loading required package: sandwich## 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## Type 'citation("pROC")' for a citation.##
## Attaching package: 'pROC'## The following objects are masked from 'package:stats':
##
## cov, smooth, var## -- 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.0.3 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()## 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"En esta parte del trabajo cargaremos la data del trabajo que son descargados de la pagina de kaggle, en donde se podrá encontrar con diferentes variables que puedan ser alternativos para la construcción del modelo. Hay 25 variables:
ID : ID de cada cliente LIMIT_BAL : Cantidad de crédito otorgado en dólares NT (incluye crédito individual y familiar / complementario SEXO : Género (1 = masculino, 2 = femenino) EDUCACIÓN : (1 = escuela de posgrado, 2 = universidad, 3 = escuela secundaria, 4 = otros, 5 = desconocido, 6 = desconocido) MATRIMONIO : Estado civil (1 = casado, 2 = soltero, 3 = otros) EDAD : edad en años PAY_0 : Estado de reembolso en septiembre de 2005 (-1 = pago debidamente, 1 = retraso en el pago durante un mes, 2 = retraso en el pago durante dos meses, … 8 = retraso en el pago durante ocho meses, 9 = retraso en el pago durante nueve meses y más) PAY_2 : Estado de reembolso en agosto de 2005 (escala igual a la anterior) PAY_3 : Estado de reembolso en julio de 2005 (escala igual a la anterior) PAY_4 : Estado de reembolso en junio de 2005 (escala igual a la anterior) PAY_5 : Estado de reembolso en mayo de 2005 (escala igual a la anterior) PAY_6 : Estado de reembolso en abril de 2005 (escala igual a la anterior) BILL_AMT1 : Cantidad de extracto de cuenta en septiembre de 2005 (dólar NT) BILL_AMT2 : Cantidad del estado de cuenta en agosto de 2005 (dólar NT) BILL_AMT3 : Cantidad de extracto de cuenta en julio de 2005 (dólar NT) BILL_AMT4 : Monto del estado de cuenta en junio de 2005 (dólar NT) BILL_AMT5 : Cantidad del estado de cuenta en mayo de 2005 (dólar NT) BILL_AMT6 : Cantidad del estado de cuenta en abril de 2005 (dólar NT) PAY_AMT1 : Monto del pago anterior en septiembre de 2005 (NT dólar) PAY_AMT2 : Monto del pago anterior en agosto de 2005 (dólar NT) PAY_AMT3 : Monto del pago anterior en julio de 2005 (dólar NT) PAY_AMT4 : Monto del pago anterior en junio de 2005 (dólar NT) PAY_AMT5 : Monto del pago anterior en mayo de 2005 (NT dólar) PAY_AMT6 : Monto del pago anterior en abril de 2005 (dólar NT) default.payment.next.month : pago predeterminado (1 = sí, 0 = no)
maindir <- getwd()
subdir <- c("/USMP/9. Noveno ciclo/Gestion de Riesgo/Practica 3/")
datos <- read.csv(paste0(maindir,"/UCI_Credit_Card.csv"),header = T)
datos <- datos[complete.cases(datos),]En esta sección se prepara la data, quitado el id. Después se procederá a correr un modelo con todas las variables, con el objetivo de escoger a las variables que tienen una probabilidad significativa. Encontramos que la variable educación no tiene probabilidad significativa (en ninguna de sus categorías), por lo que se descartara como una opción de elección de variable.
cred <- datos[,-1]
cred$SEX <- as.factor(cred$SEX)
cred$MARRIAGE <- as.factor(cred$MARRIAGE)
cred$EDUCATION <- as.factor(cred$EDUCATION)
cred$EDUCATION <- as.factor(cred$EDUCATION)
table(cred$default.payment.next.month)##
## 0 1
## 23364 6636 mean(cred$default.payment.next.month)## [1] 0.2212modelo <- glm(default.payment.next.month ~ .,data = cred,
family = binomial(link = "logit"))## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurredsummary(modelo)##
## Call:
## glm(formula = default.payment.next.month ~ ., family = binomial(link = "logit"),
## data = cred)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -3.1360 -0.7020 -0.5446 -0.2823 3.8693
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -13.1098677275 82.4386671897 -0.159 0.87365
## LIMIT_BAL -0.0000006998 0.0000001578 -4.435 0.00000918995 ***
## SEX2 -0.1125473057 0.0307294362 -3.663 0.00025 ***
## EDUCATION1 10.8032174782 82.4370190064 0.131 0.89574
## EDUCATION2 10.7186578629 82.4370193496 0.130 0.89655
## EDUCATION3 10.6967653494 82.4370244326 0.130 0.89676
## EDUCATION4 9.6558963457 82.4379629286 0.117 0.90676
## EDUCATION5 9.4400204584 82.4374020874 0.115 0.90883
## EDUCATION6 10.5007097810 82.4379975527 0.127 0.89864
## MARRIAGE1 1.3193692317 0.5159761385 2.557 0.01056 *
## MARRIAGE2 1.1304392031 0.5161274883 2.190 0.02851 *
## MARRIAGE3 1.2406146704 0.5329097416 2.328 0.01991 *
## AGE 0.0053722868 0.0018619598 2.885 0.00391 **
## PAY_0 0.5775622576 0.0177111945 32.610 < 0.0000000000000002 ***
## PAY_2 0.0815524098 0.0202014836 4.037 0.00005415025 ***
## PAY_3 0.0713238589 0.0226156524 3.154 0.00161 **
## PAY_4 0.0225008520 0.0250122334 0.900 0.36834
## PAY_5 0.0343817876 0.0268899180 1.279 0.20103
## PAY_6 0.0068923468 0.0221533280 0.311 0.75571
## BILL_AMT1 -0.0000055130 0.0000011378 -4.845 0.00000126459 ***
## BILL_AMT2 0.0000024128 0.0000015050 1.603 0.10889
## BILL_AMT3 0.0000013451 0.0000013233 1.016 0.30940
## BILL_AMT4 -0.0000001405 0.0000013513 -0.104 0.91718
## BILL_AMT5 0.0000007589 0.0000015207 0.499 0.61774
## BILL_AMT6 0.0000001952 0.0000011943 0.163 0.87014
## PAY_AMT1 -0.0000136444 0.0000023062 -5.916 0.00000000329 ***
## PAY_AMT2 -0.0000094930 0.0000020876 -4.547 0.00000543334 ***
## PAY_AMT3 -0.0000026410 0.0000017179 -1.537 0.12421
## PAY_AMT4 -0.0000040687 0.0000017861 -2.278 0.02273 *
## PAY_AMT5 -0.0000032130 0.0000017752 -1.810 0.07031 .
## PAY_AMT6 -0.0000020923 0.0000012973 -1.613 0.10679
## ---
## 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: 27827 on 29969 degrees of freedom
## AIC: 27889
##
## Number of Fisher Scoring iterations: 11##Eligiendo Cinco Variables del Modelo
En esta sección se procederá a elegir las 5 variable que ayuden a formar el modelo que logre predecir el comportamiento de los impagos.
###Modelo 1
XB1 <- as.formula("default.payment.next.month ~ factor(SEX)+BILL_AMT1 +factor(PAY_2)+factor(MARRIAGE)+LIMIT_BAL")
modelo1 <- glm(XB1,data = cred)
summary(modelo1)##
## Call:
## glm(formula = XB1, data = cred)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.77271 -0.19227 -0.15552 -0.06249 1.06388
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.13997538364 0.05339821452 2.621 0.00876
## factor(SEX)2 -0.02335616342 0.00459402150 -5.084 0.000000371722
## BILL_AMT1 0.00000017477 0.00000003782 4.621 0.000003833823
## factor(PAY_2)-1 -0.03321530113 0.00806041113 -4.121 0.000037858100
## factor(PAY_2)0 -0.06659050993 0.00799226796 -8.332 < 0.0000000000000002
## factor(PAY_2)1 -0.03884214935 0.07362571056 -0.528 0.59781
## factor(PAY_2)2 0.31682515536 0.00959428930 33.022 < 0.0000000000000002
## factor(PAY_2)3 0.36998147617 0.02275242157 16.261 < 0.0000000000000002
## factor(PAY_2)4 0.24677003241 0.03977673074 6.204 0.000000000558
## factor(PAY_2)5 0.34529859506 0.07798824004 4.428 0.000009563591
## factor(PAY_2)6 0.49739809974 0.11231302730 4.429 0.000009514798
## factor(PAY_2)7 0.34438543192 0.08714388026 3.952 0.000077705030
## factor(PAY_2)8 -0.26512813126 0.38791863665 -0.683 0.49432
## factor(MARRIAGE)1 0.15865688910 0.05290135763 2.999 0.00271
## factor(MARRIAGE)2 0.12873134610 0.05288396658 2.434 0.01493
## factor(MARRIAGE)3 0.16142247879 0.05703768124 2.830 0.00466
## LIMIT_BAL -0.00000036701 0.00000002045 -17.948 < 0.0000000000000002
##
## (Intercept) **
## factor(SEX)2 ***
## BILL_AMT1 ***
## factor(PAY_2)-1 ***
## factor(PAY_2)0 ***
## factor(PAY_2)1
## factor(PAY_2)2 ***
## factor(PAY_2)3 ***
## factor(PAY_2)4 ***
## factor(PAY_2)5 ***
## factor(PAY_2)6 ***
## factor(PAY_2)7 ***
## factor(PAY_2)8
## factor(MARRIAGE)1 **
## factor(MARRIAGE)2 *
## factor(MARRIAGE)3 **
## LIMIT_BAL ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 0.1504133)
##
## Null deviance: 5168.1 on 29999 degrees of freedom
## Residual deviance: 4509.8 on 29983 degrees of freedom
## AIC: 28324
##
## Number of Fisher Scoring iterations: 2Analisando el modelo 1, encontramos a las variables sexo, estado de cuenta 1, Pay2 , estado civil y LIMIT_BAL. Encontrando que todos son variables con probabilidad significativa, teniendo un AIC de 28324 y encontrando a 15 betas.
###Modelo 2
XB2 <- as.formula("default.payment.next.month ~ factor(SEX)+BILL_AMT1 +AGE+factor(MARRIAGE)+LIMIT_BAL")
modelo2 <- glm(XB2,data = cred)
summary(modelo2)##
## Call:
## glm(formula = XB2, data = cred)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.35396 -0.25646 -0.19858 -0.06648 1.08330
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.15658713942 0.05698328339 2.748 0.00600
## factor(SEX)2 -0.02947450205 0.00487517101 -6.046 0.0000000015
## BILL_AMT1 0.00000013814 0.00000003352 4.121 0.0000377826
## AGE 0.00067763663 0.00029432247 2.302 0.02132
## factor(MARRIAGE)1 0.15868122526 0.05582099649 2.843 0.00448
## factor(MARRIAGE)2 0.12494283832 0.05583638837 2.238 0.02525
## factor(MARRIAGE)3 0.13811033693 0.06020018677 2.294 0.02179
## LIMIT_BAL -0.00000053101 0.00000001925 -27.581 < 0.0000000000000002
##
## (Intercept) **
## factor(SEX)2 ***
## BILL_AMT1 ***
## AGE *
## factor(MARRIAGE)1 **
## factor(MARRIAGE)2 *
## factor(MARRIAGE)3 *
## LIMIT_BAL ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 0.167491)
##
## Null deviance: 5168.1 on 29999 degrees of freedom
## Residual deviance: 5023.4 on 29992 degrees of freedom
## AIC: 31542
##
## Number of Fisher Scoring iterations: 2En el modelo 2 podemos ver a las variable de sexo, BILL_AMT1, años, estado civil y LIMIT_BAL. En donde tambien encontramos a todas las variables significativas, sin embargo optiene un AIC de 31542, que es mucho mayor al modelo 1.
###Modelo 3
XB3 <- as.formula("default.payment.next.month ~ factor(SEX)+factor(MARRIAGE)+factor(PAY_0)+PAY_AMT2+LIMIT_BAL")
modelo3 <- glm(XB3,data = cred)
summary(modelo3)##
## Call:
## glm(formula = XB3, data = cred)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -0.81080 -0.17159 -0.13256 -0.04788 1.08242
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 0.09073092619 0.05156384853 1.760 0.07849
## factor(SEX)2 -0.02457969582 0.00442559654 -5.554 0.0000000282
## factor(MARRIAGE)1 0.14800444821 0.05101017684 2.901 0.00372
## factor(MARRIAGE)2 0.12161935166 0.05099265119 2.385 0.01708
## factor(MARRIAGE)3 0.14896048453 0.05500343334 2.708 0.00677
## factor(PAY_0)-1 0.02159607675 0.00871194424 2.479 0.01318
## factor(PAY_0)0 -0.03387959444 0.00794599153 -4.264 0.0000201653
## factor(PAY_0)1 0.17423428829 0.00958419101 18.179 < 0.0000000000000002
## factor(PAY_0)2 0.51435372670 0.01044728441 49.233 < 0.0000000000000002
## factor(PAY_0)3 0.57015742665 0.02222741099 25.651 < 0.0000000000000002
## factor(PAY_0)4 0.49316473575 0.04359193368 11.313 < 0.0000000000000002
## factor(PAY_0)5 0.31308481148 0.07377310739 4.244 0.0000220340
## factor(PAY_0)6 0.36411645575 0.11298513847 3.223 0.00127
## factor(PAY_0)7 0.60122181111 0.12484732985 4.816 0.0000014743
## factor(PAY_0)8 0.39594683025 0.08610960623 4.598 0.0000042795
## PAY_AMT2 -0.00000040684 0.00000009529 -4.269 0.0000196565
## LIMIT_BAL -0.00000029132 0.00000001775 -16.410 < 0.0000000000000002
##
## (Intercept) .
## factor(SEX)2 ***
## factor(MARRIAGE)1 **
## factor(MARRIAGE)2 *
## factor(MARRIAGE)3 **
## factor(PAY_0)-1 *
## factor(PAY_0)0 ***
## factor(PAY_0)1 ***
## factor(PAY_0)2 ***
## factor(PAY_0)3 ***
## factor(PAY_0)4 ***
## factor(PAY_0)5 ***
## factor(PAY_0)6 **
## factor(PAY_0)7 ***
## factor(PAY_0)8 ***
## PAY_AMT2 ***
## LIMIT_BAL ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for gaussian family taken to be 0.1397759)
##
## Null deviance: 5168.1 on 29999 degrees of freedom
## Residual deviance: 4190.9 on 29983 degrees of freedom
## AIC: 26124
##
## Number of Fisher Scoring iterations: 2Modelo 3 encontramos a las variables de Estado civil, sexo, Estado de reembolso en septiembre de 2005, Monto del pago anterior en agosto de 2005 y Cantidad de crédito otorgado en dólares. En donde encontramos un AIC de 26124 que es menor a los modelos anteriores, sin embargo la elección no será en definitivo por el AIC, sino por la lógica en las variables, como es el caso de los modelos anteriores que contienen variables como BILL_AMT1 y LIMIT_BAL que pueden contener en algún momento montos iguales, por lo que la elección de mis variable será dado por el modelo 3.
###Histograma del modelo elegido
Hmodelo3<-modelo3$fitted.values
hist(Hmodelo3)
##Variaciones Marginales
En esta sección podremos ver las probabilidades que existen de poder entrar en default el proximo mes, esto se da dependiendo tambien la variable que tenga.
log<-logitmfx(formula=XB3 , data=cred)
log## Call:
## logitmfx(formula = XB3, data = cred)
##
## Marginal Effects:
## dF/dx Std. Err. z
## factor(SEX)2 -0.026973330846 0.004931962748 -5.4691
## factor(MARRIAGE)1 0.212769922398 0.082798233032 2.5697
## factor(MARRIAGE)2 0.171709713428 0.074466589035 2.3059
## factor(MARRIAGE)3 0.275455863272 0.128815548517 2.1384
## factor(PAY_0)-1 0.028947396569 0.011041757212 2.6216
## factor(PAY_0)0 -0.040375291436 0.009683953012 -4.1693
## factor(PAY_0)1 0.181993604502 0.014701961084 12.3789
## factor(PAY_0)2 0.513666282543 0.015298120416 33.5771
## factor(PAY_0)3 0.573469148921 0.026278137455 21.8231
## factor(PAY_0)4 0.494452464924 0.055411740522 8.9232
## factor(PAY_0)5 0.315380537825 0.100217428819 3.1470
## factor(PAY_0)6 0.369978051920 0.150625332234 2.4563
## factor(PAY_0)7 0.606619109377 0.131351549476 4.6183
## factor(PAY_0)8 0.400506750311 0.114810901519 3.4884
## PAY_AMT2 -0.000001736166 0.000000278009 -6.2450
## LIMIT_BAL -0.000000335176 0.000000021581 -15.5310
## P>|z|
## factor(SEX)2 0.0000000452361 ***
## factor(MARRIAGE)1 0.0101775 *
## factor(MARRIAGE)2 0.0211183 *
## factor(MARRIAGE)3 0.0324864 *
## factor(PAY_0)-1 0.0087511 **
## factor(PAY_0)0 0.0000305538516 ***
## factor(PAY_0)1 < 0.00000000000000022 ***
## factor(PAY_0)2 < 0.00000000000000022 ***
## factor(PAY_0)3 < 0.00000000000000022 ***
## factor(PAY_0)4 < 0.00000000000000022 ***
## factor(PAY_0)5 0.0016498 **
## factor(PAY_0)6 0.0140384 *
## factor(PAY_0)7 0.0000038692149 ***
## factor(PAY_0)8 0.0004859 ***
## PAY_AMT2 0.0000000004238 ***
## LIMIT_BAL < 0.00000000000000022 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## dF/dx is for discrete change for the following variables:
##
## [1] "factor(SEX)2" "factor(MARRIAGE)1" "factor(MARRIAGE)2"
## [4] "factor(MARRIAGE)3" "factor(PAY_0)-1" "factor(PAY_0)0"
## [7] "factor(PAY_0)1" "factor(PAY_0)2" "factor(PAY_0)3"
## [10] "factor(PAY_0)4" "factor(PAY_0)5" "factor(PAY_0)6"
## [13] "factor(PAY_0)7" "factor(PAY_0)8"##Ratio de Odds
Utilizamos el Ratio de Odds como una medida estadística que ayuda a definir el número de veces es mayor un posible evento frente a otro que puede que no ocurra, en otras palabras, sería el cociente que se obtiene entre la posibilidad de que ocurra un caso de éxito frente a la posibilidad de que no ocurra, teniendo en cuenta otro evento.
ratio_de_odds <- numeric()
for (i in 2:17) {
values <- exp(modelo3$coef[i])-1
ratio_de_odds[i] <- values
}
ratio_de_odds<-ratio_de_odds[-1]; ratio_de_odds## [1] -0.0242800749762 0.1595180541341 0.1293241445940 0.1606271255789
## [5] 0.0218309598163 -0.0333121077750 0.1903344145702 0.6725572233521
## [9] 0.7685454457006 0.6374902523536 0.3676375174655 0.4392418123837
## [13] 0.8243464459920 0.4857903163572 -0.0000004068439 -0.0000002913165En este caso encontramos que: 1. Existe -0.0242800749762 de chances de caer en default para las mujeres. 2. Existe 0.1595180541341 de chances de caer en default para las personas casadas. 3. Existe 0.1293241445940 de chances de caer en default para las personas solteras. 4. Existe 0.1606271255789 de chances de caer en default para las personas con estado civil de categorías otros. 5. Existe 0.0218309598163 de chances de caer en default para las personas que están al día en sus pagos. 6. Existe 0.0333121077750 de chances de caer en default para las personas que tiene el mes de septiembre como mes de pago. 7. Existe 0.1903344145702 de chances de caer en default para las personas que tienen un mes de retraso en sus pagos. 8. Existe 0.6725572233521 de chances de caer en default para las personas que tienen dos meses de retraso en sus pagos. 9. Existe 0.7685454457006 de chances de caer en default para las personas que tienen tres meses de retraso en sus pagos. 10. Existe 0.6374902523536 de chances de caer en default para las personas que tienen cuatros meses de retraso en sus pagos. 11. Existe 0.3676375174655 de chances de caer en default para las personas que tienen cinco meses de retraso en sus pagos. 12. Existe 0.4392418123837 de chances de caer en default para las personas que tienen seis meses de retraso en sus pagos. 13. Existe 0.8243464459920 de chances de caer en default para las personas que tienen siete meses de retraso en sus pagos. 14. Existe 0.4857903163572 de chances de caer en default para las personas que tienen ocho meses de retraso en sus pagos. 15. Existe -0.0000004068439 de chances de caer en default para las personas que tienen Monto del pago anterior en agosto de 2005. 16. Existe -0.0000002913165 de chances de caer en default para las personas que tienen cantidad de crédito otorgado en dólares NT (incluye crédito individual y familiar / complementario.
##Probabilidad de Caer en Default
###PROBABILIDAD DE DEFAULT DE UNA MUJER CASADA QUE REPAGA A TIEMPO
mean(cred$LIMIT_BAL)## [1] 167484.3mean(cred$PAY_AMT2)## [1] 5921.163parametros <- c(1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, mean(cred$PAY_AMT2), mean(cred$LIMIT_BAL))
vector <- numeric()
probabilidad <- numeric()
for (i in 1:length(parametros)) {
vector[i] <- modelo3$coef[i] * parametros[i]
probabilidad <- exp(sum(vector)) / (1 + exp(sum(vector)))
}
probabilidad <- probabilidad * 100
probabilidad## [1] 53.22243Probabilidad que una mujer casada que tenga un repago a tiempo con un pago anterior de 5921.163 de dolares, una línea de crédito de 167484.3 de dolares. Pueda entrar en default es de 53.22%.
###PROBABILIDAD DE DEFAULT DE UN HOMBRE CASADO QUE REPAGA A TIEMPO
parametros_1 <- c(1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, mean(cred$PAY_AMT2), mean(cred$LIMIT_BAL))
vector1 <- numeric()
probabilidad_1 <- numeric()
for (i in 1:length(parametros_1)) {
vector1[i] <- modelo3$coef[i] * parametros_1[i]
probabilidad1 <- exp(sum(vector1)) / (1 + exp(sum(vector1)))
}
probabilidad1 <- probabilidad1 * 100
probabilidad1## [1] 53.83386Probabilidad que un hombre casado que tenga un repago a tiempo con un pago anterior de 5921.163 de dólares, una línea de crédito de 167484.3 de dólares. Pueda entrar en default es de 53.83%.
###PROBABILIDAD DE DEFAULT DE UNA MUJER SOLTERA QUE REPAGA A TIEMPO
parametros_3 <- c(1, 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, mean(cred$PAY_AMT2), mean(cred$LIMIT_BAL))
vector3 <- numeric()
probabilidad_3 <- numeric()
for (i in 1:length(parametros_3)) {
vector3[i] <- modelo3$coef[i] * parametros_3[i]
probabilidad3 <- exp(sum(vector3)) / (1 + exp(sum(vector3)))
}
probabilidad3 <- probabilidad3 * 100
probabilidad3## [1] 52.56502Probabilidad que una mujer soltera que tenga un repago a tiempo con un pago anterior de 5921.163 de dólares, una línea de crédito de 167484.3 de dólares. Pueda entrar en default es de 52.57%.
###PROBABILIDAD DE DEFAULT DE UN HOMBRE SOLTERO QUE REPAGA A TIEMPO
parametros_4 <- c(1, 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, mean(cred$PAY_AMT2), mean(cred$LIMIT_BAL))
vector4 <- numeric()
probabilidad_4 <- numeric()
for (i in 1:length(parametros_4)) {
vector4[i] <- modelo3$coef[i] * parametros_4[i]
probabilidad4 <- exp(sum(vector4)) / (1 + exp(sum(vector4)))
}
probabilidad4 <- probabilidad4 * 100
probabilidad4## [1] 53.17748Probabilidad que un hombre soltero que tenga un repago a tiempo con un pago anterior de 5921.163 de dólares, una línea de crédito de 167484.3 de dólares. Pueda entrar en default es de 53.18%.
###PROBABILIDAD DE DEFAULT DE UN HOMBRE CASADO QUE TIENE 1 MES DE ATRASO
parametros_4 <- c(1, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, mean(cred$PAY_AMT2), mean(cred$LIMIT_BAL))
vector4 <- numeric()
probabilidad_4 <- numeric()
for (i in 1:length(parametros_4)) {
vector4[i] <- modelo3$coef[i] * parametros_4[i]
probabilidad4 <- exp(sum(vector4)) / (1 + exp(sum(vector4)))
}
probabilidad4 <- probabilidad4 * 100
probabilidad4## [1] 58.94688Probabilidad que un hombre casado que tenga un mes de retraso en el pago y tiene una línea de crédito de 167484.3 de dólares. Pueda entrar en default es de 58.95%.
###PROBABILIDAD DE DEFAULT DE UN HOMBRE SOLTERO QUE TIENE 1 MES DE ATRASO
parametros_5 <- c(1, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, mean(cred$PAY_AMT2), mean(cred$LIMIT_BAL))
vector5 <- numeric()
probabilidad_5 <- numeric()
for (i in 1:length(parametros_5)) {
vector5[i] <- modelo3$coef[i] * parametros_5[i]
probabilidad5 <- exp(sum(vector5)) / (1 + exp(sum(vector5)))
}
probabilidad5 <- probabilidad5 * 100
probabilidad5## [1] 58.3069Probabilidad que un hombre soltero que tenga un mes de retraso en el pago y tiene una línea de crédito de 167484.3 de dólares. Pueda entrar en default es de 58.31%.
###PROBABILIDAD DE DEFAULT DE UNA MUJER SOLTERA QUE TIENE 1 MES DE ATRASO
parametros_6 <- c(1, 1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, mean(cred$PAY_AMT2), mean(cred$LIMIT_BAL))
vector6 <- numeric()
probabilidad_6 <- numeric()
for (i in 1:length(parametros_6)) {
vector6[i] <- modelo3$coef[i] * parametros_6[i]
probabilidad6 <- exp(sum(vector6)) / (1 + exp(sum(vector6)))
}
probabilidad6 <- probabilidad6 * 100
probabilidad6## [1] 57.70817Probabilidad que una mujer soltera que tenga un mes de retraso en el pago y tiene una línea de crédito de 167484.3 de dólares. Pueda entrar en default es de 57.71%.
###PROBABILIDAD DE DEFAULT DE UNA MUJER CASADA QUE TIENE 1 MES DE ATRASO
parametros_7 <- c(1, 1, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, mean(cred$PAY_AMT2), mean(cred$LIMIT_BAL))
vector7 <- numeric()
probabilidad_7 <- numeric()
for (i in 1:length(parametros_7)) {
vector7[i] <- modelo3$coef[i] * parametros_7[i]
probabilidad7 <- exp(sum(vector7)) / (1 + exp(sum(vector7)))
}
probabilidad7 <- probabilidad7 * 100
probabilidad7## [1] 58.35078Probabilidad que una mujer casada que tenga un mes de retraso en el pago y tiene una línea de crédito de 167484.3 de dólares. Pueda entrar en default es de 58.35%.
###PROBABILIDAD DE DEFAULT DE UN HOMBRE CASADO QUE TIENE 8 MES DE ATRASO
parametros_8 <- c(1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, mean(cred$PAY_AMT2), mean(cred$LIMIT_BAL))
vector8 <- numeric()
probabilidad_8 <- numeric()
for (i in 1:length(parametros_8)) {
vector8[i] <- modelo3$coef[i] * parametros_8[i]
probabilidad8 <- exp(sum(vector8)) / (1 + exp(sum(vector8)))
}
probabilidad8 <- probabilidad8 * 100
probabilidad8## [1] 64.18683Probabilidad que un hombre casado que tenga ocho meses de retraso en el pago y tiene una línea de crédito de 167484.3 de dólares. Pueda entrar en default es de 64.19%.
###PROBABILIDAD DE DEFAULT DE UNA MUJER CASADA QUE TIENE 8 MES DE ATRASO
parametros_9 <- c(1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, mean(cred$PAY_AMT2), mean(cred$LIMIT_BAL))
vector9 <- numeric()
probabilidad_9 <- numeric()
for (i in 1:length(parametros_9)) {
vector9[i] <- modelo3$coef[i] * parametros_9[i]
probabilidad9 <- exp(sum(vector9)) / (1 + exp(sum(vector9)))
}
probabilidad9 <- probabilidad9 * 100
probabilidad9## [1] 63.61986Probabilidad que una mujer casada que tenga ocho meses de retraso en el pago y tiene una línea de crédito de 167484.3 de dólares. Pueda entrar en default es de 63.62%.
###PROBABILIDAD DE DEFAULT DE UN HOMBRE SOLTERO QUE TIENE 8 MES DE ATRASO
parametros_10 <- c(1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, mean(cred$PAY_AMT2), mean(cred$LIMIT_BAL))
vector10 <- numeric()
probabilidad_10 <- numeric()
for (i in 1:length(parametros_10)) {
vector10[i] <- modelo3$coef[i] * parametros_10[i]
probabilidad10 <- exp(sum(vector10)) / (1 + exp(sum(vector10)))
}
probabilidad10 <- probabilidad10 * 100
probabilidad10## [1] 63.57806Probabilidad que un hombre soltero que tenga ocho meses de retraso en el pago y tiene una línea de crédito de 167484.3 de dólares. Pueda entrar en default es de 63.58%.
###PROBABILIDAD DE DEFAULT DE UNA MUJER SOLTERA QUE TIENE 8 MES DE ATRASO
parametros_11 <- c(1, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, mean(cred$PAY_AMT2), mean(cred$LIMIT_BAL))
vector11 <- numeric()
probabilidad_11 <- numeric()
for (i in 1:length(parametros_11)) {
vector11[i] <- modelo3$coef[i] * parametros_11[i]
probabilidad11 <- exp(sum(vector11)) / (1 + exp(sum(vector11)))
}
probabilidad11 <- probabilidad11 * 100
probabilidad11## [1] 63.00701Probabilidad que una mujer soltera que tenga ocho meses de retraso en el pago y tiene una línea de crédito de 167484.3 de dólares. Pueda entrar en default es de 63.01%.
##Nivel de Predicción del Modelo
Para poder examinar el nivel de predicción del modelo se procederá a realizar los siguiente:
###Punto de Corte
En esta sección se procederá a evaluar la sensibilidad; que viene a ser el nivel que tiene la capacidad para poder detectar los casos positivos (que posean dichas características). Es decir si al modelo le presentamos sólo casos positivos, la sensibilidad determina la capacidad que tiene el modelo de no equivocarse. También evaluaremos a la especificidad del modelo, que se refiere a la capacidad que tiene éste para discriminar correctamente los casos que no poseen la característica. En esta parte lo saber que lo más importante es encontrar el punto en el que se maximicen la sensibilidad y la especificidad del modelo, y ese es el punto en el que se intersectan es en 0.17, lo que quiere decir que un 17% de los clientes se encontraron en el punto del corte entre la especificidad y la sensibilidad.
c<-seq(0.01,0.3,by=0.01)
sens<-c()
spec<-c()
for (i in 1:length(c)){
y.pred<-ifelse(modelo3$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)
###Especificidad/Sensibilidad
y.pred<-ifelse(modelo3$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.6657678 0.3342322
## 1 0.3092224 0.6907776En esta parte del trabajo encontramos que la matriz de especificidad y sensibilidad, que en la especificidad existe un 66.57% de probabilidad de que el modelo detecte los casos que no caen en morosidad, mientras que, en la sensibilidad existe un 69.08% de probabilidad de que el modelo detecte los casos morosos si en realidad estos casos están en morosidad.
##Análisis de la Curva ROC
roc(cred$default.payment.next.month,Hmodelo3)## Setting levels: control = 0, case = 1## Setting direction: controls < cases##
## Call:
## roc.default(response = cred$default.payment.next.month, predictor = Hmodelo3)
##
## Data: Hmodelo3 in 23364 controls (cred$default.payment.next.month 0) < 6636 cases (cred$default.payment.next.month 1).
## Area under the curve: 0.7481El valor es esta sección nos indica que el area debajo de la curva es de 74.81%, este resultado muestra que nuestro modelo es aceptable para tratar de explicar y predecir nuestra variable dependiente.
plot(roc(cred$default.payment.next.month,Hmodelo3),main=c("Curva ROC"))## Setting levels: control = 0, case = 1## Setting direction: controls < cases