KNN classification CreditCard default

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ợ.

BAD: 1 = Khoản vay bị vỡ nợ; 0 = ứng viên đã trả nợ.
LOAN: Giá trị khoản vay.
MORTDUE: Giá trị tài sản đảm bảo được định giá.
VALUE: Giá trị tài sản hiện tại.
REASON: DebtCon = debt consolidation (ghép nợ); HomeImp = home improvement (sửa sang nhà cửa).
JOB: Công việc.
YOJ: Số năm trong nghề.
DEROG:Số lượng báo cáo vỡ nợ.
DELINQ: Giá trị tín dụng chưa thanh toán.
CLAGE: Độ tuổi tín dụng lâu nhất trong tháng.
NINQ: Số lượng yêu cầu tín dụng gần đây.
CLNO:Số lượng hạn mức tín dụng.
DEBTINC:Tỷ lệ nợ/thu nhập.

knn chỉ tính khoảng cách Euclician 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)
#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 NA 97800 ...
##  $ VALUE  : num  39025 68400 16700 NA 112000 ...
##  $ REASON : chr  "HomeImp" "HomeImp" "HomeImp" "" ...
##  $ JOB    : chr  "Other" "Other" "Other" "" ...
##  $ YOJ    : num  10.5 7 4 NA 3 9 5 11 3 16 ...
##  $ DEROG  : int  0 0 0 NA 0 0 3 0 0 0 ...
##  $ DELINQ : int  0 2 0 NA 0 0 2 0 2 0 ...
##  $ CLAGE  : num  94.4 121.8 149.5 NA 93.3 ...
##  $ NINQ   : int  1 0 1 NA 0 1 1 0 1 0 ...
##  $ CLNO   : int  9 14 10 NA 14 8 17 8 12 13 ...
##  $ DEBTINC: num  NA NA NA NA NA ...
##  $ 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 cong viec 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 == 'ProExe' ~ 6,
                .$JOB == 'Other' ~ 7))

hmeq %>% distinct(JOB.LV)

##   JOB.LV
## 1      7
## 2      1
## 3      4
## 4      2
## 5      5
## 6     NA
## 7      3

Phân chia tập train và test:

library(gmodels)
set.seed(1)
#Loai bo cac bien characters
hmeq <- hmeq %>% select(-REASON, -JOB)
#Xy ly missing value
hmeq[is.na(hmeq)] <- 0
hmeq_bad <- hmeq %>% filter(BAD == 1) 
hmeq_good <- setdiff(hmeq,hmeq_bad)
#Them STT cho BAD
#hmeq_bad$BADSTT <- 1:nrow(hmeq_bad)
#Chia tap train/test cua BAD theo ty le 0.8
training_bad <- hmeq_bad %>% sample_n(nrow(hmeq_bad) * 0.8) 
testing_bad <- setdiff(hmeq_bad,training_bad)
#Chia tap train/test cua GOOD theo ty le 0.8
training_good <- hmeq_good %>% sample_n(nrow(hmeq_good)*0.8)
testing_good <- setdiff(hmeq_good,training_good)
#Tao tap train/test
training <- rbind(training_bad,training_good)
testing <- rbind(testing_bad, testing_good)

CrossTable(training$BAD)

## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  4767 
## 
##  
##           |         0 |         1 | 
##           |-----------|-----------|
##           |      3816 |       951 | 
##           |     0.801 |     0.199 | 
##           |-----------|-----------|
## 
## 
## 
##

CrossTable(testing$BAD)

## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  1193 
## 
##  
##           |         0 |         1 | 
##           |-----------|-----------|
##           |       955 |       238 | 
##           |     0.801 |     0.199 | 
##           |-----------|-----------|
## 
## 
## 
##

Xây dựng model dự báo bằng phương pháp KNN, kích thước mẫu voting được lựa chọn là 10.

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

knn <- knn(train = select(training, -BAD,-STT),test = select(testing, -BAD,-STT), cl = cl_training,k=10)
# giá trị dự báo trên tập test:
head(knn,10)

##  [1] 1 0 0 0 1 1 0 0 0 1
## Levels: 0 1

So sánh kết quả dự báo trên tập test với giá trị thật

library(gmodels)
CrossTable(knn, testing$BAD)

## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## | Chi-square contribution |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  1193 
## 
##  
##              | testing$BAD 
##          knn |         0 |         1 | Row Total | 
## -------------|-----------|-----------|-----------|
##            0 |       943 |       186 |      1129 | 
##              |     1.703 |     6.834 |           | 
##              |     0.835 |     0.165 |     0.946 | 
##              |     0.987 |     0.782 |           | 
##              |     0.790 |     0.156 |           | 
## -------------|-----------|-----------|-----------|
##            1 |        12 |        52 |        64 | 
##              |    30.043 |   120.550 |           | 
##              |     0.188 |     0.812 |     0.054 | 
##              |     0.013 |     0.218 |           | 
##              |     0.010 |     0.044 |           | 
## -------------|-----------|-----------|-----------|
## Column Total |       955 |       238 |      1193 | 
##              |     0.801 |     0.199 |           | 
## -------------|-----------|-----------|-----------|
## 
##

Bảng trên có nội dung của 1 ô lần lượt từ trên xuống dưới là:

library("kableExtra")
library("knitr")

Static_Index <- c('N','Chi-square contribution ','N / Row Total','N / Col Total',
                  'N / Table Total')
Meaning <- c('So quan sat theo dac tinh (Actual, Predict)','Gia tri Chi-square','Ty le dong','Ty le cot','Ty le so voi tong the')

text.table <- data.frame(Static_Index,Meaning)

kable(text.table,"html") %>% 
  kable_styling("striped", full_width = F) %>%
  add_indent(c(1, 3, 5))

Static_Index	Meaning
N	So quan sat theo dac tinh (Actual, Predict)
Chi-square contribution	Gia tri Chi-square
N / Row Total	Ty le dong
N / Col Total	Ty le cot
N / Table Total	Ty le so voi tong the

Từ đó ta có thể thấy xác xuất dự báo đúng một hợp đồng không nợ xấu là 98.7%. Tỷ lệ dự báo đúng 1 hợp đồng nợ xấu là 21.8%. Tỷ lệ dự báo sai hợp đồng không nợ xấu thành nợ xấu là 1.3% và tỷ lệ dự báo sai hợp đồng nợ xấu thành không nợ xấu (đây là rủi ro lớn nhất đối với bank) là 78.2%. Tỷ lệ dự báo đúng 1 hợp đồng nợ xấu cao hơn so với xác xuất ngẫu nhiên một hợp đồng là nợ xấu là 19.9%. Tuy nhiên đối với ngân hàng, mức độ dự báo chính xác được hợp đồng nợ xấu như vậy còn tương đối thấp. Ta thử điều chỉnh kích thước tập voting để xem model có sự cải thiện hay không?

#Tao vong lap dieu chinh kich thuoc voting size
result <- data.frame()
df <- data.frame()
for (i in 1:25) {
  knn <- knn(train = select(training, -BAD, -STT),test = select(testing, -BAD, -STT), cl = cl_training,k=i)
  df <- data.frame(voting_size = i, knn)
  result <- rbind(df,result)
}


#Tao vong lap luu label BAD cua testing ung voi moi vong lap
actual <- data.frame()
for (i in 1:25) {
  df <- data.frame(voting_size = i,BAD = testing[,1])
  actual <- rbind(df,actual)
}

#Merge gia tri actual va gia tri forecast cua knn ung voi voting_size
result$actual <- actual$BAD

Hiển thị các kết quả tần xuất dự báo chính xác trên tập test

#Dự báo chính xác trường hợp nợ xấu
result %>% group_by(voting_size, actual, knn) %>%
  summarise(No_Loan = n()) %>% 
  filter(actual == 1, knn == 1) %>% 
  arrange(desc(No_Loan))

## Source: local data frame [25 x 4]
## Groups: voting_size, actual [25]
## 
## # A tibble: 25 x 4
##    voting_size actual knn   No_Loan
##          <int>  <int> <fct>   <int>
##  1           2      1 1         101
##  2           1      1 1          93
##  3           3      1 1          70
##  4           4      1 1          67
##  5           5      1 1          65
##  6           6      1 1          65
##  7           8      1 1          61
##  8           7      1 1          57
##  9           9      1 1          57
## 10          10      1 1          52
## # ... with 15 more rows

#Dự báo chính xác trường hợp không nợ xấu
result %>% group_by(voting_size, actual, knn) %>%
  summarise(No_Loan = n()) %>% 
  filter(actual == 0, knn == 0) %>% 
  arrange(desc(No_Loan))

## Source: local data frame [25 x 4]
## Groups: voting_size, actual [25]
## 
## # A tibble: 25 x 4
##    voting_size actual knn   No_Loan
##          <int>  <int> <fct>   <int>
##  1          21      0 0         949
##  2          25      0 0         949
##  3          17      0 0         948
##  4          19      0 0         948
##  5          22      0 0         948
##  6          23      0 0         948
##  7          24      0 0         948
##  8          16      0 0         947
##  9          18      0 0         947
## 10          20      0 0         947
## # ... with 15 more rows

Luôn có sự đánh đổi giữa dự báo chính xác trường hợp nợ xấu và dự báo chính xác trường hợp không nợ xấu. Trong từng trườn hợp của voting_size thì khi tỷ lệ dự báo chính xác nợ xấu cao sẽ tương ứng với lệ dự báo chính xác không nợ xấu thấp và ngược lại. Muốn ưu tiên dự báo chính xác nợ xấu ta sẽ lựa chọn voting_size thấp và muốn ưu tiên dự báo chính xác trường hợp không nợ xấu ta sẽ nâng cao voting_size.

Tuy nhiên chúng ta nhận thấy một điểm yếu của knn đó là sự khác biệt về độ đo của các biến số sẽ ảnh hưởng đến kết quả dự báo khi mà các biến có số đo lớn sẽ có tác động mạnh tới khoảng cách euclician. Do đó nếu chuẩn hóa độ đo liệu kết quả dự báo của model có cải thiện hay không? Ta sẽ thử nghiệm như bên dưới.

Xây dựng hàm chuẩn hóa dữ liệu:

#Ham chuan hoa 1
chuanhoa_min_max <- function(x){
  (x-min(x))/(max(x)-mean(x))
}
#Ham chuan hoa 2
chuanhoa_std <- function(x){
  (x-mean(x))/sd(x)
}

Áp dụng các hàm chuẩn hóa trên cho tập dữ liệu

Chuẩn hóa min-max

#Chuan hoa tren tap du lieu hmeq
hmeq_chuanhoa <- as.data.frame(lapply(select(hmeq,-BAD,-STT),chuanhoa_min_max)) %>%   data.frame(BAD=hmeq$BAD,.,STT=hmeq$STT)
#Lay tap training
training_chuanhoa <- hmeq_chuanhoa %>% filter(STT %in% training$STT)
#Lay tap testing
testing_chuanhoa <- hmeq_chuanhoa %>% filter(STT %in% testing$STT)
#Xay dung model knn

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

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

knn <- knn(train = select(training_chuanhoa, -BAD,-STT),test = select(testing_chuanhoa, -BAD,-STT), cl = cl_training,k=10)
# giá trị dự báo trên tập test:
head(knn,10)

##  [1] 1 1 1 0 1 1 1 0 1 0
## Levels: 0 1

#so sanh ket qua du bao tren tap test
CrossTable(knn,testing_chuanhoa$BAD)

## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## | Chi-square contribution |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  1193 
## 
##  
##              | testing_chuanhoa$BAD 
##          knn |         0 |         1 | Row Total | 
## -------------|-----------|-----------|-----------|
##            0 |       822 |       191 |      1013 | 
##              |     0.152 |     0.609 |           | 
##              |     0.811 |     0.189 |     0.849 | 
##              |     0.861 |     0.803 |           | 
##              |     0.689 |     0.160 |           | 
## -------------|-----------|-----------|-----------|
##            1 |       133 |        47 |       180 | 
##              |     0.854 |     3.425 |           | 
##              |     0.739 |     0.261 |     0.151 | 
##              |     0.139 |     0.197 |           | 
##              |     0.111 |     0.039 |           | 
## -------------|-----------|-----------|-----------|
## Column Total |       955 |       238 |      1193 | 
##              |     0.801 |     0.199 |           | 
## -------------|-----------|-----------|-----------|
## 
##

Ta thấy kết quả của chuẩn hóa min max đã cải thiện được chất lượng model khi tỷ lệ dự báo chính xác hợp đồng vỡ nợ cao hơn khi chưa chuẩn hóa (22.3% so với 21.8%).

Tiến hành benchmark model với các giá trị voting size khác nhau:

#Tao vong lap dieu chinh kich thuoc voting size
result <- data.frame()
df <- data.frame()
for (i in 1:25) {
  knn <- knn(train = select(training_chuanhoa, -BAD, -STT),test = select(testing_chuanhoa, -BAD, -STT), cl = cl_training_chuanhoa,k=i)
  df <- data.frame(voting_size = i, knn)
  result <- rbind(df,result)
}


#Tao vong lap luu label BAD cua testing ung voi moi vong lap
actual <- data.frame()
for (i in 1:25) {
  df <- data.frame(voting_size = i,BAD = testing_chuanhoa[,1])
  actual <- rbind(df,actual)
}

#Merge gia tri actual va gia tri forecast cua knn ung voi voting_size
result$actual <- actual$BAD

Hiển thị các kết quả tần xuất dự báo chính xác trên tập test

#Dự báo chính xác trường hợp nợ xấu
result %>% group_by(voting_size, actual, knn) %>%
  summarise(No_Loan = n()) %>% 
  filter(actual == 1, knn == 1) %>% 
  arrange(desc(No_Loan))

## Source: local data frame [25 x 4]
## Groups: voting_size, actual [25]
## 
## # A tibble: 25 x 4
##    voting_size actual knn   No_Loan
##          <int>  <int> <fct>   <int>
##  1           1      1 1         149
##  2           2      1 1         136
##  3           3      1 1         118
##  4           4      1 1         107
##  5           5      1 1         101
##  6           6      1 1          91
##  7           8      1 1          86
##  8           7      1 1          82
##  9           9      1 1          74
## 10          10      1 1          70
## # ... with 15 more rows

#Dự báo chính xác trường hợp không nợ xấu
result %>% group_by(voting_size, actual, knn) %>%
  summarise(No_Loan = n()) %>% 
  filter(actual == 0, knn == 0) %>% 
  arrange(desc(No_Loan))

## Source: local data frame [25 x 4]
## Groups: voting_size, actual [25]
## 
## # A tibble: 25 x 4
##    voting_size actual knn   No_Loan
##          <int>  <int> <fct>   <int>
##  1          15      0 0         949
##  2           9      0 0         948
##  3          10      0 0         948
##  4          11      0 0         948
##  5          12      0 0         948
##  6          13      0 0         948
##  7          14      0 0         948
##  8          21      0 0         948
##  9           4      0 0         947
## 10           5      0 0         947
## # ... with 15 more rows

Chuẩn hóa std

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

library(class)
set.seed(123)
#Lay factor nhan loai no cua tap traing
cl_training_chuanhoa <- as.factor(training_chuanhoa$BAD)

knn <- knn(train = select(training_chuanhoa, -BAD,-STT),test = select(testing_chuanhoa, -BAD,-STT), cl = cl_training,k=10)
# giá trị dự báo trên tập test:
head(knn,10)

##  [1] 1 1 1 0 1 1 1 0 1 0
## Levels: 0 1

#so sanh ket qua du bao tren tap test
CrossTable(knn,testing_chuanhoa$BAD)

## 
##  
##    Cell Contents
## |-------------------------|
## |                       N |
## | Chi-square contribution |
## |           N / Row Total |
## |           N / Col Total |
## |         N / Table Total |
## |-------------------------|
## 
##  
## Total Observations in Table:  1193 
## 
##  
##              | testing_chuanhoa$BAD 
##          knn |         0 |         1 | Row Total | 
## -------------|-----------|-----------|-----------|
##            0 |       820 |       189 |      1009 | 
##              |     0.187 |     0.751 |           | 
##              |     0.813 |     0.187 |     0.846 | 
##              |     0.859 |     0.794 |           | 
##              |     0.687 |     0.158 |           | 
## -------------|-----------|-----------|-----------|
##            1 |       135 |        49 |       184 | 
##              |     1.026 |     4.117 |           | 
##              |     0.734 |     0.266 |     0.154 | 
##              |     0.141 |     0.206 |           | 
##              |     0.113 |     0.041 |           | 
## -------------|-----------|-----------|-----------|
## Column Total |       955 |       238 |      1193 | 
##              |     0.801 |     0.199 |           | 
## -------------|-----------|-----------|-----------|
## 
##

Kết quả chuẩn hóa theo standard deviation cho thấy tỷ lệ dự báo chính xác hợp đồng xấu đã tăng lên 22.7% so với trước chuẩn hóa là 21.8%.

Tiến hành benchmark model với các giá trị voting size khác nhau:

#Tao vong lap dieu chinh kich thuoc voting size
result <- data.frame()
df <- data.frame()
for (i in 1:25) {
  knn <- knn(train = select(training_chuanhoa, -BAD, -STT),test = select(testing_chuanhoa, -BAD, -STT), cl = cl_training_chuanhoa,k=i)
  df <- data.frame(voting_size = i, knn)
  result <- rbind(df,result)
}


#Tao vong lap luu label BAD cua testing ung voi moi vong lap
actual <- data.frame()
for (i in 1:25) {
  df <- data.frame(voting_size = i,BAD = testing_chuanhoa[,1])
  actual <- rbind(df,actual)
}

#Merge gia tri actual va gia tri forecast cua knn ung voi voting_size
result$actual <- actual$BAD

Hiển thị các kết quả tần xuất dự báo chính xác trên tập test

#Dự báo chính xác trường hợp nợ xấu
result %>% group_by(voting_size, actual, knn) %>%
  summarise(No_Loan = n()) %>% 
  filter(actual == 1, knn == 1) %>% 
  arrange(desc(No_Loan))

## Source: local data frame [25 x 4]
## Groups: voting_size, actual [25]
## 
## # A tibble: 25 x 4
##    voting_size actual knn   No_Loan
##          <int>  <int> <fct>   <int>
##  1           1      1 1         149
##  2           2      1 1         128
##  3           3      1 1         118
##  4           4      1 1         108
##  5           5      1 1         101
##  6           6      1 1          89
##  7           7      1 1          82
##  8           8      1 1          80
##  9           9      1 1          74
## 10          10      1 1          71
## # ... with 15 more rows

#Dự báo chính xác trường hợp không nợ xấu
result %>% group_by(voting_size, actual, knn) %>%
  summarise(No_Loan = n()) %>% 
  filter(actual == 0, knn == 0) %>% 
  arrange(desc(No_Loan))

## Source: local data frame [25 x 4]
## Groups: voting_size, actual [25]
## 
## # A tibble: 25 x 4
##    voting_size actual knn   No_Loan
##          <int>  <int> <fct>   <int>
##  1          15      0 0         949
##  2          16      0 0         949
##  3           6      0 0         948
##  4           9      0 0         948
##  5          10      0 0         948
##  6          11      0 0         948
##  7          12      0 0         948
##  8          13      0 0         948
##  9          14      0 0         948
## 10          21      0 0         948
## # ... with 15 more rows

Như vậy tỷ lệ dự báo chính xác của knn khi chuẩn hóa cũng tuân theo qui luật khi voting size tăng thì tỷ lệ dự báo chính xác hợp đồng vỡ nợ giảm và voting size giảm thì tỷ lệ dự báo chính xác hợp động không vỡ nợ tăng. Bài tiếp theo chúng ta sẽ làm một phép so sánh giữa phương pháp knn và các phương pháp khác trong hiệu quả xác định chính xác 1 hợp đồng vỡ nợ trên chính tập số liệu này.

KNN classification CreditCard default

Pham Dinh Khanh

March 25, 2018