INTRODUCCIÓN
En el presente trabajo se realizará un análisis de los datos que provienen de la plataforma de concursos de análisis de datos kaggle, dicha base de datos contiene información de incumplimientos de pagos, factores demográficos, datos crediticios, historial de pagos y estados de cuenta de clientes de tarjeta de crédito desde abril de 2005 hasta septiembre de 2005. La base de datos de utilizará para correr un modelo logistico en la que variable dependiente es default_payment.next.month y se escogerá las variables independientes según el análisis.
default_payment.next.month se:
Estimara e interpretara el efecto de los parámetros sobre el ratio de odds.
Estimara la probabilidad de caer en default asumiendo valores específicos para sus covariables.
Evaluará la capacidad predictiva del modelo:
Punto de corte para los valores ajustados.
Especificidad / Sensibilidad
Análisis de la curva ROC
-
ANALISIS DE DATOS
IMPORTACION DE DATOS
Primero cargamos los paquetes a utilizar, luego importamos los datos, previamente descargados.
options(scipen=999)
pkges<-c("mfx","pROC","tidyverse","forecast","data.table")
#installed.packages(pkges)
lapply(pkges,"library",character.only=T)## [[1]]
## [1] "mfx" "betareg" "MASS" "lmtest" "zoo" "sandwich"
## [7] "knitr" "stats" "graphics" "grDevices" "utils" "datasets"
## [13] "methods" "base"
##
## [[2]]
## [1] "pROC" "mfx" "betareg" "MASS" "lmtest" "zoo"
## [7] "sandwich" "knitr" "stats" "graphics" "grDevices" "utils"
## [13] "datasets" "methods" "base"
##
## [[3]]
## [1] "forcats" "stringr" "dplyr" "purrr" "readr" "tidyr"
## [7] "tibble" "ggplot2" "tidyverse" "pROC" "mfx" "betareg"
## [13] "MASS" "lmtest" "zoo" "sandwich" "knitr" "stats"
## [19] "graphics" "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" "knitr"
## [19] "stats" "graphics" "grDevices" "utils" "datasets" "methods"
## [25] "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" "knitr" "stats"
## [21] "graphics" "grDevices" "utils" "datasets" "methods"
## [26] "base"Se procede a importar la base de datos:
#Getwd es una función para saber cuál es el directorio de trabajo.
maindir <- getwd()
data <- read.csv(paste0(maindir,"/UCI_Credit_Card.csv"),header = T)La base de datos a analizar no continen datos incompletos (NA), pero en caso hubiera datos incompletos se autocompletara.
## ID LIMIT_BAL SEX EDUCATION MARRIAGE AGE PAY_0 PAY_2 PAY_3 PAY_4 PAY_5 PAY_6
## 1 1 20000 2 2 1 24 2 2 -1 -1 -2 -2
## 2 2 120000 2 2 2 26 -1 2 0 0 0 2
## 3 3 90000 2 2 2 34 0 0 0 0 0 0
## BILL_AMT1 BILL_AMT2 BILL_AMT3 BILL_AMT4 BILL_AMT5 BILL_AMT6 PAY_AMT1 PAY_AMT2
## 1 3913 3102 689 0 0 0 0 689
## 2 2682 1725 2682 3272 3455 3261 0 1000
## 3 29239 14027 13559 14331 14948 15549 1518 1500
## PAY_AMT3 PAY_AMT4 PAY_AMT5 PAY_AMT6 default.payment.next.month
## 1 0 0 0 0 1
## 2 1000 1000 0 2000 1
## 3 1000 1000 1000 5000 0
## [ reached 'max' / getOption("max.print") -- omitted 29997 rows ]A continuación se presenta una breve descripción de los datos, que contiene 25 variables, ya importados:
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 repago en septiembre de 2005
` # -1 = pagar debidamente, # 1 = retraso en el pago de un mes, # 2 = retraso en el pago de dos meses, # 8 = retraso en el pago de ocho meses, # 9 = retraso en el pago de nueve meses o más`PAY_2: Estado del repago en agosto de 2005 (escala igual a la anterior)
PAY_3: estado del repago en julio de 2005 (escala igual a la anterior)
PAY_4: estado del repago en junio de 2005 (escala igual a la anterior)
PAY_5: Estado del repago en mayo de 2005 (escala igual a la anterior)
PAY_6: Estado del repago en abril de 2005 (escala igual a la anterior)
BILL_AMT1: Cantidad de estado de cuenta en septiembre de 2005 (dólar NT)
BILL_AMT2: Cantidad de estado de cuenta en agosto de 2005 (dólar NT)
BILL_AMT3: Cantidad de estado de cuenta en julio de 2005 (dólar NT)
BILL_AMT4: Cantidad de 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 (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: incumplimiento de pago (1 = sí, 0 = no)
En esta base de datos el ID es irrelevante para el análisis por ello se eliminará.
Acontinuación, se cambiara las variables que son dicotomicas para más adelante aplicar el modelo Logit.
all_data$SEX <- as.factor(all_data$SEX)
all_data$MARRIAGE <- as.factor(all_data$MARRIAGE)
all_data$EDUCATION <- as.factor(all_data$EDUCATION)
all_data$PAY_0 <- as.factor(all_data$PAY_0)
all_data$PAY_2 <- as.factor(all_data$PAY_2)
all_data$PAY_3 <- as.factor(all_data$PAY_3)
all_data$PAY_4 <- as.factor(all_data$PAY_4)
all_data$PAY_5 <- as.factor(all_data$PAY_5)
all_data$PAY_6 <- as.factor(all_data$PAY_6)Luego se realiza un breve resumen de los datos de los cuales se puede decir lo siguiente:
Hay 30,000 clientes distintos de tarjetas de crédito.El valor promedio para el monto del límite de la tarjeta de crédito es 167,484, el valor máximo es 1M. El nivel de educación es principalmente escuela de posgrado y universidad. La mayoría de los clientes están casados o solteros (menos frecuente el otro estado). La edad promedio es de 35.5 años.
Como el valor 0 para el inclumplimiento de pagos significa ‘no default’ y el valor 1 significa ‘default’.
## LIMIT_BAL SEX EDUCATION MARRIAGE AGE
## Min. : 10000 1:11888 0: 14 0: 54 Min. :21.00
## 1st Qu.: 50000 2:18112 1:10585 1:13659 1st Qu.:28.00
## Median : 140000 2:14030 2:15964 Median :34.00
## Mean : 167484 3: 4917 3: 323 Mean :35.49
## 3rd Qu.: 240000 4: 123 3rd Qu.:41.00
## Max. :1000000 5: 280 Max. :79.00
## 6: 51
## PAY_0 PAY_2 PAY_3 PAY_4
## 0 :14737 0 :15730 0 :15764 0 :16455
## -1 : 5686 -1 : 6050 -1 : 5938 -1 : 5687
## 1 : 3688 2 : 3927 -2 : 4085 -2 : 4348
## -2 : 2759 -2 : 3782 2 : 3819 2 : 3159
## 2 : 2667 3 : 326 3 : 240 3 : 180
## 3 : 322 4 : 99 4 : 76 4 : 69
## (Other): 141 (Other): 86 (Other): 78 (Other): 102
## PAY_5 PAY_6 BILL_AMT1 BILL_AMT2
## 0 :16947 0 :16286 Min. :-165580 Min. :-69777
## -1 : 5539 -1 : 5740 1st Qu.: 3559 1st Qu.: 2985
## -2 : 4546 -2 : 4895 Median : 22382 Median : 21200
## 2 : 2626 2 : 2766 Mean : 51223 Mean : 49179
## 3 : 178 3 : 184 3rd Qu.: 67091 3rd Qu.: 64006
## 4 : 84 4 : 49 Max. : 964511 Max. :983931
## (Other): 80 (Other): 80
## BILL_AMT3 BILL_AMT4 BILL_AMT5 BILL_AMT6
## Min. :-157264 Min. :-170000 Min. :-81334 Min. :-339603
## 1st Qu.: 2666 1st Qu.: 2327 1st Qu.: 1763 1st Qu.: 1256
## Median : 20089 Median : 19052 Median : 18105 Median : 17071
## Mean : 47013 Mean : 43263 Mean : 40311 Mean : 38872
## 3rd Qu.: 60165 3rd Qu.: 54506 3rd Qu.: 50191 3rd Qu.: 49198
## Max. :1664089 Max. : 891586 Max. :927171 Max. : 961664
##
## PAY_AMT1 PAY_AMT2 PAY_AMT3 PAY_AMT4
## Min. : 0 Min. : 0 Min. : 0 Min. : 0
## 1st Qu.: 1000 1st Qu.: 833 1st Qu.: 390 1st Qu.: 296
## Median : 2100 Median : 2009 Median : 1800 Median : 1500
## Mean : 5664 Mean : 5921 Mean : 5226 Mean : 4826
## 3rd Qu.: 5006 3rd Qu.: 5000 3rd Qu.: 4505 3rd Qu.: 4013
## Max. :873552 Max. :1684259 Max. :896040 Max. :621000
##
## PAY_AMT5 PAY_AMT6 default.payment.next.month
## Min. : 0.0 Min. : 0.0 Min. :0.0000
## 1st Qu.: 252.5 1st Qu.: 117.8 1st Qu.:0.0000
## Median : 1500.0 Median : 1500.0 Median :0.0000
## Mean : 4799.4 Mean : 5215.5 Mean :0.2212
## 3rd Qu.: 4031.5 3rd Qu.: 4000.0 3rd Qu.:0.0000
## Max. :426529.0 Max. :528666.0 Max. :1.0000
## ANALISIS DE LAS VARIABLES
1) LIMIT_BAL
Es la cantidad de crédito otorgado en dólares NT (incluye crédito individual y familiar / complementario), esta variable es de importancia cuando se trata de morosidad, ya que a mayor linea de credito, esto quiere decir mayor monto otorgado a un individuo hay más probabilidad que este entre en default(incumpla el pago), pero aqui hay un aspecto importante, para que un banco otorgue dicha linea de crédito se basan en otros factores y esperan que la probabilidad de impago se reduzca. A continuación se analizara dicha variable, ralizando un grafico box, en el que se puede observar que aquellos que tienen menor linea de crédito presentan mayor incumplimiento de pagos, ello se puede explicar por el hecho que se comento antes, que para que un entidad financiera otorgue un crédito analisan diversos factores y no solo por el hecho de que se tenga una linea de crédito con un monto cada vez mayor.
boxplot(all_data$LIMIT_BAL ~ all_data$default.payment.next.month, col = "red",
main = "LINEA DE CREDITO Y DEFAULT")
2) EDUCATION
Esta variable esta descrita por niveles en este caso 1 = escuela de posgrado, 2 = universidad, 3 = escuela secundaria, 4 = otros, 5 = desconocido y 6 = desconocido.
En niveles educativos mas bajos hay mas mujeres, lo cual tiene sentido, por ello hoy en día se aplica la inclusión financiera: tema de brechas de género en acceso al crédito y su correlación con el tema educativo.
Se puede decir que estas dos variables estan correlacionadas, por lo tanto no necesariamente tienen que ir ambas en nuestro nuevo modelo, además se pude observar que solo tres niveles son más resaltantes y ello puede ser por la brecha salarial de dichos niveles y otros factores.
plot1 <- ggplot(data = datos, aes(x=factor(EDUCATION), fill =factor(SEX))) +
geom_bar() +
ylab("Observations count") +
xlab("(1=graduate school, 2=university, 3=high school, 4=others, 5=unknown, 6=unknown)")
plot1
3) GÉNERO
En esta variable 1=varón y 2=mujer.
En el grafico se pude observar la probabilidad de exito=1 default o la probabilidad de fracaso =0 no default, se puede observar como se distribuye por géneros donde se otorga más créditos a las mujeres y según el gráfico mostrado hay más probabilidad que las mujeres no pagen, ello quiere decir que entren en default. La variable sex o género es de importancia para el modelo ya que según estudios crediticios se relaciona el género femenino con el inclumpliento de pagos, quiere decir entrar en default, además dicha variable solo se clasifica en 2 grupos y ello es mejor para el modelo.
plot2 <- ggplot(data = data, aes(x=factor(SEX), fill =factor(default.payment.next.month))) +
geom_bar() +
ylab("Observations count") +
scale_x_discrete(labels = c('Male','Female')) +
xlab("")
plot2
4) AGE
Esta variable “edad” se relaciona con probabilidad de caer en default, ya que a más edad la probabilidad de default disminuye, ello es asociado a distintos factores, como economicos, educativos y hasta psicologicos. A continuación se haran dos grafcicos:
plot3<-ggplot(data = data, aes(x = AGE)) +
geom_histogram(bins = 50, fill = "purple", col = "blue", alpha = 0.3) +
scale_x_continuous(breaks = seq(min(0), max(90), by = 5), na.value = TRUE)
plot3
En el siguiente grafico se puede observar que la edad promedio que tiene mas tarjetas de credito es aprox las personas que tienen 33 años de edad, por lo cual se puede decir que ellos serian los que tendrian más probabiidad de impagos.
En el siguiente box se observa que tanto la probabilidad de caer en default como la probabilidad de no caer default, estan distribuidos con personas de la misma edad no hay una diferencia significativa, por ello quizá se preveé que no sera de tanta importancia en el modelo.
5) MARRIAGE
Esta variable esta dividida en 1=casados, 2= solteros y 3=otros.El estado civil es una variable de importancia cuando se trata de créditos, ya que se asocia a los casados con una menor probabilidad de impago, puede ser por distintos factores, como educativos, estabilidad economica, madurez, etc.
plot3 <- ggplot(data = data, aes(x=factor(MARRIAGE), fill =factor(default.payment.next.month))) +
geom_bar() +
ylab("Observations count") +
scale_x_discrete(labels = c('1=married', '2=single', '3=others')) +
xlab("")
plot3
Se observa un caso atipico ya que los solteros son los que presentan menor prob de impago, ello puede ser por la cantidad de datos que se tiene.
6) PAY_0
Se refiere al estado de repago de la deuda en donde se divide en: # -1 = pagar debidamente, 1 = retraso en el pago de un mes, 2 = retraso en el pago de dos meses, 8 = retraso en el pago de ocho meses,9 = retraso en el pago de nueve meses o más.
Se observa que exite mayor cantidad de observaciones en “0” que en este caso podria ser que sean datos no encontrados o que dentro de ellos haya categorias 1y2. Por otro lado las categorias que tienen mayor probabilidad de impago son los que tienen retrasos de un mes y dos meses, además también se puede observar que a mayor mes de retraso dicha probabilidad se reduce.
plot4 <- 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))")
plot4
7) PAY_AMT1
Es el monto del pago anterior, ello sta asociado a la probabilidad de entrar n default respecto al monto ya cancelado, ello quiere decir que si no se realiza el pago del mes anterior exite mayor probabilidad de caer default que cuando se esta al día con todos los pagos.
En la siguiente gráfica se puede observar que exite una diferencia en cuanto a los valores máximos de la no probabilidad de entrar en default. Dicha variable se puede considerar significativa para el modelo a realizar.
boxplot(datos$PAY_AMT1 ~ datos$default.payment.next.month, col = "red",
main = "MONTO DEL PAGO ANTERIOR & DEFAULT")
8) BILL_AMT1
Es el monto del estado de cuenta en dolares, es una variable importante cuando se trata de incluplimiento de creditos, ya que se esperaria a que cuando haya un importe mayor del estado de cuenta, gastar más de lo que se tenga, la probabilidad de impago aumente.
boxplot(datos$BILL_AMT1 ~ datos$default.payment.next.month, col = "red",
main = "MONTO DEL ESTADO DE CUENTA & DEFAULT")
-
-
MODELO LOGIT
Para esta parte, se tomará en cuenta el análisis de las variables previamente realizadas, en esta sección también se tratará de explicar brevemente en que consiste el Modelo Logit, correr varios modelos con la finalidad de ir descartando y quedarse con el modelo que prediga de mejor manera la variable dependiente, cuando se tenga ya el modelo establecido se procederá a estimar e interpretar el efecto de los parámetros sobre el ratio de odds, estimará la probabilidad de caer en default asumiendo valores específicos para sus covariables, se evaluará la capacidad predictiva del modelo:punto de corte para los valores ajustados, especificidad / sensibilidad y análisis de la curva ROC. Cabe destacar que para la eleccion del modelo se tomará solo 5 o 6 variables.
EXPLICACION DEL MODELO LOGIT
La Regresión Logística Simple, desarrollada por David Cox en 1958, es un método de regresión que permite estimar la probabilidad de una variable cualitativa binaria en función de una variable cuantitativa. Una de las principales aplicaciones de la regresión logística es la de clasificación binaria, en el que las observaciones se clasifican en un grupo u otro dependiendo del valor que tome la variable empleada como predictor.
Es importante tener en cuenta que, aunque la regresión logística permite clasificar, se trata de un modelo de regresión que modela el logaritmo de la probabilidad de pertenecer a cada grupo. La asignación final se hace en función de las probabilidades predichas.
¿Por qué regresión logística y no lineal?
Si una variable cualitativa con dos niveles se codifica como 1 y 0, matemáticamente es posible ajustar un modelo de regresión lineal por mínimos cuadrados \(β_0+β_1x\). El problema de esta aproximación es que, al tratarse de una recta, para valores extremos del predictor, se obtienen valores de Y menores que 0 o mayores que 1, lo que entra en contradicción con el hecho de que las probabilidades siempre están dentro del rango [0,1].
CONDICIONES DEL MODELO LOGÍSTICO
La regresión logística no requiere de ciertas condiciones como linealidad, normalidad y homocedasticidad de los residuos que sí lo son para la regresión lineal. Las principales condiciones que este modelo requiere son:
Respuesta binaria: La variable dependiente ha de ser binaria.
Independencia: las observaciones han de ser independientes.
Multicolinealidad: se requiere de muy poca a ninguna multicolinealidad entre los predictores (para regresión logística múltiple).
Linealidad entre la variable independiente y el logaritmo natural de odds.
Tamaño muestral: como regla general, se requiere un mínimo de 10 casos con el resultado menos frecuente para cada variable independiente del modelo.
MODELO FORMAL
\[y∣β ∼ Binomial(1−ρ)\]
Despues de operar matemáticamente la delimitación brindada (debido a que es un tema avanzado no se tratará en el curso) podemos llegar a la siguiente ecuación:
\[E(y)=ρ=\frac{e^{xβ}}{1+e^{xβ}}=\frac{e^{β_0+β_1x_1+…+β_nx_n}}{1+e^{β_0+β_1x_1+…+β_nx_n}}\]
\[y=0→1−ρ\]
\[y=1→ρ\]
Se tien que operar:
\[ρ=\frac{e^{β_x}}{1+e^{β_x}}\]
\[ρ+ρe^{β_x}=e^{β_x}\]
\[ρ=e^{β_x}−ρe^{β_x}\]
\[ρ=(1−ρ)e^{β_x}\]
\[\frac{ρ}{1−ρ}=e^{βx}\]
Se llega al siguiente resultado:
\[log(\frac{ρ}{1−ρ})=βx=β_0+β_1x_1+…+β_nx_n\]
MODELOS
Primero se hara un modelo con todas las variables para que se pueda observar que variables son significativas y cuales no, para luego escoger las variables más significativas teniendo en cuenta además el análisis previo de las variables.
modelo01 <- glm(default.payment.next.month ~ .,data = all_data, family = binomial(link = "logit"))
summary(modelo01)##
## Call:
## glm(formula = default.payment.next.month ~ ., family = binomial(link = "logit"),
## data = all_data)
##
## 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: 12Se puede observar que el AIC= 26164,el AIC es un criterio de información, tendrá que ser comparado con otro AIC de otro modelo para elegir el mejor modelo que prediga mejor la prob de caer de caer en default. Por otro lado, se puede analizar el p value de cada una de las variables independientes, para poder elegir las mejores variables, teniendo en cuenta además el análisis previo realizado, en este caso las siguientes variables que tienen un p- value menor al 0.05 lo cual no se aceptaria la Ho y se aceptaría la Hipotesis alterna que dichos betas de las variabls si son significativos: Limit_bal, sex, marriage, pay_0, pay_amt1 y pay_amt2 . Por último, se puede analizar los betas, estos son las pendientes o la velocidad de cambio de P(probabilidad) cuando varia x(que podria ser el sexo, l nivel de educacion, etc). Cuando beta es más grande la velocidad es mayor, ello se analizará mas adelante con el modelo elegido.
A continuación, se procede a correr un modelo con 5 variables entre las cuales se escoge, la variable género, porque como se describio antes es una variable dicotomica que solo tiene dos grupo(femenino y masculino), por ello se considerará para el modelo02, dado análisis previo y el modelo01 observado que es una variable significativa. Además se considerará la variable MARRIAGE, ya que también tiene un beta significativo, ´por otro lado aunque la variable EDUCATION no tiene un beta significativo en el modelo01, lo incluiremos en el modelo02 porque dado al análisis cualitativo es una variable común utilizada en modelos de crédito, otra variable que se incluirá en el modelo02 es LIMIT_BAL, esta tiene un beta significativo según el modelo01 y por último la variable pay_0, según el analisis cualitativo es importante cuando se trata de modelos de crédito.
XB <- as.formula("default.payment.next.month ~ LIMIT_BAL+ factor(SEX)+factor(MARRIAGE)+factor(EDUCATION)+factor(PAY_0)")
modelo02 <- glm(XB,data = all_data,family = binomial(link="logit") )
summary(modelo02)##
## Call:
## glm(formula = XB, family = binomial(link = "logit"), data = all_data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8544 -0.6037 -0.5242 -0.3647 2.8686
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -13.3730262234 84.8711009813 -0.158 0.874797
## LIMIT_BAL -0.0000023751 0.0000001437 -16.533 < 0.0000000000000002
## factor(SEX)2 -0.1720945328 0.0314765159 -5.467 0.0000000457
## factor(MARRIAGE)1 1.3152480227 0.5021476880 2.619 0.008812
## factor(MARRIAGE)2 1.1197658938 0.5023351616 2.229 0.025806
## factor(MARRIAGE)3 1.3050745480 0.5209376529 2.505 0.012237
## factor(EDUCATION)1 10.9610635382 84.8695966165 0.129 0.897238
## factor(EDUCATION)2 11.0013671096 84.8695970095 0.130 0.896862
## factor(EDUCATION)3 10.9570880098 84.8696030742 0.129 0.897275
## factor(EDUCATION)4 9.7356221975 84.8705452932 0.115 0.908674
## factor(EDUCATION)5 9.5524374067 84.8699940688 0.113 0.910384
## factor(EDUCATION)6 10.6100611274 84.8706440493 0.125 0.900512
## factor(PAY_0)-1 0.1557798504 0.0672024967 2.318 0.020446
## factor(PAY_0)0 -0.2864451740 0.0634194273 -4.517 0.0000062817
## factor(PAY_0)1 0.9642210375 0.0678009715 14.221 < 0.0000000000000002
## factor(PAY_0)2 2.3740177338 0.0723131282 32.830 < 0.0000000000000002
## factor(PAY_0)3 2.6259908783 0.1440917010 18.224 < 0.0000000000000002
## factor(PAY_0)4 2.2213377320 0.2564007507 8.664 < 0.0000000000000002
## factor(PAY_0)5 1.5222673370 0.4037409534 3.770 0.000163
## factor(PAY_0)6 1.6945411396 0.6117406897 2.770 0.005605
## factor(PAY_0)7 2.8291008331 0.8088415740 3.498 0.000469
## factor(PAY_0)8 1.8237823118 0.4754977120 3.836 0.000125
##
## (Intercept)
## LIMIT_BAL ***
## factor(SEX)2 ***
## 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(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 ***
## ---
## 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: 26697 on 29978 degrees of freedom
## AIC: 26741
##
## Number of Fisher Scoring iterations: 11Se observa que tiene un AIC= 26741 menor al modelo01, pero si se observa las variables, la variable EDUCATION no tiene un beta significativo y ello se puede explicar debido a que no exista una diferencia entre los salarios.
Por ello cambiaremos dicha variable por la variable AGE para el modelo03:
XB1 <- as.formula("default.payment.next.month ~ LIMIT_BAL+ factor(SEX)+factor(MARRIAGE)+factor(PAY_0)+AGE
")
modelo03 <- glm(XB1,data = all_data, family = binomial(link="logit") )
summary(modelo03)##
## Call:
## glm(formula = XB1, family = binomial(link = "logit"), data = all_data)
##
## 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 *
## 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 ***
## AGE 0.0035686388 0.0018858892 1.892 0.058453 .
## ---
## 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: 4Se observa que tiene un AIC= 26791 mayor al modelo02, ello se puede deber a que variable AGE, su beta no es significativo.
Por ello cambiaremos AGE por la variable PAY_AMT1 , dicha variable es de gran importancia cuando se trata de modelos de créditos, porque hace referencia al importe del pago anterior en septiembre, además dicha variable tiene un beta significativo visto en el modelo01.
XB2 <- as.formula("default.payment.next.month ~ LIMIT_BAL+ factor(SEX)+factor(MARRIAGE)+factor(PAY_0)+PAY_AMT1")
modelo04 <- glm(XB2,data = all_data, family = binomial(link="logit") )
summary(modelo04)##
## Call:
## glm(formula = XB2, family = binomial(link = "logit"), data = all_data)
##
## 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: 5Se observa que el modelo04 tiene un AIC=26741 este es menor al modelo03, pero igual al modelo02, en este modelo todas los betas de las variables son significativos, por lo que se podría decir que es un modelo óptimo.
Pero vamos a realizar un último modelo incorporando una variable más y en este caso sera BILL_AMT1, este es el importe del estado de cuenta en septiembre y esta relacionado con la linea de crédito, pero de todas formas dado al análisis previo se considerará para dicho modelo, en este caso tendremos 6 variables en el modelo.
XB3 <- as.formula("default.payment.next.month ~ LIMIT_BAL + factor(SEX)+factor(MARRIAGE)+factor(PAY_0)+PAY_AMT1+ BILL_AMT1 ")
modelo05 <- glm(XB3 ,data = all_data,family = binomial(link="logit") )
summary(modelo05 )##
## Call:
## glm(formula = XB3, family = binomial(link = "logit"), data = all_data)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8378 -0.5973 -0.5248 -0.3599 3.5420
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.2967276301 0.5058931912 -4.540 0.000005626871088 ***
## LIMIT_BAL -0.0000025763 0.0000001560 -16.520 < 0.0000000000000002 ***
## factor(SEX)2 -0.1681513737 0.0314931775 -5.339 0.000000093308575 ***
## factor(MARRIAGE)1 1.2831590933 0.5020269828 2.556 0.01059 *
## factor(MARRIAGE)2 1.0903507822 0.5019559444 2.172 0.02984 *
## factor(MARRIAGE)3 1.2726876586 0.5209735336 2.443 0.01457 *
## factor(PAY_0)-1 0.1714724542 0.0674071734 2.544 0.01096 *
## factor(PAY_0)0 -0.3983698190 0.0674868177 -5.903 0.000000003571064 ***
## factor(PAY_0)1 0.8955206556 0.0688123795 13.014 < 0.0000000000000002 ***
## factor(PAY_0)2 2.2506688318 0.0756317349 29.758 < 0.0000000000000002 ***
## factor(PAY_0)3 2.5137723805 0.1448236060 17.357 < 0.0000000000000002 ***
## factor(PAY_0)4 2.0575691135 0.2563373173 8.027 0.000000000000001 ***
## factor(PAY_0)5 1.2899719899 0.4012885183 3.215 0.00131 **
## factor(PAY_0)6 1.5022529056 0.6123686442 2.453 0.01416 *
## factor(PAY_0)7 2.5124749498 0.8065056413 3.115 0.00184 **
## factor(PAY_0)8 1.5823470266 0.4719580751 3.353 0.00080 ***
## PAY_AMT1 -0.0000138360 0.0000020745 -6.670 0.000000000025662 ***
## BILL_AMT1 0.0000017573 0.0000002752 6.386 0.000000000170266 ***
## ---
## 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: 26667 on 29982 degrees of freedom
## AIC: 26703
##
## Number of Fisher Scoring iterations: 5Se observa que el AIC= 26703, es menor al modelo04 y todas sus betas son significativos, por ello se trabajará con este modelo.
VARIACIONES MARGINALES
Las variaciones marginales se refiere a como cambiria la probabilidad de caer en defualt en próximo mes (beta) cuando un individuo presenta una determina variable. En este caso seria como cambia la probabilidad de caer en default cuando un persona es mujer o esta casada, etc.
## Call:
## logitmfx(formula = XB3, data = all_data)
##
## Marginal Effects:
## dF/dx Std. Err. z
## LIMIT_BAL -0.000000394688 0.000000023585 -16.7347
## factor(SEX)2 -0.026042993380 0.004927008891 -5.2858
## factor(MARRIAGE)1 0.204085104874 0.082614055796 2.4703
## factor(MARRIAGE)2 0.164131623088 0.074511061280 2.2028
## factor(MARRIAGE)3 0.263788858307 0.128397529284 2.0545
## factor(PAY_0)-1 0.027144252320 0.011009862903 2.4654
## factor(PAY_0)0 -0.060930680328 0.010293321189 -5.9194
## factor(PAY_0)1 0.165486281581 0.014673583720 11.2778
## factor(PAY_0)2 0.484001013565 0.016686148202 29.0062
## factor(PAY_0)3 0.552033796322 0.028017980969 19.7028
## factor(PAY_0)4 0.456437993514 0.058683790721 7.7779
## factor(PAY_0)5 0.269274418072 0.099579439622 2.7041
## factor(PAY_0)6 0.322298408812 0.152994445961 2.1066
## factor(PAY_0)7 0.552856203097 0.154537032272 3.5775
## factor(PAY_0)8 0.342240372387 0.117510105030 2.9124
## PAY_AMT1 -0.000002119687 0.000000314887 -6.7316
## BILL_AMT1 0.000000269224 0.000000042029 6.4057
## P>|z|
## LIMIT_BAL < 0.00000000000000022 ***
## factor(SEX)2 0.000000125182977806 ***
## factor(MARRIAGE)1 0.0134983 *
## factor(MARRIAGE)2 0.0276101 *
## factor(MARRIAGE)3 0.0399302 *
## factor(PAY_0)-1 0.0136842 *
## factor(PAY_0)0 0.000000003230428758 ***
## factor(PAY_0)1 < 0.00000000000000022 ***
## factor(PAY_0)2 < 0.00000000000000022 ***
## factor(PAY_0)3 < 0.00000000000000022 ***
## factor(PAY_0)4 0.000000000000007373 ***
## factor(PAY_0)5 0.0068486 **
## factor(PAY_0)6 0.0351521 *
## factor(PAY_0)7 0.0003469 ***
## factor(PAY_0)8 0.0035862 **
## PAY_AMT1 0.000000000016784254 ***
## BILL_AMT1 0.000000000149683180 ***
## ---
## 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
El Ratio de Odds también conocido como razón de oportunidades (OR), una medida estadistica que define que tantas veces mayor es un posible evento frente a que no ocurra dicho evento, también se puede interpretar de la siguient manera es el cociente que se obtiene entre la probabilidad de que ocurra un suceso de exito frente a la probabilidad de que no ocurra, teniendo en cuenta otro evento.
Dicho ratio es una medida de “tamaño de efecto”, quiere decir cuantas chancs hay de que ocurra un evento respecto a que no ocurra.
Se puede calcular con la siguinte ecuación:
\[RatiodeOdds=\frac{ρ}{(1−ρ)}=e^{βx}\] Pero para la interpretación se va restar 1 a ambas partes.
r.odds <- numeric()
for (i in 2:18) {
v <- exp(modelo05$coef[i])-1
r.odds[i] <- v
}
r.odds<-r.odds[-1]; r.odds## [1] -0.000002576278 -0.154774119964 2.608019811795 1.975317578025
## [5] 2.570435790840 0.187051444020 -0.328586319775 1.448610340331
## [9] 8.494083658476 11.351436603328 6.826920311085 2.632684802572
## [13] 3.491797275099 11.335421862250 3.866363903858 -0.000013835912
## [17] 0.000001757331Los valores obtenidos se interpretan de la siguinte manera:
Un cambio positivo de la variable LMIT_BAL(linea de credito) reduce en 0.000257% las chances de entrar en default.
Un cambio en la variable sex2(femenino), un incremento, reduce en 15.48% las chances de entrar en default.
Un cambio positivo de la variable casado, aumenta un 260% las chances de entrar en default.
Un cambio en la variable soltero aumenta un 198% las chances de entrar en default.
Un cambio en la variable marriage3(otra condición civil ) aumenta un 257%las chances de entrar en default.
Un cambio positivo de la variable PAY_0_-1 (persona esta al día en sus repagos) aumenta un 187% las chances de entrar en default.
Un cambio positivo de la variable PAY_0_0(variable 0 de la data ) reduce un 32.86% las chances de entrar en default.
Un cambio positivo de la variable PAY_0_1(persona tiene un mes de retraso en sus repagos) aumenta un 145% las chances de entrar en default.
Un cambio positivo de la variable PAY_0_2 (persona tiene dos meses de retraso en sus repagos) aumenta un 849.41% las chances de entrar en default.
Un cambio positivo en la variable PAY_0_3 (persona tiene tres meses de retraso en sus repagos) aumenta un 1135.14% las chances de entrar en default.
Un cambio positivo en la variable PAY_0_4(persona tiene cuatro meses de retraso en sus repagos) aumenta un 682.69% las chances de entrar en default.
Un cambio positivo en la variable PAY_0_5 (persona tiene cinco meses de retraso en sus repagos) aumenta un 263.27% las chances de entrar en default.
Un cambio positivo en la variable PAY_0_6(persona tiene seis meses de retraso en sus repagos) aumenta un 349.18% las chances de entrar en default.
Un cambio positivo en la variable PAY_0_7(persona tiene siete meses de retraso en sus repagos) aumenta un 1133.54% las chances de entrar en default.
Un cambio positivo en la variable PAY_0_8(persona tiene ocho meses de retraso en sus repagos) aumenta un 386.63% las chances de entrar en default.
Un cambio positivo en la variable PAY_AMT1(importe del pago previo) reduce un 0.001384%las chances de entrar en default.
Un cambio positivo en la variable BILL_AMT1(monto de la línea de crédito) aumenta un 0.000176%las chances de entrar en default.
Cuando el\(e^β\) es mayor de 1 señala que un aumento de la variable independiente, aumenta los odds que ocurra el evento
Cuando el \(e^β\) es menor de 1 indica que un aumento de la variable independiente, reduce los odds que ocurra el evento.
PROBABILIDAD DE CAER EN DEFAULT
\[ρ=\frac{e^{βx}}{(1+e^{βx})}\] 1. PROBABILIDAD DE DEFAULT DE UNA MUJER SOLTERA QUE REPAGA A TIEMPO CON UN PAGO ANTERIOR DE \(\$5663.581\), UNA LINEA DE CREDITO DE \(\$167484.3\) Y Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$51223.33\)
## [1] 167484.3## [1] 5663.581parametros <- c(0,mean(all_data$LIMIT_BAL), 1, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, mean(all_data$PAY_AMT1), mean(all_data$BILL_AMT1))
vec <- numeric()
prob <- numeric()
for (i in 1:length(parametros)) {
vec[i] <- modelo05$coef[i] * parametros[i]
prob <- exp(sum(vec)) / (1 + exp(sum(vec)))
}
probabilidad <- prob * 100
probabilidad## [1] 52.5976PROBABILIDAD DE DEFAULT DE UNA MUJER SOLTERA QUE REPAGA A TIEMPO CON UN PAGO ANTERIOR DE \(\$5663.581\), UNA LINEA DE CREDITO DE \(\$167484.3\)Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$51223.33\) ES 52.60%.
2. PROBABILIDAD DE DEFAULT DE UN HOMBRE SOLTERO QUE REPAGA A TIEMPO, CON UN PAGO ANTERIOR DE \(\$5663.581\), UNA LINEA DE CREDITO DE \(\$167484.3\) Y Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$51223.33\)
parametros1 <- c(0,mean(all_data$LIMIT_BAL), 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, mean(all_data$PAY_AMT1), mean(all_data$BILL_AMT1))
vec1 <- numeric()
prob1 <- numeric()
for (i in 1:length(parametros1)) {
vec1[i] <- modelo05$coef[i] * parametros1[i]
prob1 <- exp(sum(vec1)) / (1 + exp(sum(vec1)))
}
probabilidad1 <- prob1 * 100
probabilidad1## [1] 56.76205PROBABILIDAD DE DEFAULT DE UN HOMBRE SOLTRO QUE REPAGA A TIEMPO, CON UN PAGO ANTERIOR DE \(\$5663.581\), UNA LINEA DE CREDITO DE \(\$167484.3\)Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$51223.33\) ES 56.76%
3. PROBABILIDAD DE DEFAULT DE UNA MUJER CASADA QUE REPAGA CON 5 MESES DE ATRASO, CON UN PAGO ANTERIOR DE \(\$5663.581\), UNA LINEA DE CREDITO DE \(\$167484.3\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$51223.33\)
## [1] 51223.33parametros2 <- c(0,mean(all_data$LIMIT_BAL), 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, mean(all_data$PAY_AMT1), mean(all_data$BILL_AMT1))
vec2 <- numeric()
prob2 <- numeric()
for (i in 1:length(parametros2)) {
vec2[i] <- modelo05$coef[i] * parametros2[i]
prob2 <- exp(sum(vec2)) / (1 + exp(sum(vec2)))
}
probabilidad2 <- prob2 * 100
probabilidad2## [1] 87.92289PROBABILIDAD DE DEFAULT DE UNA MUJER CASADA QUE REPAGA CON 5 MESES DE ATRASO, CON UN PAGO ANTERIOR DE \(\$5663.581\), UNA LINEA DE CREDITO DE \(\$167484.3\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$51223.33\) ES 87.92%
4.PROBABILIDAD DE DEFAULT DE UN HOMBRE DE “CASADO” QUE REPAGA CON 1 MESES DE ATRASO, CON UN PAGO ANTERIOR DE \(\$5663.581\), UNA LINEA DE CREDITO DE \(\$167484.3\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$51223.33\)
parametros3 <- c(0,mean(all_data$LIMIT_BAL), 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, mean(all_data$PAY_AMT1), mean(all_data$BILL_AMT1))
vec3 <- numeric()
prob3 <- numeric()
for (i in 1:length(parametros3)) {
vec3[i] <- modelo05$coef[i] * parametros3[i]
prob3 <- exp(sum(vec3)) / (1 + exp(sum(vec3)))
}
probabilidad3 <- prob3 * 100
probabilidad3## [1] 91.94726PROBABILIDAD DE DEFAULT DE UN HOMBRE DE “OTRO ESTADO CIVIL” QUE REPAGA CON 8 MESES DE ATRASO, CON UN PAGO ANTERIOR DE \(\$5663.581\), UNA LINEA DE CREDITO DE \(\$167484.3\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$51223.33\) ES DE 91.94%, SE PUEDE OBSERVAR QUE A MAYOR REPAGO CON MAS RETRASOS LA PROBABILIDAD DE DEFAULT AUMENTA.
5.PROBABILIDAD DE DEFAULT DE UN HOMBRE “CASADO” QUE REPAGA CON 2 MESES DE ATRASO, CON UN PAGO ANTERIOR DE \(\$2831.79405\), UNA LINEA DE CREDITO DE \(\$83742.15\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$25611.665\)
parametros4 <- c(0,mean(all_data$LIMIT_BAL)/2, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, mean(all_data$PAY_AMT1)/2, mean(all_data$BILL_AMT1)/2)
vec4 <- numeric()
prob4 <- numeric()
for (i in 1:length(parametros4)) {
vec4[i] <- modelo05$coef[i] * parametros4[i]
prob4 <- exp(sum(vec4)) / (1 + exp(sum(vec4)))
}
probabilidad4 <- prob4 * 100
probabilidad4## [1] 87.74783PROBABILIDAD DE DEFAULT DE UN HOMBRE CASADO QUE REPAGA CON 2 MESES DE ATRASO, CON UN PAGO ANTERIOR DE \(\$2831.79405\), UNA LINEA DE CREDITO DE \(\$83742.15\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$25611.665\) ES 87.748%
6.PROBABILIDAD DE DEFAULT DE UNA MUJER “DE OTRO ESTADO CIVIL” QUE REPAGA CON 3 MESES DE ATRASO, CON UN PAGO ANTERIOR DE \(\$2831.79405\), UNA LINEA DE CREDITO DE \(\$83742.15\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$25611.665\)
parametros5 <- c(0,mean(all_data$LIMIT_BAL)/2, 1, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, mean(all_data$PAY_AMT1)/2, mean(all_data$BILL_AMT1)/2)
vec5 <- numeric()
prob5 <- numeric()
for (i in 1:length(parametros5)) {
vec5[i] <- modelo05$coef[i] * parametros5[i]
prob5 <- exp(sum(vec5)) / (1 + exp(sum(vec5)))
}
probabilidad5 <- prob5 * 100
probabilidad5## [1] 96.79658PROBABILIDAD DE DEFAULT DE UNA MUJER “DE OTRO ESTADO CIVIL” QUE REPAGA CON 3 MESES DE ATRASO, CON UN PAGO ANTERIOR DE \(\$2831.79405\), UNA LINEA DE CREDITO DE \(\$83742.15\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$25611.665\) ES 96.797%, SE PUEDE OBSERVAR QUE CUANDO EL MONTO DE LA LINEA DE CREDITO, DEL REPAGO Y DEL IMPORTE DE DEUDA SON MENORES A SU MEDIA, HAY MÁS PROBABILIDAD DE IMPAGO.
7. PROBABILIDAD DE DEFAULT DE UNA MUJER “CASADA” QUE PAGA SU DEUDA ANTES DE LA FECHA, CON UN PAGO ANTERIOR DE \(\$113227.1762\), UNA LINEA DE CREDITO DE \(\$167484.3\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$25611.665\)
parametros6 <- c(0,mean(all_data$LIMIT_BAL), 1, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, mean(all_data$PAY_AMT1)*2, mean(all_data$BILL_AMT1)/2)
vec6 <- numeric()
prob6 <- numeric()
for (i in 1:length(parametros6)) {
vec5[i] <- modelo05$coef[i] * parametros6[i]
prob6 <- exp(sum(vec6)) / (1 + exp(sum(vec6)))
}
probabilidad6 <- prob5 * 100
probabilidad6## [1] 96.79658PROBABILIDAD DE DEFAULT DE UNA MUJER “CASADA” QUE PAGA SU DEUDA ANTES DE LA FECHA, CON UN PAGO ANTERIOR DE \(\$113227.1762\), UNA LINEA DE CREDITO DE \(\$167484.3\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$25611.665\) ES 67.7712%
8. PROBABILIDAD DE DEFAULT DE UNA HOMBRE “SOLTERO” QUE PAGA SU DEUDA EN LA FECHA INDICADA, CON UN PAGO ANTERIOR DE \(\$5663.5881\), UNA LINEA DE CREDITO DE \(\$167484.3\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$25611.665\)
parametros7 <- c(0,mean(all_data$LIMIT_BAL), 0, 0, 1, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, mean(all_data$PAY_AMT1), mean(all_data$BILL_AMT1)/2)
vec7 <- numeric()
prob7 <- numeric()
for (i in 1:length(parametros7)) {
vec7[i] <- modelo05$coef[i] * parametros7[i]
prob7 <- exp(sum(vec7)) / (1 + exp(sum(vec7)))
}
probabilidad7 <- prob7 * 100
probabilidad7## [1] 55.65424PROBABILIDAD DE DEFAULT DE UNA HOMBRE “SOLTERO” QUE PAGA SU DEUDA EN LA FECHA INDICADA, CON UN PAGO ANTERIOR DE \(\$5663.5881\), UNA LINEA DE CREDITO DE \(\$167484.3\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$25611.665\) ES 55.65%
9.PROBABILIDAD DE DEFAULT DE UNA MUJER “SOLTERA” QUE PAGA SU DEUDA CON 3 MESES DE RETRASO, CON UN PAGO ANTERIOR DE \(\$5663.5881\), UNA LINEA DE CREDITO DE \(\$334968.6\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$102446.66\)
parametros8 <- c(0,mean(all_data$LIMIT_BAL)*2, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, mean(all_data$PAY_AMT1), mean(all_data$BILL_AMT1)*2)
vec8 <- numeric()
prob8 <- numeric()
for (i in 1:length(parametros8)) {
vec8[i] <- modelo05$coef[i] * parametros8[i]
prob8 <- exp(sum(vec8)) / (1 + exp(sum(vec8)))
}
probabilidad8 <- prob8 * 100
probabilidad8## [1] 93.55153PROBABILIDAD DE DEFAULT DE UNA MUJER “SOLTERA” QUE PAGA SU DEUDA CON 3 MESES DE RETRASO, CON UN PAGO ANTERIOR DE \(\$5663.5881\), UNA LINEA DE CREDITO DE \(\$334968.6\) Y UN IMPORTE DEL ESTADO DE CUENTA DE \(\$102446.66\) ES 93.55%
CAPACIDAD PREDICTIVA DEL MODELO
Para evaluar la capacidad predictiva del modelo se realizan los siguientes puntos:
PUNTO DE CORTE
Recordar, que se require maximizar la especifidad y sensibilidad El punto maximo evaluado en distintos puntos de corte y el punto maximo es el punto donde se cruzan.
c<-seq(0.01,0.3,by=0.001)
sens<-c()
spec<-c()
for (i in 1:length(c)){
y.pred<-ifelse(modelo05$fitted.values > c[i], yes = 1, no = 0)
spec[i]<-prop.table(table(all_data$default.payment.next.month,y.pred),1)[1]
sens[i]<-prop.table(table(all_data$default.payment.next.month,y.pred),1)[4]
}
o.cut<-mean(c[which(round(spec,1.5)==round(sens,1.5))],na.rm = T)
plot(c,sens,type="l",col=2,main=c("Especificidad vs Sensibilidad"),ylab=c("Especificidad/Sensibilidad"))
lines(c,spec,col=3)
#Se observa el punto donde se cruzan :
abline(v=o.cut)
## [1] 0.163El corte óptimo se identifica como 0.163,es decir que un 16.3% de los clientes se encontraran en la posición de corte, donde cumplen las mismas características implicadas tanto para sensibilidad y especificidad.
ESPECIFICIDAD/SENSIBILIDAD
Se evalua la matriz de confusion para interpretar la especificidad y la sensibilidad.
y.pred<-ifelse(modelo05$fitted.values > o.cut, yes = 1, no = 0)
matriz_confusion <-table(all_data$default.payment.next.month, y.pred,
dnn = c("observaciones", "predicciones"))
matriz_confusion## predicciones
## observaciones 0 1
## 0 15793 7571
## 1 2127 4509## predicciones
## observaciones 0 1
## 0 0.6759545 0.3240455
## 1 0.3205244 0.6794756Se observa la matriz de confusion de la cual se puede decir lo siguiente:
Si el modelo es correcto en predicción se tendrá la predicción correcta de fracasos y exitos.
La especificidad se interpreta de la siguiente manera: con el modelo que se ha elejido hasta ahora se tiene un 67.60% probabilidad de fracaso, en este caso 0= no default, por ello se puede decir que exite un 67.60% de probabilidad de que no se entre en default en el próximo mes, de acuerdo a las variables tomadas para dicha prediccion.
La sensibilidad se interpreta de la siguiente manera: con el modelo que se ha elejido hasta el momento se tiene un 67.94% de probabilidad de exito, en este caso exito se definido como default, existe un 67.94% de probabilidad que se incumpla los pagos para el próximo mes, de acuerdo a las variables tomadas para dicha predicción.
ANALISIS DE LA CURVA DE ROC
##
## Call:
## roc.default(response = all_data$default.payment.next.month, predictor = modelo05$fitted.values)
##
## Data: modelo05$fitted.values in 23364 controls (all_data$default.payment.next.month 0) < 6636 cases (all_data$default.payment.next.month 1).
## Area under the curve: 0.7497
El area bajo la curva es 0.7467, por ello decimos que el modelo es medio aceptable para explicar y predecir si un cliente caera en default en el siguiente mes, se esperaria que sea mayor a 0.90 para que se acepte completamente que si se hizo una buena prediccion. Es mejor cuando esta pegado a 1.