Business Issue Understanding

Bank merupakan insitusi yang mendapatkan keuntungan dari penyaluran kredit. Kredit yang disalurkan haruslah merupakan kredit yang berkualitas baik dimana pengembalian kredit lancar sekaligus meminimalkan kredit macet. Berdasarkan ilustrasi diatas, debitur(nasabah yang memiliki pinjaman) sebaiknya memiliki track record yang baik.Model ini digunakan dalam melakukan prediksi credit scoring pada nasabah, diharapkan debitur yang memiliki score yang baik diprediksikan lancar dalam pembayaran kredit sampai jangka waktu kredit berakhir.

# library

library(gmodels)
library(dplyr)
library(caret)

Data Understanding

bank3 <- readRDS("loan_data_ch1.rds")

head(bank3)

Pada dataset bank ini terdiri dari informasi dari nasabah yaitu :

  • loan_status : status pinjaman dari nasabah ( 0 : no default, 1 : default)
  • loan_amt : Jumlah pinjaman debitur
  • int_rate : suku bunga pinjaman
  • grade : klasifikasi debitur berdasarkan kolektibilitas
  • home_ownership : status kepemilikan rumah dari debitur
  • annual_inc : income tahunan dari debitur
  • age : umur debitur
str(bank3)
## 'data.frame':    29092 obs. of  8 variables:
##  $ loan_status   : int  0 0 0 0 0 0 1 0 1 0 ...
##  $ loan_amnt     : int  5000 2400 10000 5000 3000 12000 9000 3000 10000 1000 ...
##  $ int_rate      : num  10.7 NA 13.5 NA NA ...
##  $ grade         : Factor w/ 7 levels "A","B","C","D",..: 2 3 3 1 5 2 3 2 2 4 ...
##  $ emp_length    : int  10 25 13 3 9 11 0 3 3 0 ...
##  $ home_ownership: Factor w/ 4 levels "MORTGAGE","OTHER",..: 4 4 4 4 4 3 4 4 4 4 ...
##  $ annual_inc    : num  24000 12252 49200 36000 48000 ...
##  $ age           : int  33 31 24 39 24 28 22 22 28 22 ...
CrossTable(bank3$grade,bank3$loan_status,prop.r = TRUE,
           prop.c = FALSE, prop.t = FALSE, prop.chisq = FALSE)
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |           N / Row Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  29092 
## 
##  
##              | bank3$loan_status 
##  bank3$grade |         0 |         1 | Row Total | 
## -------------|-----------|-----------|-----------|
##            A |      9084 |       565 |      9649 | 
##              |     0.941 |     0.059 |     0.332 | 
## -------------|-----------|-----------|-----------|
##            B |      8344 |       985 |      9329 | 
##              |     0.894 |     0.106 |     0.321 | 
## -------------|-----------|-----------|-----------|
##            C |      4904 |       844 |      5748 | 
##              |     0.853 |     0.147 |     0.198 | 
## -------------|-----------|-----------|-----------|
##            D |      2651 |       580 |      3231 | 
##              |     0.820 |     0.180 |     0.111 | 
## -------------|-----------|-----------|-----------|
##            E |       692 |       176 |       868 | 
##              |     0.797 |     0.203 |     0.030 | 
## -------------|-----------|-----------|-----------|
##            F |       155 |        56 |       211 | 
##              |     0.735 |     0.265 |     0.007 | 
## -------------|-----------|-----------|-----------|
##            G |        35 |        21 |        56 | 
##              |     0.625 |     0.375 |     0.002 | 
## -------------|-----------|-----------|-----------|
## Column Total |     25865 |      3227 |     29092 | 
## -------------|-----------|-----------|-----------|
## 
##

Insight yang dapat diambil dari variabel grade terhadap loan_status adalah pada grade yang paling bawah (grade G) proporsi nasabah yang default semakin besar dan grade A memiliki proporsi nasabah defaulted yang sedikit.Sehingga dapat disimpulkan proporsi gagal bayar meningkat dari grade A ke grade G

Data Wrangling

Outlier Handling

Pada bagian ini, visualisasi dengan histogram dibuituhkan untuk mengetahui pesebaran variabel continous yang dimiliki oleh dataset ini yaitu loan_amt dan dapat memberikan informasi tentang berapa jumlah pinjaman yang paling banyak diajukan oleh debitur

Berdasarkan histogram dibawah, pinjaman di $ 5000 dan $ 10000 merupakan jumlah pinjaman yang paling banyak dipinjam oleh debitur sementara jumlah pinjaman yang besar yaitu > $2000 merupakan jumlah pinjaman yang paling sedikit dipinjam oleh debitur.

 hist(bank3$loan_amnt, breaks = 200, xlab = "Loan amount", 
               main = "Histogram of the loan amount")

plot(bank3$age,ylab="Age")

scatterplot dapat digunakan dalam mendeteksi apakah ada outlier dalam data. pada scatter plot diatas, ada nasabah yang berusia diatas 120 tahun sehingga perlu di hilangkan dari dataset ini karena asumsi jika umur nasabah berada dalam range 0- 70 tahun

bank3_high_age <- which(bank3$age>122)

bank_no_out3<- bank3[-bank3_high_age, ]
plot(bank_no_out3$age, bank_no_out3$annual_inc, xlab = "Age", ylab = "Annual Income")

## Missing Value Handling

summary(bank_no_out3)
##   loan_status       loan_amnt        int_rate     grade      emp_length    
##  Min.   :0.0000   Min.   :  500   Min.   : 5.42   A:9649   Min.   : 0.000  
##  1st Qu.:0.0000   1st Qu.: 5000   1st Qu.: 7.90   B:9329   1st Qu.: 2.000  
##  Median :0.0000   Median : 8000   Median :10.99   C:5747   Median : 4.000  
##  Mean   :0.1109   Mean   : 9594   Mean   :11.00   D:3231   Mean   : 6.145  
##  3rd Qu.:0.0000   3rd Qu.:12250   3rd Qu.:13.47   E: 868   3rd Qu.: 8.000  
##  Max.   :1.0000   Max.   :35000   Max.   :23.22   F: 211   Max.   :62.000  
##                                   NA's   :2776    G:  56   NA's   :809     
##   home_ownership    annual_inc           age      
##  MORTGAGE:12001   Min.   :   4000   Min.   :20.0  
##  OTHER   :   97   1st Qu.:  40000   1st Qu.:23.0  
##  OWN     : 2301   Median :  56400   Median :26.0  
##  RENT    :14692   Mean   :  66965   Mean   :27.7  
##                   3rd Qu.:  80000   3rd Qu.:30.0  
##                   Max.   :2039784   Max.   :94.0  
##

Pada summary diatas, terdapat missing value pada int_rate dan emp_legth. pada dataset ini untuk int_rate, akan dibagi menjadi beberapa sub categori sehingga int_rate dengan missing value akan dikelompokkan menjadi subcategory missing . Perlakuan yang sama juga pada variabel emp_legth dengan mengelompokkan NA kepada category missing pada variabel emp_cat

bank_clean3 <- which(is.na(bank_no_out3$int_rate))

bank_int_rate_clean3 <- bank_no_out3[-bank_clean3, ]

summary(bank_int_rate_clean3)
##   loan_status       loan_amnt        int_rate     grade      emp_length    
##  Min.   :0.0000   Min.   :  500   Min.   : 5.42   A:8750   Min.   : 0.000  
##  1st Qu.:0.0000   1st Qu.: 5000   1st Qu.: 7.90   B:8399   1st Qu.: 2.000  
##  Median :0.0000   Median : 8000   Median :10.99   C:5189   Median : 4.000  
##  Mean   :0.1115   Mean   : 9584   Mean   :11.00   D:2945   Mean   : 6.127  
##  3rd Qu.:0.0000   3rd Qu.:12250   3rd Qu.:13.47   E: 793   3rd Qu.: 8.000  
##  Max.   :1.0000   Max.   :35000   Max.   :23.22   F: 186   Max.   :62.000  
##                                                   G:  53   NA's   :745     
##   home_ownership    annual_inc           age       
##  MORTGAGE:10815   Min.   :   4000   Min.   :20.00  
##  OTHER   :   85   1st Qu.:  40000   1st Qu.:23.00  
##  OWN     : 2096   Median :  56136   Median :26.00  
##  RENT    :13319   Mean   :  66865   Mean   :27.68  
##                   3rd Qu.:  80000   3rd Qu.:30.00  
##                   Max.   :2039784   Max.   :84.00  
## 
bank_emp_clean3 <- which(is.na(bank_int_rate_clean3$emp_length))
 
bank_clean3 <- bank_int_rate_clean3[-bank_emp_clean3, ]

head(bank_clean3)
bank_clean3<-bank_clean3 %>% 
  mutate(loan_status =as.factor(loan_status))
summary(bank_clean3)
##  loan_status   loan_amnt        int_rate     grade      emp_length    
##  0:22778     Min.   :  500   Min.   : 5.42   A:8412   Min.   : 0.000  
##  1: 2792     1st Qu.: 5000   1st Qu.: 7.90   B:8174   1st Qu.: 2.000  
##              Median : 8000   Median :10.99   C:5078   Median : 4.000  
##              Mean   : 9655   Mean   :11.03   D:2888   Mean   : 6.127  
##              3rd Qu.:12500   3rd Qu.:13.48   E: 783   3rd Qu.: 8.000  
##              Max.   :35000   Max.   :23.22   F: 182   Max.   :62.000  
##                                              G:  53                   
##   home_ownership    annual_inc           age      
##  MORTGAGE:10525   Min.   :   4000   Min.   :20.0  
##  OTHER   :   85   1st Qu.:  40000   1st Qu.:23.0  
##  OWN     : 1945   Median :  57006   Median :26.0  
##  RENT    :13015   Mean   :  67505   Mean   :27.7  
##                   3rd Qu.:  80004   3rd Qu.:30.0  
##                   Max.   :2039784   Max.   :84.0  
##

Build Logistic Model

RNGkind(sample.kind = "Rounding") 
set.seed(417)
# index sampling
bank_split3<- sample(x = nrow(bank_clean3), size = nrow(bank_clean3)*0.8)

# splitting8
bank_split_train3 <- bank_clean3[bank_split3,] # mengambil 80% dari total data untuk digunakan sebagai data train
bank_split_test3 <- bank_clean3[-bank_split3,]
model_log_default3<-glm(loan_status ~ ., family = "binomial", data = bank_split_train3)

summary(model_log_default3)
## 
## Call:
## glm(formula = loan_status ~ ., family = "binomial", data = bank_split_train3)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.1606  -0.5347  -0.4395  -0.3316   3.3776  
## 
## Coefficients:
##                       Estimate Std. Error z value Pr(>|z|)    
## (Intercept)         -2.828e+00  2.096e-01 -13.491  < 2e-16 ***
## loan_amnt           -2.894e-06  4.032e-06  -0.718 0.472839    
## int_rate             6.685e-02  2.253e-02   2.968 0.003000 ** 
## gradeB               4.528e-01  1.063e-01   4.261 2.04e-05 ***
## gradeC               6.979e-01  1.541e-01   4.527 5.98e-06 ***
## gradeD               7.955e-01  1.951e-01   4.076 4.58e-05 ***
## gradeE               9.138e-01  2.446e-01   3.735 0.000187 ***
## gradeF               1.267e+00  3.238e-01   3.912 9.15e-05 ***
## gradeG               1.679e+00  4.442e-01   3.780 0.000157 ***
## emp_length           8.585e-03  3.455e-03   2.485 0.012956 *  
## home_ownershipOTHER  4.985e-01  3.400e-01   1.466 0.142593    
## home_ownershipOWN   -7.566e-02  9.308e-02  -0.813 0.416339    
## home_ownershipRENT  -2.066e-02  5.202e-02  -0.397 0.691193    
## annual_inc          -5.399e-06  7.511e-07  -7.187 6.62e-13 ***
## age                 -6.962e-03  3.840e-03  -1.813 0.069814 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 14109  on 20455  degrees of freedom
## Residual deviance: 13512  on 20441  degrees of freedom
## AIC: 13542
## 
## Number of Fisher Scoring iterations: 5
model_log_default_step3 <-step(object = model_log_default3,
                   direction = "backward", 
                   trace = 0)
summary(model_log_default_step3)
## 
## Call:
## glm(formula = loan_status ~ int_rate + grade + emp_length + annual_inc + 
##     age, family = "binomial", data = bank_split_train3)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.1445  -0.5347  -0.4398  -0.3320   3.3971  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -2.854e+00  2.063e-01 -13.834  < 2e-16 ***
## int_rate     6.637e-02  2.251e-02   2.948 0.003199 ** 
## gradeB       4.494e-01  1.062e-01   4.233 2.31e-05 ***
## gradeC       6.959e-01  1.541e-01   4.515 6.34e-06 ***
## gradeD       7.913e-01  1.951e-01   4.056 5.00e-05 ***
## gradeE       9.077e-01  2.444e-01   3.714 0.000204 ***
## gradeF       1.256e+00  3.234e-01   3.885 0.000102 ***
## gradeG       1.656e+00  4.433e-01   3.736 0.000187 ***
## emp_length   8.672e-03  3.392e-03   2.556 0.010583 *  
## annual_inc  -5.496e-06  6.670e-07  -8.241  < 2e-16 ***
## age         -7.071e-03  3.840e-03  -1.841 0.065563 .  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 14109  on 20455  degrees of freedom
## Residual deviance: 13515  on 20445  degrees of freedom
## AIC: 13537
## 
## Number of Fisher Scoring iterations: 5

Model Evaluation

bank_split_test3$pred_default <- predict(object = model_log_default_step3,
                     newdata = bank_split_test3,
                     type = "response")
rmarkdown::paged_table(head(as.data.frame(bank_split_test3),10))
bank_split_test3$label_default <- ifelse(test = bank_split_test3$pred_default > 0.15,
                                yes = 1,
                                no = 0)
head(bank_split_test3)
bank_split_test3$label_default <- as.factor(bank_split_test3$label_default)

class(bank_split_test3$label_default)
## [1] "factor"
head(bank_split_test3 %>% 
  select(pred_default,
          label_default,
         loan_status))
pred_table3 <- table(predict=bank_split_test3$label_default,
      actual =bank_split_test3$loan_status)
pred_table3
##        actual
## predict    0    1
##       0 3578  342
##       1  978  216

Confusion Matrix

Pada tahap ini perlu dilakukan evaluasi model dengan menggunakan confusion Matrix dengan penjelasan sebagai berikut

confusionMatrix(data = bank_split_test3$label_default, 
                reference = bank_split_test3$loan_status,
                positive = "1")
## Confusion Matrix and Statistics
## 
##           Reference
## Prediction    0    1
##          0 3578  342
##          1  978  216
##                                           
##                Accuracy : 0.7419          
##                  95% CI : (0.7297, 0.7538)
##     No Information Rate : 0.8909          
##     P-Value [Acc > NIR] : 1               
##                                           
##                   Kappa : 0.1149          
##                                           
##  Mcnemar's Test P-Value : <2e-16          
##                                           
##             Sensitivity : 0.38710         
##             Specificity : 0.78534         
##          Pos Pred Value : 0.18090         
##          Neg Pred Value : 0.91276         
##              Prevalence : 0.10911         
##          Detection Rate : 0.04224         
##    Detection Prevalence : 0.23348         
##       Balanced Accuracy : 0.58622         
##                                           
##        'Positive' Class : 1               
## 
CrossTable(bank_split_test3$label_default,bank_split_test3$loan_status)
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## | Chi-square contribution |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  5114 
## 
##  
##                                | bank_split_test3$loan_status 
## bank_split_test3$label_default |         0 |         1 | Row Total | 
## -------------------------------|-----------|-----------|-----------|
##                              0 |      3578 |       342 |      3920 | 
##                                |     2.104 |    17.179 |           | 
##                                |     0.913 |     0.087 |     0.767 | 
##                                |     0.785 |     0.613 |           | 
##                                |     0.700 |     0.067 |           | 
## -------------------------------|-----------|-----------|-----------|
##                              1 |       978 |       216 |      1194 | 
##                                |     6.908 |    56.401 |           | 
##                                |     0.819 |     0.181 |     0.233 | 
##                                |     0.215 |     0.387 |           | 
##                                |     0.191 |     0.042 |           | 
## -------------------------------|-----------|-----------|-----------|
##                   Column Total |      4556 |       558 |      5114 | 
##                                |     0.891 |     0.109 |           | 
## -------------------------------|-----------|-----------|-----------|
## 
##

Dalam meelakukan intrepretasi dari hasil confusion matrix diatas, maka perlu ditentukan kelas positif dan negatif yaitu :

  • Positif : Nasabah gagal bayar
  • Negatif : Nasabah tidak gagal bayar
  • False Negative : Calon Nasabah diprediksi tidak gagal bayar tapi gagal bayar
  • False Positif: Calon Nasabah diprediksi gagal bayar tapi tidak gagal bayar

Pada dataset ini, divisi kredit membutuhkan model ini untuk mengevaluasi presentase nasabah yang secara akurat diklasifikasikan sebagai nasabah yang lancar dalam melakukan pembayaran maka metric specificity dapat digunakan karena secara akurat mengklasifikasikan nasabah yang lancar pembayaran dan mengurangi false positif yaitu memberikan kredit pada nasabah yang diprediksi lancar namun gagal bayar sehingga bisa mengakibatkan kemungkinan kredit macet. Pada matrix diatas, presentase specificity adalah 76 %

Conclusion

  1. Pada dataset ini, divisi kredit membutuhkan model ini untuk mengevaluasi presentase nasabah yang secara akurat diklasifikasikan sebagai nasabah yang lancar dalam melakukan pembayaran maka metric specificity dapat digunakan karena secara akurat mengklasifikasikan nasabah yang lancar pembayaran dan mengurangi false positif yaitu memberikan kredit pada nasabah yang diprediksi lancar namun gagal bayar sehingga bisa mengakibatkan kemungkinan kredit macet. Pada matrix diatas, presentase specificity adalah 76 %

  2. Perlu dilakukan tuning dalam model agar dapat menaikkan metrics dalam confusion matrix sehingga dapat lebih akurat dalam intrepretasi model.