Análisis de Riesgo de Credito (Credit Risk). Caso de Estudio.

Los clientes de banco son candidatos potenciales que piden préstamos a crédito con la estipulación de realizar pagos mensuales con un cierto interés sobre la cantidad para pagar el monto total del crédito. En un mundo perfecto habría préstamos de crédito distribuidos libremente y los clientes los pagarían sin problemas. Desafortunadamente, no estamos viviendo en un mundo utópico, y por lo tanto habrá clientes que incumplirán sus préstamos de crédito y no podrán pagar el monto estipulado causando enormes pérdidas al banco. Por lo tanto, el análisis de riesgo de crédito es una de las áreas cruciales en las que se centran los bancos donde analizan información detallada relativa a los clientes y su historial de crédito.

Debemos analizar el conjunto de datos pertenecientes a los clientes, construir un modelo predictivo utilizando algoritmos de machine learning y predecir si un cliente es probable que incumpla el pago del préstamo de crédito y ser etiquetado como un potencial riesgo de crédito.

Los bancos obtienen valor del modelo al utilizar a los analistas de negocio para traducir los resultados de predicción y números en bruto de algoritmos a decisiones basadas en datos que, cuando se ejecutan en el momento adecuado, ayudan a crecer el negocio.

La regresión logística es un caso especial de modelos de regresión que se utilizan para la clasificación, donde el algoritmo calcula las probabilidades de que una variable esté en una de las etiquetas de la clase como una función de las otras características. Prediciendo la calificación crediticia para los clientes de un banco, donde la calificación crediticia puede ser buena, que se denotan por 1 o malo, que se denomina 0.

Utilizaremos el conjunto de datos german_credit_dataset.csv y cambiaremos un poco el nombre de las columnas para que sea significativo.

Cargamos el set de datos

credit.df <- read.csv("german_credit.csv", header = TRUE, stringsAsFactors = FALSE)

Debemos transformar los datos, principalmente realizar factoring de las variables categóricas, y transformar el tipo de datos de numérico a factor. Existen varias variables numéricas, que incluyen la cantidad de crédito, la edad y la duración del crédito, todos tienen valores diferentes que podrian distorsionar los datos y son distribuciones asimétricas. Esto tiene múltiples efectos adversos, como la colinealidad inducida y los modelos que toman tiempos más largos para converger. Vamos a utilizar normalización z-score.

##data type transformations - factoring

to.factors <- function(df, variables) {

                for(variable in variables) {

                               df[[variable]] <- as.factor(df[[variable]])

                }

                return(df)

}

## normalizing - scaling

scale.features <- function(df, variables) {

                for(variable in variables) {

                               df[[variable]] <- scale(df[[variable]], center=T, scale=T)

                }

                return(df)

}

#normalize variables

numeric.vars <- c("credit.duration.months", "age", "credit.amount")

credit.df <- scale.features(credit.df, numeric.vars)

#factor variables

categorical.vars <- c('credit.rating','account.balance','previous.credit.payment.status','credit.purpose','savings',

'employment.duration','installment.rate','marital.status','guarantor','residence.duration','current.assets','other.credits', 'apartment.type','bank.credits','occupation','dependents','telephone','foreign.worker')

credit.df <- to.factors(df=credit.df, variables = categorical.vars)

Dividimos el training and test dataset a una proporcion de 60:40.

indexes <- sample(1:nrow(credit.df), size = 0.6*nrow(credit.df))

train.data <- credit.df[indexes, ]

test.data <- credit.df[-indexes, ]

Cargamos las librerias

library(caret)

library(ROCR)

library(e1071)

#separate feature and class variable

test.feature.vars <- test.data[,-1]

test.class.vars <- test.data[,1]

Entrenamos el modelo inicial con todas las variables independientes:

formula.init <- "credit.rating ~ ."

formula.init <- as.formula(formula.init)

lr.model <- glm(formula=formula.init, data=train.data, family="binomial")

detalles

summary(lr.model)

Call:

glm(formula = formula.init, family = "binomial", data = train.data)

Deviance Residuals:

    Min       1Q   Median       3Q      Max 

-2.9964  -0.5453   0.2840   0.6255   2.0303 

Coefficients:

                                  Estimate Std. Error z value Pr(>|z|)   

(Intercept)                      -3.144809   1.382285  -2.275 0.022901 * 

account.balance2                 -0.004871   0.309540  -0.016 0.987444   

account.balance3                  0.834650   0.468293   1.782 0.074696 . 

account.balance4                  1.914813   0.338392   5.659 1.53e-08 ***

credit.duration.months           -0.218489   0.157883  -1.384 0.166400   

previous.credit.payment.status1   0.188968   0.760591   0.248 0.803787   

previous.credit.payment.status2   1.030730   0.579406   1.779 0.075249 . 

previous.credit.payment.status3   1.872516   0.643985   2.908 0.003641 **

previous.credit.payment.status4   2.733108   0.614143   4.450 8.58e-06 ***

credit.purpose1                   1.547360   0.498281   3.105 0.001900 **

credit.purpose2                   0.953451   0.383743   2.485 0.012969 * 

credit.purpose3                   1.049455   0.352351   2.978 0.002897 **

credit.purpose4                   0.435514   0.873065   0.499 0.617897   

credit.purpose5                   1.659976   0.791140   2.098 0.035887 * 

credit.purpose6                  -0.215683   0.587505  -0.367 0.713532   

credit.purpose8                  16.107223 589.297502   0.027 0.978194   

credit.purpose9                   0.862159   0.471874   1.827 0.067685 . 

credit.purpose10                  2.225815   1.163834   1.912 0.055814 . 

credit.amount                    -0.470781   0.184143  -2.557 0.010570 * 

savings2                          0.720460   0.418107   1.723 0.084862 . 

savings3                          0.251267   0.631581   0.398 0.690750   

savings4                          2.087306   0.729554   2.861 0.004222 **

savings5                          1.296324   0.366558   3.536 0.000405 ***

employment.duration2              1.212411   0.629362   1.926 0.054053 . 

employment.duration3              1.450061   0.594548   2.439 0.014731 * 

employment.duration4              2.062809   0.650394   3.172 0.001516 **

employment.duration5              1.064146   0.582952   1.825 0.067934 . 

installment.rate2                 0.405239   0.438865   0.923 0.355809   

installment.rate3                -0.104170   0.475769  -0.219 0.826688   

installment.rate4                -0.840081   0.433362  -1.939 0.052560 . 

marital.status2                   0.259297   0.548115   0.473 0.636162   

marital.status3                   0.633599   0.535577   1.183 0.236801   

marital.status4                   0.375088   0.648738   0.578 0.563142   

guarantor2                       -1.099162   0.628273  -1.749 0.080205 . 

guarantor3                        1.106218   0.654839   1.689 0.091162 . 

residence.duration2              -0.576764   0.415320  -1.389 0.164917   

residence.duration3              -0.446258   0.471767  -0.946 0.344186   

residence.duration4              -0.393400   0.433344  -0.908 0.363970   

current.assets2                   0.302149   0.370269   0.816 0.414485   

current.assets3                  -0.012336   0.328560  -0.038 0.970049   

current.assets4                  -0.620318   0.554436  -1.119 0.263214   

age                               0.303512   0.147159   2.062 0.039163 * 

other.credits2                    0.411071   0.594295   0.692 0.489128   

other.credits3                    0.344513   0.362462   0.950 0.341868   

apartment.type2                   0.650850   0.337055   1.931 0.053484 . 

apartment.type3                   1.063537   0.640660   1.660 0.096902 . 

bank.credits2                    -0.744306   0.360400  -2.065 0.038902 * 

bank.credits3                    -0.635698   0.912803  -0.696 0.486163   

bank.credits4                    -1.779649   1.495298  -1.190 0.233982   

occupation2                      -0.973953   0.981885  -0.992 0.321236   

occupation3                      -0.919371   0.947409  -0.970 0.331844   

occupation4                      -0.581313   0.960812  -0.605 0.545164   

dependents2                      -0.467817   0.335598  -1.394 0.163324   

telephone2                        0.426096   0.297590   1.432 0.152194   

foreign.worker2                   2.676072   1.093251   2.448 0.014373 * 

---

Signif. codes:  0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

    Null deviance: 738.05  on 599  degrees of freedom

Residual deviance: 477.09  on 545  degrees of freedom

AIC: 587.09

Number of Fisher Scoring iterations: 14

lr.predictions <- predict(lr.model, test.data, type = "response")

lr.predictions <- round(lr.predictions)

confusionMatrix(data=lr.predictions, reference=test.class.vars, positive = '1')

Confusion Matrix and Statistics

          Reference

Prediction   0   1

         0  56  49

         1  61 234

                                         

               Accuracy : 0.725          

                 95% CI : (0.6784, 0.7682)

    No Information Rate : 0.7075         

    P-Value [Acc > NIR] : 0.2387         

                                         

                  Kappa : 0.315          

 Mcnemar's Test P-Value : 0.2943         

                                         

            Sensitivity : 0.8269         

            Specificity : 0.4786         

         Pos Pred Value : 0.7932         

         Neg Pred Value : 0.5333         

             Prevalence : 0.7075         

         Detection Rate : 0.5850         

   Detection Prevalence : 0.7375          

      Balanced Accuracy : 0.6527         

                                         

       'Positive' Class : 1  

lr.prediction.values <- predict(lr.model, test.feature.vars, type = "response")

predictions <- prediction(lr.prediction.values, test.class.vars)

perf <- performance(predictions,"tpr","fpr")

plot(perf,col="black")

auc <- performance(predictions,"auc")

auc

AUC es de 0,73 que es bastante bueno para empezar. Ahora tenemos un modelo, pero esto no depende únicamente de la precisión, sino del analisis del negocio. Si predecimos que un cliente con una calificación crediticia mala (0) es bueno (1), significa que vamos a aprobar el préstamo de crédito para el cliente que terminará por no pagarlo, lo que causará pérdidas al banco. Sin embargo, si predijeramos que un cliente con buena calificación crediticia (1) es malo (0), significa que le negaremos el préstamo, en cuyo caso el banco no beneficiará ni incurrirá en pérdidas. Esto es mucho mejor que incurrir en enormes pérdidas al predecir mal las calificaciones de crédito malas como buenas.

Ahora depende de ti. Como puedes ver p-value en summary, trata de aplicar el mismo procedimiento con el fin de obtener un mejor modelo con variables seleccionados tomando como referencia los p-values. Trate de implementar otro algoritmo como SVM o árbol de decisión y comparalo! Te sorprenderas de los resultados.