Practica 2
https://rpubs.com/LUCIANO_DIBURGA_RICCI/638199
MODELO LOGIT
Enmarcando una regresión lineal normal se puede indicar que el análisis logit es, en muchos sentidos, el complemento natural de la regresión lineal ordinaria siempre que la regresión no sea una variable continua sino un estado que puede o no contener, o una categoría en una clasificación dada. Cuando tales variables discretas ocurren entre las variables independientes o regresores de una ecuación de regresión, se tratan mediante la introducción de una o varias variables ficticias (0, 1), pero cuando la variable dependiente pertenece a este tipo, el modelo de regresión se descompone y resulta un sin sentido. El análisis logit o la regresión logística (que son dos nombres para el mismo método) proporciona una alternativa lista. A primera vista, es bastante diferente del modelo familiar de regresión lineal, y ligeramente aterrador por su aparente complejidad; Sin embargo, los dos modelos tienen mucho en común.
Primero, ambos modelos pertenecen al ámbito de las relaciones causales, en oposición a la asociación estadística; existe una clara asimetría a priori entre las variables independientes con nombres extraños, los regresores o covariables, que son las variables explicativas o determinantes, y la variable dependiente o el resultado. Ambos modelos fueron diseñados inicialmente para el análisis de datos experimentales, o al menos para datos donde la dirección de la causalidad no está en duda. Al interpretar aplicaciones empíricas, a menudo es útil tener en cuenta estos orígenes.
Dentro de este contexto causal, el modelo de regresión lineal ordinario ofrece un marco burdo, pero casi universal para el análisis empírico. Es cierto que a menudo no es más que una aproximación simplificada a otra cosa que presumiblemente sería mejor. Pero sirve, dentro de sus limitaciones, para la detección empírica de la evidencia. La regresión logística se puede usar de la misma manera para fenómenos categóricos.
Por supuesto, también hay diferencias. A diferencia de la regresión, el modelo logit permite una interpretación financiera específica en términos de probabilidades en situaciones de elección discreta. Entre los economistas, esto confiere un estatus más alto en el modelo que el de un dispositivo empírico conveniente, aunque hay otros de mayor complejidad y mejores, el modelo sirve para a modo introductorio se amplié el conocimiento sobre esta familia de modelos. Además hay una sutil distinción en que el modelo de regresión ordinario requiere un término de perturbación que se adhiere a la parte sistemática como una molestia necesaria (el error), mientras que en el modelo logit el carácter aleatorio del resultado es una parte integral de la especificación inicial. Junto con el modelo probit, el modelo logit pertenece a la clase de modelos de probabilidad que determinan probabilidades discretas sobre un número limitado de resultados posibles, también es de notarse que al igual que el modelo de regresión, el modelo logit permite todo tipo de extensiones y variantes bastante sofisticadas.
Modelo Formal
Para trabajar el modelo formalmente se tiene que tener preconceptos estadísticos y de probabilidad asimilados, por ejemplo, según la delimitación teórica dada anteriormente al tratar con variables discretas el modelo Logit se asociara a una distribución de datos discreta como definimos en nuestro caso (existe el modelo logit multinomial donde se puede asumir una distribución normal sin embargo seguiremos el modelo más simple):
\[y \mid x \beta \text{ } \sim \text{ } \text{Binomial} (1-\rho)\]
Después 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)= \rho = \dfrac{e^{x \beta}}{1+e^{x \beta}} = \dfrac{e^{\beta_0+\beta_1 x_1+ \ldots + \beta_n x_n}}{1+e^{\beta_0+\beta_1 x_1+ \ldots + \beta_n x_n}}\]
Donde:
\[y=0 \rightarrow 1-\rho\]
\[y=1 \rightarrow \rho\]
Operando:
\[\rho = \dfrac{e^{\beta x}}{1+e^{\beta x}}\]
\[\rho + \rho e^{ \beta x} = e^{ \beta x}\]
\[\rho = e^{ \beta x} - \rho e^{ \beta x}\]
\[\rho = (1 - \rho) e^{\beta x}\]
\[\dfrac{\rho}{1 - \rho} = e^{\beta x}\]
Se llega al siguiente resultado:
\[\log(\dfrac{\rho}{1 - \rho})= \beta x = \beta_0+\beta_1 x_1+ \ldots + \beta_n x_n\]
Importación de los Datos
Los paquetes que se usaran son los siguientes:
pkges<-c("mfx","pROC","tidyverse","forecast","data.table","knitr","kableExtra")
#install.packages("pkges")
lapply(pkges,library,character.only=T)## [[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"
##
## [[6]]
## [1] "knitr" "data.table" "forecast" "forcats" "stringr"
## [6] "dplyr" "purrr" "readr" "tidyr" "tibble"
## [11] "ggplot2" "tidyverse" "pROC" "mfx" "betareg"
## [16] "MASS" "lmtest" "zoo" "sandwich" "stats"
## [21] "graphics" "grDevices" "utils" "datasets" "methods"
## [26] "base"
##
## [[7]]
## [1] "kableExtra" "knitr" "data.table" "forecast" "forcats"
## [6] "stringr" "dplyr" "purrr" "readr" "tidyr"
## [11] "tibble" "ggplot2" "tidyverse" "pROC" "mfx"
## [16] "betareg" "MASS" "lmtest" "zoo" "sandwich"
## [21] "stats" "graphics" "grDevices" "utils" "datasets"
## [26] "methods" "base"Para el desarrollo de la Practica 2 se tiene que usar la data brindada en clase por ello procedemos a importarla:
options(scipen=999) #Esta parte del código permite que los valores que aparezcan posteriormente ya no se muestren con notación científica
#importando datos
datos <- read.csv("C:/Users/usuario/Desktop/Carpeta de luciano/Tareas de riesgos/Modelo Logit/UCI_Credit_Card.csv", header=TRUE)
#usando solo los datos completos
datos <- datos[complete.cases(datos),]
#preparamos la data para modelar quitando el id
cred <- datos[,-1]
#definimos las variables categóricas
cred$SEX <- as.factor(cred$SEX)
cred$MARRIAGE <- as.factor(cred$MARRIAGE)
cred$EDUCATION <- as.factor(cred$EDUCATION)
cred$PAY_0 <- as.factor(cred$PAY_0)
cred$PAY_2 <- as.factor(cred$PAY_2)
cred$PAY_3 <- as.factor(cred$PAY_3)
cred$PAY_4 <- as.factor(cred$PAY_4)
cred$PAY_5 <- as.factor(cred$PAY_5)
cred$PAY_6 <- as.factor(cred$PAY_6)La data importada brinda información de clientes poseedores de tarjetas de crédito, por ello se hará una breve descripción de cada variable:
• ID: ID del cliente
• LIMIT_BAL: Hace referencia a la línea de crédito que tiene cada TC
• SEX: Hace referencia al género del cliente (1=masculino, 2=femenino)
• EDUCATION: Hace referencia al nivel educativo del cliente (1=Posgrado, 2=Universitario, 3=Secundaria completa, 4=otras, 5=desconocido, 6=desconocido)
• MARRIAGE: Hace referencia al Estado Civil (1=casado, 2=soltero, 3=otros)
• AGE: Edad en Años
• PAY_(i): Estado del repago a septiembre (Abril, Mayo, Junio, Julio y Agosto), 2005
-1=pago debidamente,
1=pago con un mes de retraso,
2=pago con dos meses de retraso,
8=pago con ocho meses de retraso,
9=pago con nueve meses de retraso y mas
• BILL_AMT(i): Importe del estado de cuenta en Septiembre, 2005 (Abril, Mayo, Junio, Julio y Agosto)
• PAY_AMT(i): Importe del pago anterior en Septiembre, 2005 (Abril, Mayo, Junio, Julio y Agosto)
• default.payment.next.month: Incumplimiento de Pago (1=si, 0=no)
Análisis de los Datos
La finalidad del presente documento es generar un modelo Logit factible con 5 variables, para este fin es necesario tener un análisis de los datos para tener una noción sobre que variables incluir en el modelo.
• LIMIT_BAL
La línea de crédito asociada a una tarjeta de crédito juega un papel teórico importante en el desempeño de la morosidad, este resultado es medianamente ambiguo en dos aspectos, en primera instancia ante un aumento de la línea de crédito los clientes tienen el incentivo a endeudarse más, lo que en efectos prácticos implica una mayor posibilidad de impago; por otro lado se tiene que las líneas de crédito no solo se otorgan por el poder adquisitivo del cliente, hay otros factores por los cuales los bancos deciden hacer un “Upgrate” (aumento de la línea de crédito), tales como el cumplimiento de la deuda y el historial crediticio completo. Ahora procederemos a analizar la data:
boxplot(datos$LIMIT_BAL ~ datos$default.payment.next.month, col = "gray",
main = "Monto de la Línea de Crédito vs La Probabilidad de Impago")
Al tener una variable cuantitativa discreta y una variable categórica procedemos a realizar un gráfico “box” que compara estas dos variables, como se observa en el gráfico, los valores del monto de línea crediticia asociada al cumplimiento o incumplimiento son poco distantes entre si, aunque como se puede notar, las personas con mayor línea crediticia tienen menos incumplimiento.
• SEX
La variable sexo en múltiples estudios del crédito se asocia con el nivel de incumplimiento teniendo un sesgo por el cumplimiento hacia el género femenino, a continuación, se graficará la relación:
plot1 <- ggplot(data = 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
Como se puede observar en la gráfica, se otorgan mayores líneas de crédito a las mujeres, también es de notar que las mujeres tienen menos tendencia al incumplimiento en concordancia a lo dicho anteriormente.
• EDUCATION
El nivel educativo se relaciona directamente con el nivel de ingresos que se pueda tener y puede ser “una proxy cualitativa de ello”, esto trae como consecuencia directa que a un mayor nivel educativo se tenga menos probabilidad de incumplir un crédito, a continuación graficaremos que relación se tiene entre el nivel educativo y el incumplimiento:
plot2 <- ggplot(data = 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
Como se puede observar en la gráfica a pesar de variaciones en el monto máximo de los créditos la proporción no parece variar mucho en las 3 categorías que engloban la mayoría de los datos, lo que podría indicar, por ejemplo, que la brecha salarial no es muy amplia entre los niveles de educación, entre otros factores más.
• AGE
La edad como variable se asocia teóricamente al incumplimiento inversamente, mientras más edad tienes menos probabilidad de incumplimiento, esta característica tiene explicaciones de múltiple nivel, de sociológicas hasta económicas, donde se enmarca desde la madurez de la población hasta los ingresos asociados por edades.
boxplot(datos$AGE ~ datos$default.payment.next.month, col = "gray",
main = "Edad vs La Probabilidad de Impago")
cómo se observa en el gráfico no hay gran diferencia entre el nivel de incumplimiento por edades, los datos de ambos se agrupan alrededor de los 34 años además varían similarmente en los máximos y los mínimos lo que implica que la relación no sea significativa al momento de estimar un modelo.
• MARRIAGE
El estado civil de una persona tiene características y fundamentos parecidos al de la edad, donde se asocia a los casados con una menor probabilidad de incumplimiento, veamos la siguiente gráfica:
plot4 <- ggplot(data = datos, aes(x=factor(MARRIAGE), fill =factor(default.payment.next.month))) +
geom_bar() +
ylab("Observations count") +
xlab("1=married 2=single 3=others")
plot4
Se puede observar como en el caso del género otra atipicidad, pues los solteros tienen menos probabilidad de impago, lo que hace referencia a que sea data reducida tal vez de una ciudad específica y no a un genérico conglomerado.
• PAY_(i)
El estado del repago hace referencia al atraso en el pago de los montos del estado de cuenta y se asocia de manera positiva a la probabilidad de incumplimiento pues, mientras más retrasos tengas te acercas al incumplimiento.
plot5 <- 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))")
plot5
Según la gráfica, y tras una revisión de la data y su fuente el numero 0 puede significar ausencia de datos o en su defecto que también absorbe probabilidades de los status 1 y 2. Para efectos prácticos al analizar la data vemos que a partir del segundo mes de retraso la probabilidad de impago se hace inminente, aunque hay datos atípicos en el sexto y séptimo mes, posiblemente es cuando aprovechan una compra de deuda o algún plan similar en tarjetas de crédito.
• BILL_AMT(i)
El importe del estado de cuenta es un variable relacionada estrechamente a la línea de crédito, por lo que pueden tener una similar distribución en ciertas condiciones, en general si gastas más de tu línea de crédito (un sobregiro) se debe tener más probabilidades de incumplimiento y si gastas menos simplemente se te facilita el pago.
boxplot(datos$BILL_AMT1 ~ datos$default.payment.next.month, col = "gray",
main = "Importe del estado de cuenta vs La Probabilidad de Impago")
Como se puede notar en el gráfico hay una gran cantidad de datos atípicos, las distribuciones entre los cuantiles índica que si hay variación respecto a la probabilidad de pago e impago por lo que puede ser una variable significativa a la hora de modelar.
• PAY_AMT(i)
El importe del pago anterior se asocia con la probabilidad de impago mediante el monto cancelado respecto a tu monto facturado, es decir, si pagas el total de la deuda correspondiente, sea revolvente o a plazos, se tiene menos probabilidad de incumplir un crédito, por el contrario, si solo realizas los pagos mínimos consecutivamente tienes más probabilidad de entrar en incumplimiento.
boxplot(datos$PAY_AMT1 ~ datos$default.payment.next.month, col = "gray",
main = "Importe del pago anterior vs La Probabilidad de Impago")
Como se puede apreciar en la gráfica debido a lo pequeño de las cantidades pagadas se podría indicar que se hace un pago mínimo regularmente, se nota, además, aunque muy pequeña, una diferencia entre los valores máximos de la cantidad asociada a la no probabilidad de impago, aparte de mayores montos atípicos, por ello puede resultar una variable a tomar en consideración a la hora de modelar.
Modelo Logit en R
Para proceder a modelar tenemos que tener en cuenta el análisis previo, pues al entender que el importe del estado de cuenta y el valor de la línea de crédito podrían estar conteniendo información similar, típicamente los modelos de crédito implican el estado de anteriores, la educación, el estado civil, el género, la línea de crédito y la edad. Como se solicitan 5 variables se incluirá las variables típicas para estos casos, que serán el pago anterior, el nivel de educación, el estado civil, línea de crédito y el género, por ello tenemos:
XB <- as.formula("default.payment.next.month ~ factor(SEX)+factor(MARRIAGE)+factor(EDUCATION)+LIMIT_BAL+factor(PAY_0)")
modelo <- glm(XB,data = cred, family = binomial(link = "logit"))
summary(modelo)##
## Call:
## glm(formula = XB, family = binomial(link = "logit"), data = cred)
##
## 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.3730262263 84.8711009346 -0.158 0.874797
## 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.9610635410 84.8695965699 0.129 0.897238
## factor(EDUCATION)2 11.0013671125 84.8695969629 0.130 0.896862
## factor(EDUCATION)3 10.9570880126 84.8696030275 0.129 0.897275
## factor(EDUCATION)4 9.7356222004 84.8705452465 0.115 0.908674
## factor(EDUCATION)5 9.5524374096 84.8699940222 0.113 0.910384
## factor(EDUCATION)6 10.6100611303 84.8706440026 0.125 0.900512
## LIMIT_BAL -0.0000023751 0.0000001437 -16.533 < 0.0000000000000002
## 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)
## 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
## LIMIT_BAL ***
## 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: 11Como se puede observar los betas asociados al factor educación no resultan significativos, esto como se explicó anteriormente puede deberse a que existe una brecha corta entre los salarios y el acceso al crédito según el nivel de educación, por ello se empleara otra variable que también se suele incluir en estos modelos, la edad, esto con el fundamento de tener un modelo que explique el incumplimiento, y con ello tenemos:
XB1 <- as.formula("default.payment.next.month ~ factor(SEX)+factor(MARRIAGE)+factor(PAY_0)+AGE+LIMIT_BAL")
modelo1 <- glm(XB1,data = cred, family = binomial(link = "logit"))
summary(modelo1)##
## Call:
## glm(formula = XB1, family = binomial(link = "logit"), data = cred)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8542 -0.6007 -0.5229 -0.3822 2.6178
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.5557838607 0.5096535423 -5.015 0.000000531 ***
## 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 .
## LIMIT_BAL -0.0000024360 0.0000001394 -17.472 < 0.0000000000000002 ***
## ---
## 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: 4Al reemplazar la variable asociada a la educación por la la variable edad subió el AIC, este aumento seria aceptado si la variable por la que se reemplazó resultara significativa, debido a esto debemos replantear y tomar en cuenta lo que se informó en el análisis cualitativo, donde se tomaran variables a tener en cuenta variables como el pago anterior y el monto del estado de cuenta, debido a que el monto de la línea de crédito y el importe del estado de cuenta pueden presentar información similar optaremos por quitar la variable edad y agregar el pago anterior, cabe resaltar que se utilizará la información más actual es decir a los meses de septiembre, entonces el modelo se muestra a continuación:
XB2 <- as.formula("default.payment.next.month ~ factor(SEX)+factor(MARRIAGE)+factor(PAY_0)+PAY_AMT1+LIMIT_BAL")
modelo2 <- glm(XB2,data = cred, family = binomial(link = "logit"))
summary(modelo2)##
## Call:
## glm(formula = XB2, family = binomial(link = "logit"), data = cred)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.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 ***
## 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 ***
## LIMIT_BAL -0.0000021996 0.0000001418 -15.514 < 0.0000000000000002 ***
## ---
## 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: 5El modelo tiene menor AIC que el anterior modelo, además todas sus variables son representativas concordante con un modelo que intente explicar la probabilidad de default, como último paso reemplazaremos la variable asociada al importe del estado de cuenta y el monto de la línea de crédito para comprar y quedarnos con el AIC menor:
XB3 <- as.formula("default.payment.next.month ~ factor(SEX)+factor(MARRIAGE)+factor(PAY_0)+PAY_AMT1+BILL_AMT1")
modelo3 <- glm(XB3,data = cred, family = binomial(link = "logit"))
summary(modelo3)##
## Call:
## glm(formula = XB3, family = binomial(link = "logit"), data = cred)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8270 -0.5869 -0.5309 -0.4476 3.9004
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -2.79783690055 0.50542207098 -5.536 0.0000000310
## factor(SEX)2 -0.17703053716 0.03129934028 -5.656 0.0000000155
## factor(MARRIAGE)1 1.19413004185 0.50232934388 2.377 0.017445
## factor(MARRIAGE)2 1.05273160984 0.50227961635 2.096 0.036090
## factor(MARRIAGE)3 1.32748028539 0.52128526104 2.547 0.010879
## factor(PAY_0)-1 0.28906022303 0.06670933567 4.333 0.0000147004
## factor(PAY_0)0 -0.03533549465 0.06381958731 -0.554 0.579799
## factor(PAY_0)1 1.15592614420 0.06676203504 17.314 < 0.0000000000000002
## factor(PAY_0)2 2.65846498156 0.07188201026 36.984 < 0.0000000000000002
## factor(PAY_0)3 2.93133435133 0.14243346559 20.580 < 0.0000000000000002
## factor(PAY_0)4 2.54427003872 0.25422692841 10.008 < 0.0000000000000002
## factor(PAY_0)5 1.80549644368 0.39956962655 4.519 0.0000062249
## factor(PAY_0)6 1.95979058945 0.60916736190 3.217 0.001295
## factor(PAY_0)7 2.99043129985 0.80545712844 3.713 0.000205
## factor(PAY_0)8 2.08522708711 0.46967961533 4.440 0.0000090093
## PAY_AMT1 -0.00001877280 0.00000220107 -8.529 < 0.0000000000000002
## BILL_AMT1 -0.00000003443 0.00000025053 -0.137 0.890703
##
## (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_AMT1 ***
## BILL_AMT1
## ---
## 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: 26962 on 29983 degrees of freedom
## AIC: 26996
##
## Number of Fisher Scoring iterations: 5El nuevo modelo no solo tiene mayor AIC, también hace que el beta asociado a la variable se haga no significativo, por ello nos quedaremos con el modelo anterior.
Cabe resaltar que el criterio para elegir el modelo no solo fue en base al AIC, sino también tomando en cuenta un criterio lógico que intente explicar lo mejor posible la relación entre las variables y la probabilidad de incumplimiento.
Ahora definiremos al modelo elegido con los valores ajustados y lo procederemos a graficar:
RATIO DE ODDS
La razón de oportunidades o razón de probabilidades se conoce en inglés como el Ratio Odds (OR), este ratio es una medida estadística que en términos formales, define que tantas veces mayor es un posible evento frente a que no ocurra dicho evento, en un aspecto teórico puede verse como cuantas chances hay de que ocurra un evento respecto a que no lo haga, como se puede notar en la definición el ratio de odds es una medida de “tamaño de efecto”.
Matemáticamente el Ratio de Odds se mide como un cociente de “Odds” siendo estos Odds una forma alternativa de expresar la posibilidad de ocurrencia de un evento de interés.
Para calcularlo usaremos la siguiente ecuación:
\[\textit{Ratio de Odds}=\dfrac{\rho}{1 - \rho}= e^{\beta x}\]
Para una mejor interpretación del Ratio de Odds se le restada uno, con lo que quedará de la siguiente manera
\[\textit{Para la Interpretacion del Ratio de Odds}=\dfrac{\rho}{1 - \rho}-1= e^{\beta x}-1\]
Para obtener los datos se empleará el siguiente código (la formula se deriva de las ecuaciones trabajas al inicio del documento):
ratio.odds <- numeric()
for (i in 2:17) {
valores <- exp(modelo2$coef[i])-1
ratio.odds[i] <- valores
}
ratio.odds<-ratio.odds[-1]; ratio.odds## [1] -0.159189248405 2.695615586542 2.043286493183 2.645424153349
## [5] 0.206778899960 -0.224143884485 1.629116375628 9.968059451691
## [9] 12.801473911801 8.285244962137 3.395378180370 4.447932963634
## [13] 15.745910727014 5.180637183849 -0.000011778852 -0.000002199587Estos valores de los Ratios de Odds se interpretan de la siguiente manera:
• La “chance” que se entre en default dado que la persona pertenece al género femenino “se reduce” en 15.92%.
• La “chance” que se entre en default dado que la persona tiene un estado civil de casada “aumenta” en 269.56%.
• La “chance” que se entre en default dado que la persona tiene un estado civil de soltera “aumenta” en 204.33%.
• La “chance” que se entre en default dado que la persona tiene un estado civil de otros “aumenta” en 264.54%.
• La “chance” que se entre en default dado que la persona esta al día en sus repagos “aumenta” en 20.68%.
• La “chance” que se entre en default dado que la persona esta al día en sus repagos (variable 0 de la data) “se reduce” en 22.41%.
• La “chance” que se entre en default dado que la persona tiene un mes de retraso en sus repagos “aumenta” en 162.91%.
• La “chance” que se entre en default dado que la persona tiene dos meses de retraso en sus repagos “aumenta” en 996.81%.
• La “chance” que se entre en default dado que la persona tiene tres meses de retraso en sus repagos “aumenta” en 1280.15%.
• La “chance” que se entre en default dado que la persona tiene cuatro meses de retraso en sus repagos “aumenta” en 828.52%.
• La “chance” que se entre en default dado que la persona tiene cinco meses de retraso en sus repagos “aumenta” en 339.54%.
• La “chance” que se entre en default dado que la persona tiene seis meses de retraso en sus repagos “aumenta” en 444.79%.
• La “chance” que se entre en default dado que la persona tiene siete meses de retraso en sus repagos “aumenta” en 1574.59%.
• La “chance” que se entre en default dado que la persona tiene ocho meses de retraso en sus repagos “aumenta” en 518.06%.
• La “chance” que se entre en default dado que la persona aumenta el importe del pago previo “se reduce” en 0.001178%.
• La “chance” que se entre en default dado que la persona aumenta el monto de la línea de crédito “se reduce” en 0.00022%.
Cuando el \(e^{\beta}\) es mayor de 1 señala que un aumento de la variable independiente, aumenta los odds que ocurra el evento (es decir, la variable dependiente). Cuando el \(e^{\beta}\) es menor de 1 indica que un aumento de la variable independiente, reduce los odds que ocurra el evento (variable dependiente).
PROBABILIDAD DE CAER EN DEFAULT
Para calcular la probabilidad de Default se usará la siguiente fórmula:
\[\rho = \dfrac{e^{\beta x}}{1+e^{\beta x}}\]
Es de indicar que la probabilidad de default para casos acotados implica la suposición, por ejemplo, de un valor específico para las variables cuantitativas, y en el caso de las variables categóricas tomar el valor de 0 o 1 para indicar las características de un determinado cliente, para efectos prácticos se tomará los siguientes valores cuantitativos:
• Para el importe del pago anterior se tomará la media de los datos (y múltiplos de estos) para emular lo que un cliente promedio pagaría.
• Para el monto de la línea de crédito se tomará la media de los datos (y múltiplos de estos) para emular el monto de la línea de crédito de un cliente promedio.
En R el código que se seguirá es:
#PROBABILIDAD DE DEFAULT DE UNA MUJER CASADA QUE REPAGA A TIEMPO CON UN PAGO ANTERIOR DE 5663.581$ Y UNA LINEA DE CREDITO DE 167484.3$
parametros <- c(1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, mean(cred$PAY_AMT1), mean(cred$LIMIT_BAL))
vector <- numeric()
probabilidad <- numeric()
for (i in 1:length(parametros)) {
vector[i] <- modelo2$coef[i] * parametros[i]
probabilidad <- exp(sum(vector)) / (1 + exp(sum(vector)))
}
probabilidad <- probabilidad * 100
#PROBABILIDAD DE DEFAULT DE UN HOMBRE CASADO QUE REPAGA A TIEMPO, CON UN PAGO ANTERIOR DE 5663.581$ Y UNA LINEA DE CREDITO DE 167484.3$
parametros1 <- c(1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, mean(cred$PAY_AMT1), mean(cred$LIMIT_BAL))
vector1 <- numeric()
probabilidad1 <- numeric()
for (i in 1:length(parametros1)) {
vector1[i] <- modelo2$coef[i] * parametros1[i]
probabilidad1 <- exp(sum(vector1)) / (1 + exp(sum(vector1)))
}
probabilidad1 <- probabilidad1 * 100
#PROBABILIDAD DE DEFAULT DE UNA MUJER SOLTERA QUE REPAGA CON 3 MESES DE ATRASO, CON UN PAGO ANTERIOR DE 5663.581$ Y UNA LINEA DE CREDITO DE 167484.3$
parametros2 <- c(1, 1, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, mean(cred$PAY_AMT1), mean(cred$LIMIT_BAL))
vector2 <- numeric()
probabilidad2 <- numeric()
for (i in 1:length(parametros2)) {
vector2[i] <- modelo2$coef[i] * parametros2[i]
probabilidad2 <- exp(sum(vector2)) / (1 + exp(sum(vector2)))
}
probabilidad2 <- probabilidad2 * 100
#PROBABILIDAD DE DEFAULT DE UN HOMBRE CON ESTADO CIVIL "OTROS" QUE REPAGA CON 4 MESES DE ATRASO, CON UN PAGO ANTERIOR DE 5663.581$ Y UNA LINEA DE CREDITO DE 167484.3$
parametros3 <- c(1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, mean(cred$PAY_AMT1), mean(cred$LIMIT_BAL))
vector3 <- numeric()
probabilidad3 <- numeric()
for (i in 1:length(parametros3)) {
vector3[i] <- modelo2$coef[i] * parametros3[i]
probabilidad3 <- exp(sum(vector3)) / (1 + exp(sum(vector3)))
}
probabilidad3 <- probabilidad3 * 100
#PROBABILIDAD DE DEFAULT DE UNA MUJER CON ESTADO CIVIL "CASADA" QUE REPAGA CON 5 MESES DE ATRASO, CON UN PAGO ANTERIOR DE 11327.16$ Y UNA LINEA DE CREDITO DE 334968.6$
parametros4 <- c(1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, mean(cred$PAY_AMT1)*2, mean(cred$LIMIT_BAL)*2)
vector4 <- numeric()
probabilidad4 <- numeric()
for (i in 1:length(parametros4)) {
vector4[i] <- modelo2$coef[i] * parametros4[i]
probabilidad4 <- exp(sum(vector4)) / (1 + exp(sum(vector4)))
}
probabilidad4 <- probabilidad4 * 100
#PROBABILIDAD DE DEFAULT DE UNA MUJER CASADA QUE REPAGA A TIEMPO CON UN PAGO ANTERIOR DE 2831.79$ Y UNA LINEA DE CREDITO DE 83742.16$
parametros5 <- c(1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, mean(cred$PAY_AMT1)/2, mean(cred$LIMIT_BAL)/2)
vector5 <- numeric()
probabilidad5 <- numeric()
for (i in 1:length(parametros5)) {
vector5[i] <- modelo2$coef[i] * parametros5[i]
probabilidad5 <- exp(sum(vector5)) / (1 + exp(sum(vector5)))
}
probabilidad5 <- probabilidad5 * 100
#PROBABILIDAD DE DEFAULT DE UNA MUJER CASADA QUE REPAGA A TIEMPO CON UN PAGO ANTERIOR DE 2831.79$ Y UNA LINEA DE CREDITO DE 334968.6$
parametros6 <- c(1, 1, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, mean(cred$PAY_AMT1)/2, mean(cred$LIMIT_BAL)*2)
vector6 <- numeric()
probabilidad6 <- numeric()
for (i in 1:length(parametros6)) {
vector6[i] <- modelo2$coef[i] * parametros6[i]
probabilidad6 <- exp(sum(vector6)) / (1 + exp(sum(vector6)))
}
probabilidad6 <- probabilidad6 * 100
#PROBABILIDAD DE DEFAULT DE UNA MUJER CASADA QUE REPAGA A TIEMPO CON UN PAGO ANTERIOR DE 11327.16$ Y UNA LINEA DE CREDITO DE 334968.6$
parametros7 <- c(1, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, mean(cred$PAY_AMT1)*2, mean(cred$LIMIT_BAL)*2)
vector7 <- numeric()
probabilidad7 <- numeric()
for (i in 1:length(parametros7)) {
vector7[i] <- modelo2$coef[i] * parametros7[i]
probabilidad7 <- exp(sum(vector7)) / (1 + exp(sum(vector7)))
}
probabilidad7 <- probabilidad7 * 100La interpretación que se le da a los datos obtenidos se realiza suponiendo un conjunto de información del cliente y calculando la probabilidad, correspondiente, de incumplimiento, en el código que se ejecutó líneas arriba se tienen ciertos casos y sus correspondientes probabilidades que se resumen en la siguiente tabla:
| DESCRIPCIÓN DEL CLIENTE | PROBABILIDAD DE INCUMPLIMIENTO |
|---|---|
| Mujer casada que repaga a tiempo con un pago anterior de 5663.581$ y una línea de crédito de 167484.3$ | 12.46 % |
| Hombre casado que repaga a tiempo, con un pago anterior de 5663.581$ y una línea de crédito de 167484.3$ | 14.48 % |
| Mujer soltera que repaga con 3 meses de atraso, con un pago anterior de 5663.581$ y una línea de crédito de 167484.3$ | 67.58 % |
| Hombre con estado civil otros que repaga con 4 meses de atraso, con un pago anterior de 5663.581$ y una línea de crédito de 167484.3$ | 66.65 % |
| Mujer con estado civil casada que repaga con 5 meses de atraso, con un pago anterior de 11327.16$ y una línea de crédito de 334968.6$ | 56.39 % |
| Mujer casada que repaga a tiempo con un pago anterior de 2831.79$ y una línea de crédito de 83742.16$ | 15.03 % |
| Mujer casada que repaga a tiempo con un pago anterior de 2831.79$ y una línea de crédito de 334968.6$ | 9.24 % |
| Hombre casado que repaga a tiempo con un pago anterior de 11327.16$ y una línea de crédito de 334968.6$ | 9.87 % |
CAPACIDAD PREDICTIVA DEL MODELO
Para evaluar la capacidad predictiva del modelo se analizará los puntos siguientes:
Punto de Corte
Para los posteriores análisis debemos tener en cuenta dos conceptos importantes:
• La sensibilidad del modelo: se refiere a la capacidad que tiene éste para detectar como positivos los casos que poseen la característica. En términos coloquiales, si al modelo le presentamos sólo casos positivos, la sensibilidad determina la capacidad que tiene el modelo de no equivocarse.
• La especificidad del modelo: se refiere a la capacidad que tiene éste para discriminar correctamente los casos que no poseen la característica. Es decir, sobre un conjunto de casos que no poseen la característica, determina en qué grado no va a confundirlos con casos que poseen la característica.
Teniendo en cuenta las definiciones de la sensibilidad como la especificidad se trazan las curvas respectivas y se encuentra un punto corte. Dicho punto en el que se cruzan las líneas (y, por lo tanto, la sensibilidad es igual a la especificidad) optimiza la precisión del modelo que estima la probabilidad de default.
c<-seq(0.01,0.3,by=0.001)
sens<-c()
spec<-c()
for (i in 1:length(c)){
y.pred<-ifelse(modelo2$fitted.values > c[i], yes = 1, no = 0)
spec[i]<-prop.table(table(cred$default.payment.next.month,y.pred),1)[1]
sens[i]<-prop.table(table(cred$default.payment.next.month,y.pred),1)[4]
}
o.cut<-mean(c[which(round(spec,1)==round(sens,1))],na.rm = T)
plot(c,sens,type="l",col=2,main=c("Especificidad vs Sensibilidad"),ylab=c("Especificidad/Sensibilidad"))
lines(c,spec,col=3)
abline(v=o.cut)
## [1] 0.1675En este gráfico, el corte óptimo se identifica como 0.1675 (es decir que un 16.75 % de los clientes se encontraran en la posición de corte, donde cumplen las mismas características implicadas tanto para sensibilidad y especificidad) donde la sensibilidad y la especificidad se aproximan a 0.68.
Especificidad/Sensibilidad
Como ya se mencionó, el análisis de especificidad y sensibilidad compara la probabilidad de éxito de detectar los casos de default del modelo estimado vs la data real y para ello podemos definir una matriz de confusión, en R podemos emplear el siguiente código:
y.pred<-ifelse(modelo2$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.6799349 0.3200651
## 1 0.3169078 0.6830922Se puede observar a través de la matriz de especificidad y sensibilidad, que en la especificidad existe un 67.99% de probabilidad de que el modelo detecte los casos que no caen en morosidad, si en realidad estos casos no están en morosidad; y en la sensibilidad existe un 68.30% 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
Al realizar la curva ROC nos da una probabilidad de un área de:
##
## Call:
## roc.default(response = cred$default.payment.next.month, predictor = modelo.elegido)
##
## Data: modelo.elegido in 23364 controls (cred$default.payment.next.month 0) < 6636 cases (cred$default.payment.next.month 1).
## Area under the curve: 0.7495Esto valor se interpreta en términos porcentuales como un 74.95%, este resultado muestra que nuestro modelo es medianamente aceptable para tratar de explicar y predecir nuestra variable dependiente. Mientras el valor se acerque más al 100% el modelo explicará mejor la variable independiente y mientras más cercana 0% será espurio.
Procederemos a graficar dicha curva:
VARIACIONES MARGINALES
Las variaciones marginales indican como cambia la probabilidad de caer en morosidad (beta) cuando un cliente varía en determinada característica, es decir, cuando pasa a de tener, por ejemplo, un estado civil de casado cuando era soltero, cuando tiene determinado género, etc. Por la parte de las variables cuantitativas indica la variación ante un aumento de los valores analizados, en nuestro caso sería un aumento del monto de la línea de crédito o el importe del pago anterior.
Matemáticamente se puede apreciar de la siguiente manera:
\[\dfrac{\partial \rho}{\partial x}= [ \dfrac{e^{x \beta}}{1+e^{x \beta}} ]\textbf{´}\]
\[\dfrac{\partial \rho}{\partial x}= \dfrac{\beta e^{x \beta} (1+e^{x \beta}) - e^{x \beta} (\beta e^{x \beta})}{(1+ e^{x \beta})^{2}}\]
\[\dfrac{\partial \rho}{\partial x}= \dfrac{\beta e^{x \beta}}{(1+e^{x \beta})} - \dfrac{\beta e^{x \beta}e^{x \beta}}{(1+e^{x \beta})^{2}}\]
\[\dfrac{\partial \rho}{\partial x}= \beta (\dfrac{e^{x \beta}}{(1+e^{x \beta})}) - \beta (\dfrac{e^{x \beta}}{(1+e^{x \beta})}) (\dfrac{e^{x \beta}}{(1+e^{x \beta})})\]
Recordando:
\[\rho = \dfrac{e^{x \beta}}{1+e^{x \beta}}\]
Se obtiene:
\[\dfrac{\partial \rho}{\partial x}= \beta \rho - \beta \rho \rho\]
\[\dfrac{\partial \rho}{\partial x}= \beta \rho (1- \rho)\]
En R se ejecuta el siguiente código:
## Call:
## logitmfx(formula = XB2, data = cred)
##
## Marginal Effects:
## dF/dx Std. Err. z
## factor(SEX)2 -0.026942444163 0.004937962605 -5.4562
## factor(MARRIAGE)1 0.208598006336 0.082980586418 2.5138
## factor(MARRIAGE)2 0.167969298890 0.074764856505 2.2466
## factor(MARRIAGE)3 0.269377079949 0.128843152318 2.0907
## factor(PAY_0)-1 0.029932019286 0.011078820490 2.7017
## factor(PAY_0)0 -0.038950683710 0.009706359218 -4.0129
## factor(PAY_0)1 0.181241060005 0.014698502911 12.3306
## factor(PAY_0)2 0.515670054556 0.015245850625 33.8236
## factor(PAY_0)3 0.573104396834 0.026280197151 21.8075
## factor(PAY_0)4 0.494826898499 0.055368930173 8.9369
## factor(PAY_0)5 0.317266581304 0.100239894872 3.1651
## factor(PAY_0)6 0.370707701237 0.150557340737 2.4622
## factor(PAY_0)7 0.607052391248 0.130986869930 4.6345
## factor(PAY_0)8 0.401474447228 0.114709818509 3.4999
## PAY_AMT1 -0.000001809913 0.000000292276 -6.1925
## LIMIT_BAL -0.000000337982 0.000000021561 -15.6758
## P>|z|
## factor(SEX)2 0.0000000486469 ***
## factor(MARRIAGE)1 0.0119432 *
## factor(MARRIAGE)2 0.0246634 *
## factor(MARRIAGE)3 0.0365517 *
## factor(PAY_0)-1 0.0068979 **
## factor(PAY_0)0 0.0000599764147 ***
## 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.0015504 **
## factor(PAY_0)6 0.0138074 *
## factor(PAY_0)7 0.0000035788387 ***
## factor(PAY_0)8 0.0004654 ***
## PAY_AMT1 0.0000000005923 ***
## 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"COMPARACIÓN CON EL MODELO TRABAJADO EN CLASE
El modelo trabajado en clase tiene el siguiente código:
modelox <- glm(default.payment.next.month ~ .,data = cred,
family = binomial(link = "logit"))
summary(modelox)##
## 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: 12Se Calcula un nuevo modelo a través del siguiente código:
## 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
##
## 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
##
## 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
##
## 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
##
## 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
##
## 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
##
## 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
##
## 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 27599Se puede observar su histograma aquí:
Ahora se procede a calcular el punto de corte:
c<-seq(0.01,0.3,by=0.001)
sens<-c()
spec<-c()
for (i in 1:length(c)){
y.pred<-ifelse(model.AIC$fitted.values > c[i], yes = 1, no = 0)
spec[i]<-prop.table(table(cred$default.payment.next.month,y.pred),1)[1]
sens[i]<-prop.table(table(cred$default.payment.next.month,y.pred),1)[4]
}
o.cut<-mean(c[which(round(spec,1)==round(sens,1))],na.rm = T)
plot(c,sens,type="l",col=2,main=c("Especificidad vs Sensibilidad"),ylab=c("Especificidad/Sensibilidad"))
lines(c,spec,col=3)
abline(v=o.cut)
El punto de corte es:
## [1] 0.1695Se procede a calcular la matriz de confusión:
y.pred<-ifelse(model.AIC$fitted.values > o.cut, yes = 1, no = 0)
matriz_confusion1 <- table(cred$default.payment.next.month, y.pred,
dnn = c("observaciones", "predicciones"))
prop.table(matriz_confusion1,1)## predicciones
## observaciones 0 1
## 0 0.7065571 0.2934429
## 1 0.3071127 0.6928873Por último, se ve el área bajo la curva de la gráfica ROC
## Setting levels: control = 0, case = 1## Setting direction: controls < cases##
## Call:
## roc.default(response = cred$default.payment.next.month, predictor = yhat1)
##
## Data: yhat1 in 23364 controls (cred$default.payment.next.month 0) < 6636 cases (cred$default.payment.next.month 1).
## Area under the curve: 0.7724Y se procede a graficarla:
## Setting levels: control = 0, case = 1## Setting direction: controls < cases
Comparando los dos modelos tenemos los siguiente:
• Mientras que el modelo trabajado en clase tiene un AIC de 26157, el que se desarrolló en el trabajo tiene un AIC de 26741 lo que indica que es preferible el trabajado en clase, sin embargo, es de acotar que ese modelo tiene todas las variables y no trabajan con la limitante de 5 variables, además muchas de las variables resultan no significativas.
• El punto de corte es el modelo trabajado en clase es de 0.1695 y el del modelo es de 0.1675.
• El modelo trabajado en clase tiene una sensibilidad de 70.65% y el que se trabajó una de 67.99% lo que hace preferible al primero.
• El modelo trabajado en clase tiene una especificidad de 69.28% y el que se trabajó una especificidad de 68.35% lo que hace preferible al primer modelo.
• Por último el valor del área bajo la curva ROC en el modelo trabajo en clase es del 77.24% y el del modelo trabajado es de 74.95% lo que hace una mejor elección al modelo trabajado en clase.
Después del análisis se puede inferir que se elige al modelo trabajado en clase, sin embargo, también es importante acotar otros análisis teóricos y metodológicos pues no todas las variables son significativas.