Práctica_tres
KAREN ROSADO SERQUEN
12/7/2020
https://rpubs.com/KarenRosado/635831
MODELO LOGIT
Cuando un crédito va a ser considerando moroso o va a caer en default nos interesa predecir la probabilidad que ese credito caiga en default Nos interesa predecir la prob de que ese credito caiga en default
Se utiliza un modelo Logit para predecir los potenciales clientes morosos Y|XB~ Binomial (l,P)
Y dado nuestros variables y parámetros con prob P
La variable dependiente del modelo Logit toma valores de 0 y 1.
Y=0 -> 1-p no car en la probabilidad de impago de crédito Y=1 -> P caer en probabilidad de impago de crédito
Los datos contienen información sobre los pagos predeterminados, factores demográficos, datos crediticios,historial de pagos y estado de cuenta de clientes de tarjetas de créditos desde Abril 2005 hasta Setiembre de 2005. Los datos se ecnuentran almacenados en el archivo UCI_Credit_Card.
Datos : 25 variables 30000 observaciones
- ID: ID de cada cliente
- LIMIT_BAL: Cantidad de crédito otorgado en dólares NT (incluye crédito individual y familiar / complementario)
- SEXO: Sexo (1 = masculino, 2 = femenino)
- EDUCATION: (1 = escuela de posgrado, 2 = universidad, 3 = escuela secundaria, 4 = otros, 5=desconocido, 6=desconocido)
- MARRIAGE: Estado civil (1 = casado, 2 = soltero, 3 = otros)
- AGE: 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 del estado de cuenta en septiembre de 2005 (dólar NT)
- BILL_AMT2: Cantidad de extracto 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: Cantidad del estado de cuenta en junio de 2005 (dólar NT)
- BILL_AMT5: Monto del estado de cuenta en mayo de 2005 (dólar NT)
- BILL_AMT6: Monto 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 (NT dólar)
- PAY_AMT5: Monto del pago anterior en mayo de 2005 (dólar NT)
- PAY_AMT6: Monto del pago anterior en abril de 2005 (dólar NT)
- default.payment.next.month: Incumplimiento de pago (1 = sí, 0 = no)
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.3
## v tibble 2.1.3 v dplyr 0.8.5
## v tidyr 1.0.2 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"# Importar datos
maindir <- getwd()UCI_datos <- read.csv(paste0(maindir,"/UCI_Credit_Card.csv"),header = T)
UCI_datos <- UCI_datos[complete.cases(UCI_datos),]Convertir a una variable categórica: La variable categótica se utiliza para asignar una característica no númerica o cualitativa. Las variables categóricas del modelo son:
- SEX (1) masculino (2)femenino
- MARRIAGE (1) married (2) single (3)others
- EDUCATION (1) graduate school (2) university (3) high school (4)others (5) unknown (6) unknown
- PAY_0 (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 2005
- PAY_3 Estado de reembolso en Julio 2005
- PAY_4 Estado de reembolso en Junio 2005
- PAY_5 Estado de reembolso en Mayo 2005
- PAY_6 Estado de reembolso en Abril 2005
cred <- UCI_datos[,-1]
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)# Tabala de éxitos y fracasos: 1 son los morosos y 0 son los no morosos
table(cred$default.payment.next.month)##
## 0 1
## 23364 6636 mean(cred$default.payment.next.month)## [1] 0.2212Table de exitos : Número de exitos y de fracasos 1= son los morosos y 0 = no morosos
La tabla muestra que 6636 personas caen en incumpliento de pago de tarjeta de crédito, mientras que 23364 no caen en incumplimiento de pago de tarjeta de crédito.
DIAGRAMAS DE BARRAS
Diagramas de barras: El diagrama de barras se utiliza para representar variables categóricas (atributos u ordinales) y variables cuantitativas discretas.
** Diagrama de barras para Sexo **
En el diagrama se muestra los morosos por género. La varriable de estudio es “default.payment.next.month” es el incumplimiento de pago: - (0) probabilidad de que el préstamo no caiga en morosidad. - (1) probabilidad de que el préstamo caiga en morosidad.
La gráfica muestra que las mujeres caen en menor porcentaje de caer en morosidad y no pagar el préstamo que los hombres.
plot1 <- ggplot(data = UCI_datos, aes(x=factor(SEX), fill =factor(default.payment.next.month))) +
geom_bar() +
ylab("Observations count") +
scale_x_discrete(labels = c('Male','Female')) +
xlab("")
plot1
** Diagrama de barras para Educación **
En el diagrama se muestra los morosos por nivel de educación. La varriable de estudio es “default.payment.next.month”. - (0) no cae en morosidad. - (1) cae en morosidad. Se muestra una mayor probabilidad de impago de las personas que tienen un nivel de educación universitario.
plot2 <- ggplot(data = UCI_datos, aes(x=factor(EDUCATION), fill =factor(default.payment.next.month))) +
geom_bar() +
ylab("Observations count") +
xlab("(1=graduate school, 2=university, 3=high school, 4=others, 5=unknown, 6=unknown)")
plot2
** Diagrama de barras para Estado Civil **
En el diagrama se muestra los morosos por Estado Civil. La varriable de estudio es “default.payment.next.month”.
- es la probabbilidad de caer en morosidad y
- es la probablidad de no caer en morosidad.
Se muestra una mayor probabilidad de impago de las personas casadas según la variable Estado Civil.
plot3 <- ggplot(data = UCI_datos, aes(x=factor(MARRIAGE), fill =factor(default.payment.next.month))) +
geom_bar() +
ylab("Observations count") +
xlab("(1=married, 2=single, 3=others)")
plot3
Modelo Generalizado
La regresión Logit es una técnica de clasificación para predecir en este caso se utilizara para predecir el incumplimiento de pago de tarjeta de crédito. Este algoritmo es utilizado principalmente para clasificación binaria. Las covariables del modelo son 25 Esta técnica de predicción se utiliza cuando la variable dependiente es dicotómica. En este modelo la variable dependiente es “default.payment.next.month” La variable dependiente “default.payment.next.month” es el incumpliento de pago Esta variable dependiente es categórica: - (0) Probabilidad de que el préstamo no caiga en morosidad - (1) Probabilidad de que el préstamo caiga en morosidad
Se creo el modelo de regresión Logit utilizando el paquete de modelo lineal de scikit learn , a la variable denominada UCI_Modelo . El modelo tiene la distribución : familia binominal El enlace en el modelo es LOgit, este enlace muestra como se relaciona la variable dependiente (default.payment.next.month) con las covariables del modelo.
UCI_Modelo <- glm(default.payment.next.month ~ .,data = cred,
family = binomial(link = "logit"))summary(UCI_Modelo)##
## 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** AIC **
AIC es el Criterios de información de Akaike. Este criterio se utiliza como medida relativa de la parsimonia de un modelo. Es decir este criterio muestra unas pocas variables claves que capturen la esencia del modelo bajo estudio relegando toda influencia menor y aleatoria al término de error.
Se obtiene AIC con un valor de 26164, este valor de AIC se utiliza para seleccionar el modelo que explique mejor la variable dependiente. Al comparar modelos por la máxima probabilidad a los mismos datos, cuanto más pequeño sea el AIC , mejor será el ajuste.
** Modelo de selección de variables: StepAIC **
El Modelo de selección de variables itera una serie de covariable en busca un mejor AIC.Ayuda a seleccionar la mejor seleción de variables para tener el menor AIC
model.AIC <- stepAIC(UCI_Modelo)## 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 27599La función StepAIC del paquete MASS es útil para hacer selección de variables en un modelo de regresión. La estructura de la función se muestra a continuación. La función StepAIC permite la especificación del rango de variables que se incluirán en el modelo utilizando el argumento de alcance. El modelo inferior es en modelo con el menor número de varibales y el modelo superior es el modelo más grande posible. Los componentes de alcance superior es inferiror se pueden especificar explicitamente, sí el alcance es una fórmula única específica el componente superior y el modelo infeiror está vació. Si falta el alcance, el modelo inical es el modelo superior.
StepAIC elige el mejor modelo de acuerdo con el criterio de Akaike
StepAIC itera una serie de cavariables en busca de un mejor AIC
Los StepAIC que itero con toas las covariables del modelo son:
- STEP: 26164.34
- STEP: 26162.36
- STEP: 26160.42
- STEP: 26159.07
- STEP: 26158.41
- STEP: 26158.12
- STEP: 26156.99
STEP AIC del modelo linel generalizado es 26156.99. Es el mejor AIC debido a que es el menor monto de las 6 iteraciones.
yhat1<-model.AIC$fitted.values
hist(yhat1)
El histograma del modelo no muestra una distribrución normal.
** Sencibilidad y especificidad **
- Sencibilidad
- P(ŷ=1| y=1)
- Especificidad
- P(ŷ=0| y=0)
** Gráfica de Especificidad vs Sencibilidad ** Maximizar especificidad y sencibilidad el punto donde se maximiza en donde se cruzan las curvas de especificidad y sencibilidad El punto donde se intersectan las curvas es 0.17 punto donde se maximiza la especificidad y sencibilidad
** Matriz de confusión ** La matriz de confusión se utiliza para interpretar la sencibilidad y especificidad #Y
#0 #1 #ŷ #0 #p11 #p12
#1 #p21 #p22 - p11:Especificidad Prob de fracaso dado que si fue un fracaso la observasión - p22:Sencibilidad Prob de exito dado que si fue exitoso la observacion
c<-seq(0.01,0.3,by=0.01)
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)
print(o.cut)## [1] 0.17y.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")) #predicciones
#0 #1
#observaciones #0 #0.7089539 #0.2910461
#1 #0.3090717 #0.6909283
- p11:Especificidad Prob de fracaso dado que si fue un fracaso la observasión
- p22:Sencibilidad Prob de exito dado que si fue exitoso la observacion
Se obtiene de la matriz de confusión:
- La matriz de confusión da como resultado 70% de probabilidad de fracaso dado que si fue un fracaso (Especificidad)
- La matriz de confusión da como resultado 69% de probabilidad de exito dado que si fue exitosa la observasión (Sencibilidad)
- Un buen modelo de prediccion esta por encima del 90% en p11 y p22. Uno acepatable por encima de 70%
- El modelo generico se muestra como buen predictor de impago de tarjeto de crédito.
** 2. ESTIMACIÓN DE LA PROBABILIDAD DE CAER EN DEFAULT
** Probabilidad de caer en default **
# Probabilidad de caer en default de una mujer casada graduada del colegio que repaga con un mes de atraso
Prob1 <- -13.911400051 -0.179601714*(1) + 1.243900261*(1) + 10.990596441*(1) + 1.122418736*(1)
exp(Prob1)/(1+exp(Prob1))## [1] 0.3242987# Probabilidad de caer en default de una mujer soltera con grado universitario que repaga con dos meses de atraso
Prob2 <- -13.911400051 -0.179601714*(1) + 1.126354180*(1) + 11.151515529*(1) + 2.609156946*(1)
exp(Prob2)/(1+exp(Prob2))## [1] 0.6891235# Probabilidad de caer en default de una mujer con estado civil otros con grado de secundaria que repaga con tres meses de atraso
Prob3 <- -13.911400051 -0.179601714*(1) + 1.372293235*(1) + 11.156865235*(1) + 2.877047789*(1)
exp(Prob3)/(1+exp(Prob3))## [1] 0.7883828# Probabilidad de caer en default de una mujer casada con graduada del colegio que repaga con cuatro meses de atraso
Prob4 <- -13.911400051 -0.179601714*(1) + 1.243900261*(1) + 10.990596441*(1) + 2.471144999*(1)
exp(Prob4)/(1+exp(Prob4))## [1] 0.6489985# Probabilidad de caer en default de una mujer soltera con grado universitario que repaga con cinco meses de atraso
Prob5 <- -13.911400051 -0.179601714*(1) + 1.126354180*(1) + 11.151515529*(1) + 1.762715980*(1)
exp(Prob5)/(1+exp(Prob5))## [1] 0.4873987# Probabilidad de caer en default de una mujer casada con grado secundario que repaga con seis meses de atraso
Prob6 <- -13.911400051 -0.179601714*(1) + 1.243900261*(1) + 11.156865235*(1) + 1.853575087*(1)
exp(Prob6)/(1+exp(Prob6))## [1] 0.5407442# Probabilidad de caer en default de una mujer soltera otros con grado colegio que repaga con siete meses de atraso
Prob7 <- -13.911400051 -0.179601714*(1) + 1.126354180*(1) + 10.990596441*(1) + 2.908431829*(1)
exp(Prob7)/(1+exp(Prob7))## [1] 0.7179632# Probabilidad de caer en default de una mujer casada con grado universitario que repaga con ocho meses de atraso
Prob8 <- -13.911400051 -0.179601714*(1) + 1.243900261*(1) + 11.151515529*(1) + 2.015320940*(1)
exp(Prob8)/(1+exp(Prob8))## [1] 0.5792597La probabilidad de caer en default de una mujer casada graduada del colegio que repaga con un mes de atraso es de 32.4%
La probabilidad de caer en default de una mujer soltera con grado universitario que repaga con dos meses de atraso es de 68.91%
-La probabilidad de caer en default de una mujer con estado civil otros con grado de secundaria que repaga con tres meses de atraso es de 78.83%
-La probabilidad de caer en default de una mujer casada con graduada del colegio que repaga con cuatro meses de atraso es de 64.89%
-La Probabilidad de caer en default de una mujer soltera con grado universitario que repaga con cinco meses de atraso es de 48.73%
-La probabilidad de caer en default de una mujer casada con grado secundario que repaga con seis meses de atraso es de 54.07%
-La probabilidad de caer en default de una mujer soltera otros con grado colegio que repaga con siete meses de atraso es de 71.79%
-La probabilidad de caer en default de una mujer casada con grado universitario que repaga con ocho meses de atraso es de 57.92%
** Variaciones Marginales **
Las variacones marginales es una medida de cuanto varia la probabilidad de éxito cuando varia una covariable. Mide el cambio de la probabilidad del cliente en caer en default cuando el cliente varia una variable, esta variable determina una caracterpistica del cliente.
Por ejemplo mide como cambia la probabailidad de caer en morosidad cuando aumenta la educación de una persona
UCI_LOG_Modelo2<-logitmfx(formula = UCI_Modelo2, data = cred)
UCI_LOG_Modelo2## Call:
## logitmfx(formula = UCI_Modelo2, data = cred)
##
## Marginal Effects:
## dF/dx Std. Err. z P>|z|
## factor(MARRIAGE)1 0.19861795240 0.08307302250 2.3909 0.016808
## factor(MARRIAGE)2 0.17037816910 0.07508947930 2.2690 0.023268
## factor(MARRIAGE)3 0.28930034726 0.12960637878 2.2321 0.025605
## factor(EDUCATION)1 0.99170600337 0.33132216239 2.9932 0.002761
## factor(EDUCATION)2 0.98760485884 0.54357823724 1.8169 0.069239
## factor(EDUCATION)3 0.96325802812 0.51243650775 1.8798 0.060141
## factor(EDUCATION)4 0.81559710599 0.07954126323 10.2538 < 0.00000000000000022
## factor(EDUCATION)5 0.82303616069 0.14419240221 5.7079 0.00000001144
## factor(EDUCATION)6 0.81249961083 0.03528151563 23.0290 < 0.00000000000000022
## factor(SEX)2 -0.02798818448 0.00498384322 -5.6158 0.00000001957
## factor(PAY_0)-1 0.04411870433 0.01140811237 3.8673 0.000110
## factor(PAY_0)0 -0.01266507935 0.00958077435 -1.3219 0.186193
## factor(PAY_0)1 0.21613992626 0.01540177380 14.0334 < 0.00000000000000022
## factor(PAY_0)2 0.55977454931 0.01413969035 39.5889 < 0.00000000000000022
## factor(PAY_0)3 0.61629221568 0.02266606873 27.1901 < 0.00000000000000022
## factor(PAY_0)4 0.54499648479 0.04954109217 11.0009 < 0.00000000000000022
## factor(PAY_0)5 0.38754125538 0.09813005405 3.9493 0.00007839264
## factor(PAY_0)6 0.40961277704 0.14619999856 2.8017 0.005083
## factor(PAY_0)7 0.62129062986 0.12318720545 5.0435 0.00000045717
## factor(PAY_0)8 0.44769613739 0.10835570205 4.1317 0.00003600485
## PAY_AMT1 -0.00000278227 0.00000032754 -8.4944 < 0.00000000000000022
##
## factor(MARRIAGE)1 *
## factor(MARRIAGE)2 *
## factor(MARRIAGE)3 *
## factor(EDUCATION)1 **
## factor(EDUCATION)2 .
## factor(EDUCATION)3 .
## factor(EDUCATION)4 ***
## factor(EDUCATION)5 ***
## factor(EDUCATION)6 ***
## factor(SEX)2 ***
## 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_AMT1 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## dF/dx is for discrete change for the following variables:
##
## [1] "factor(MARRIAGE)1" "factor(MARRIAGE)2" "factor(MARRIAGE)3"
## [4] "factor(EDUCATION)1" "factor(EDUCATION)2" "factor(EDUCATION)3"
## [7] "factor(EDUCATION)4" "factor(EDUCATION)5" "factor(EDUCATION)6"
## [10] "factor(SEX)2" "factor(PAY_0)-1" "factor(PAY_0)0"
## [13] "factor(PAY_0)1" "factor(PAY_0)2" "factor(PAY_0)3"
## [16] "factor(PAY_0)4" "factor(PAY_0)5" "factor(PAY_0)6"
## [19] "factor(PAY_0)7" "factor(PAY_0)8"yhat2<-UCI_Modelo3$fitted.values
hist(yhat2)
-El histograma del modelo no muestra una distribución normal.
** 3. EVALUCIÓN DE LA CAPACIDAD PREDICTIVA DEL MODELO **
** Sencibilidad y especificidad **
- Sencibilidad
- P(ŷ=1| y=1)
- Especificidad
- P(ŷ=0| y=0)
** Gráfica de Especificidad vs Sencibilidad ** Maximizar especificidad y sencibilidad el punto donde se maximiza en donde se cruzan las curvas de especificidad y sencibilidad
** Punto de corte para los valores ajustados **
- El punto donde se intersectan las curvas es 0.159 punto donde se maximiza la especificidad y sencibilidad
** Matriz de confusión ** La matriz de confusión se utiliza para interpretar la sencibilidad y especificidad #Y
#0 #1 #ŷ #0 #p11 #p12
#1 #p21 #p22 - p11:Especificidad Prob de fracaso dado que si fue un fracaso la observasión - p22:Sencibilidad Prob de exito dado que si fue exitoso la observacion
c<-seq(0.01,0.3,by=0.001)
sens<-c()
spec<-c()
for (i in 1:length(c)){
y.pred<-ifelse(UCI_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)
print(o.cut)## [1] 0.159 #predicciones
#0 #1
#observaciones #0 #0.7410974 #0.2589026
#1 #0.3808017 #0.6191983
- p11:Especificidad Prob de fracaso dado que si fue un fracaso la observasión
- p22:Sencibilidad Prob de exito dado que si fue exitoso la observacion
Se obtiene de la matriz de confusión:
- La matriz de confusión da como resultado 74% de probabilidad de fracaso dado que si fue un fracaso (Especificidad)
- La matriz de confusión da como resultado 61% de probabilidad de exito dado que si fue exitosa la observasión (Sencibilidad)
- Un buen modelo de prediccion esta por encima del 90% en p11 y p22. Uno acepatable por encima de 70%
- El modelo generico no se muestra como buen predictor de impago de tarjeto de crédito debido a que los porcentajes no estan por arriba del 70%
y.pred1<-ifelse(UCI_Modelo3$fitted.values > o.cut, 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.6757833 0.3242167
## 1 0.3313743 0.6686257** 4. AMÁLISIS DE LA CURVA DE ROC **
** Area bajo la curva **
El área bajo la curva muestra que tan bueno ha sido nuestro modelo para predecir - 0.5≤ ARC< 0.7 - 0.7≤ ARC< 0.9 - 0.9≤ ARC
El área bajo la curva de ROC es 0.7397. El resultado muestra que el modelo es bueno para predecir la probabilidad de impago de tarjeta de crédito debido a que la probabilidad resultante es mayor a 0,7
El modelo se establece como buen predictor de impagos de créditos.
prop.table(matriz_confusion1,1)## predicciones
## observaciones 0 1
## 0 0.6757833 0.3242167
## 1 0.3313743 0.6686257roc1<- roc(cred$default.payment.next.month,UCI_Modelo3$fitted.values)## Setting levels: control = 0, case = 1## Setting direction: controls < casesroc1##
## Call:
## roc.default(response = cred$default.payment.next.month, predictor = UCI_Modelo3$fitted.values)
##
## Data: UCI_Modelo3$fitted.values in 23364 controls (cred$default.payment.next.month 0) < 6636 cases (cred$default.payment.next.month 1).
## Area under the curve: 0.7397** Curva de Roc **
Indicador clave para determinar una buena predicción
Cuando la curva del modelo esta más a uno nuestro modelo se muestra como mejor predictor. Los valores acpetables para el área de la curva debe ser mayor a 0.7. El valor ideal para el área de la curva 0.9 a 1 se define el modelo como buen predictor.
El modelo se establece como buen predictor de impagos de créditos.
El área bajo la curva de Roc es de 0.73 es una medida aceptable debido a que esta or arriba del 0.7.
plot(roc1,main=c("Curva ROC"))
RESULTADOS
El Modelo Generalizado desarrolado en clase tiene un AIC de 26156.99 mientras el modelo desarrollado en el trabajo tiene un AIC de 26920. Los resultados de AIC muestran que el modelo desarrollado en clase es mejor al modelo del trabajo . Se debe de tener en consideración que el modelo desarrollado en clase, es el modelo generalizado este modelo tiene las 25 variables del trabajo mientras que el modelo desarrollado en el trabajo solo tiene 5 variables.
El modelo generalizado tiene una especificidad de 70.89% mientras que el modelo desarrollado en el trabajo tiene una especificidad de 74.10%.
El modelo generalizado tiene una sencibilidad de 69.095 mientras que el modelo desarrollado en clase tiene un sencibilidad de 61.91%.
Los resultados del análisis de sencibilidad y especificidad muestran al modelo generalizado como mejor modelo para detectar los casos de default.
El punto donde se intersectan las curvas del modelo generalizado es de 0.17 punto donde se maximiza la especificadad y sencibilidad mientras que el punto de corte para el modelo desarrollado en el trabajo es de 0.159.
El área debajo de la curva de ROC para el modelo generalizado es de 77.24% mientras que para el modelo desarrollado en el trabajo es de 73.97%. Los resultados del análisis muestra al modelo generalizado como un mejor modelo para detectar los casos de default.
El análisis de como resultado que el modelo generalizado es el mejor modelo para predecir los créditos caigan en default respecto al modelo 2 que es el modelo desarrolado en el trabajo.