Se utilizará el dataset \(\textbf{Default}\). Es una base de datos que contiene 10000 registros de clientes de un banco. La idea es poder inferir, en base a los registros, que clientes no podrán pagar sus cuota de tarjeta de credito y caer en default.
names(Default)
[1] "default" "student" "balance" "income" "coded_default"
attach(Default)
The following objects are masked from Default (pos = 4):
balance, coded_default, default, income, student
head(Default)
summary(Default)
default student balance income coded_default
No :9667 No :7056 Min. : 0.0 Min. : 772 Min. :0.0000
Yes: 333 Yes:2944 1st Qu.: 481.7 1st Qu.:21340 1st Qu.:0.0000
Median : 823.6 Median :34553 Median :0.0000
Mean : 835.4 Mean :33517 Mean :0.0333
3rd Qu.:1166.3 3rd Qu.:43808 3rd Qu.:0.0000
Max. :2654.3 Max. :73554 Max. :1.0000
Vamos a dicotomizar la variable Default y agregarla al dataset con el nombre de coded_default. Vemos como la regresion lineal estándar no sirve para modelar lo que sucede con los datos, obtenemos valores fuera de rango y no se ajusta a las variaciones bruzcas, ademas que el error cometido en el rango entre extremos es muy alto.
Default$coded_default <- ifelse(Default$default=="Yes",1,0)
Default %>% ggplot(aes(x=balance,y=coded_default))+
geom_point(aes(col=Default$default))+
geom_smooth(method = "lm")
De la recta de regresión, podemos concluir que a medida que crece que balance de la tarjeta de crédito (deuda), mayor es la probabilidad de entrar en default. Por las limitaciones de MCO en este caso, solo podemos extraer conclusiones cualitativas.
fit_lm <- lm(coded_default ~ balance, data=Default)
summary(fit_lm)
Call:
lm(formula = coded_default ~ balance, data = Default)
Residuals:
Min 1Q Median 3Q Max
-0.23533 -0.06939 -0.02628 0.02004 0.99046
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) -0.075191959 0.003354360 -22.42 <0.0000000000000002 ***
balance 0.000129872 0.000003475 37.37 <0.0000000000000002 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
Residual standard error: 0.1681 on 9998 degrees of freedom
Multiple R-squared: 0.1226, Adjusted R-squared: 0.1225
F-statistic: 1397 on 1 and 9998 DF, p-value: < 0.00000000000000022
| \(\beta_0\) | \(\beta_1\) |
|---|---|
| -0.075192 | 0.0001299 |
\(\beta_1\) es cuanto aumenta la propabilidad de caer en default cuando aumenta en una unidad el balance (deuda)
Simil a teoria de desición. Dado un balance, quiero saber la probabilidad de caer en default. Se puede definir un umbral de probabilidad a traves del cual se toma la desición.
Trabajamos con el logaritmos de Odd (chance), que se define como \(\frac{p}{1-p}\). Donde \(p = P(caer\_en\_mora)\)
\[ P(default = Yes|balance) \]
\[ P(default = Yes|balance) = \beta_0 + \beta_1 balance \] \[ P(X) = \beta_0 + \beta_1 X \]
\[ ln(\frac{p}{1-p}) = \beta_0 + \beta_1 X \]
\[ \frac{p}{1-p} = e^{\beta_0 + \beta_1 X} \]
\[ p = e^{\beta_0 + \beta_1 X} (1-p) \]
\[ p = e^{\beta_0 + \beta_1 X} - p e^{\beta_0 + \beta_1 X} \]
\[ p + p e^{\beta_0 + \beta_1 X} = e^{\beta_0 + \beta_1 X} \] \[ p (1 + e^{\beta_0 + \beta_1 X}) = e^{\beta_0 + \beta_1 X} \]
\[ p = \frac{e^{\beta_0 + \beta_1 X}}{(1 + e^{\beta_0 + \beta_1 X})} \]
Calculamos los parámetros \(\beta_0\) y \(\beta_1\) de la regresion logística
logit_reg <- glm(default ~ balance, data=Default, family = binomial)
summary(logit_reg)$coefficients
Estimate Std. Error z value
(Intercept) -10.651330614 0.3611573721 -29.49221
balance 0.005498917 0.0002203702 24.95309
Pr(>|z|)
(Intercept) 0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003623124
balance 0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001976601736462045296666174727056650651646940960033647670370745
Odds aumentan 0.0054989 por cada dolar que tengo en balance (deuda). Podemos resumir los resultados del modelo de la siguiente manera
\[ ln Odds = \beta_0 + \beta_1 \cdot balance \] donde \(\beta_0 =\) -10.6513306 y \(\beta_1 =\) 0.0054989
\[ ln Odds = -10.6513306 + 0.0054989 \cdot balance \]
\[ Odds = e^{-10.6513306 + 0.0054989 \cdot balance} \] \[ p = \frac{e^{-10.6513306 + 0.0054989 \cdot balance}}{1+e^{-10.6513306 + 0.0054989 \cdot balance}} \]
beta0 <- logit_reg$coefficients[1]
beta1 <- logit_reg$coefficients[2]
p <- exp(beta0+beta1*Default$balance)/(1+exp(beta0+beta1*Default$balance))
plot(Default$balance,p)
Al aumentar el balance en la tarjeta de credito aumenta la probabilidad \(p\) de caer en mora.
Armamos una funcion para calcular la probabilidad.
prob_default <- function(beta0, beta1, balance){
p <- exp(beta0+beta1*balance)/(1+exp(beta0+beta1*balance))
return(as.numeric(p))
}
prob_default(beta0, beta1, 1500)
[1] 0.08294762
prob_default(beta0, beta1, 1800)
[1] 0.320107
prob_default(beta0, beta1, 2000)
[1] 0.5857694
prob_default(beta0, beta1, 2500)
[1] 0.9567259
summary(logit_reg)$coefficients
Estimate Std. Error z value
(Intercept) -10.651330614 0.3611573721 -29.49221
balance 0.005498917 0.0002203702 24.95309
Pr(>|z|)
(Intercept) 0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000003623124
balance 0.00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000001976601736462045296666174727056650651646940960033647670370745
Funciones para hallar coeficientes e intervalos de confianza para regresiones. Me interesa si en el intervalo se encuentra \(e^{0} = 1\), si no pertence entonces puede asegurar significancia estadística (test de hipótesis).
coef(logit_reg)
(Intercept) balance
-10.651330614 0.005498917
confint(logit_reg)
Waiting for profiling to be done...
2.5 % 97.5 %
(Intercept) -11.383288936 -9.966565064
balance 0.005078926 0.005943365
Generamos otro modelo contemplando todas las variables del dataframe para evaluar que estadisticos son relevantes para el análisis de la mora.
logit_reg2 <- glm(default ~ balance + student + income, data = default, family = binomial)
summary(logit_reg2)$coefficients
Estimate Std. Error z value
(Intercept) -10.86904519617 0.492255515606 -22.080088
balance 0.00573650526 0.000231894519 24.737563
studentYes -0.64677580664 0.236252528745 -2.737646
income 0.00000303345 0.000008202615 0.369815
Pr(>|z|)
(Intercept) 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004911279576424167001347828332502319
balance 0.000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000004219578
studentYes 0.006188063286482599519022773648657675948925316333770751953125000000000000000000000000000000000000000000000000000000000000000000000000000000000
income 0.711520342121125359824418410426005721092224121093750000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000