Trong bài trước ta đã so sánh kết quả của model knn trong việc phân loại các hợp đồng nợ xấu giữa các trường hợp : Chuẩn hóa, không chuẩn hóa. Tuy nhiên hiệu quả dự báo chính xác hợp đồng nợ xấu vẫn chưa được cải thiện nhiều (chỉ từ 20-23%). Ở bài phân tích này chúng ta sẽ thay đổi cách tiếp cận bằng việc loại bỏ những biến không liên quan đến tỷ lệ nợ xấu bằng hệ số tương quan. Để khách quan ta sẽ cùng training model trên cùng một tập dữ liệu như bài phân tích trước ở đường link sau:

http://rpubs.com/phamdinhkhanh/374854

Kết quả cho thấy:

rm(list = ls())
library(tidyverse)
library(data.table)
setwd("D:/Rcode/RPub/BankingData")
hmeq <- fread("hmeq.csv")

Giải thích dữ liệu hmeq. HMEQ là bộ dữ liệu về các khoản vay có tài sản đảm bảo là nhà. Dữ liệu bao gồm 5960 khoản vay được phân loại thành các nhóm vỡ nợ hoặc không vỡ nợ.

knn chỉ tính khoảng cách Euclidean của những tọa độ số học nên với các biến factor ta phải chuẩn hóa về dạng số học.

#Them bien STT
hmeq$STT <- 1:nrow(hmeq)
#Xy ly missing value
hmeq[is.na(hmeq)] <- 0
#Tim cac bien factor
str(hmeq)
## Classes 'data.table' and 'data.frame':   5960 obs. of  14 variables:
##  $ BAD    : int  1 1 1 1 0 1 1 1 1 1 ...
##  $ LOAN   : int  1100 1300 1500 1500 1700 1700 1800 1800 2000 2000 ...
##  $ MORTDUE: num  25860 70053 13500 0 97800 ...
##  $ VALUE  : num  39025 68400 16700 0 112000 ...
##  $ REASON : chr  "HomeImp" "HomeImp" "HomeImp" "" ...
##  $ JOB    : chr  "Other" "Other" "Other" "" ...
##  $ YOJ    : num  10.5 7 4 0 3 9 5 11 3 16 ...
##  $ DEROG  : num  0 0 0 0 0 0 3 0 0 0 ...
##  $ DELINQ : num  0 2 0 0 0 0 2 0 2 0 ...
##  $ CLAGE  : num  94.4 121.8 149.5 0 93.3 ...
##  $ NINQ   : num  1 0 1 0 0 1 1 0 1 0 ...
##  $ CLNO   : num  9 14 10 0 14 8 17 8 12 13 ...
##  $ DEBTINC: num  0 0 0 0 0 ...
##  $ STT    : int  1 2 3 4 5 6 7 8 9 10 ...
##  - attr(*, ".internal.selfref")=<externalptr>
#Co 2 bien numeric la REASON va JOB
#Cac gia tri factor cua REASON
hmeq %>% distinct(REASON)
##     REASON
## 1: HomeImp
## 2:        
## 3: DebtCon
#Tao bien REASON.LV
#Thong ke tan xuat REASON doi voi no xau
hmeq %>% filter(BAD == 1) %>% group_by(BAD,REASON) %>% 
  summarise(No_Loan = n()) %>% 
  arrange(No_Loan)
## Source: local data frame [3 x 3]
## Groups: BAD [1]
## 
## # A tibble: 3 x 3
##     BAD REASON  No_Loan
##   <int> <chr>     <int>
## 1     1 ""           48
## 2     1 HomeImp     396
## 3     1 DebtCon     745
#Tao bien REASON.LV gan gia tri lon hon doi voi nguyen nhan co ty le no xau cao hon
hmeq <- hmeq %>% mutate(REASON.LV = case_when(
               .$REASON == '' ~ 1,
               .$REASON == 'HomeImp' ~ 2,
               .$REASON == 'DebtCon' ~ 3
                )) 


#Cac gia tri factor cua JOB
hmeq %>% distinct(JOB)
##       JOB
## 1   Other
## 2        
## 3  Office
## 4   Sales
## 5     Mgr
## 6 ProfExe
## 7    Self
#Thong ke tan suat JOB doi voi no xau
hmeq %>% filter(BAD == 1) %>% group_by(BAD,JOB) %>% 
  summarise(No_Loan = n()) %>% 
  arrange(No_Loan) 
## Source: local data frame [7 x 3]
## Groups: BAD [1]
## 
## # A tibble: 7 x 3
##     BAD JOB     No_Loan
##   <int> <chr>     <int>
## 1     1 ""           23
## 2     1 Sales        38
## 3     1 Self         58
## 4     1 Office      125
## 5     1 Mgr         179
## 6     1 ProfExe     212
## 7     1 Other       554
#Tao bien JOB.LV gan gia tri lon hon doi voi cong viec co ty le no xau cao hon
hmeq <- hmeq %>% mutate(JOB.LV = case_when(
                .$JOB == '' ~ 1,
                .$JOB == 'Sales' ~ 2,
                .$JOB == 'Self' ~ 3,
                .$JOB == 'Office' ~ 4,
                .$JOB == 'Mgr' ~ 5,
                .$JOB == 'ProfExe' ~ 6,
                .$JOB == 'Other' ~ 7))

hmeq %>% distinct(JOB.LV)
##   JOB.LV
## 1      7
## 2      1
## 3      4
## 4      2
## 5      5
## 6      6
## 7      3

Trong các biến đưa vào model có những biến không thực sự ảnh hưởng tới nợ xấu. Vì vậy chúng ta cần đưa ra một tiêu chuẩn để lọc bỏ những biến không quan trọng trong model. Trong bài viết này tôi sẽ lựa chọn tiêu chuẩn về trị tuyệt đối hệ số tương quan > 0.15. Sử dụng gói ggcorrplot để vẽ biểu đồ visualization cho các hệ số tương quan.

library(ggcorrplot)
library(dplyr)
par(mfrow = c(2,1))
ggcorrplot(cor(select(hmeq,-STT, -REASON, -JOB)))

ggcorrplot(cor(select(hmeq,-STT, -REASON, -JOB)),method = "circle")

#Chi lay correlation doi voi BAD lon hon 0.15
cor_abs <- cor(select(hmeq,-STT, -REASON, -JOB)) %>% abs() 
is_choice <- cor_abs[,1] > 0.15
is_choice[is_choice == TRUE]
##     BAD   DEROG  DELINQ   CLAGE    NINQ DEBTINC 
##    TRUE    TRUE    TRUE    TRUE    TRUE    TRUE

Như vậy chỉ giữ lại các biến gồm DEROG, DELINQ, CLAGE, NINQ, DEBTINC.

Xây dựng model knn dựa trên các biến trên. Để đảm bảo khách quan trong so sánh kết quả model ta sẽ lấy dữ liệu tập train/test trùng với dữ liệu tập train và test đã qua chuẩn hóa ở bài phân tích trước.

library(rio)
#Import du lieu training/testing tu cac bai truoc
training_chuanhoa <- import("D:/Rcode/RPub/BankingData/training_chuanhoa.rds")
testing_chuanhoa <- import("D:/Rcode/RPub/BankingData/testing_chuanhoa.rds")
traing_adjust_cor <- training_chuanhoa %>% select(BAD, DEROG, DELINQ, CLAGE, NINQ, DEBTINC,STT)
testing_adjust_cor <- testing_chuanhoa %>% select(BAD, DEROG, DELINQ, CLAGE, NINQ, DEBTINC,STT)

Xây dựng model với voting size = 10.

library(class)
set.seed(1)
#Lay factor nhan loai no cua tap traing
cl_training_adjust_cor <- as.factor(traing_adjust_cor$BAD)

knn <- knn(train = select(traing_adjust_cor, -BAD,-STT),test = select(testing_adjust_cor, -BAD,-STT), cl = cl_training_adjust_cor,k=10)
# giá trị dự báo trên tập test:
head(knn,10)
##  [1] 1 1 1 0 0 0 1 1 0 1
## Levels: 0 1
#so sanh ket qua du bao tren tap test
library(gmodels)
CrossTable(knn,testing_adjust_cor$BAD)
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## | Chi-square contribution |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  1193 
## 
##  
##              | testing_adjust_cor$BAD 
##          knn |         0 |         1 | Row Total | 
## -------------|-----------|-----------|-----------|
##            0 |       912 |       101 |      1013 | 
##              |    12.602 |    50.568 |           | 
##              |     0.900 |     0.100 |     0.849 | 
##              |     0.955 |     0.424 |           | 
##              |     0.764 |     0.085 |           | 
## -------------|-----------|-----------|-----------|
##            1 |        43 |       137 |       180 | 
##              |    70.923 |   284.585 |           | 
##              |     0.239 |     0.761 |     0.151 | 
##              |     0.045 |     0.576 |           | 
##              |     0.036 |     0.115 |           | 
## -------------|-----------|-----------|-----------|
## Column Total |       955 |       238 |      1193 | 
##              |     0.801 |     0.199 |           | 
## -------------|-----------|-----------|-----------|
## 
## 

Ta có thể nhận thấy kết quả dự báo chính xác hợp đồng nợ xấu được cải thiện gấp hơn 2 lần (từ 22.7% lên tới 57.6%). Điều đó cho thấy việc loại bỏ những biến không liên quan tới biến dự báo và chuẩn hóa các biến khác độ đo sẽ cải thiện độ chính xác của model.

Với tỷ lệ cứ 2 hợp đồng nợ xấu thì 1 hợp đồng được dự báo chính xác thì model có thể áp dụng vào thực tế.

Ta nhận thấy 0.15 chưa đủ mạnh để đảm bảo mối quan hệ tương quan mạnh giữa biến dự báo và biến được dự báo. Chúng ta muốn nâng con số này lên 0.3.

library(ggcorrplot)
par(mfrow = c(2,1))
ggcorrplot(cor(select(hmeq,BAD, DEROG, DELINQ, CLAGE, NINQ, DEBTINC)))

## Note: no visible binding for global variable 'x' 
## Note: no visible binding for global variable 'width' 
## Note: no visible binding for global variable 'x' 
## Note: no visible binding for global variable 'width' 
## Note: no visible binding for global variable 'y' 
## Note: no visible binding for global variable 'height' 
## Note: no visible binding for global variable 'y' 
## Note: no visible binding for global variable 'height'
ggcorrplot(cor(select(hmeq,BAD, DEROG, DELINQ, CLAGE, NINQ, DEBTINC)),method = "circle")

#Chi lay correlation doi voi BAD lon hon 0.3
cor_abs <- cor(select(hmeq,BAD, DEROG, DELINQ, CLAGE, NINQ, DEBTINC)) %>% abs() 
cor_abs
##               BAD      DEROG     DELINQ      CLAGE       NINQ    DEBTINC
## BAD     1.0000000 0.26992128 0.34650326 0.16257011 0.17344867 0.41892770
## DEROG   0.2699213 1.00000000 0.17128598 0.05558241 0.14359578 0.14938419
## DELINQ  0.3465033 0.17128598 1.00000000 0.05989182 0.06866244 0.18781952
## CLAGE   0.1625701 0.05558241 0.05989182 1.00000000 0.05765636 0.08978028
## NINQ    0.1734487 0.14359578 0.06866244 0.05765636 1.00000000 0.06663547
## DEBTINC 0.4189277 0.14938419 0.18781952 0.08978028 0.06663547 1.00000000

Khi đó model chỉ còn 2 biến được lựa chọn đó là DELINQ, DEBTINC . Kiểm tra mức độ chính xác của model trong trường hợp này:

traing_adjust_cor <- training_chuanhoa %>% select(BAD, DELINQ, DEBTINC, STT)
testing_adjust_cor <- testing_chuanhoa %>% select(BAD, DELINQ, DEBTINC, STT)

Xây dựng model với voting size = 10.

library(class)
#set.seed(1)
#Lay factor nhan loai no cua tap traing
cl_training_adjust_cor <- as.factor(traing_adjust_cor$BAD)

knn <- knn(train = select(traing_adjust_cor, -BAD,-STT),test = select(testing_adjust_cor, -BAD,-STT), cl = cl_training_adjust_cor,k=10)
# giá trị dự báo trên tập test:
head(knn,10)
##  [1] 1 1 1 1 1 1 1 1 1 1
## Levels: 0 1
#so sanh ket qua du bao tren tap test
library(gmodels)
CrossTable(knn,testing_adjust_cor$BAD)
## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## | Chi-square contribution |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  1193 
## 
##  
##              | testing_adjust_cor$BAD 
##          knn |         0 |         1 | Row Total | 
## -------------|-----------|-----------|-----------|
##            0 |       867 |        67 |       934 | 
##              |    19.045 |    76.422 |           | 
##              |     0.928 |     0.072 |     0.783 | 
##              |     0.908 |     0.282 |           | 
##              |     0.727 |     0.056 |           | 
## -------------|-----------|-----------|-----------|
##            1 |        88 |       171 |       259 | 
##              |    68.681 |   275.591 |           | 
##              |     0.340 |     0.660 |     0.217 | 
##              |     0.092 |     0.718 |           | 
##              |     0.074 |     0.143 |           | 
## -------------|-----------|-----------|-----------|
## Column Total |       955 |       238 |      1193 | 
##              |     0.801 |     0.199 |           | 
## -------------|-----------|-----------|-----------|
## 
## 

Ta thấy chất lượng dự báo hợp đồng nợ xấu đã tăng độ chính xác từ 57.6% lên 71.8% sau khi nâng cao tiêu chuẩn lựa chọn biến có độ tương quan cao với nợ xấu.

Như vậy trong xây dựng model classfication, để đạt được tỷ lệ dự báo chuẩn xác các nhóm mục tiêu (ở model dự báo nợ xấu là các hợp đồng nợ xầu, đối với các model dự báo bệnh là khả năng mắc bệnh) cao chúng ta sẽ phải:

Ở bài tiếp theo ta sẽ sử dụng phương pháp PCA để so sánh xem việc đánh giá trên các biến thành phần chính (là biến tổ hợp tuyến tính từ các biến dự báo nhằm giảm số chiều của dữ liệu) có tốt hơn so với việc chỉ đánh giá trên các biến tương quan cao với nợ xấu hay không?