## Warning: package 'rmdformats' was built under R version 4.0.2

INTRODUCCION

El conjunto de datos a utilizar proviene de la plataforma de concursos de análisis de datos kaggle. La base de fatos contiene informacion de incumplimientos de pagos, factores demograficos, datos crediticios, historial de pagos y estados de cuenta de clientes de tarjeta de credito desde abril de 2005 hasta septiembre de 2005.

Contiene 25 variables:

ID: ID of each client
LIMIT_BAL: Amount of given credit in NT dollars (includes individual and family/supplementary credit
SEX: Gender (1=male, 2=female)
EDUCATION: (1=graduate school, 2=university, 3=high school, 4=others, 5=unknown, 6=unknown)
MARRIAGE: Marital status (1=married, 2=single, 3=others)
AGE: Age in years
PAY_0: Repayment status in September, 2005 # (-1=pay duly, # 1=payment delay for one month, # 2=payment delay for two months, … # 8=payment delay for eight months, # 9=payment delay for nine months and above)
PAY_2: Repayment status in August, 2005 (scale same as above)
PAY_3: Repayment status in July, 2005 (scale same as above)
PAY_4: Repayment status in June, 2005 (scale same as above)
PAY_5: Repayment status in May, 2005 (scale same as above)
PAY_6: Repayment status in April, 2005 (scale same as above)
BILL_AMT1: Amount of bill statement in September, 2005 (NT dollar)
BILL_AMT2: Amount of bill statement in August, 2005 (NT dollar)
BILL_AMT3: Amount of bill statement in July, 2005 (NT dollar)
BILL_AMT4: Amount of bill statement in June, 2005 (NT dollar)
BILL_AMT5: Amount of bill statement in May, 2005 (NT dollar)
BILL_AMT6: Amount of bill statement in April, 2005 (NT dollar)
PAY_AMT1: Amount of previous payment in September, 2005 (NT dollar)
PAY_AMT2: Amount of previous payment in August, 2005 (NT dollar)
PAY_AMT3: Amount of previous payment in July, 2005 (NT dollar)
PAY_AMT4: Amount of previous payment in June, 2005 (NT dollar)
PAY_AMT5: Amount of previous payment in May, 2005 (NT dollar)
PAY_AMT6: Amount of previous payment in April, 2005 (NT dollar)
default.payment.next.month: Default payment (1=yes, 0=no)

Base de Datos: Primer Modelo

Primero cargamos los paquetes a utilizar, luego importamos los datos, previamente descargados.

options(scipen=999)

pkges<-c("mfx","pROC","tidyverse","forecast","data.table")
lapply(pkges,"library",character.only=T)

## [[1]]
##  [1] "mfx"        "betareg"    "MASS"       "lmtest"     "zoo"       
##  [6] "sandwich"   "rmdformats" "knitr"      "stats"      "graphics"  
## [11] "grDevices"  "utils"      "datasets"   "methods"    "base"      
## 
## [[2]]
##  [1] "pROC"       "mfx"        "betareg"    "MASS"       "lmtest"    
##  [6] "zoo"        "sandwich"   "rmdformats" "knitr"      "stats"     
## [11] "graphics"   "grDevices"  "utils"      "datasets"   "methods"   
## [16] "base"      
## 
## [[3]]
##  [1] "forcats"    "stringr"    "dplyr"      "purrr"      "readr"     
##  [6] "tidyr"      "tibble"     "ggplot2"    "tidyverse"  "pROC"      
## [11] "mfx"        "betareg"    "MASS"       "lmtest"     "zoo"       
## [16] "sandwich"   "rmdformats" "knitr"      "stats"      "graphics"  
## [21] "grDevices"  "utils"      "datasets"   "methods"    "base"      
## 
## [[4]]
##  [1] "forecast"   "forcats"    "stringr"    "dplyr"      "purrr"     
##  [6] "readr"      "tidyr"      "tibble"     "ggplot2"    "tidyverse" 
## [11] "pROC"       "mfx"        "betareg"    "MASS"       "lmtest"    
## [16] "zoo"        "sandwich"   "rmdformats" "knitr"      "stats"     
## [21] "graphics"   "grDevices"  "utils"      "datasets"   "methods"   
## [26] "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"   "rmdformats" "knitr"     
## [21] "stats"      "graphics"   "grDevices"  "utils"      "datasets"  
## [26] "methods"    "base"

Base de datos

maindir <- getwd() #Para saber cual es el directorio de trabajo.
data <- read.csv(paste0(maindir,"/UCI_Credit_Card.csv"),header = T)


#Solo nos quedamos con los datos completos, en este caso no hay datos faltantes
datos <- data[complete.cases(data),]

En esta base de datos el ID es irrelevante para el analisis por ello se eliminara.

all_data <- datos[,-1]

Se tiene que cambiar las variables, que son dicotomicas:

all_data$SEX <- as.factor(all_data$SEX)
all_data$MARRIAGE <- as.factor(all_data$MARRIAGE)
all_data$EDUCATION <- as.factor(all_data$EDUCATION)

Resumen de la data

Hay 30,000 clientes distintos de tarjetas de crédito.El valor promedio para el monto del límite de la tarjeta de crédito es 167,484, el valor máximo es 1M.

El nivel de educación es principalmente escuela de posgrado y universidad. La mayoría de los clientes están casados o solteros (menos frecuente el otro estado).

La edad promedio es de 35.5 años.

Como el valor 0 para el inclumplimiento de pagos significa ‘no default’ y el valor 1 significa ‘default’.

options(max.print=999999)
summary(all_data)

##    LIMIT_BAL       SEX       EDUCATION MARRIAGE       AGE       
##  Min.   :  10000   1:11888   0:   14   0:   54   Min.   :21.00  
##  1st Qu.:  50000   2:18112   1:10585   1:13659   1st Qu.:28.00  
##  Median : 140000             2:14030   2:15964   Median :34.00  
##  Mean   : 167484             3: 4917   3:  323   Mean   :35.49  
##  3rd Qu.: 240000             4:  123             3rd Qu.:41.00  
##  Max.   :1000000             5:  280             Max.   :79.00  
##                              6:   51                            
##      PAY_0             PAY_2             PAY_3             PAY_4        
##  Min.   :-2.0000   Min.   :-2.0000   Min.   :-2.0000   Min.   :-2.0000  
##  1st Qu.:-1.0000   1st Qu.:-1.0000   1st Qu.:-1.0000   1st Qu.:-1.0000  
##  Median : 0.0000   Median : 0.0000   Median : 0.0000   Median : 0.0000  
##  Mean   :-0.0167   Mean   :-0.1338   Mean   :-0.1662   Mean   :-0.2207  
##  3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.: 0.0000  
##  Max.   : 8.0000   Max.   : 8.0000   Max.   : 8.0000   Max.   : 8.0000  
##                                                                         
##      PAY_5             PAY_6           BILL_AMT1         BILL_AMT2     
##  Min.   :-2.0000   Min.   :-2.0000   Min.   :-165580   Min.   :-69777  
##  1st Qu.:-1.0000   1st Qu.:-1.0000   1st Qu.:   3559   1st Qu.:  2985  
##  Median : 0.0000   Median : 0.0000   Median :  22382   Median : 21200  
##  Mean   :-0.2662   Mean   :-0.2911   Mean   :  51223   Mean   : 49179  
##  3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.:  67091   3rd Qu.: 64006  
##  Max.   : 8.0000   Max.   : 8.0000   Max.   : 964511   Max.   :983931  
##                                                                        
##    BILL_AMT3         BILL_AMT4         BILL_AMT5        BILL_AMT6      
##  Min.   :-157264   Min.   :-170000   Min.   :-81334   Min.   :-339603  
##  1st Qu.:   2666   1st Qu.:   2327   1st Qu.:  1763   1st Qu.:   1256  
##  Median :  20089   Median :  19052   Median : 18105   Median :  17071  
##  Mean   :  47013   Mean   :  43263   Mean   : 40311   Mean   :  38872  
##  3rd Qu.:  60165   3rd Qu.:  54506   3rd Qu.: 50191   3rd Qu.:  49198  
##  Max.   :1664089   Max.   : 891586   Max.   :927171   Max.   : 961664  
##                                                                        
##     PAY_AMT1         PAY_AMT2          PAY_AMT3         PAY_AMT4     
##  Min.   :     0   Min.   :      0   Min.   :     0   Min.   :     0  
##  1st Qu.:  1000   1st Qu.:    833   1st Qu.:   390   1st Qu.:   296  
##  Median :  2100   Median :   2009   Median :  1800   Median :  1500  
##  Mean   :  5664   Mean   :   5921   Mean   :  5226   Mean   :  4826  
##  3rd Qu.:  5006   3rd Qu.:   5000   3rd Qu.:  4505   3rd Qu.:  4013  
##  Max.   :873552   Max.   :1684259   Max.   :896040   Max.   :621000  
##                                                                      
##     PAY_AMT5           PAY_AMT6        default.payment.next.month
##  Min.   :     0.0   Min.   :     0.0   Min.   :0.0000            
##  1st Qu.:   252.5   1st Qu.:   117.8   1st Qu.:0.0000            
##  Median :  1500.0   Median :  1500.0   Median :0.0000            
##  Mean   :  4799.4   Mean   :  5215.5   Mean   :0.2212            
##  3rd Qu.:  4031.5   3rd Qu.:  4000.0   3rd Qu.:0.0000            
##  Max.   :426529.0   Max.   :528666.0   Max.   :1.0000            
##

Se analiza la varible que sera dependiente en el modelo:

table(all_data$default.payment.next.month)

## 
##     0     1 
## 23364  6636

mean(all_data$default.payment.next.month)

## [1] 0.2212

La media es 0.221, ello quiere decir que hay un 22.1% de los contratos de tarjetas de credito que incumpliran el proximo mes.

Haremos uso de los modelo Logit ya que es un modelo que analisa variables dicotomicas, como la base de datos que se tiene.

MODELO LOGIT

El modelo logit es un modelo de regresión típico, \(Y=f(X+ε)\), en el que la variable respuesta (variable aleatoria Y) es dicotómica o binaria (toma dos valores: 0 y 1), habitualmente sobre si el individuo tiene una característica (1) o no (0), y las variables predictivas (vector aleatorio X) son continuas. El modelo logit es un caso particular de los llamados modelos lineales generalizados (GLMs, Generalized Linear Model).

Eleccion del mejor modelo que pueda explicar mejor al default.payment.next.month.Primero modelaremos con todas las variables, en este caso es un modelo lineal generalizado

modelo01  <- glm(default.payment.next.month ~ .,data = all_data, 
                family = binomial(link = "logit"))
summary(modelo01)

## 
## Call:
## glm(formula = default.payment.next.month ~ ., family = binomial(link = "logit"), 
##     data = all_data)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.1360  -0.7020  -0.5446  -0.2823   3.8693  
## 
## Coefficients:
##                   Estimate     Std. Error z value             Pr(>|z|)    
## (Intercept) -13.1098677275  82.4386671934  -0.159              0.87365    
## LIMIT_BAL    -0.0000006998   0.0000001578  -4.435        0.00000918995 ***
## SEX2         -0.1125473057   0.0307294362  -3.663              0.00025 ***
## EDUCATION1   10.8032174781  82.4370190102   0.131              0.89574    
## EDUCATION2   10.7186578628  82.4370193533   0.130              0.89655    
## EDUCATION3   10.6967653493  82.4370244363   0.130              0.89676    
## EDUCATION4    9.6558963456  82.4379629323   0.117              0.90676    
## EDUCATION5    9.4400204583  82.4374020911   0.115              0.90883    
## EDUCATION6   10.5007097809  82.4379975564   0.127              0.89864    
## MARRIAGE1     1.3193692317   0.5159761385   2.557              0.01056 *  
## MARRIAGE2     1.1304392031   0.5161274883   2.190              0.02851 *  
## MARRIAGE3     1.2406146704   0.5329097416   2.328              0.01991 *  
## AGE           0.0053722868   0.0018619598   2.885              0.00391 ** 
## PAY_0         0.5775622576   0.0177111945  32.610 < 0.0000000000000002 ***
## PAY_2         0.0815524098   0.0202014836   4.037        0.00005415025 ***
## PAY_3         0.0713238589   0.0226156524   3.154              0.00161 ** 
## PAY_4         0.0225008520   0.0250122334   0.900              0.36834    
## PAY_5         0.0343817876   0.0268899180   1.279              0.20103    
## PAY_6         0.0068923468   0.0221533280   0.311              0.75571    
## BILL_AMT1    -0.0000055130   0.0000011378  -4.845        0.00000126459 ***
## BILL_AMT2     0.0000024128   0.0000015050   1.603              0.10889    
## BILL_AMT3     0.0000013451   0.0000013233   1.016              0.30940    
## BILL_AMT4    -0.0000001405   0.0000013513  -0.104              0.91718    
## BILL_AMT5     0.0000007589   0.0000015207   0.499              0.61774    
## BILL_AMT6     0.0000001952   0.0000011943   0.163              0.87014    
## PAY_AMT1     -0.0000136444   0.0000023062  -5.916        0.00000000329 ***
## PAY_AMT2     -0.0000094930   0.0000020876  -4.547        0.00000543334 ***
## PAY_AMT3     -0.0000026410   0.0000017179  -1.537              0.12421    
## PAY_AMT4     -0.0000040687   0.0000017861  -2.278              0.02273 *  
## PAY_AMT5     -0.0000032130   0.0000017752  -1.810              0.07031 .  
## PAY_AMT6     -0.0000020923   0.0000012973  -1.613              0.10679    
## ---
## 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: 27827  on 29969  degrees of freedom
## AIC: 27889
## 
## Number of Fisher Scoring iterations: 11

Se puede observar que el AIC= 27889, es un creterio de informacion, tendra que ser comparado con otro AIC de otro modelo para elegir el mejor modelo que explique mejor la variable dependiente. Por otro lado, se puede analizar el p value de cada una de las variables independientes, para poder elegir las mejores variables que expliquen mejor al modelo, en este caso se tendria las siguientes variables que tienen un p- value menor al 0.05 lo cual no se aceptaria la Ho y se aceptaría la Hipotesis alterna que dichas variables si son significativas: Limit_bal, sex, marriage, age, pay_0, pay_2, pay_3, bill_amt1, pay_amt1, pay_amt2 y pay_amt4. Más adelante se correrá un modelo con dichas variables antes mencionadas, esperando que el AIC sea menor que el del modelo 1. Por último, se puede analizar los betas, estos son la pendiente o la velocidad de cambio de P(probabilidad) cuando varia x. Cuando beta es mas grande la velocidad es mayor, ello se analizará mas adelnate con mayor profunidad.

#TEST AIC: Se elije el modelo con el menor AIC

model.AIC <- stepAIC(modelo01)

## Start:  AIC=27889.26
## 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    27827 27887
## - BILL_AMT6  1    27827 27887
## - PAY_6      1    27827 27887
## - BILL_AMT5  1    27828 27888
## - PAY_4      1    27828 27888
## - BILL_AMT3  1    27828 27888
## - PAY_5      1    27829 27889
## <none>            27827 27889
## - PAY_AMT3   1    27830 27890
## - BILL_AMT2  1    27830 27890
## - PAY_AMT6   1    27830 27890
## - PAY_AMT5   1    27831 27891
## - PAY_AMT4   1    27833 27893
## - AGE        1    27836 27896
## - PAY_3      1    27837 27897
## - SEX        1    27841 27901
## - PAY_2      1    27844 27904
## - LIMIT_BAL  1    27847 27907
## - PAY_AMT2   1    27853 27913
## - BILL_AMT1  1    27854 27914
## - MARRIAGE   3    27865 27921
## - PAY_AMT1   1    27874 27934
## - EDUCATION  6    27887 27937
## - PAY_0      1    28886 28946
## 
## Step:  AIC=27887.27
## 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_AMT6  1    27827 27885
## - PAY_6      1    27827 27885
## - BILL_AMT5  1    27828 27886
## - PAY_4      1    27828 27886
## - BILL_AMT3  1    27828 27886
## - PAY_5      1    27829 27887
## <none>            27827 27887
## - BILL_AMT2  1    27830 27888
## - PAY_AMT6   1    27830 27888
## - PAY_AMT3   1    27831 27889
## - PAY_AMT5   1    27831 27889
## - PAY_AMT4   1    27834 27892
## - AGE        1    27836 27894
## - PAY_3      1    27837 27895
## - SEX        1    27841 27899
## - PAY_2      1    27844 27902
## - LIMIT_BAL  1    27847 27905
## - PAY_AMT2   1    27853 27911
## - BILL_AMT1  1    27854 27912
## - MARRIAGE   3    27865 27919
## - PAY_AMT1   1    27874 27932
## - EDUCATION  6    27887 27935
## - PAY_0      1    28886 28944
## 
## Step:  AIC=27885.29
## 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 + PAY_AMT1 + PAY_AMT2 + 
##     PAY_AMT3 + PAY_AMT4 + PAY_AMT5 + PAY_AMT6
## 
##             Df Deviance   AIC
## - PAY_6      1    27827 27883
## - PAY_4      1    27828 27884
## - BILL_AMT3  1    27829 27885
## - BILL_AMT5  1    27829 27885
## - PAY_5      1    27829 27885
## <none>            27827 27885
## - BILL_AMT2  1    27830 27886
## - PAY_AMT6   1    27830 27886
## - PAY_AMT3   1    27831 27887
## - PAY_AMT5   1    27832 27888
## - PAY_AMT4   1    27834 27890
## - AGE        1    27836 27892
## - PAY_3      1    27837 27893
## - SEX        1    27841 27897
## - PAY_2      1    27844 27900
## - LIMIT_BAL  1    27847 27903
## - PAY_AMT2   1    27853 27909
## - BILL_AMT1  1    27854 27910
## - MARRIAGE   3    27865 27917
## - PAY_AMT1   1    27874 27930
## - EDUCATION  6    27887 27933
## - PAY_0      1    28886 28942
## 
## Step:  AIC=27883.4
## default.payment.next.month ~ LIMIT_BAL + SEX + EDUCATION + MARRIAGE + 
##     AGE + PAY_0 + PAY_2 + PAY_3 + PAY_4 + PAY_5 + BILL_AMT1 + 
##     BILL_AMT2 + BILL_AMT3 + BILL_AMT5 + PAY_AMT1 + PAY_AMT2 + 
##     PAY_AMT3 + PAY_AMT4 + PAY_AMT5 + PAY_AMT6
## 
##             Df Deviance   AIC
## - PAY_4      1    27828 27882
## - BILL_AMT3  1    27829 27883
## - BILL_AMT5  1    27829 27883
## <none>            27827 27883
## - BILL_AMT2  1    27830 27884
## - PAY_AMT6   1    27830 27884
## - PAY_5      1    27830 27884
## - PAY_AMT3   1    27831 27885
## - PAY_AMT5   1    27832 27886
## - PAY_AMT4   1    27834 27888
## - AGE        1    27836 27890
## - PAY_3      1    27837 27891
## - SEX        1    27841 27895
## - PAY_2      1    27844 27898
## - LIMIT_BAL  1    27848 27902
## - PAY_AMT2   1    27853 27907
## - BILL_AMT1  1    27855 27909
## - MARRIAGE   3    27865 27915
## - PAY_AMT1   1    27875 27929
## - EDUCATION  6    27887 27931
## - PAY_0      1    28888 28942
## 
## Step:  AIC=27882.24
## default.payment.next.month ~ LIMIT_BAL + SEX + EDUCATION + MARRIAGE + 
##     AGE + PAY_0 + PAY_2 + PAY_3 + PAY_5 + BILL_AMT1 + BILL_AMT2 + 
##     BILL_AMT3 + BILL_AMT5 + PAY_AMT1 + PAY_AMT2 + PAY_AMT3 + 
##     PAY_AMT4 + PAY_AMT5 + PAY_AMT6
## 
##             Df Deviance   AIC
## - BILL_AMT3  1    27830 27882
## - BILL_AMT5  1    27830 27882
## <none>            27828 27882
## - BILL_AMT2  1    27831 27883
## - PAY_AMT6   1    27831 27883
## - PAY_AMT3   1    27832 27884
## - PAY_AMT5   1    27833 27885
## - PAY_AMT4   1    27835 27887
## - PAY_5      1    27837 27889
## - AGE        1    27837 27889
## - SEX        1    27842 27894
## - PAY_3      1    27844 27896
## - PAY_2      1    27845 27897
## - LIMIT_BAL  1    27849 27901
## - PAY_AMT2   1    27854 27906
## - BILL_AMT1  1    27856 27908
## - MARRIAGE   3    27866 27914
## - PAY_AMT1   1    27876 27928
## - EDUCATION  6    27888 27930
## - PAY_0      1    28897 28949
## 
## Step:  AIC=27881.48
## default.payment.next.month ~ LIMIT_BAL + SEX + EDUCATION + MARRIAGE + 
##     AGE + PAY_0 + PAY_2 + PAY_3 + PAY_5 + BILL_AMT1 + BILL_AMT2 + 
##     BILL_AMT5 + PAY_AMT1 + PAY_AMT2 + PAY_AMT3 + PAY_AMT4 + PAY_AMT5 + 
##     PAY_AMT6
## 
##             Df Deviance   AIC
## <none>            27830 27882
## - PAY_AMT6   1    27832 27882
## - BILL_AMT5  1    27834 27884
## - PAY_AMT5   1    27834 27884
## - PAY_AMT3   1    27835 27885
## - BILL_AMT2  1    27836 27886
## - PAY_AMT4   1    27838 27888
## - PAY_5      1    27838 27888
## - AGE        1    27838 27888
## - SEX        1    27843 27893
## - PAY_3      1    27845 27895
## - PAY_2      1    27846 27896
## - LIMIT_BAL  1    27850 27900
## - PAY_AMT2   1    27857 27907
## - BILL_AMT1  1    27857 27907
## - MARRIAGE   3    27867 27913
## - PAY_AMT1   1    27878 27928
## - EDUCATION  6    27889 27929
## - PAY_0      1    28898 28948

summary(model.AIC)

## 
## Call:
## glm(formula = default.payment.next.month ~ LIMIT_BAL + SEX + 
##     EDUCATION + MARRIAGE + AGE + PAY_0 + PAY_2 + PAY_3 + PAY_5 + 
##     BILL_AMT1 + BILL_AMT2 + BILL_AMT5 + PAY_AMT1 + PAY_AMT2 + 
##     PAY_AMT3 + PAY_AMT4 + PAY_AMT5 + PAY_AMT6, family = binomial(link = "logit"), 
##     data = all_data)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.1366  -0.7018  -0.5444  -0.2818   3.8921  
## 
## Coefficients:
##                   Estimate     Std. Error z value             Pr(>|z|)    
## (Intercept) -13.1120464286  82.3982253802  -0.159             0.873566    
## LIMIT_BAL    -0.0000007101   0.0000001573  -4.514        0.00000637379 ***
## SEX2         -0.1123797642   0.0307240996  -3.658             0.000254 ***
## EDUCATION1   10.8007604556  82.3965760071   0.131             0.895710    
## EDUCATION2   10.7165631107  82.3965763766   0.130             0.896518    
## EDUCATION3   10.6948219315  82.3965815183   0.130             0.896727    
## EDUCATION4    9.6530316120  82.3975208560   0.117             0.906740    
## EDUCATION5    9.4356863571  82.3969595030   0.115             0.908830    
## EDUCATION6   10.5020932398  82.3975545437   0.127             0.898579    
## MARRIAGE1     1.3226791073   0.5160476660   2.563             0.010374 *  
## MARRIAGE2     1.1337218775   0.5161999893   2.196             0.028072 *  
## MARRIAGE3     1.2456734652   0.5329695761   2.337             0.019427 *  
## AGE           0.0053935893   0.0018617771   2.897             0.003767 ** 
## PAY_0         0.5785344772   0.0176741401  32.733 < 0.0000000000000002 ***
## PAY_2         0.0813300144   0.0201746163   4.031        0.00005546821 ***
## PAY_3         0.0812594767   0.0203432758   3.994        0.00006485431 ***
## PAY_5         0.0515534839   0.0179029769   2.880             0.003982 ** 
## BILL_AMT1    -0.0000054973   0.0000011307  -4.862        0.00000116410 ***
## BILL_AMT2     0.0000032301   0.0000012842   2.515             0.011893 *  
## BILL_AMT5     0.0000013345   0.0000006637   2.011             0.044363 *  
## PAY_AMT1     -0.0000137782   0.0000023038  -5.981        0.00000000222 ***
## PAY_AMT2     -0.0000083444   0.0000018525  -4.504        0.00000665582 ***
## PAY_AMT3     -0.0000033216   0.0000015241  -2.179             0.029303 *  
## PAY_AMT4     -0.0000043035   0.0000016189  -2.658             0.007852 ** 
## PAY_AMT5     -0.0000030598   0.0000015047  -2.033             0.042005 *  
## PAY_AMT6     -0.0000021011   0.0000012781  -1.644             0.100207    
## ---
## 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: 27829  on 29974  degrees of freedom
## AIC: 27881
## 
## Number of Fisher Scoring iterations: 11

yhat01<-model.AIC$fitted.values
hist(yhat01)

Cuando realizamos un resumen del modelo AIC, se puede observar que este AIC= 27881 este es menor al AIC del modelo01 que tomaba todas las variables, Ahora lo que se buscara más adelante es un modelo con un AIC menor al de este modelo, pero que solo sontenga 5 variables.

#(ESPECIFICIDAD Y SENSIBILIDAD)

Recordar, que se require maximizar la especifidad y sensibilidad El punto maximo evaluado en distintos puntos de corte y el punto maximo es el punto donde se cruzan.

c1<-seq(0.02,0.4,by=0.001)
sens1<-c()
spec1<-c()
for (i in 1:length(c1)){
  y.pred1<-ifelse(model.AIC$fitted.values > c1[i], yes = 1, no = 0) 
  spec1[i]<-prop.table(table(all_data$default.payment.next.month,y.pred1),1)[1]
  sens1[i]<-prop.table(table(all_data$default.payment.next.month,y.pred1),1)[4]
}

o.cut1<-mean(c1[which(round(spec1,1)==round(sens1,1))],na.rm = T)
plot(c1,sens1,type="l",col=2,main=c("Especificidad vs Sensibilidad"),ylab=c("Especificidad/Sensibilidad"))
lines(c1,spec1,col=3)

#Se observa el punto donde se cruzan :

abline(v=o.cut1)

print(o.cut1)

## [1] 0.217

o.cut1

## [1] 0.217

#Se evalua la mtriz de confusion para interpretar la especificidad y la sensibilidad.

y.pred1<-ifelse(model.AIC$fitted.values > o.cut1, yes = 1, no = 0) 
matriz_confusion1 <- table(all_data$default.payment.next.month, y.pred1,
                          dnn = c("observaciones", "predicciones"))

matriz_confusion1

##              predicciones
## observaciones     0     1
##             0 15714  7650
##             1  2246  4390

prop.table(matriz_confusion1,1)

##              predicciones
## observaciones         0         1
##             0 0.6725732 0.3274268
##             1 0.3384569 0.6615431

Se observa la matriz de confusion de la cual se puede decir lo siguiente: Si el modelo es correcto en prediccion se tendra la prediccion correcta de fracasos y exitos. La especificidad se interpreta de la siguiente manera: con el modelo que se ha elejido hasta ahora se tiene un 67% probabilidad de fracaso, en este caso 0= no default, por ello se puede decir que exite un 67% de probabilidad de que no se entre en default en proximo mes, de acuerdo a las variables tomadas para dicha prediccion. La sensibilidad se interpreta de la siguiente manera: con el modelo que se ha elejido hasta el momento se tiene un 66% de probabilidad de exito, en este caso exito se definio como default, existe un 66% de probabilidad que se incumpla los pagos para el proximo mes, de acuerdo a las variables tomadas para dicha prediccion.

#AREA BAJO LA CURVA ROC

roc<- roc(all_data$default.payment.next.month,yhat01)

roc

## 
## Call:
## roc.default(response = all_data$default.payment.next.month, predictor = yhat01)
## 
## Data: yhat01 in 23364 controls (all_data$default.payment.next.month 0) < 6636 cases (all_data$default.payment.next.month 1).
## Area under the curve: 0.726

plot(roc,main=c("Curva ROC"))

El area bajo la curva es 0.726, por ello decimos que es media aceptable, se esperaria que sa mayor a 0.90 para que se acepte completamente que si se hizo una buena prediccion. Es mejor cuando esta pegado a 1.

SEGUNDO MODELO

Ahora se procedera a buscar un mejor modelo con el cual se pueda predecir mejor, que contenga solo 5 variables de las 25.

ANALISIS DE LAS VARIABLES

#GENERO VS default.payment.next.month

plot1 <- ggplot(data = data, aes(x=factor(SEX), fill =factor(default.payment.next.month))) +
  geom_bar() +
  ylab("Observations count") +
  scale_x_discrete(labels = c('Male','Female')) +
  xlab("")

plot1

En el grafico se pude observar la probabilidad de exito=1 default o la prob de fracaso =0 no default, vemos como se distribuye por generos donde habido mas creditos a las mujeres y segun el grafico mostrado hay mas probabilidad que las mujeres no pagen, ello quiere decir que entren en default.

#DISTRIBUCION DE HOMBRES Y MUJERES

plot2 <- ggplot(data = datos, aes(x=factor(EDUCATION), fill =factor(SEX))) +
  geom_bar() +
  ylab("Observations count") +
  xlab("(1=graduate school, 2=university, 3=high school, 4=others, 5=unknown, 6=unknown)") 

plot2

En niveles educativos mas bajos hay mas mujeres, lo cual tiene sentido, por ello hoy en dia se aplica la inclusion financiera:tema de brechas de genero en acceso al credito y su correlacion con el tema educativo.

Se puede decir que estas dos variables estan correlacionadas, por lo tanto tienen que ir ambas en nuestro nuevo modelo.

#GENERO VS default.payment.next.month

plot3 <- ggplot(data = data, aes(x=factor(MARRIAGE), fill =factor(default.payment.next.month))) +
  geom_bar() +
  ylab("Observations count") +
  scale_x_discrete(labels = c('1=married', '2=single', '3=others')) +
  xlab("")

plot3

En el grafico se puede observar que los solteros y otros son los que tienen más tarjetas de credito y hay más probabilidad de default en otros, para nuestro analisi es muy importante tener en cuenta que de la variable Marriage nos interesa mas que nada los solteros y otros.

#DISTRIBUCION POR EDAD

plot4<-ggplot(data = data, aes(x = AGE)) + 
  geom_histogram(bins = 50, fill = "purple", col = "blue", alpha = 0.3) + 
  scale_x_continuous(breaks = seq(min(0), max(90), by = 5), na.value = TRUE)

plot4

En el siguiente grafico se puede observar que la edad promedio que tiene mas tarjetas de credito es aprox las personas que tienen 30 años de edad, por lo cual se puede decir que ellos serian los que tendrian más probabiidad de impagos.

Ello tambien se puede observar en el siguiente grafico: Gráfico de conteo para determinar qué grupo de edad tiene más saldo límite

theme_set(theme_bw())  
g <- ggplot(data =data, aes(x = AGE, y = LIMIT_BAL))
g + geom_count(col="blue", show.legend=F) +
  labs(title="Counts Plot", 
       subtitle="Age Vs Credit Amount", 
       caption="source: UCI Credit Card")

#Analisis de las variables cuantitativas

categorical = c('SEX','EDUCATION', 'MARRIAGE',
               colnames(all_data)[grep("PAY_\\d", colnames(all_data))])

# Creamos una tabla de datos para las variables cuantitativas

quanti = all_data[, !colnames(all_data) %in% categorical]
df = cbind.data.frame(quanti, target = all_data$default.payment.next.month)

# Se crea una tabala de variables categoricas

quali = all_data[,categorical]
summary(quali)

##  SEX       EDUCATION MARRIAGE      PAY_0             PAY_2        
##  1:11888   0:   14   0:   54   Min.   :-2.0000   Min.   :-2.0000  
##  2:18112   1:10585   1:13659   1st Qu.:-1.0000   1st Qu.:-1.0000  
##            2:14030   2:15964   Median : 0.0000   Median : 0.0000  
##            3: 4917   3:  323   Mean   :-0.0167   Mean   :-0.1338  
##            4:  123             3rd Qu.: 0.0000   3rd Qu.: 0.0000  
##            5:  280             Max.   : 8.0000   Max.   : 8.0000  
##            6:   51                                                
##      PAY_3             PAY_4             PAY_5             PAY_6        
##  Min.   :-2.0000   Min.   :-2.0000   Min.   :-2.0000   Min.   :-2.0000  
##  1st Qu.:-1.0000   1st Qu.:-1.0000   1st Qu.:-1.0000   1st Qu.:-1.0000  
##  Median : 0.0000   Median : 0.0000   Median : 0.0000   Median : 0.0000  
##  Mean   :-0.1662   Mean   :-0.2207   Mean   :-0.2662   Mean   :-0.2911  
##  3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.: 0.0000   3rd Qu.: 0.0000  
##  Max.   : 8.0000   Max.   : 8.0000   Max.   : 8.0000   Max.   : 8.0000  
##

df.melt = melt(df, id.vars = 'target')

Density Plots

ggplot(data = df.melt, aes(x = value)) +
 facet_wrap(~variable, scales = "free") +
 #theme_minimal() +
 theme(axis.text.x=element_blank())+
 geom_density(aes(fill = target),alpha = .5)+
 ggtitle("Density Plots")

Gráficos de densidad: en cuanto a densidad, estas variables tal como están no serán de mucha ayuda. No discriminan tanto la variable objetivo. Crear variables definitivamente será útil, pero en este caso se hará eso, solo se escojera 5 variables que mejor predigan el default para el proximo mes.

Violin plots

dodge = position_dodge(width = 2)
ggplot(df.melt, aes(x=variable, y=value,fill=target))+
    geom_violin(width = 3,position = dodge) +
    geom_boxplot(width = 0.5,position = dodge)+
    labs(x="features", y = "values")+
    facet_wrap(~variable, scales = "free") +
    ggtitle("Violin Plot") +
    theme(axis.text.x=element_blank())

Las variables que parecen tener el mejor corte entre default/ no default son las variables PAY_AMTX. El comportamiento observado es el siguiente: Si bien el monto de la factura se distribuye de la misma manera entre los valores default/ no default, el monto del pago es significativamente menor entre los valores default. Ahora, también podemos resaltar que hay cantidades de facturas negativas que se corresponden con pagos muy altos, supongo (para verificar dos veces). Entonces, si bien las variables BILL_AMTX son absolutamente feas e inutilizables, podrian servir para algun otro trabajo de mayor analisis para crear nuevas variables que nos permitirán saber cuándo los pagos de alguien no coinciden con el monto de su factura.

ELECCION DEL MODELO

Dado a lo analizado lineas arriba ahora se tiene una idea mas clara de que variables se podria elegir.

Además, se tomará en cuenta el summary del modelo01, donde se puede ver que variables son significativas.

summary(modelo01)

## 
## Call:
## glm(formula = default.payment.next.month ~ ., family = binomial(link = "logit"), 
##     data = all_data)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.1360  -0.7020  -0.5446  -0.2823   3.8693  
## 
## Coefficients:
##                   Estimate     Std. Error z value             Pr(>|z|)    
## (Intercept) -13.1098677275  82.4386671934  -0.159              0.87365    
## LIMIT_BAL    -0.0000006998   0.0000001578  -4.435        0.00000918995 ***
## SEX2         -0.1125473057   0.0307294362  -3.663              0.00025 ***
## EDUCATION1   10.8032174781  82.4370190102   0.131              0.89574    
## EDUCATION2   10.7186578628  82.4370193533   0.130              0.89655    
## EDUCATION3   10.6967653493  82.4370244363   0.130              0.89676    
## EDUCATION4    9.6558963456  82.4379629323   0.117              0.90676    
## EDUCATION5    9.4400204583  82.4374020911   0.115              0.90883    
## EDUCATION6   10.5007097809  82.4379975564   0.127              0.89864    
## MARRIAGE1     1.3193692317   0.5159761385   2.557              0.01056 *  
## MARRIAGE2     1.1304392031   0.5161274883   2.190              0.02851 *  
## MARRIAGE3     1.2406146704   0.5329097416   2.328              0.01991 *  
## AGE           0.0053722868   0.0018619598   2.885              0.00391 ** 
## PAY_0         0.5775622576   0.0177111945  32.610 < 0.0000000000000002 ***
## PAY_2         0.0815524098   0.0202014836   4.037        0.00005415025 ***
## PAY_3         0.0713238589   0.0226156524   3.154              0.00161 ** 
## PAY_4         0.0225008520   0.0250122334   0.900              0.36834    
## PAY_5         0.0343817876   0.0268899180   1.279              0.20103    
## PAY_6         0.0068923468   0.0221533280   0.311              0.75571    
## BILL_AMT1    -0.0000055130   0.0000011378  -4.845        0.00000126459 ***
## BILL_AMT2     0.0000024128   0.0000015050   1.603              0.10889    
## BILL_AMT3     0.0000013451   0.0000013233   1.016              0.30940    
## BILL_AMT4    -0.0000001405   0.0000013513  -0.104              0.91718    
## BILL_AMT5     0.0000007589   0.0000015207   0.499              0.61774    
## BILL_AMT6     0.0000001952   0.0000011943   0.163              0.87014    
## PAY_AMT1     -0.0000136444   0.0000023062  -5.916        0.00000000329 ***
## PAY_AMT2     -0.0000094930   0.0000020876  -4.547        0.00000543334 ***
## PAY_AMT3     -0.0000026410   0.0000017179  -1.537              0.12421    
## PAY_AMT4     -0.0000040687   0.0000017861  -2.278              0.02273 *  
## PAY_AMT5     -0.0000032130   0.0000017752  -1.810              0.07031 .  
## PAY_AMT6     -0.0000020923   0.0000012973  -1.613              0.10679    
## ---
## 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: 27827  on 29969  degrees of freedom
## AIC: 27889
## 
## Number of Fisher Scoring iterations: 11

Como se habia mencionada antes las variables mas significativas son las siguientes: Limit_bal, sex, marriage, eduaction, age, pay_0, pay_2, pay_3, bill_amt1, pay_amt1, pay_amt2 y pay_amt4. Ahora se va a correr modelos con esas variables, pero tomando solo 5 de ellas y se vera cual de esos modelos tiene un mejor criterio de informacion, este se esperaria que sea menor a 27889 y tambien se esperaria que sea menor al AIC del modelAIC que fue igual a 27886, pero es muy poco probable que ello suceda ya que 5 variables son muy pocas y ademas que se tendria que realizar ciertos cambios a las variables para que predigan mejor.

Modelo2

XB <- as.formula("default.payment.next.month ~ LIMIT_BAL+ factor(SEX)+factor(MARRIAGE)+factor(EDUCATION)+PAY_0")
modelo2  <- glm(XB,data = all_data)
summary(modelo2)#aqui tambien se pueden ver los betas

## 
## Call:
## glm(formula = XB, data = all_data)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.1720  -0.2437  -0.1707   0.0306   1.1278  
## 
## Coefficients:
##                          Estimate     Std. Error t value             Pr(>|t|)
## (Intercept)         0.00769585811  0.11737860413   0.066             0.947725
## LIMIT_BAL          -0.00000025161  0.00000001883 -13.362 < 0.0000000000000002
## factor(SEX)2       -0.01781226199  0.00462529665  -3.851             0.000118
## factor(MARRIAGE)1   0.13837721132  0.05341297624   2.591             0.009583
## factor(MARRIAGE)2   0.09972189759  0.05344158838   1.866             0.062051
## factor(MARRIAGE)3   0.12069707993  0.05754271800   2.098             0.035956
## factor(EDUCATION)1  0.16163239312  0.10449660183   1.547             0.121929
## factor(EDUCATION)2  0.14738532083  0.10449768215   1.410             0.158427
## factor(EDUCATION)3  0.14963882404  0.10460720203   1.430             0.152589
## factor(EDUCATION)4  0.05659822798  0.11021384825   0.514             0.607584
## factor(EDUCATION)5  0.00366259186  0.10702079663   0.034             0.972699
## factor(EDUCATION)6  0.09361101503  0.11790747588   0.794             0.427239
## PAY_0               0.11238571620  0.00209637308  53.610 < 0.0000000000000002
##                       
## (Intercept)           
## LIMIT_BAL          ***
## factor(SEX)2       ***
## factor(MARRIAGE)1  ** 
## factor(MARRIAGE)2  .  
## factor(MARRIAGE)3  *  
## factor(EDUCATION)1    
## factor(EDUCATION)2    
## factor(EDUCATION)3    
## factor(EDUCATION)4    
## factor(EDUCATION)5    
## factor(EDUCATION)6    
## PAY_0              ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.1526576)
## 
##     Null deviance: 5168.1  on 29999  degrees of freedom
## Residual deviance: 4577.7  on 29987  degrees of freedom
## AIC: 28765
## 
## Number of Fisher Scoring iterations: 2

Se observa el modelo dos que nos da un AIC= 28765 este es muy cercado al AIC del modelaic.

Modelo3

XB1 <- as.formula("default.payment.next.month ~ LIMIT_BAL+ factor(SEX)+factor(EDUCATION)+PAY_0+ PAY_AMT1")
modelo3  <- glm(XB1,data = all_data)
summary(modelo3)

## 
## Call:
## glm(formula = XB1, data = all_data)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.16953  -0.24340  -0.17434   0.02574   1.13507  
## 
## Coefficients:
##                          Estimate     Std. Error t value             Pr(>|t|)
## (Intercept)         0.11371362514  0.10456177751   1.088               0.2768
## LIMIT_BAL          -0.00000020676  0.00000001892 -10.929 < 0.0000000000000002
## factor(SEX)2       -0.01720541557  0.00462584564  -3.719               0.0002
## factor(EDUCATION)1  0.16519506138  0.10454509646   1.580               0.1141
## factor(EDUCATION)2  0.15785328635  0.10454023119   1.510               0.1311
## factor(EDUCATION)3  0.16384393806  0.10464088057   1.566               0.1174
## factor(EDUCATION)4  0.06164540256  0.11026216830   0.559               0.5761
## factor(EDUCATION)5  0.01577064936  0.10706293698   0.147               0.8829
## factor(EDUCATION)6  0.11127917852  0.11795297158   0.943               0.3455
## PAY_0               0.11201317377  0.00209808726  53.388 < 0.0000000000000002
## PAY_AMT1           -0.00000091427  0.00000013900  -6.577      0.0000000000487
##                       
## (Intercept)           
## LIMIT_BAL          ***
## factor(SEX)2       ***
## factor(EDUCATION)1    
## factor(EDUCATION)2    
## factor(EDUCATION)3    
## factor(EDUCATION)4    
## factor(EDUCATION)5    
## factor(EDUCATION)6    
## PAY_0              ***
## PAY_AMT1           ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.1528006)
## 
##     Null deviance: 5168.1  on 29999  degrees of freedom
## Residual deviance: 4582.3  on 29989  degrees of freedom
## AIC: 28791
## 
## Number of Fisher Scoring iterations: 2

En este modelo quitamos la variable mariagge y añadimos pay_amt1, que es el monto del pago anterior en septiembre de 2005 (dólar NT), pero el AIC que tenemos en este caso es mayor al anterior, por lo cual se descarta este modelo.

Modelo4

XB4 <- as.formula("default.payment.next.month ~ LIMIT_BAL+ factor(SEX)+factor(MARRIAGE) + factor(EDUCATION)+ PAY_AMT1")
modelo4  <- glm(XB4,data = all_data)
summary(modelo4)

## 
## Call:
## glm(formula = XB4, data = all_data)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -0.34642  -0.25671  -0.19921  -0.06244   1.27052  
## 
## Coefficients:
##                          Estimate     Std. Error t value             Pr(>|t|)
## (Intercept)        -0.01568850788  0.12275543570  -0.128              0.89831
## LIMIT_BAL          -0.00000046477  0.00000001948 -23.865 < 0.0000000000000002
## factor(SEX)2       -0.03169922750  0.00482983297  -6.563   0.0000000000535184
## factor(MARRIAGE)1   0.16376023290  0.05585877375   2.932              0.00337
## factor(MARRIAGE)2   0.12599969196  0.05588815518   2.254              0.02417
## factor(MARRIAGE)3   0.15015232570  0.06017598873   2.495              0.01259
## factor(EDUCATION)1  0.19384703347  0.10928192062   1.774              0.07610
## factor(EDUCATION)2  0.20193858150  0.10927976624   1.848              0.06463
## factor(EDUCATION)3  0.20299797709  0.10939465161   1.856              0.06351
## factor(EDUCATION)4  0.05963055957  0.11526267130   0.517              0.60492
## factor(EDUCATION)5  0.03920926701  0.11192155375   0.350              0.72609
## factor(EDUCATION)6  0.12077332798  0.12331073635   0.979              0.32738
## PAY_AMT1           -0.00000110875  0.00000014529  -7.631   0.0000000000000239
##                       
## (Intercept)           
## LIMIT_BAL          ***
## factor(SEX)2       ***
## factor(MARRIAGE)1  ** 
## factor(MARRIAGE)2  *  
## factor(MARRIAGE)3  *  
## factor(EDUCATION)1 .  
## factor(EDUCATION)2 .  
## factor(EDUCATION)3 .  
## factor(EDUCATION)4    
## factor(EDUCATION)5    
## factor(EDUCATION)6    
## PAY_AMT1           ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.1669643)
## 
##     Null deviance: 5168.1  on 29999  degrees of freedom
## Residual deviance: 5006.8  on 29987  degrees of freedom
## AIC: 31452
## 
## Number of Fisher Scoring iterations: 2

En este modelo el AIC es muchisimo mayor al modelo2. AIC: 31452, se descarta el modelo.

Modelo5

XB5 <- as.formula("default.payment.next.month ~  factor(SEX)+factor(MARRIAGE) + factor(EDUCATION)+ PAY_0+ PAY_AMT1")
modelo5  <- glm(XB5,data = all_data)
summary(modelo5)

## 
## Call:
## glm(formula = XB5, data = all_data)
## 
## Deviance Residuals: 
##      Min        1Q    Median        3Q       Max  
## -1.18930  -0.23488  -0.20116   0.02597   1.14931  
## 
## Coefficients:
##                        Estimate   Std. Error t value             Pr(>|t|)    
## (Intercept)        -0.033372713  0.117522013  -0.284               0.7764    
## factor(SEX)2       -0.018745112  0.004632848  -4.046            0.0000522 ***
## factor(MARRIAGE)1   0.128884689  0.053502504   2.409               0.0160 *  
## factor(MARRIAGE)2   0.098817536  0.053533628   1.846               0.0649 .  
## factor(MARRIAGE)3   0.130390047  0.057635226   2.262               0.0237 *  
## factor(EDUCATION)1  0.162910304  0.104674589   1.556               0.1196    
## factor(EDUCATION)2  0.162515653  0.104669121   1.553               0.1205    
## factor(EDUCATION)3  0.170190352  0.104773194   1.624               0.1043    
## factor(EDUCATION)4  0.056217473  0.110401485   0.509               0.6106    
## factor(EDUCATION)5  0.016219160  0.107199100   0.151               0.8797    
## factor(EDUCATION)6  0.115703880  0.118102310   0.980               0.3272    
## PAY_0               0.117792366  0.002044408  57.617 < 0.0000000000000002 ***
## PAY_AMT1           -0.000001195  0.000000137  -8.723 < 0.0000000000000002 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for gaussian family taken to be 0.1531778)
## 
##     Null deviance: 5168.1  on 29999  degrees of freedom
## Residual deviance: 4593.3  on 29987  degrees of freedom
## AIC: 28867
## 
## Number of Fisher Scoring iterations: 2

En este modelo se obserca que el AIC es igual a 28867 este que el del modelo2 y cercano al AIC del modeloaic que tenia un AIC= 278896.

Por lo tanto nos quedaremos con este modelo ya que tiene un menor AIC.

Analisis del Modelo elegigo

En R, los GLMs se ajustan con la función glm. La principal diferencia con la función lm para ajustar modelos lineales es que le tenemos que proporcionar la familia de la distribución. En nuestro caso, como es una variable dicotómica, la familia es la binomial:

XB5 <- as.formula("default.payment.next.month ~  factor(SEX)+factor(MARRIAGE) + factor(EDUCATION)+ PAY_0+ PAY_AMT1")
modelo5  <- glm(XB5,data = all_data, family = binomial(link="logit"))
summary(modelo5)

## 
## Call:
## glm(formula = XB5, family = binomial(link = "logit"), data = all_data)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -3.0001  -0.6877  -0.5945  -0.3163   3.9966  
## 
## Coefficients:
##                        Estimate   Std. Error z value             Pr(>|z|)    
## (Intercept)        -13.26356461  81.90591803  -0.162               0.8714    
## factor(SEX)2        -0.13629606   0.03010537  -4.527           0.00000597 ***
## factor(MARRIAGE)1    1.22279855   0.51208716   2.388               0.0169 *  
## factor(MARRIAGE)2    1.04480750   0.51225431   2.040               0.0414 *  
## factor(MARRIAGE)3    1.23761156   0.52873890   2.341               0.0192 *  
## factor(EDUCATION)1  10.90596462  81.90431929   0.133               0.8941    
## factor(EDUCATION)2  10.93029186  81.90431843   0.133               0.8938    
## factor(EDUCATION)3  10.96582934  81.90432374   0.134               0.8935    
## factor(EDUCATION)4   9.64599020  81.90527369   0.118               0.9062    
## factor(EDUCATION)5   9.49410026  81.90470321   0.116               0.9077    
## factor(EDUCATION)6  10.61205849  81.90529716   0.130               0.8969    
## PAY_0                0.71255870   0.01443441  49.365 < 0.0000000000000002 ***
## PAY_AMT1            -0.00002187   0.00000231  -9.466 < 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: 28253  on 29987  degrees of freedom
## AIC: 28279
## 
## Number of Fisher Scoring iterations: 11

La interpretación de los p-valores es similar a la del modelo lineal. Podemos ver que la variable education no es significativa en el modelo (p-valor mucho mayor de 0.05), mientras que las demas variables si lo son.

En cuanto a los coeficientes, la interpretación cambia. El modelo GLM no ajusta la variable respuesta sino una función de enlace. En el caso del modelo logit esta función es: \(η=log(p/1−p)\)

siendo p la probabilidad de que el default for the next month tome el valor “1” que en este caso es default en la variable dicotómica. Al cociente p/p1−p se le conoce como odds ratio. Por tanto, los coeficientes del modelo logit se interpretan como el logaritmo del odds ratio. Si nos fijamos en el coeficiente de la variable SEX (-0.136), nos está indicando que el logaritmo del odds ratio de caer en default disminuye 0.136 unidades por cada unidad que aumente los creditos a las mujeres.

Una forma de faciliar la interpretación de los coeficientes es exponenciando:

exp(coefficients(modelo5))

##        (Intercept)       factor(SEX)2  factor(MARRIAGE)1  factor(MARRIAGE)2 
##     0.000001736629     0.872584260662     3.396680219429     2.842851218305 
##  factor(MARRIAGE)3 factor(EDUCATION)1 factor(EDUCATION)2 factor(EDUCATION)3 
##     3.447369793668 54500.470986489156 55842.575823517080 57862.763495435276 
## factor(EDUCATION)4 factor(EDUCATION)5 factor(EDUCATION)6              PAY_0 
## 15459.673523575857 13281.139945745879 40621.732718319559     2.039202294471 
##           PAY_AMT1 
##     0.999978128884

Que se corresponde con este modelo:

\(odds=e^(β_0)⋅e^(β_1x_1)⋅e^(β_2x_2)\)

Lo que nos viene a decir que aumentar en el factor(sex)2 un punto o que en otras palabras una mujer pida un credito mas disminuye un 13% las posibilidades de caer en default el proximo mes, mientras que aumentar un punto PAY_AMT1,las reduce casi un 1% aproximadamente la posibilidad de caer en default.

Para cuncluir, los betas son la pendiente o velocidad de cambio de P cuando varia una variable, cuando mas grande es beta la velocidad de cambio es mayor.

Ratio de odds

Por último, una interpretación probabilística sería estimar la probabilidad p de caer en default el proximo mes de acuerdo a cada variable:

\(p=e^η/1+e^η\)

Así, podemos predecir la función \(η\) :

#PROBABILIDAD segun sexo
exp(-0.13629)-1

## [1] -0.1274105

exp(-0.13629)/(1+exp(-0.13629))

## [1] 0.4659801

#PROBABILIDAD segun PAY_ATM1
exp(-0.00002187)-1

## [1] -0.00002186976

exp(-0.00002187)/(1+exp(-0.00002187))

## [1] 0.4999945

#PROBABILIDAD segun PAY_0
exp(0.71)-1

## [1] 1.033991

exp(0.71)/(1+exp(0.71))

## [1] 0.6704012

El ratio de Odds para la variable sexo nos da -0.1274, con lo cual las chances de caer en default se reducen en 12.74% cuando es mujer.

El ratio de Odds para la variable PAY_ATM1, nos indica que las chances de caer en default se reeducen en 0.00002186.

El ratio de Odds para la variable PAY_0, nos indica que las chances de caer en default aumentan en 1.033.

Se sigue el analisis del mismo modo para las demas variables.

log<-logitmfx(formula=XB5, data=all_data)
log

## Call:
## logitmfx(formula = XB5, data = all_data)
## 
## Marginal Effects:
##                             dF/dx      Std. Err.       z                 P>|z|
## factor(SEX)2       -0.02113055105  0.00473114520 -4.4663         0.00000795968
## factor(MARRIAGE)1   0.19471280192  0.08434964140  2.3084               0.02098
## factor(MARRIAGE)2   0.15784193578  0.07640159308  2.0660               0.03883
## factor(MARRIAGE)3   0.25562837221  0.12995020524  1.9671               0.04917
## factor(EDUCATION)1  0.99137123444  0.33630522127  2.9478               0.00320
## factor(EDUCATION)2  0.98605173673  0.59333993259  1.6619               0.09654
## factor(EDUCATION)3  0.96221543122  0.51437195277  1.8707               0.06139
## factor(EDUCATION)4  0.81607676682  0.07954058232 10.2599 < 0.00000000000000022
## factor(EDUCATION)5  0.82325417556  0.14512117873  5.6729         0.00000001404
## factor(EDUCATION)6  0.81301082868  0.03580369448 22.7075 < 0.00000000000000022
## PAY_0               0.10950318610  0.00338691839 32.3312 < 0.00000000000000022
## PAY_AMT1           -0.00000336110  0.00000035776 -9.3950 < 0.00000000000000022
##                       
## 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 ***
## PAY_0              ***
## PAY_AMT1           ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## dF/dx is for discrete change for the following variables:
## 
##  [1] "factor(SEX)2"       "factor(MARRIAGE)1"  "factor(MARRIAGE)2" 
##  [4] "factor(MARRIAGE)3"  "factor(EDUCATION)1" "factor(EDUCATION)2"
##  [7] "factor(EDUCATION)3" "factor(EDUCATION)4" "factor(EDUCATION)5"
## [10] "factor(EDUCATION)6"

Como cambia la prob de caer en morosidad cuando una persona tiene ese nivel de educacion, dF/dx, efecto marginal, o cuando es mujer, tambien se puede realizar analisis cuando es casado o soltero.

SENSIBILIDAD Y ESPECIFICIDAD

Recordar, que se require maximizar la especifidad y sensibilidad El punto maximo evaluado en distintos puntos de corte y el punto maximo es el punto donde se cruzan.

yhat2<-modelo5$fitted.values
hist(yhat2)

c<-seq(0.01,0.3,by=0.001)
sens<-c()
spec<-c()
for (i in 1:length(c)){
  y.pred<-ifelse(modelo5$fitted.values > c[i], yes = 1, no = 0) 
  spec[i]<-prop.table(table(all_data$default.payment.next.month,y.pred),1)[1]
  sens[i]<-prop.table(table(all_data$default.payment.next.month,y.pred),1)[4]
}

o.cut<-mean(c[which(round(spec,1.5)==round(sens,1.5))],na.rm = T)
plot(c,sens,type="l",col=2,main=c("Especificidad vs Sensibilidad"),ylab=c("Especificidad/Sensibilidad"))
lines(c,spec,col=3)

#Se observa el punto donde se cruzan :

abline(v=o.cut)

o.cut

## [1] 0.208

Se evalua la mtriz de confusion para interpretar la especificidad y la sensibilidad.

y.pred1<-ifelse(modelo5$fitted.values > o.cut, yes = 1, no = 0) 
matriz_confusion1 <- table(all_data$default.payment.next.month, y.pred1,
                          dnn = c("observaciones", "predicciones"))

matriz_confusion1

##              predicciones
## observaciones     0     1
##             0 15148  8216
##             1  2293  4343

prop.table(matriz_confusion1,1)

##              predicciones
## observaciones         0         1
##             0 0.6483479 0.3516521
##             1 0.3455395 0.6544605

Se observa la matriz de confusion de la cual se puede decir lo siguiente: Si el modelo es correcto en prediccion se tendrá la prediccion correcta de fracasos y exitos. La especificidad se interpreta de la siguiente manera: con el modelo que se ha elejido hasta ahora se tiene un 64.34% probabilidad de fracaso, en este caso 0= no default, por ello se puede decir que exite un 64.83% de probabilidad de que no se entre en default en proximo mes, de acuerdo a las variables tomadas para dicha prediccion. La sensibilidad se interpreta de la siguiente manera: con el modelo que se ha elejido hasta el momento se tiene un 65.45% de probabilidad de exito, en este caso exito se definio como default, existe un 65.45% de probabilidad que se incumpla los pagos para el proximo mes, de acuerdo a las variables tomadas para dicha prediccion.

Curva de ROC

roc1<- roc(all_data$default.payment.next.month,modelo5$fitted.values)

roc1

## 
## Call:
## roc.default(response = all_data$default.payment.next.month, predictor = modelo5$fitted.values)
## 
## Data: modelo5$fitted.values in 23364 controls (all_data$default.payment.next.month 0) < 6636 cases (all_data$default.payment.next.month 1).
## Area under the curve: 0.7082

plot(roc1,main=c("Curva ROC"))

El area bajo la curva es 0.7082, por ello decimos que es media aceptable, se esperaria que sea mayor a 0.90 para que se acepte completamente que si se hizo una buena prediccion. Es mejor cuando esta pegado a 1.

Modelo Logit- Default of Credit Card Clients Dataset

Modelo Logit- Default of Credit Card Clients Dataset

INTRODUCCION

Base de Datos: Primer Modelo

SEGUNDO MODELO

ANALISIS DE LAS VARIABLES

Density Plots

Violin plots

ELECCION DEL MODELO

Modelo2

Modelo3

Modelo4

Modelo5

Analisis del Modelo elegigo

Ratio de odds

SENSIBILIDAD Y ESPECIFICIDAD

Curva de ROC