El director del banco se muestra preocupado por el aumento de clientes morosos y fallidos. Con objetod de reducir este problema encargo al investigador la realizacion de un estudio que permita identificar con la mayora precision posible aquellas solicitudes de prestamo s que probablemente, puedan llevar a convertirse en prestamos morosos o fallidos en el caso de que se concedieran.
Después de analizar la documentación existente en el banco, el investigador solo puede conseguir información relativamente completa acerca de 25 clientes a los que se ha concedido prestamos los 3 ultimos años. Esta información es la que aparece
library(readxl)
datacaso <- read_excel("C:/Users/maria/Downloads/Ejercicio Analisis de regresión.xlsx")
datacaso<-as.data.frame(datacaso)
str(datacaso)
## 'data.frame': 25 obs. of 7 variables:
## $ Cliente : num 1 2 3 4 5 6 7 8 9 10 ...
## $ Categ : num 1 1 1 1 1 1 1 1 1 1 ...
## $ Ingresos: num 5450 3100 2100 6200 975 1250 4900 8900 3350 5200 ...
## $ Patrneto: num 56 34 8 45 10 22 15 38 54 80 ...
## $ Proviv : num 1 1 0 1 0 1 0 1 0 1 ...
## $ Casado : num 1 0 1 0 1 1 1 1 1 1 ...
## $ Salfij : num 0 1 1 1 1 1 1 1 1 0 ...
Las variables consideradas son:
Categ: Es el grado de cumplimiento del cliente en el reintegro del prestamo, toma los siguientes valores: \(1\) si el cliente es cumplidor, \(2\) si el cliente es moroso (tiene varios pendientes), \(3\) si es un cliente fallido(prestamos irrecuperable)
Ingresos: Son ingresos anuales netos
Patrneto: Es el patrimonio neto en decenas de miles
Proviv: Es una variable dicotomica que toma los valores : \(1\) Propietario de la vivienda que habita, \(0\) cualquier otra situación.
Casado: Toma los valores : \(1\) casado y \(0\) cualquier otra situación
Salfij: Es una variable dicotomica que toma los valores : \(1\) asalariado o contrato fijo, \(0\) cualquier otra situación
El problema que se plantea es construir funciones discriminantes que permitan clasificar, con los menores errores posibles, a los clientes en los diferentes grupos. Si se obtienen buenos resultados, estás funciones discriminantes se podrán utilizar para analizar si se concede un prestamo o no a un futuro peticional.
Se abordara el problema con regresión logística binomial.
library(stats)
library(MASS)
library(dplyr)
library(ggplot2)
library(GGally)
library(car)
library(ISLR)
library(tidyverse)
library(vcd)
library(gmodels)
library(ggeffects)
library(ggplot2)
library(carData)
datacaso$Categ<- as.factor(datacaso$Categ)
datacaso$Proviv<- as.factor(datacaso$Proviv)
datacaso$Casado<- as.factor(datacaso$Casado)
datacaso$Salfij<- as.factor(datacaso$Salfij)
str(datacaso)
## 'data.frame': 25 obs. of 7 variables:
## $ Cliente : num 1 2 3 4 5 6 7 8 9 10 ...
## $ Categ : Factor w/ 2 levels "1","2": 1 1 1 1 1 1 1 1 1 1 ...
## $ Ingresos: num 5450 3100 2100 6200 975 1250 4900 8900 3350 5200 ...
## $ Patrneto: num 56 34 8 45 10 22 15 38 54 80 ...
## $ Proviv : Factor w/ 2 levels "0","1": 2 2 1 2 1 2 1 2 1 2 ...
## $ Casado : Factor w/ 2 levels "0","1": 2 1 2 1 2 2 2 2 2 2 ...
## $ Salfij : Factor w/ 2 levels "0","1": 1 2 2 2 2 2 2 2 2 1 ...
#View(datacaso)
El objetivo es analizar qué variable tuvierón más significancia en explicar la El grado de cumplimiento del cliente.
Comenzamos con un análisis descriptivo unitario, viendo la relación entre la variable dependiente (Categ) y la independientes (proviv, casado,salfij) por separado.
Cuando la variable independiente sea no métrica (cualitativa) se utiliza tablas cruzadas y cuando sea métrica (cuantitativa) se puede comparar la media entre los grupos que considera la variable dependiente.
El modelo logístico que se estima esta dado en la siguiente instrucción
Variable Proviv
\(H_{0}: El \ cumplimiento \ del \ cliente \ ES \ independiente \ de \ proviv \ del \ cliente\)
\(H_{1}: El \ cumplimiento \ del \ cliente \ NO \ ES \ independiente \ de \ proviv \ del \ cliente\)
CrossTable(datacaso$Categ, datacaso$Proviv, chisq = TRUE, prop.c = TRUE )
## Warning in chisq.test(t, correct = TRUE, ...): Chi-squared approximation may be
## incorrect
## Warning in chisq.test(t, correct = FALSE, ...): Chi-squared approximation may
## be incorrect
##
##
## Cell Contents
## |-------------------------|
## | N |
## | Chi-square contribution |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 25
##
##
## | datacaso$Proviv
## datacaso$Categ | 0 | 1 | Row Total |
## ---------------|-----------|-----------|-----------|
## 1 | 4 | 9 | 13 |
## | 0.277 | 0.185 | |
## | 0.308 | 0.692 | 0.520 |
## | 0.400 | 0.600 | |
## | 0.160 | 0.360 | |
## ---------------|-----------|-----------|-----------|
## 2 | 6 | 6 | 12 |
## | 0.300 | 0.200 | |
## | 0.500 | 0.500 | 0.480 |
## | 0.600 | 0.400 | |
## | 0.240 | 0.240 | |
## ---------------|-----------|-----------|-----------|
## Column Total | 10 | 15 | 25 |
## | 0.400 | 0.600 | |
## ---------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 0.9615385 d.f. = 1 p = 0.3267996
##
## Pearson's Chi-squared test with Yates' continuity correction
## ------------------------------------------------------------
## Chi^2 = 0.3271902 d.f. = 1 p = 0.5673183
##
##
Tomando en cuenta el \(p-valor=0.32\), siendo mayor a \(0.05\), ** No se rechaza la Hipótesis nula**, es decir, el cumplimiento del cliente ES independiente al proviv. Entoces, está variable no puede servir.
Variable Casado
\(H_{0}: El \ cumplimiento \ del \ cliente \ ES \ independiente \ de \ estado\ civil \ del \ cliente\)
\(H_{1}: El \ cumplimiento \ del \ cliente \ NO \ ES \ independiente \ de \ estado \ civil \ del \ cliente\)
CrossTable(datacaso$Categ, datacaso$Casado, chisq = TRUE, prop.c = TRUE )
## Warning in chisq.test(t, correct = TRUE, ...): Chi-squared approximation may be
## incorrect
## Warning in chisq.test(t, correct = FALSE, ...): Chi-squared approximation may
## be incorrect
##
##
## Cell Contents
## |-------------------------|
## | N |
## | Chi-square contribution |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 25
##
##
## | datacaso$Casado
## datacaso$Categ | 0 | 1 | Row Total |
## ---------------|-----------|-----------|-----------|
## 1 | 2 | 11 | 13 |
## | 0.402 | 0.127 | |
## | 0.154 | 0.846 | 0.520 |
## | 0.333 | 0.579 | |
## | 0.080 | 0.440 | |
## ---------------|-----------|-----------|-----------|
## 2 | 4 | 8 | 12 |
## | 0.436 | 0.138 | |
## | 0.333 | 0.667 | 0.480 |
## | 0.667 | 0.421 | |
## | 0.160 | 0.320 | |
## ---------------|-----------|-----------|-----------|
## Column Total | 6 | 19 | 25 |
## | 0.240 | 0.760 | |
## ---------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 1.102114 d.f. = 1 p = 0.2938026
##
## Pearson's Chi-squared test with Yates' continuity correction
## ------------------------------------------------------------
## Chi^2 = 0.3377334 d.f. = 1 p = 0.5611405
##
##
Notemos que el \(p-valor=0.29\) siendo valor que \(0.05\), por lo cual no se tiene evidencia suficiente para rechazar la hipotesis nula, por lo cual el cumplimiento del cliente ES Independiente al estado civil del cliente.
Variable Salfij
\(H_{0}: El \ cumplimiento \ del \ cliente \ ES \ independiente \ al \ tipo \ de \ salario \ del \ cliente\)
\(H_{1}: El \ cumplimiento \ del \ cliente \ NO \ ES \ independiente \ al \ tipo \ de \ salario \ del \ cliente\)
CrossTable(datacaso$Categ, datacaso$Salfij, chisq = TRUE, prop.c = TRUE )
## Warning in chisq.test(t, correct = TRUE, ...): Chi-squared approximation may be
## incorrect
## Warning in chisq.test(t, correct = FALSE, ...): Chi-squared approximation may
## be incorrect
##
##
## Cell Contents
## |-------------------------|
## | N |
## | Chi-square contribution |
## | N / Row Total |
## | N / Col Total |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 25
##
##
## | datacaso$Salfij
## datacaso$Categ | 0 | 1 | Row Total |
## ---------------|-----------|-----------|-----------|
## 1 | 2 | 11 | 13 |
## | 1.535 | 0.863 | |
## | 0.154 | 0.846 | 0.520 |
## | 0.222 | 0.688 | |
## | 0.080 | 0.440 | |
## ---------------|-----------|-----------|-----------|
## 2 | 7 | 5 | 12 |
## | 1.663 | 0.935 | |
## | 0.583 | 0.417 | 0.480 |
## | 0.778 | 0.312 | |
## | 0.280 | 0.200 | |
## ---------------|-----------|-----------|-----------|
## Column Total | 9 | 16 | 25 |
## | 0.360 | 0.640 | |
## ---------------|-----------|-----------|-----------|
##
##
## Statistics for All Table Factors
##
##
## Pearson's Chi-squared test
## ------------------------------------------------------------
## Chi^2 = 4.995771 d.f. = 1 p = 0.02540933
##
## Pearson's Chi-squared test with Yates' continuity correction
## ------------------------------------------------------------
## Chi^2 = 3.305567 d.f. = 1 p = 0.06904553
##
##
Tomando en cuenta el \(p-valor= 0.02\) siendo menor a \(0.05\), entonces se tiene evidencia suficiente para rechazar la hipotesis nula, por lo tanto El cumplimiento del cliente No Es Independiente al tipo de salario del cliente.
De acuerdo con el p-valor el Tipo de salario esta relacionada con la probabilidad de cumplimiento
Pruebas t.test: Si la variable es numerica y numerica: t.test(datacaso\(Categ, datacaso\)Ingresos, alternative = “two.sided”)
Pruebas t.test: Si la variable es categorica y numerica: t.test(Ingresos ~ Categ, data = datacaso, alternative = “two.sided”)
Variable ingresos
\(H_{0}: El \ cumplimiento \ del \ cliente \ ES \ independiente \ de \ los\ ingresos \ del \ cliente\)
\(H_{1}: El \ cumplimiento \ del \ cliente \ NO \ ES \ independiente \ de \ los \ ingresos \ del \ cliente\)
Compare los ingresos con respecto a las categorias
t.test(Ingresos ~ Categ, data = datacaso, alternative = "two.sided")
##
## Welch Two Sample t-test
##
## data: Ingresos by Categ
## t = 2.2437, df = 20.794, p-value = 0.03588
## alternative hypothesis: true difference in means between group 1 and group 2 is not equal to 0
## 95 percent confidence interval:
## 133.8447 3555.2579
## sample estimates:
## mean in group 1 mean in group 2
## 4490.385 2645.833
Notemos que el \(p-valor=0.03\) es menor al \(0.05\), por lo que se tiene evidencia suficiente para rechazar la hipotesis nula, por lo cual El cumplimiento del cliente NO ES inpependiente a los ingresos del cliente. Por lo cual está variable puede funcionar.
Gráficamente
boxplot(Ingresos ~ Categ, data = datacaso,
main = "Distribución de Ingresos por Categoría",
xlab = "Categoría",
ylab = "Ingresos",
col = c("green", "red"),
border = "gray40")
Notemos que el cliente es \(1= Cumplicor\) tiene ingresos mayores, en comparación con \(2= tiene deudas\) tiene menos ingresos.
Variable patrimonio neto
\(H_{0}: El \ cumplimiento \ del \ cliente \ ES \ independiente \ del \ patrimonio \ neto \ del \ cliente\)
\(H_{1}: El \ cumplimiento \ del \ cliente \ NO \ ES \ independiente \ del \ patrimonio \ neto \ del \ cliente\)
Compare el patrimonio neto con respecto a las categorias
t.test(Patrneto ~ Categ, data = datacaso, alternative = "two.sided", na.action = na.omit)
##
## Welch Two Sample t-test
##
## data: Patrneto by Categ
## t = 2.5309, df = 18.039, p-value = 0.02089
## alternative hypothesis: true difference in means between group 1 and group 2 is not equal to 0
## 95 percent confidence interval:
## 2.90245 31.23858
## sample estimates:
## mean in group 1 mean in group 2
## 33.15385 16.08333
Notemos que el \(p-valor=0.02\) es menor al \(0.05\), por lo que se tiene evidencia suficiente para rechazar la hipotesis nula, por lo cual El cumplimiento del cliente NO ES independiente al patrimonio neto del cliente. Por lo cual está variable puede funcionar.
Gráficamente
boxplot(Patrneto ~ Categ, data = datacaso,
main = "Distribución de Patrimonio neto por Categoría",
xlab = "Categoría",
ylab = "Patrimonio",
col = c("green", "red"),
border = "gray40")
Notemos que el cliente es \(1= Cumplidor\) tiene mayor patrimonio neto, en comparación con \(2= tiene deudas\) tiene menos patrimonio neto.
Notemos que las variables cuanlitativas que el cumplimiento del cliente, depende de la variable salfij, y la variables cuantitativas en la que el cumplimiento depende de la variables Ingresos, Y Patrneto.
El modelo logístico que se estima está dado en la siguiente instrucción:
# modelo logistico simple
modelc <- glm(Categ ~ Salfij + Ingresos + Patrneto,
data = datacaso, family = binomial)
modelc
##
## Call: glm(formula = Categ ~ Salfij + Ingresos + Patrneto, family = binomial,
## data = datacaso)
##
## Coefficients:
## (Intercept) Salfij1 Ingresos Patrneto
## 1.157e+01 -9.038e+00 -2.548e-05 -2.398e-01
##
## Degrees of Freedom: 24 Total (i.e. Null); 21 Residual
## Null Deviance: 34.62
## Residual Deviance: 12.98 AIC: 20.98
library(stargazer)
##
## Please cite as:
## Hlavac, Marek (2022). stargazer: Well-Formatted Regression and Summary Statistics Tables.
## R package version 5.2.3. https://CRAN.R-project.org/package=stargazer
stargazer(modelc, type= "text" )
##
## =============================================
## Dependent variable:
## ---------------------------
## Categ
## ---------------------------------------------
## Salfij1 -9.038*
## (4.997)
##
## Ingresos -0.00003
## (0.0004)
##
## Patrneto -0.240*
## (0.123)
##
## Constant 11.572*
## (6.162)
##
## ---------------------------------------------
## Observations 25
## Log Likelihood -6.490
## Akaike Inf. Crit. 20.980
## =============================================
## Note: *p<0.1; **p<0.05; ***p<0.01
El modelo logistico es el siguente
\(Cumplidor = 11.57 - 9.038*Salfij - 0.00003*Ingresos - 0.2398*Patrneto\)
Veamos que todas las variables son significativas, a excepción de la variable ingresos, los coeficientes negativos, por ejemplo el coeficiente de la Patrimonio neto,implica entre menos patrimonio aumenta la probabilidad del grado del cumplimiento del cliente (al ser una variable cuantitativa). Para interpretar una variable cualitativa se necesita ser más cuidadoso, por ejemplo el signo negativo del salfij, recordemos \(1\) asalariado o contrato fijo, \(0\) cualquier otra situación; el signo negativo implica que ser asalariado reduce el grado de cumplimiento del cliente.
La primera cuestion que hay que analizar es la significatividad global del modelo mediante la diferencia entre la deviance del modelo nulo y la deviance del modelo estimado, esta prueba la ralizamos con el estadistico ji-cuadrado
deviance.modelc<-modelc$deviance
deviance.base<-modelc$null.deviance
chi<-deviance.base - deviance.modelc
gl_chi <- modelc$df.null - modelc$df.residual
sig.chi <- 1-pchisq(chi, df= gl_chi)
cat("Deviance del Modelo:", deviance.modelc, "\n",
"Deviance base:", deviance.base, "\n",
"Estadístico Ji-cuadrado:", chi, "\n",
"Grados de libertad:", gl_chi, "\n",
"p-valor:", sig.chi, "\n")
## Deviance del Modelo: 12.97957
## Deviance base: 34.61735
## Estadístico Ji-cuadrado: 21.63778
## Grados de libertad: 3
## p-valor: 7.758863e-05
Notemos que el \(pvalor =7.758863e-05\) es MENOR al nivel de significancia \(0.05\) por lo que el modelo ES SIGNIFICATIVO GLOBAL
Ahora, determinemos que variables individuales tienen un efecto significativo en el grado de cumplimiento del cliente (test de Wald), el sentido de esta (signo de los coeficientes no estándarizadas) y la importancia de cada una (odd ratio).
# modelo logistico simple
summary(modelc)
##
## Call:
## glm(formula = Categ ~ Salfij + Ingresos + Patrneto, family = binomial,
## data = datacaso)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.157e+01 6.162e+00 1.878 0.0604 .
## Salfij1 -9.038e+00 4.997e+00 -1.809 0.0705 .
## Ingresos -2.548e-05 4.197e-04 -0.061 0.9516
## Patrneto -2.398e-01 1.233e-01 -1.945 0.0518 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 34.617 on 24 degrees of freedom
## Residual deviance: 12.980 on 21 degrees of freedom
## AIC: 20.98
##
## Number of Fisher Scoring iterations: 7
Notemos que ahora ninguna de las variables es tan significativa en el modelo
anova(modelc, test= "Chisq")
| Df | Deviance | Resid. Df | Resid. Dev | Pr(>Chi) | |
|---|---|---|---|---|---|
| NULL | NA | NA | 24 | 34.61735 | NA |
| Salfij | 1 | 5.207873 | 23 | 29.40948 | 0.0224848 |
| Ingresos | 1 | 4.252754 | 22 | 25.15672 | 0.0391867 |
| Patrneto | 1 | 12.177149 | 21 | 12.97957 | 0.0004838 |
Anova(modelc)
| LR Chisq | Df | Pr(>Chisq) | |
|---|---|---|---|
| Salfij | 14.0921651 | 1 | 0.0001741 |
| Ingresos | 0.0036635 | 1 | 0.9517362 |
| Patrneto | 12.1771487 | 1 | 0.0004838 |
Notemos que las variables significativas en el modelo son las Salfij y Partneto
summary(modelc)
##
## Call:
## glm(formula = Categ ~ Salfij + Ingresos + Patrneto, family = binomial,
## data = datacaso)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 1.157e+01 6.162e+00 1.878 0.0604 .
## Salfij1 -9.038e+00 4.997e+00 -1.809 0.0705 .
## Ingresos -2.548e-05 4.197e-04 -0.061 0.9516
## Patrneto -2.398e-01 1.233e-01 -1.945 0.0518 .
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 34.617 on 24 degrees of freedom
## Residual deviance: 12.980 on 21 degrees of freedom
## AIC: 20.98
##
## Number of Fisher Scoring iterations: 7
Probando otro modelo logistico
# modelo logistico simple
modelc1 <- glm(Categ ~ Salfij + Patrneto,
data = datacaso, family = binomial)
modelc1
##
## Call: glm(formula = Categ ~ Salfij + Patrneto, family = binomial, data = datacaso)
##
## Coefficients:
## (Intercept) Salfij1 Patrneto
## 11.5114 -9.0337 -0.2411
##
## Degrees of Freedom: 24 Total (i.e. Null); 22 Residual
## Null Deviance: 34.62
## Residual Deviance: 12.98 AIC: 18.98
library(stargazer)
stargazer(modelc1, type= "text")
##
## =============================================
## Dependent variable:
## ---------------------------
## Categ
## ---------------------------------------------
## Salfij1 -9.034*
## (4.979)
##
## Patrneto -0.241**
## (0.121)
##
## Constant 11.511*
## (6.052)
##
## ---------------------------------------------
## Observations 25
## Log Likelihood -6.492
## Akaike Inf. Crit. 18.983
## =============================================
## Note: *p<0.1; **p<0.05; ***p<0.01
El modelo logistico es el siguente
\(Cumplidor=11.511- 9.0337*Salfij1 - 0.2411*Patrneto\)
Veamos que todas las variables son significativas, los coeficientes negativos, por ejemplo el coeficiente de la Patrimonio neto,implica entre menos patrimonio aumenta la probabilidad del grado del cumplimiento del cliente (al ser una variable cuantitativa). Para interpretar una variable cualitativa se necesita ser más cuidadoso, por ejemplo el signo negativo del salfij, recordemos \(1\) asalariado o contrato fijo, \(0\) cualquier otra situación; el signo negativo implica que ser asalariado reduce el grado de cumplimiento del cliente.
La primera cuestion que hay que analizar es la significatividad global del modelo mediante la diferencia entre la deviance del modelo nulo y la deviance del modelo estimado, esta prueba la ralizamos con el estadistico ji-cuadrado
deviance.modelc1<-modelc1$deviance
deviance.base1<-modelc1$null.deviance
chi1<-deviance.base - deviance.modelc1
gl_chi1 <- modelc1$df.null - modelc1$df.residual
sig.chi1 <- 1-pchisq(chi, df= gl_chi)
cat("Deviance del Modelo:", deviance.modelc1, "\n",
"Deviance base:", deviance.base1, "\n",
"Estadístico Ji-cuadrado:", chi1, "\n",
"Grados de libertad:", gl_chi1, "\n",
"p-valor:", sig.chi1, "\n")
## Deviance del Modelo: 12.98324
## Deviance base: 34.61735
## Estadístico Ji-cuadrado: 21.63411
## Grados de libertad: 2
## p-valor: 7.758863e-05
Notemos que el \(pvalor =7.758863e-05\) es MENOR al nivel de significancia \(0.05\) por lo que el modelo ES SIGNIFICATIVO GLOBAL, tomando en cuenta que es lo mismo, que el modelo anterior pero quitando la variable ingresos que nos es de mucha suignificancia.
Ahora, determinemos que variables individuales tienen un efecto significativo en el grado de cumplimiento del cliente (test de Wald), el sentido de esta (signo de los coeficientes no estándarizadas) y la importancia de cada una (odd ratio).
# modelo logistico simple
summary(modelc1)
##
## Call:
## glm(formula = Categ ~ Salfij + Patrneto, family = binomial, data = datacaso)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 11.5114 6.0517 1.902 0.0571 .
## Salfij1 -9.0337 4.9792 -1.814 0.0696 .
## Patrneto -0.2411 0.1215 -1.985 0.0472 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 34.617 on 24 degrees of freedom
## Residual deviance: 12.983 on 22 degrees of freedom
## AIC: 18.983
##
## Number of Fisher Scoring iterations: 7
Notemos que la unica variable significativa es la variable patrneto.
Anova(modelc1)
| LR Chisq | Df | Pr(>Chisq) | |
|---|---|---|---|
| Salfij | 15.38940 | 1 | 8.75e-05 |
| Patrneto | 16.42624 | 1 | 5.06e-05 |
Notemos que todas las variables son significativas, la variable salfij y la variable patrneto
modelc1$coefficients
## (Intercept) Salfij1 Patrneto
## 11.5114205 -9.0337341 -0.2410663
# Exponencial de los coeficientes estimados
# Solo es del beta i correspondiente
exp(modelc1$coefficients)
## (Intercept) Salfij1 Patrneto
## 9.984961e+04 1.193161e-04 7.857896e-01
Seleccionamos tres personas de la base de datos para estimar la probabilidad de cumplimiento del cliente con base al modelo logistico:
datacaso[c(7,18,25),]
| Cliente | Categ | Ingresos | Patrneto | Proviv | Casado | Salfij | |
|---|---|---|---|---|---|---|---|
| 7 | 7 | 1 | 4900 | 15 | 0 | 1 | 1 |
| 18 | 18 | 2 | 6400 | 4 | 0 | 1 | 1 |
| 25 | 25 | 2 | 2650 | 25 | 0 | 0 | 0 |
\(1\) si el cliente es cumplidor, \(2\) si el cliente es moroso (tiene varios pendientes)
Proviv: Es una variable dicotomica que toma los valores : \(1\) Propietario de la vivienda que habita, \(0\) cualquier otra situación.
Casado: Toma los valores : \(1\) casado y \(0\) cualquier otra situación
Salfij: Es una variable dicotomica que toma los valores : \(1\) asalariado o contrato fijo, \(0\) cualquier otra situación
Para el primer cliente seleccionado “7”, categoria \(1=cliente \ cumplidor\), con un ingreso de \(4,900\) pesos, con un patrimonio neto de 15 decenas de miles, Proviv \(0=cualquier otra situación, es decir no es propietario de vivienda que habita\), la variable casado $1= casado $, con la variable salfij \(1= asalariado\)
Para el segundo cliente seleccionado “18”, categoria \(2=cliente \ moroso\), con un ingreso de \(6,400\) pesos, con un patrimonio neto de 4 decenas de miles, Proviv \(0=cualquier otra situación, es decir no es propietario de vivienda que habita\), la variable casado $1= casado $, con la variable salfij \(1= asalariado\)
Para el tercer cliente seleccionado “25”, categoria \(2=cliente \ moroso\), con un ingreso de \(2,650\) pesos, con un patrimonio neto de 25 decenas de miles, Proviv \(0=cualquier otra situación, es decir no es propietario de vivienda que habita\), la variable casado $0= no casado $, con la variable salfij \(0= no \ es\ asalariado\)
Tomando en cuenta el modelo \(Sobreviviente = 11.511 - 9.0337*Salfij1 - 0.2411*Patrneto\)
odd_c7<- exp(11.511 - 9.0337*1 - 0.2411*15)
cat("Razon odd cliente 7:", odd_c7, "\n")
## Razon odd cliente 7: 0.320075
odd_c18<- exp( 11.511 - 9.0337*1 - 0.2411*4)
cat("Razon odd cliente 18:", odd_c18, "\n")
## Razon odd cliente 18: 4.539877
odd_c25<- exp( 11.511 - 9.0337*0 - 0.2411*25)
cat("Razon odd cliente 25:", odd_c25, "\n")
## Razon odd cliente 25: 240.6876
Recuerde que el odd de un acontecimiento se define como la razón entre su probabilidad de ocurrencia y la de no ocurrencia.
\(\dfrac{\pi_i}{1-\pi_i}=\ e^{ 11.511 - 9.0337*Salfij1 - 0.2411*Patrneto}\)
Con la cuál se obtuvieron las odd de los clientes \(7,18 y 25\).
Para la odd del pasajero \(7\), es MENOR A 1, entonces la probabilidad de NO cumplir es mayor a la probabilidad de cumplir.
Para el cliente \(18\), es MAYOR A 1, que indicaría que se espera observar 4 cumplidores por cada No cumplidor, en las condiciones de ser asalariado y tener un patrimonio neto de 4 decenas de miles .
Mientras que para el cliuente \(25\) tiene una razon odd MAYOR A 1, que indicaría que se espera observar 240 cumplidores por cada No cumplidor o moroso, en las condiciones de no ser asalariado y con un patrimonio neto de \(25\) en decenas de miles.
Veamos las probabilidades estimnadas
datacaso1<- data.frame(datacaso, modelc1$fitted.values)
head(datacaso1)
| Cliente | Categ | Ingresos | Patrneto | Proviv | Casado | Salfij | modelc1.fitted.values |
|---|---|---|---|---|---|---|---|
| 1 | 1 | 5450 | 56 | 1 | 1 | 0 | 0.1204379 |
| 2 | 1 | 3100 | 34 | 1 | 0 | 1 | 0.0032737 |
| 3 | 1 | 2100 | 8 | 0 | 1 | 1 | 0.6339398 |
| 4 | 1 | 6200 | 45 | 1 | 0 | 1 | 0.0002316 |
| 5 | 1 | 975 | 10 | 0 | 1 | 1 | 0.5167497 |
| 6 | 1 | 1250 | 22 | 1 | 1 | 1 | 0.0559473 |
datacaso$ProbEstimSob <- as.numeric(modelc1$fitted.values)
head(datacaso)
| Cliente | Categ | Ingresos | Patrneto | Proviv | Casado | Salfij | ProbEstimSob |
|---|---|---|---|---|---|---|---|
| 1 | 1 | 5450 | 56 | 1 | 1 | 0 | 0.1204379 |
| 2 | 1 | 3100 | 34 | 1 | 0 | 1 | 0.0032737 |
| 3 | 1 | 2100 | 8 | 0 | 1 | 1 | 0.6339398 |
| 4 | 1 | 6200 | 45 | 1 | 0 | 1 | 0.0002316 |
| 5 | 1 | 975 | 10 | 0 | 1 | 1 | 0.5167497 |
| 6 | 1 | 1250 | 22 | 1 | 1 | 1 | 0.0559473 |
Veamos las probabilidades de cumplimiento de los clientes \(7\),\(18\) y \(25\)
datacaso[c(7,18,25), c("Categ","ProbEstimSob")]
| Categ | ProbEstimSob | |
|---|---|---|
| 7 | 1 | 0.2426313 |
| 18 | 2 | 0.8195677 |
| 25 | 2 | 0.9958676 |
El cliente \(7\) es cumplidor y su probabilidad estimada era de \(0.2426313\) de cumplidor
El cliente \(18\) moroso y su probabilidad estimada era de \(0.8195677\) de cumplidor
El cliente \(25\) es moroso y tenia una probabilidad de \(0.9958676\) de cumplidor.
Calculamos la probabilidad de cumplidor de cada pasajero así como la probabilidad de no cumplir o moroso.
Al término \(e^{\beta_{i}}\) se le conoce como odd ratio y su interpretación es:
odd ratio es el factor en que se incrementa la odd cuando la variable independiente \(i-ésima\) se incrementa en una unidad y el resto permanece constante.
Recordemos el modelo:
\[Cumplidor = 11.511 - 9.0337*Salfij1 - 0.2411*Patrneto\]
** Si el coeficiente no estandarizado (\({\beta_{1}}\)) es positivo su odd ratio será mayor que 1 (incrementa el odd)
** Si el coeficiente (\({\beta_{1}}\)) es negativo su odd ratio será menor a 1 (disminuye el odd)
En el ejemplo, el odd ratio de Patrneto es \(e^{\beta_{2}}=e^{(-0.2411)}=0.7857\)
Consideremos la Patrneto 34 y 35, ¿en cuánto se incrementa la probabilidad de cumplidor de un cliente con patrimonio neto de \(34\) decenas de miles a un cliente con un patrimonio neto de \(35\)decenas de miles (es decir, cuando el patrimonio tiene un incremento de uitario)
Un pasajero con \(Patrneto=34\) decenas de miles tendrá probabilidad de cumplir
\(P(Y=1)=\dfrac{1}{1+e^{-Y}}=\dfrac{1}{1+e^{-(11.511 - 9.0337*Salfij1 - 0.2411*Patrneto)}}\)
Mantiendo fijo el salfij, no será asalariado, entonces el modelo queda como:
\(P(Y=1)=\dfrac{1}{1+e^{-Y}}=\dfrac{1}{1+e^{-(11.511-0.2411*Patrneto)}}\)
\(P(Y=1)=\dfrac{1}{1+e^{-Y}}=\dfrac{1}{1+e^{-(11.511-0.2411*34)}}=0.9648\)
Si el cliente tubiera un patrimonio neto de 35 decenas demiles, entonces su probabilidad de cumplir es:
\(P(Y=1)=\dfrac{1}{1+e^{-Y}}=\dfrac{1}{1+e^{-(11.511-0.2411*25)}}=0.9557\)
Las nuevas odd son: \(Nuevas \ odds= (anterior\ odd)(odd\ ratio)(Cambio en la variable)\)
entonces
\(Nuevas \ odds= (0.9648)(0.7857)(1)=0.7551\)
Como
\(Odd=\dfrac{P(Y=1)}{1-P(Y=1)}\)
entonces
\(P(Y=1)=(Odd)(1-P(Y=1))\)
de donde
\(P(Y=1)=Odd-Odd*P(Y=1)\)
\(P(Y=1)+ Odd*P(Y=1)= Odd\)
\(P(Y=1)[1+Odd]= Odd\)
así
\(P(Y=1)= \dfrac{Odd}{1+Odd}\)
El clientye pasa a tener una probabilidad de cumplir de
\(P(Y=1)= \dfrac{0.7551}{1+0.7551}=0.43023\)
Es decir, al pasar de un patrimonio de 34 a 35 decenas de miles , el clinete tiene un incremento en su probabilidad de cunplir de \(\dfrac{(0.43023-0.7551)}{0.7551}=-0.4302\)
Calculamos la probabilidad de cumplir de cada cliente así como la probabilidad de no cumplir.
NO_Cump<-1-datacaso$ProbEstimSob
datacaso$ProbFrac<-NO_Cump
datacaso$Odd<- (datacaso$ProbEstimSob)/(datacaso$ProbFrac)
head(datacaso)
| Cliente | Categ | Ingresos | Patrneto | Proviv | Casado | Salfij | ProbEstimSob | ProbFrac | Odd |
|---|---|---|---|---|---|---|---|---|---|
| 1 | 1 | 5450 | 56 | 1 | 1 | 0 | 0.1204379 | 0.8795621 | 0.1369294 |
| 2 | 1 | 3100 | 34 | 1 | 0 | 1 | 0.0032737 | 0.9967263 | 0.0032844 |
| 3 | 1 | 2100 | 8 | 0 | 1 | 1 | 0.6339398 | 0.3660602 | 1.7317914 |
| 4 | 1 | 6200 | 45 | 1 | 0 | 1 | 0.0002316 | 0.9997684 | 0.0002316 |
| 5 | 1 | 975 | 10 | 0 | 1 | 1 | 0.5167497 | 0.4832503 | 1.0693210 |
| 6 | 1 | 1250 | 22 | 1 | 1 | 1 | 0.0559473 | 0.9440527 | 0.0592629 |
datacaso[c(7,18,25),]
| Cliente | Categ | Ingresos | Patrneto | Proviv | Casado | Salfij | ProbEstimSob | ProbFrac | Odd | |
|---|---|---|---|---|---|---|---|---|---|---|
| 7 | 7 | 1 | 4900 | 15 | 0 | 1 | 1 | 0.2426313 | 0.7573687 | 0.3203608 |
| 18 | 18 | 2 | 6400 | 4 | 0 | 1 | 1 | 0.8195677 | 0.1804323 | 4.5422449 |
| 25 | 25 | 2 | 2650 | 25 | 0 | 0 | 0 | 0.9958676 | 0.0041324 | 240.9921016 |
Vemos nuevamente que el modelo ajusta bien la probabilidad con algunas muestras pero hay algunos en los que falla, obtenemos la matriz de confunsion que muestra la calidad de estimación del modelo, el punto de corte será 0.5.
library(gmodels)
predict.modelc1<- modelc1$fitted.values
predict.modelc1[predict.modelc1>=0.5]<-1
predict.modelc1[predict.modelc1<0.5]<-0
CrossTable(datacaso$Categ, predict.modelc1, prop.chisq = FALSE,
prop.c = FALSE, prop.r = FALSE)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 25
##
##
## | predict.modelc1
## datacaso$Categ | 0 | 1 | Row Total |
## ---------------|-----------|-----------|-----------|
## 1 | 11 | 2 | 13 |
## | 0.440 | 0.080 | |
## ---------------|-----------|-----------|-----------|
## 2 | 1 | 11 | 12 |
## | 0.040 | 0.440 | |
## ---------------|-----------|-----------|-----------|
## Column Total | 12 | 13 | 25 |
## ---------------|-----------|-----------|-----------|
##
##
Considerando el punto de corte de 0.5 se tiene \(1= cumplidor\), \(0=moroso\)
De los \(13\) que cumplieron, el modelo dice que los que cumplieron son \(2\), es decir, se tienen 11 clientes mal asignados que que no cumplieron.
De los \(12\) que no cumplieron, el modelo dice que los que no cumplieron fueron \(1\), es decir, se tienen \(11\) cliente mal asignados que cumplen.
Graficos de las probabilidades estimadas contra las variables explicativas
boxplot(modelc1$fitted.values ~ factor(datacaso$Categ),
col = "bisque",
main = "Probabilidades predichas bajo el modelo logístico",
xlab = "Cumplidores (1) o No cumplidores (0)",
ylab = "Probabilidades predichas")
Las probabilidades estimadas para los que cumplieron estan debajo de \(0.3\), sin embargo están en un rango de \((0.0,0.5)\) pero hay valores extremos. Las probabilidades estimadas para los que no cumplieron están estan por arriba de \(0.6\), estban en un rango de $(0.6,1)
Gráficas de la curva logistica que representa el comportamiento de las probabilidades estimadas con respecto a las variables explicativas
library(magrittr)
##
## Adjuntando el paquete: 'magrittr'
## The following object is masked from 'package:purrr':
##
## set_names
## The following object is masked from 'package:tidyr':
##
## extract
modelc1 %>%
ggpredict(terms = c ("Patrneto", "Salfij")) %>%
plot() +
labs(title = "Valores esperados : Probabilidad de cumplir",
color = "Salario fijo del cliente", x = "Patrimonio neto", y = "Pr(y=1)")
## Data were 'prettified'. Consider using `terms="Patrneto [all]"` to get
## smooth plots.
Para el gráfico rojo es la probabilidad de cumplir para lostienen salario fijo o asalariados. Notemos que se tiene una probabilidad alta de cumplir si está sui patrimonio neto de entre \((0,30)\).
Si se tiene más de de 40 de patrimonio netoy eres asalariado se tiene una probabilidad de cumlir arriba del 75%.
Para el gráfico azul es la probabilidad de cumplir para los no tienen salario fijo o asalariados.Tambien la probabilidad de cumplir es decreciente pero esta por arriba debajo del 75%, tienes menos chance de cumplir entre \((30,80)\) decenas de miles de cumplimiento neto.
Si se tiene más de 60 años y viajas en segunda clase se tiene una probabilidad de sobrevivir debajo del 70%.
library(Epi)
ROC(data=datacaso, form= Categ ~ Salfij+ Patrneto )
Este punto optimo sugerido es para incrementar el éxito
MATRIZ DE CONFUSION
library(gmodels)
predict.modelc2<- modelc1$fitted.values
predict.modelc2[predict.modelc1>=0.517]<-1
predict.modelc2[predict.modelc1<0.517]<-0
CrossTable(datacaso$Categ, predict.modelc2, prop.chisq = FALSE,
prop.c = FALSE, prop.r = FALSE)
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 25
##
##
## | predict.modelc2
## datacaso$Categ | 0 | 1 | Row Total |
## ---------------|-----------|-----------|-----------|
## 1 | 11 | 2 | 13 |
## | 0.440 | 0.080 | |
## ---------------|-----------|-----------|-----------|
## 2 | 1 | 11 | 12 |
## | 0.040 | 0.440 | |
## ---------------|-----------|-----------|-----------|
## Column Total | 12 | 13 | 25 |
## ---------------|-----------|-----------|-----------|
##
##
Comparando con la matriz de confusion con el punto de corte de 0.5 no incrementa tanto.
This is an R Markdown document. Markdown is a simple formatting syntax for authoring HTML, PDF, and MS Word documents. For more details on using R Markdown see http://rmarkdown.rstudio.com.
When you click the Knit button a document will be generated that includes both content as well as the output of any embedded R code chunks within the document. You can embed an R code chunk like this:
summary(cars)
## speed dist
## Min. : 4.0 Min. : 2.00
## 1st Qu.:12.0 1st Qu.: 26.00
## Median :15.0 Median : 36.00
## Mean :15.4 Mean : 42.98
## 3rd Qu.:19.0 3rd Qu.: 56.00
## Max. :25.0 Max. :120.00
You can also embed plots, for example:
Note that the echo = FALSE parameter was added to the
code chunk to prevent printing of the R code that generated the
plot.