library(stats)
library(psych)
library(MASS)
library(ISLR)
library(fRegression)
library(vcd)
library(dplyr)
library(openxlsx)
library(mlbench)
library(magrittr)
library(neuralnet)
library(keras)
library(caret)
library(glmnet)

Base de datos

Importar df

Primero se va a importar la base de datos que nos fue proporcionada, está en el formato xlsx de Excel por lo que se necesita la librería “openxslx” para poder la función read.xlsx(““).

Y se va a almacenar en una variable llamada Datos.

Datos <- read.xlsx("Fojal_Evidencia 2.xlsx")

Selección de variables

Tras leer la base de datos y revisar los datos proporcionados, eliminamos todos los datos que no son relevantes para la construcción del modelo de probabilidad de incumplimiento por lo que eliminaron las columnas de “ID” y “Year” ya que no la información que contienen no afecta de forma directa o indirecta a la función que queremos determinar.

El comando select() de la paquetería dplyr nos permite seleccionar ciertas columnas específicas de un df, en este caso el primer argumento es el nombre del df (en este caso la variable “Datos”) y después separadas por comas cada columna que se quiera seleccionar, en este caso se le pone un guión antes para denotar que se quiere eliminar esa columna, entonces ese comando de select se guarda de nuevo en la misma variable y ya se queda actualizadas sin las columnas seleccionadas.

Datos <- select (Datos, -ID, -Year)

Renombramiento de columnas

Con la función colnames(), generaremos un vector que tendrá almacenado los nombres que queremos añadir a las variables.

colnames(Datos) <- c("WC_TA", "RE_TA", "EBIT_TA", "ME_TL", "S_TA", "Default" )

Comprender df

Con el comando head(,3) obtendremos los primeros 3 renglones de cada columna de la base de datos, esto nos servirá para conocer cada columna de la base y tener un contexto más amplio de los datos con los que estaremos trabajando.

head(Datos, 3)

##       WC_TA     RE_TA   EBIT_TA     ME_TL      S_TA Default
## 1 0.5007986 0.3068458 0.0433734 0.9562708 0.3347738       0
## 2 0.5477802 0.3222137 0.0518426 1.0645450 0.3345913       0
## 3 0.4510005 0.2251504 0.0268132 0.8040959 0.2455852       0

Ya que tenemos el resumen observamos todas las columnas:

WC_TA es “working capital” o “capital de trabajo”
RE_TA es “retained earning / total assets” o “ingresos retenidos / activos totales”
EBIT_TA es “EBIT / total assets” o “EBIT / activos totales”
ME_TL es “market value / total assets” o “valor de mercado / activos totales”
S_TA es “sales / total assets” o “ventas / activos totales”
Default es la columna que se querá predecir

Verificación de clases

Al haber seleccionado las variables relevantes y haber acomodado la base de datos con los nombres de columnas, ahora utilizaremos el comando str() para conocer la estructura de la base de datos, esta función nos menciona la clase de cada una de las columnas así como algunos de sus valores.

Tras eliminar las columnas irrelevantes, checamos nuevamente la estructura de nuestra base de datos para confirmar que todas las columnas proporcionan datos que son numéricos. Con este paso también confirmamos que no necesitamos generar variables dummies, ya que como se mencionó anteriormente, todas las columnas proporcionan datos numéricos.

str(Datos)

## 'data.frame':    4000 obs. of  6 variables:
##  $ WC_TA  : num  0.501 0.548 0.451 0.307 0.447 ...
##  $ RE_TA  : num  0.307 0.322 0.225 0.192 0.217 ...
##  $ EBIT_TA: num  0.0434 0.0518 0.0268 0.0301 0.0325 ...
##  $ ME_TL  : num  0.956 1.065 0.804 0.387 0.792 ...
##  $ S_TA   : num  0.335 0.335 0.246 0.253 0.276 ...
##  $ Default: num  0 0 0 0 0 0 0 0 0 0 ...

Vemos que todas las columnas tienen clase numérica por lo que no es necesario convertir ninguna o generar alguna variable dummy.

Limpieza de base de datos

Lo último que necesitamos verificar para tener una base de datos limpia es asegurar que no existe ningún dato NA, es decir, que ninguna de nuestras columnas tengan espacios en blanco. Para hacer esto se utiliza la función colSums() para contar las columnas que se determinen con el argumento interior. El argumento interior es is.na(Datos) que nos arroja el número de NAs que hay dentro de la base de datos y luego son separados por columnas por el comando anterior colSums() y con ello sabemos cuáles columnas tienen NA,

colSums(is.na(Datos))

##   WC_TA   RE_TA EBIT_TA   ME_TL    S_TA Default 
##       0       0       0       0       0       0

Se puede apreciar que ninguna columna cuenta con algún NA por lo que no es necesario hacer una limpeza o rellenar con promedios.

Entrenamiento de variables

Al haber comprendido la base de datos y ajustado los valores que se tenían que ajustar, es necesario entrenar las variables para posteriormente generar los modelos predictivos. Antes de entrenar los datos se transformó la columna “Default” de una clase numérica a que fuera de factor, esto se realiza con la función as.factor. Esto se hizo con el fin de que el programa reconozca que los valores que se quieren obtener deben de ser 0 y 1 ya que será un modelo binomial, en el que el 0 es cumplimiento de pago y 1 es incumplimiento de pago

Datos$Default <- as.factor(Datos$Default)

Train/Test Split

El procedimiento train/test split se utiliza para estimar el desempeño que tendrá un algoritmo de machine learning cuando se utilizan en para hacer predicciones en datos que no son usados para entreanr el modelo. Es rápido y sensillo y los resultados permiten determinar y comparar el desempeño de los algoritmos para el modelo predictivo que se esté realizando.

Para realizar este procedimiento primero se tiene que tomar la infomración y dividirla en 2 subsets, el primer subset se utiliza para ajustar el modelo y se le denomina train dataset y el segundo subset se denomina test dataset**, este no es utilizado para entrenar el modelo, sino que los datos de la base de datos le son integrados, después se hacen predicciones y se comparan con los valores esperados. Esto segundo subset es utilizado para evaluar el ajuste del modelo.

Para poder realizar el modelo, primero se tiene que determinar cuántos datos se irán a cada una de las dos variables. Para esto se determina una ponderación de datos que tendrá cada variables, no hay alguna norma pero las ponderaciones más comunes son:

Train: 80%, Test: 20%
Train: 67%, Test: 33%
Train: 50%, Test: 50%

Y resultados empíricos dados en un paper (https://scholarworks.utep.edu/cs_techrep/1209/) indican que los mejores resultados se obtienen cuando del 20 al 30% de lso datos se utilizan para Testing y el resto para train, por eso en esta ocasión se utilizarán 67% para train y 33% para test.

Para ello se utilizará la funcion createDataPartition() de la librería caret que genera una división aleatoria estratificada de la base de datos basado en el porcentaje que le menciones, dado en la variable p = %.

Se utilizará el comando set.seed() para ayudar en la generación de números pseudoaleatorios basados en esa semilla y así poder reproducir el mismo output en la simulación.

set.seed(101)
train <- createDataPartition(y = Datos$Default, p=0.8, list=FALSE, times = 1)

Ya que separamos el 67% en una variable llamada train procederemos a añadir esos valores a una variable llamada datos_train y a restale esos valores a una variable llamada datos_test.

datos_train <- Datos[train,]
datos_test <- Datos[-train,]

Selección de variables

Para poder seleccionar las variables que se utilizarán en el modelo predictivo existe una metodología llamada “stepwise regression”.

Dentro de esta metodología existen varios métodos, siendo los dos que utilizaremos forward stepwise y backward stepwise.

El método foward es un modelo que comienza con ninguna variable y después empieza a añadir las variables con más significancia una detrás de otra, hasta que alguna regla de parar se haya cumplido o hasta que todas las variables posibles estén incluidas en el modelo.
El método backward stepwise es un modelo que comienza con todas las posibles variables y va quitando las variables con menos significancia una después de otra. Hasta que alguna regla de parar se haya cumplido o hasta que no quede ninguna variable en el modelo.

Forward Stepwise Selection

Para realizar el modelo foward primero generaremos una variable llamada glm_null que dejará vacío el modelo, después con la función step() se irán agregando las variables y se almacenarán en una variable llamada modelo_step_forward.

set.seed(101)
glm_null <- glm(Default ~ 1, family = binomial(link="probit"), datos_train)
modelo_step_forward <- step(glm_null, direction = "forward",trace ~ WC_TA + RE_TA + EBIT_TA + ME_TL + S_TA, data = datos_train)

## Start:  AIC=582.19
## Default ~ 1
## 
##           Df Deviance    AIC
## + RE_TA    1   495.75 499.75
## + ME_TL    1   513.72 517.72
## + EBIT_TA  1   543.80 547.80
## + WC_TA    1   566.66 570.66
## + S_TA     1   577.18 581.18
## <none>         580.19 582.19
## 
## Step:  AIC=499.75
## Default ~ RE_TA
## 
##           Df Deviance    AIC
## + ME_TL    1   463.27 469.27
## + EBIT_TA  1   482.42 488.42
## + S_TA     1   490.92 496.92
## <none>         495.75 499.75
## + WC_TA    1   494.18 500.18
## 
## Step:  AIC=469.27
## Default ~ RE_TA + ME_TL
## 
##           Df Deviance    AIC
## + EBIT_TA  1   455.88 463.88
## + S_TA     1   460.04 468.04
## <none>         463.27 469.27
## + WC_TA    1   463.27 471.27
## 
## Step:  AIC=463.88
## Default ~ RE_TA + ME_TL + EBIT_TA
## 
##         Df Deviance    AIC
## + S_TA   1   450.89 460.89
## <none>       455.88 463.88
## + WC_TA  1   455.54 465.54
## 
## Step:  AIC=460.89
## Default ~ RE_TA + ME_TL + EBIT_TA + S_TA
## 
##         Df Deviance    AIC
## <none>       450.89 460.89
## + WC_TA  1   450.79 462.79

Ya que se tiene el modelo, la función summary() nos dará la fórmula que deberemos utilizar en la parte de test.

summary(modelo_step_forward)

## 
## Call:
## glm(formula = Default ~ RE_TA + ME_TL + EBIT_TA + S_TA, family = binomial(link = "probit"), 
##     data = datos_train)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.9264  -0.1896  -0.1305  -0.0597   4.5248  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  -1.6875     0.1271 -13.279  < 2e-16 ***
## RE_TA        -0.8099     0.1180  -6.862 6.78e-12 ***
## ME_TL        -0.3348     0.1005  -3.330 0.000868 ***
## EBIT_TA      -4.7069     1.6050  -2.933 0.003360 ** 
## S_TA          0.4637     0.1981   2.340 0.019259 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 580.19  on 3200  degrees of freedom
## Residual deviance: 450.89  on 3196  degrees of freedom
## AIC: 460.89
## 
## Number of Fisher Scoring iterations: 9

La fórmula obtenida con este modelo es “Default ~ RE_TA + ME_TL + EBIT_TA + S_TA”

Backward Stepwise Selection

Para realizar el backward se hará lo mismo que en el anterior solo que la variable se llamará glm_full y contendrá todas las variables.

set.seed(101)
glm_null2 <- glm(Default ~  WC_TA + RE_TA + EBIT_TA + ME_TL + S_TA, family = binomial(link="probit"), datos_train)
modelo_step_backward <- step(glm_null2, direction = "backward",trace = 1, data = datos_train)

## Start:  AIC=462.79
## Default ~ WC_TA + RE_TA + EBIT_TA + ME_TL + S_TA
## 
##           Df Deviance    AIC
## - WC_TA    1   450.89 460.89
## <none>         450.79 462.79
## - S_TA     1   455.54 465.54
## - EBIT_TA  1   459.98 469.98
## - ME_TL    1   473.95 483.95
## - RE_TA    1   492.78 502.78
## 
## Step:  AIC=460.89
## Default ~ RE_TA + EBIT_TA + ME_TL + S_TA
## 
##           Df Deviance    AIC
## <none>         450.89 460.89
## - S_TA     1   455.88 463.88
## - EBIT_TA  1   460.04 468.04
## - ME_TL    1   474.64 482.64
## - RE_TA    1   493.81 501.81

Ya que se tiene el modelo, la función summary() nos dará la fórmula que deberemos utilizar en la parte de test.

summary(modelo_step_backward)

## 
## Call:
## glm(formula = Default ~ RE_TA + EBIT_TA + ME_TL + S_TA, family = binomial(link = "probit"), 
##     data = datos_train)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.9264  -0.1896  -0.1305  -0.0597   4.5248  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  -1.6875     0.1271 -13.279  < 2e-16 ***
## RE_TA        -0.8099     0.1180  -6.862 6.78e-12 ***
## EBIT_TA      -4.7069     1.6050  -2.933 0.003360 ** 
## ME_TL        -0.3348     0.1005  -3.330 0.000868 ***
## S_TA          0.4637     0.1981   2.340 0.019259 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 580.19  on 3200  degrees of freedom
## Residual deviance: 450.89  on 3196  degrees of freedom
## AIC: 460.89
## 
## Number of Fisher Scoring iterations: 9

La fórmula obtenida con este modelo es “Default ~ RE_TA + EBIT_TA + ME_TL + S_TA”

Both Stepwise Selection

set.seed(201)
glm_null2 <- glm(Default ~ ., family = binomial(link="probit"), datos_train)
modelo_step_both <- step(glm_null2, direction = "both", data = datos_train)

## Start:  AIC=462.79
## Default ~ WC_TA + RE_TA + EBIT_TA + ME_TL + S_TA
## 
##           Df Deviance    AIC
## - WC_TA    1   450.89 460.89
## <none>         450.79 462.79
## - S_TA     1   455.54 465.54
## - EBIT_TA  1   459.98 469.98
## - ME_TL    1   473.95 483.95
## - RE_TA    1   492.78 502.78
## 
## Step:  AIC=460.89
## Default ~ RE_TA + EBIT_TA + ME_TL + S_TA
## 
##           Df Deviance    AIC
## <none>         450.89 460.89
## + WC_TA    1   450.79 462.79
## - S_TA     1   455.88 463.88
## - EBIT_TA  1   460.04 468.04
## - ME_TL    1   474.64 482.64
## - RE_TA    1   493.81 501.81

Ya que se tiene el modelo, la función summary() nos dará la fórmula que deberemos utilizar en la parte de test.

summary(modelo_step_both)

## 
## Call:
## glm(formula = Default ~ RE_TA + EBIT_TA + ME_TL + S_TA, family = binomial(link = "probit"), 
##     data = datos_train)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.9264  -0.1896  -0.1305  -0.0597   4.5248  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  -1.6875     0.1271 -13.279  < 2e-16 ***
## RE_TA        -0.8099     0.1180  -6.862 6.78e-12 ***
## EBIT_TA      -4.7069     1.6050  -2.933 0.003360 ** 
## ME_TL        -0.3348     0.1005  -3.330 0.000868 ***
## S_TA          0.4637     0.1981   2.340 0.019259 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 580.19  on 3200  degrees of freedom
## Residual deviance: 450.89  on 3196  degrees of freedom
## AIC: 460.89
## 
## Number of Fisher Scoring iterations: 9

La fórmula dada con este modelo es “Default ~ RE_TA + EBIT_TA + ME_TL + S_TA”

Resultados de los modelos

Tras entrenar las variables en ambas direcciones, nos encontramos que en ambos casos nos indican las mismas variables significativas, las cuales son: “RE_TA”, “ME_TL”, “EBIT_TA” y “S_TA”. Las más significativas son las primeras dos (RE_TA y ME_TL) ya que están indicadas con tres asteriscos, seguida por “EBIT_TA” indicada con dos asteriscos y por último la menos significativa es “S_TA” indicada con un solo asterisco.

Ajuste de Modelos

Para ajustar el modelo es necesario que la variable a predecir sea un factor, lo que ya se hizo con anterioridad en un comienzo.

Modelo Forward

Después generaremos ajustaremos el modelo forward con la formula que obtuvimos:

forward_ajustado <- train(Default ~ RE_TA + ME_TL + EBIT_TA + S_TA,data=datos_train,family=binomial(link="probit"),method="glm")

summary(forward_ajustado)

## 
## Call:
## NULL
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.9264  -0.1896  -0.1305  -0.0597   4.5248  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  -1.6875     0.1271 -13.279  < 2e-16 ***
## RE_TA        -0.8099     0.1180  -6.862 6.78e-12 ***
## ME_TL        -0.3348     0.1005  -3.330 0.000868 ***
## EBIT_TA      -4.7069     1.6050  -2.933 0.003360 ** 
## S_TA          0.4637     0.1981   2.340 0.019259 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 580.19  on 3200  degrees of freedom
## Residual deviance: 450.89  on 3196  degrees of freedom
## AIC: 460.89
## 
## Number of Fisher Scoring iterations: 9

forward_ajustado$finalModel

## 
## Call:  NULL
## 
## Coefficients:
## (Intercept)        RE_TA        ME_TL      EBIT_TA         S_TA  
##     -1.6875      -0.8099      -0.3348      -4.7069       0.4637  
## 
## Degrees of Freedom: 3200 Total (i.e. Null);  3196 Residual
## Null Deviance:       580.2 
## Residual Deviance: 450.9     AIC: 460.9

Modelo Backward

Después generaremos ajustaremos el modelo backward con la formula que obtuvimos:

backward_ajustado <- train(Default ~ RE_TA + EBIT_TA + ME_TL + S_TA,data=datos_train,family = binomial(link="probit"),method="glm")

summary(backward_ajustado)

## 
## Call:
## NULL
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.9264  -0.1896  -0.1305  -0.0597   4.5248  
## 
## Coefficients:
##             Estimate Std. Error z value Pr(>|z|)    
## (Intercept)  -1.6875     0.1271 -13.279  < 2e-16 ***
## RE_TA        -0.8099     0.1180  -6.862 6.78e-12 ***
## EBIT_TA      -4.7069     1.6050  -2.933 0.003360 ** 
## ME_TL        -0.3348     0.1005  -3.330 0.000868 ***
## S_TA          0.4637     0.1981   2.340 0.019259 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 580.19  on 3200  degrees of freedom
## Residual deviance: 450.89  on 3196  degrees of freedom
## AIC: 460.89
## 
## Number of Fisher Scoring iterations: 9

backward_ajustado$finalModel

## 
## Call:  NULL
## 
## Coefficients:
## (Intercept)        RE_TA      EBIT_TA        ME_TL         S_TA  
##     -1.6875      -0.8099      -4.7069      -0.3348       0.4637  
## 
## Degrees of Freedom: 3200 Total (i.e. Null);  3196 Residual
## Null Deviance:       580.2 
## Residual Deviance: 450.9     AIC: 460.9

Evaluar Modelo

Predicciones

Para evaluar el modelo realizaremos las predicciones y se evaluarán con los datos test, guardaremos la información de la predicción con forward en la variable predF y la información del backward en la variable predB. Para esto se utilizará la función predict()

E imprimiremos los primeros 10 datos para ver que todo esté en orden.

predF <- predict(forward_ajustado,datos_test[,-6], type="prob")[,2]
predB <- predict(backward_ajustado,datos_test[,-6], type="prob")[,2]

predF[1:10]

##  [1] 1.572520e-02 1.065451e-02 1.586942e-02 4.916791e-10 2.273328e-05
##  [6] 3.833499e-05 1.509768e-02 1.374998e-02 1.785567e-02 2.472819e-02

predB[1:10]

##  [1] 1.572520e-02 1.065451e-02 1.586942e-02 4.916791e-10 2.273328e-05
##  [6] 3.833499e-05 1.509768e-02 1.374998e-02 1.785567e-02 2.472819e-02

Después se utilizará un ciclo ifelse() para sustituir los valores por 0 y 1.

predicciones_forward <- ifelse(test = predF > 0.21, yes = 1, no = 0)
predicciones_backward <- ifelse(test = predB > 0.21, yes = 1, no = 0)

Matriz de Confusión

CM Forward

Teniendo estos datos se generará una matriz de confusiones para ambos métodos para evaluar los modelos.

Primero por el foward.

mc_forward <- confusionMatrix(as.factor(predicciones_forward),as.factor(datos_test$Default), dnn = c( "predicciones","observaciones"))
mc_forward

## Confusion Matrix and Statistics
## 
##             observaciones
## predicciones   0   1
##            0 782  14
##            1   3   0
##                                           
##                Accuracy : 0.9787          
##                  95% CI : (0.9662, 0.9876)
##     No Information Rate : 0.9825          
##     P-Value [Acc > NIR] : 0.82910         
##                                           
##                   Kappa : -0.0062         
##                                           
##  Mcnemar's Test P-Value : 0.01529         
##                                           
##             Sensitivity : 0.9962          
##             Specificity : 0.0000          
##          Pos Pred Value : 0.9824          
##          Neg Pred Value : 0.0000          
##              Prevalence : 0.9825          
##          Detection Rate : 0.9787          
##    Detection Prevalence : 0.9962          
##       Balanced Accuracy : 0.4981          
##                                           
##        'Positive' Class : 0               
##

CM Backward

Después con el backward.

mc_backward <- confusionMatrix(as.factor(predicciones_backward),as.factor(datos_test$Default), dnn = c( "predicciones","observaciones"))
mc_backward

## Confusion Matrix and Statistics
## 
##             observaciones
## predicciones   0   1
##            0 782  14
##            1   3   0
##                                           
##                Accuracy : 0.9787          
##                  95% CI : (0.9662, 0.9876)
##     No Information Rate : 0.9825          
##     P-Value [Acc > NIR] : 0.82910         
##                                           
##                   Kappa : -0.0062         
##                                           
##  Mcnemar's Test P-Value : 0.01529         
##                                           
##             Sensitivity : 0.9962          
##             Specificity : 0.0000          
##          Pos Pred Value : 0.9824          
##          Neg Pred Value : 0.0000          
##              Prevalence : 0.9825          
##          Detection Rate : 0.9787          
##    Detection Prevalence : 0.9962          
##       Balanced Accuracy : 0.4981          
##                                           
##        'Positive' Class : 0               
##

Resultados Matrices

Como ya se ha mencionado, los modelos tanto “Forward” como “Backward” son iguales, por lo que tienen la misma matriz de confusión.

La matriz de confusión contiene:

782 TN
3 FN
14 FP
0 TN

La exactitud de la predicción (accuracy) fue del 97.87%, por lo que consideramos que es una buena predicción, ya que es un valor arriba de 90%.

La sensibilidad (sensitivity) es del 99.62% lo que nos indica que es la probabilidad de que el modelo pueda predecir positivos es un 99.62%, lo que nos da demasiada confianza de que los valores se aproximen a la realidad y nos permita confiar en el modelo para decidir si una persona puede incumplir con un pago.

Aunque de manera general nuestro modelo parece ser uno bueno, se mencionó que se buscaban comparar dos modelos para encontrar el más preciso y eso no se cumplió dado que las predicciones por ambos métodos fueron iguales. Para cumplir con este objetivo, nuestro modelo final se va a comparar con un modelo Lasso para determinar su eficacia.

Método Lasso

Con el fin de comparar nuestro modelo con otro de distinta metodología utilizamos el método Lasso, el objetivo de este es penalizar el incluir variables innecesarias, llevándolas a un valor de 0, y favorecer modelos con variables significativas.

Matriz

Para utilizar este modelo es necesario tener nuestras variables “x” en un vector, para esto utilizamos la función model.matrix, Default que es nuestra variable dependiente,para seleccionar todas las variables independientes de la base Datos y por último [,-1] para borrar la columna intercept que genera la función model.matrix.

x = model.matrix(Default ~ ., Datos)[,-1]

Posteriormente generamos la variable “y”, está lo obtenemos de la base Datos y en este caso es nuestra variable dependiente Default

y = Datos$Default

Generación Modelo

Utilizamos la función cv.glmnet para crear nuestro modelo Lasso, cv es una abreviación de validación cruzada, esto quiere decir que va a generar muchos modelos con diferentes valores de lambda, luego usamos nuestras variables x, y, previamente creadas, familia binomial porque son 0 y 1, alpha 1 para indicar que es un modelo lasso y nfolds 5 que es la cantidad en que se va a separar la data.

set.seed(23) 
cv.outL = cv.glmnet(x,y,family="binomial",alpha=1,nfolds=5)

Posteriormente graficamos y obtenemos la mejor lambda que es la menor.

plot(cv.outL)

bestlamL = cv.outL$lambda.min
bestlamL

## [1] 5.741374e-05

Ajuste del modelo

Para ajustar el modelo usamos el valor de lambda obtenido mediante la validación cruzada y estandarizamos los datos (se resta la media y se divide entre la desviación estándar).

set.seed(23)
lasso.mod = glmnet(x,y,alpha=1, family="binomial", lambda=bestlamL, standardize=TRUE)
outL = glmnet(x,y,family="binomial",alpha=1)
coef(cv.outL,s=bestlamL)

## 6 x 1 sparse Matrix of class "dgCMatrix"
##                     s1
## (Intercept) -2.5820367
## WC_TA        0.3878668
## RE_TA       -1.4651843
## EBIT_TA     -7.9735358
## ME_TL       -1.5205390
## S_TA         0.6218441

Predicción

Ya con nuestro modelo ajustado realizamos predicciones con la función predict() para conocer la precisión de nuestro modelo.

predLprobs <- predict(lasso.mod, as.matrix(datos_test[,-6]), type="response")
predLprobs[1:10]

##  [1] 1.762385e-02 8.599426e-03 1.907302e-02 9.994283e-10 7.670524e-06
##  [6] 1.285488e-05 1.131705e-02 1.338799e-02 2.304764e-02 4.015414e-02

CM Lasso

Finalmente generamos la matriz de confusiones del modelo lasso.

predicciones_lasso <- ifelse(test = predLprobs > 0.21, yes = 1, no = 0)
mc_lasso <- confusionMatrix(as.factor(predicciones_lasso),as.factor(datos_test$Default), dnn = c( "predicciones","observaciones"))
mc_lasso

## Confusion Matrix and Statistics
## 
##             observaciones
## predicciones   0   1
##            0 783  14
##            1   2   0
##                                           
##                Accuracy : 0.98            
##                  95% CI : (0.9677, 0.9885)
##     No Information Rate : 0.9825          
##     P-Value [Acc > NIR] : 0.75746         
##                                           
##                   Kappa : -0.0044         
##                                           
##  Mcnemar's Test P-Value : 0.00596         
##                                           
##             Sensitivity : 0.9975          
##             Specificity : 0.0000          
##          Pos Pred Value : 0.9824          
##          Neg Pred Value : 0.0000          
##              Prevalence : 0.9825          
##          Detection Rate : 0.9800          
##    Detection Prevalence : 0.9975          
##       Balanced Accuracy : 0.4987          
##                                           
##        'Positive' Class : 0               
##

La matriz de confusión contiene:

783 TN
2 FN
14 FP
0 TN

Vemos que con este modelo se obtiene un TN más que en la de los otros modelos, lo que nos indica que sí hubo una mejoría en la generación de la predicción usando este modelo.

La exactitud de la predicción (accuracy) fue del 98%, mayor que la exactitud del modelo anterior, comprobando nuevamente que es un modelo muy confiable ya que casi se acerca a valores que podrían considerarse exactos.

La sensibilidad (sensitivity) es del 99.75% lo que nos indica que es la probabilidad de que el modelo pueda predecir positivos es un 99.75%, lo que nos da demasiada confianza de que los valores se aproximen a la realidad y nos permita confiar en el modelo para decidir si una persona puede incumplir con un pago.

Evidencia 2

Matias, Aldo, Sebastián y Emiliano

2022-10-15

Base de datos

Importar df

Selección de variables

Renombramiento de columnas

Comprender df

Verificación de clases

Limpieza de base de datos

Entrenamiento de variables

Train/Test Split

Selección de variables

Forward Stepwise Selection

Backward Stepwise Selection

Both Stepwise Selection

Resultados de los modelos

Ajuste de Modelos

Modelo Forward

Modelo Backward

Evaluar Modelo

Predicciones

Matriz de Confusión

CM Forward

CM Backward

Resultados Matrices

Método Lasso

Matriz

Generación Modelo

Ajuste del modelo

Predicción

CM Lasso