MÔ HÌNH CHẤM ĐIỂM TÍN DỤNG KHÁCH HÀNG CÁ NHÂN
Nguyễn Ngọc Quỳnh Anh
2024-04-15
NGUỒN DỮ LIỆU: KAGGLE
Mục tiêu của mô hình chấm điểm tín dụng là dự đoán độ tin cậy của khách hàng và xác định xem họ có thể đáp ứng một nghĩa vụ tài chính nhất định hay không trả được nợ. Những mô hình như vậy cho phép các tổ chức tài chính giảm thiểu rủi ro thua lỗ bằng cách đặt ra các quy tắc liên quan đến việc quyết định khách hàng nào sẽ nhận được khoản vay và phê duyệt thẻ tín dụng. Trong dự án này, tôi sẽ sử dụng các phương pháp thống kê và học máy qua các mô hình Logistics (Logistics Regression), cây quyết định (Decision Trees) và rừng cây ngẫu nhiên (Random Forest) để dự đoán mức độ tin cậy của 4446 khách hàng cá nhân vay vốn tại ngân hàng. Thông qua kết quả so sánh độ chính xác của các mô hình, tôi sẽ xác định được mô hình có độ chính xác trong dự đoán cao nhất, từ đó khuyến nghị ngân hàng nên lựa chọn mô hình đó để phân loại. Cuối cùng, tôi sử dụng hồi quy logit để chấm điểm tín dụng khách hàng cá nhân.
TIỀN XỬ LÝ DỮ LIỆU
#Call packages
library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.3.2## Warning: package 'readr' was built under R version 4.3.2## Warning: package 'forcats' was built under R version 4.3.2## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.2 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.3 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errorslibrary(dplyr)
library(readxl)
library(ModelMetrics)## Warning: package 'ModelMetrics' was built under R version 4.3.3##
## Attaching package: 'ModelMetrics'
##
## The following object is masked from 'package:base':
##
## kappalibrary(caret)## Warning: package 'caret' was built under R version 4.3.3## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following objects are masked from 'package:ModelMetrics':
##
## confusionMatrix, precision, recall, sensitivity, specificity
##
## The following object is masked from 'package:purrr':
##
## lift#Import Data from Excel file
credit = read_excel("D:/FRM/Quản trị rủi ro định lượng 2/DATA for Assignment/CreditScoring.xlsx")
View(credit)
#Thống kê mô tả
summary(credit)## BAD Seniority Home Time
## Min. :0.0000 Min. : 0.000 Length:4446 Min. : 6.00
## 1st Qu.:0.0000 1st Qu.: 2.000 Class :character 1st Qu.:36.00
## Median :0.0000 Median : 5.000 Mode :character Median :48.00
## Mean :0.2809 Mean : 7.991 Mean :46.45
## 3rd Qu.:1.0000 3rd Qu.:12.000 3rd Qu.:60.00
## Max. :1.0000 Max. :48.000 Max. :72.00
## Age Marital Records Job
## Min. :18.00 Length:4446 Length:4446 Length:4446
## 1st Qu.:28.00 Class :character Class :character Class :character
## Median :36.00 Mode :character Mode :character Mode :character
## Mean :37.08
## 3rd Qu.:45.00
## Max. :68.00
## Expenses Income Assets Debt
## Min. : 35.0 Min. : 1.0 Min. : 0 Min. : 0.0
## 1st Qu.: 35.0 1st Qu.: 90.0 1st Qu.: 0 1st Qu.: 0.0
## Median : 51.0 Median :124.0 Median : 3000 Median : 0.0
## Mean : 55.6 Mean :140.6 Mean : 5355 Mean : 342.3
## 3rd Qu.: 72.0 3rd Qu.:170.0 3rd Qu.: 6000 3rd Qu.: 0.0
## Max. :180.0 Max. :959.0 Max. :300000 Max. :30000.0
## Amount Price
## Min. : 100 Min. : 105
## 1st Qu.: 700 1st Qu.: 1116
## Median :1000 Median : 1400
## Mean :1039 Mean : 1462
## 3rd Qu.:1300 3rd Qu.: 1692
## Max. :5000 Max. :11140#Check missing value
colSums(is.na(credit))## BAD Seniority Home Time Age Marital Records Job
## 0 0 0 0 0 0 0 0
## Expenses Income Assets Debt Amount Price
## 0 0 0 0 0 0#Box-plot cho các biến numeric
#Tạo data chỉ gồm các biến numeric
numeric_data = credit[sapply(credit, is.numeric)]
#Tách biến BAD ra khỏi data các biến numeric
xx = numeric_data[, !(names(numeric_data) %in% "BAD")]
#Vẽ boxplot
boxplot(xx[,-4]) #Có tồn tại Outliers
#Check Outliers
#Tính z-score cho mỗi biến numeric
z_scores = scale(xx)
#Xác định outliers
outliers = apply(z_scores, 2, function(col) (col > 3) | (col < -3))
sum(outliers ==TRUE)## [1] 394#Tỉ lệ GOOD/BAD
credit = credit %>% dplyr::rename(BAD = BAD)
table(credit$BAD)##
## 0 1
## 3197 1249round(prop.table(table(credit$BAD)),3)##
## 0 1
## 0.719 0.281ggplot(credit,aes(x = factor(BAD), fill = factor(BAD))) +
geom_bar()+
scale_fill_manual(values = c("#66c2a0", "#fc8d69"))+
xlab("BAD") +
ylab("Count") +
ggtitle("Count plot of BAD") +
theme_minimal()
KIỂM TRA SỰ TƯƠNG QUAN GIỮA CÁC BIẾN ĐỘC LẬP
library(corrplot)## Warning: package 'corrplot' was built under R version 4.3.3## corrplot 0.92 loaded#Tương quan giữa các biến định lượng
#Tạo data chỉ gồm các biến numeric
numeric_data1 = credit[sapply(credit, is.numeric)]
#Tách biến BAD ra khỏi data các biến numeric
xx1 = numeric_data1[, !(names(numeric_data1) %in% "BAD")]
xx2 = cor(xx1)
#Tương quan giữa 2 biến Price và Amount là cao nhất, xấp xỉ 0.7 => Vẫn nằm trong phạm vi cho phép vì nếu tương quan > 0.7 thì sẽ dựa theo IV của biến nào cao hơn sẽ giữ lại
corrplot(xx2,tl.col = "black")
CHIA TẬP DỮ LIỆU TRAIN VÀ TEST
# train 70% - test 30%
set.seed(17777)
ind = sample(2, nrow(credit), replace = TRUE, prob = c(0.7, 0.3))
train.credit = credit [ind == 1, ]
test.credit = credit [ind == 2, ]MÔ HÌNH LOGIT CHO TẬP TRAIN VỚI CÁC BIẾN ĐƯỢC PHÂN NHÓM THEO WOE
Quá trình hồi quy sẽ tiếp nhận features đầu vào đã được tiền xử lý theo phương pháp trọng số dấu hiệu (WOE - weight of evidence). Đầu ra của mô hình là xác suất vỡ nợ (default probability) của một hồ sơ vay vốn. Xác suất càng cao là dấu hiệu cho thấy khả năng xảy ra rủi ro càng lớn. Từ xác suất, thông qua các phép scale ta sẽ biến đổi sang credit score đại diện cho mức độ uy tín của khách hàng cá nhân. Điểm số này bằng tổng các điểm số tương ứng với mỗi một đặc trưng của người dùng được tạo ra từ WOE.
#Xác định IV của từng biến cho tập train
library(ROSE)## Warning: package 'ROSE' was built under R version 4.3.3## Loaded ROSE 0.0-4IV = Information::create_infotables(data = train.credit, y = "BAD", parallel = FALSE)
print(IV$Summary)## Variable IV
## 1 Seniority 0.5027229039
## 7 Job 0.3650265724
## 6 Records 0.3565615434
## 9 Income 0.2373614964
## 10 Assets 0.2098821657
## 2 Home 0.1971169613
## 12 Amount 0.1482082928
## 4 Age 0.1019360045
## 5 Marital 0.0727805395
## 8 Expenses 0.0715250803
## 3 Time 0.0698550985
## 13 Price 0.0661207021
## 11 Debt 0.0003336772#Loại các biến có IV nhỏ hơn 0.02
vars_removed = IV$Summary %>% as.data.frame %>%
subset(IV < 0.02) %>% pull(1)
vars_removed## [1] "Debt"train.credit_removed = train.credit %>% dplyr::select(-all_of(vars_removed))Bin các biến theo woe:
library(scorecard)## Warning: package 'scorecard' was built under R version 4.3.3##
## Attaching package: 'scorecard'## The following object is masked from 'package:tidyr':
##
## replace_nabins = woebin(train.credit_removed, y = "BAD")## ℹ Creating woe binning ...## ✔ Binning on 3154 rows and 13 columns in 00:00:03woebin_plot(bins)## $Seniority
##
## $Home
##
## $Time
##
## $Age
##
## $Marital
##
## $Records
##
## $Job
##
## $Expenses
##
## $Income
##
## $Assets
##
## $Amount
##
## $Price
#Chuyển dữ liệu sang WOE
train.credit_woe = woebin_ply(train.credit_removed, bins)## ℹ Converting into woe values ...## ✔ Woe transformating on 3154 rows and 12 columns in 00:00:00head(train.credit_woe)Mô hình logit cho tập train
logit.model_woe = glm(BAD ~., family = binomial(link = 'logit'), data = train.credit_woe )
summary(logit.model_woe)##
## Call:
## glm(formula = BAD ~ ., family = binomial(link = "logit"), data = train.credit_woe)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.96268 0.04862 -19.800 < 2e-16 ***
## Seniority_woe 0.74401 0.07639 9.740 < 2e-16 ***
## Home_woe 0.42427 0.15069 2.815 0.004871 **
## Time_woe 0.95009 0.21624 4.394 1.11e-05 ***
## Age_woe 0.23097 0.16590 1.392 0.163868
## Marital_woe -0.43261 0.22733 -1.903 0.057041 .
## Records_woe 1.15493 0.07883 14.651 < 2e-16 ***
## Job_woe 0.76839 0.08115 9.469 < 2e-16 ***
## Expenses_woe 0.62510 0.16431 3.804 0.000142 ***
## Income_woe 1.02968 0.09941 10.358 < 2e-16 ***
## Assets_woe 0.53331 0.15155 3.519 0.000433 ***
## Amount_woe 1.23942 0.13923 8.902 < 2e-16 ***
## Price_woe 0.71020 0.18072 3.930 8.50e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 3738.2 on 3153 degrees of freedom
## Residual deviance: 2749.6 on 3141 degrees of freedom
## AIC: 2775.6
##
## Number of Fisher Scoring iterations: 5Lọc biến theo stepwise để giảm overfitting
train.step_woe = step(logit.model_woe, direction = "backward", trace = 0)
summary(train.step_woe)##
## Call:
## glm(formula = BAD ~ Seniority_woe + Home_woe + Time_woe + Marital_woe +
## Records_woe + Job_woe + Expenses_woe + Income_woe + Assets_woe +
## Amount_woe + Price_woe, family = binomial(link = "logit"),
## data = train.credit_woe)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -0.96310 0.04860 -19.817 < 2e-16 ***
## Seniority_woe 0.76122 0.07532 10.107 < 2e-16 ***
## Home_woe 0.43083 0.15043 2.864 0.004184 **
## Time_woe 0.95053 0.21558 4.409 1.04e-05 ***
## Marital_woe -0.33611 0.21624 -1.554 0.120097
## Records_woe 1.15453 0.07882 14.647 < 2e-16 ***
## Job_woe 0.77371 0.08102 9.549 < 2e-16 ***
## Expenses_woe 0.63010 0.16439 3.833 0.000127 ***
## Income_woe 1.02936 0.09929 10.367 < 2e-16 ***
## Assets_woe 0.53953 0.15139 3.564 0.000365 ***
## Amount_woe 1.24196 0.13911 8.928 < 2e-16 ***
## Price_woe 0.71477 0.18049 3.960 7.49e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 3738.2 on 3153 degrees of freedom
## Residual deviance: 2751.5 on 3142 degrees of freedom
## AIC: 2775.5
##
## Number of Fisher Scoring iterations: 5#Tính độ chính xác của mô hình Logit trên tập train
train.prob_woe = predict(train.step_woe, type = "response")
train.pred_woe = ifelse(train.prob_woe > .5, "1", "0")
train.pred_woe = as.factor(train.pred_woe)
train.credit_woe$BAD = as.factor(train.credit_woe$BAD)
caret::confusionMatrix(train.pred_woe, train.credit_woe$BAD, positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 2079 457
## 1 193 425
##
## Accuracy : 0.7939
## 95% CI : (0.7794, 0.8079)
## No Information Rate : 0.7204
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.4369
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.4819
## Specificity : 0.9151
## Pos Pred Value : 0.6877
## Neg Pred Value : 0.8198
## Prevalence : 0.2796
## Detection Rate : 0.1347
## Detection Prevalence : 0.1959
## Balanced Accuracy : 0.6985
##
## 'Positive' Class : 1
## Accuracy của mô hình Logistic trên tập train là 79.39%
Thực hiện mô hình trên tập test cho mô hình logit với dữ liệu ban đầu
test.credit_woe = woebin_ply(test.credit[-12], bins)## ℹ Converting into woe values ...## ✔ Woe transformating on 1292 rows and 12 columns in 00:00:00test.credit_woe$BAD = as.factor(test.credit_woe$BAD)
test.prob_woe= predict(train.step_woe, test.credit_woe, type = 'response')
test.pred_woe= as.factor(ifelse(test.prob_woe > 0.5, 1, 0))
caret::confusionMatrix(test.pred_woe, test.credit_woe$BAD, positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 830 198
## 1 95 169
##
## Accuracy : 0.7732
## 95% CI : (0.7494, 0.7958)
## No Information Rate : 0.7159
## P-Value [Acc > NIR] : 1.805e-06
##
## Kappa : 0.3909
##
## Mcnemar's Test P-Value : 2.539e-09
##
## Sensitivity : 0.4605
## Specificity : 0.8973
## Pos Pred Value : 0.6402
## Neg Pred Value : 0.8074
## Prevalence : 0.2841
## Detection Rate : 0.1308
## Detection Prevalence : 0.2043
## Balanced Accuracy : 0.6789
##
## 'Positive' Class : 1
## Accuracy của mô hình Logistic trên tập test là 77.32%
Thực hiện tính score:
my_card = scorecard(bins,train.step_woe, points0 = 600, odds0 = 1/19, pdo = 50)
my_card## $basepoints
## variable bin woe points
## 1: basepoints NA NA 457
##
## $Seniority
## variable bin count count_distr neg pos posprob woe
## 1: Seniority [-Inf,2) 725 0.2298668 367 358 0.4937931 0.9213949
## 2: Seniority [2,3) 334 0.1058973 210 124 0.3712575 0.4193978
## 3: Seniority [3,12) 1237 0.3922004 942 295 0.2384802 -0.2148062
## 4: Seniority [12, Inf) 858 0.2720355 753 105 0.1223776 -1.0238812
## bin_iv total_iv breaks is_special_values points
## 1: 0.22515574 0.48002 2 FALSE -51
## 2: 0.02019819 0.48002 3 FALSE -23
## 3: 0.01721576 0.48002 12 FALSE 12
## 4: 0.21745028 0.48002 Inf FALSE 56
##
## $Home
## variable bin count count_distr neg pos posprob
## 1: Home owner 1486 0.4711477 1198 288 0.1938089
## 2: Home parents%,%ignore%,%priv 756 0.2396956 525 231 0.3055556
## 3: Home rent 685 0.2171845 424 261 0.3810219
## 4: Home other 227 0.0719721 125 102 0.4493392
## woe bin_iv total_iv breaks is_special_values
## 1: -0.4792246 0.096208225 0.1954974 owner FALSE
## 2: 0.1252432 0.003861349 0.1954974 parents%,%ignore%,%priv FALSE
## 3: 0.4610107 0.050387844 0.1954974 rent FALSE
## 4: 0.7428828 0.045039983 0.1954974 other FALSE
## points
## 1: 15
## 2: -4
## 3: -14
## 4: -23
##
## $Time
## variable bin count count_distr neg pos posprob woe
## 1: Time [-Inf,20) 200 0.06341154 173 27 0.1350000 -0.91123100
## 2: Time [20,35) 267 0.08465441 215 52 0.1947566 -0.47317059
## 3: Time [35, Inf) 2687 0.85193405 1884 803 0.2988463 0.09342598
## bin_iv total_iv breaks is_special_values points
## 1: 0.041490281 0.06595657 20 FALSE 62
## 2: 0.016879587 0.06595657 35 FALSE 32
## 3: 0.007586702 0.06595657 Inf FALSE -6
##
## $Marital
## variable bin count count_distr neg pos posprob
## 1: Marital widow%,%married 2351 0.7454027 1760 591 0.2513824
## 2: Marital single%,%divorced%,%separated 803 0.2545973 512 291 0.3623910
## woe bin_iv total_iv breaks
## 1: -0.1450293 0.01516715 0.05503533 widow%,%married
## 2: 0.3812224 0.03986818 0.05503533 single%,%divorced%,%separated
## is_special_values points
## 1: FALSE -4
## 2: FALSE 9
##
## $Records
## variable bin count count_distr neg pos posprob woe bin_iv
## 1: Records no_rec 2615 0.8291059 2035 580 0.2217973 -0.3089993 0.07356971
## 2: Records yes_rec 539 0.1708941 237 302 0.5602968 1.1885906 0.28299183
## total_iv breaks is_special_values points
## 1: 0.3565615 no_rec FALSE 26
## 2: 0.3565615 yes_rec FALSE -99
##
## $Job
## variable bin count count_distr neg pos posprob woe
## 1: Job fixed 2004 0.6353836 1593 411 0.2050898 -0.4085574
## 2: Job freelance%,%others 831 0.2634750 560 271 0.3261131 0.2204058
## 3: Job partime 319 0.1011414 119 200 0.6269592 1.4654176
## bin_iv total_iv breaks is_special_values points
## 1: 0.09607552 0.3650116 fixed FALSE 23
## 2: 0.01339568 0.3650116 freelance%,%others FALSE -12
## 3: 0.25554041 0.3650116 partime FALSE -82
##
## $Expenses
## variable bin count count_distr neg pos posprob woe
## 1: Expenses [-Inf,44) 907 0.28757134 613 294 0.3241455 0.21143856
## 2: Expenses [44,46) 583 0.18484464 461 122 0.2092624 -0.38315327
## 3: Expenses [46,58) 179 0.05675333 118 61 0.3407821 0.28641296
## 4: Expenses [58,64) 629 0.19942930 494 135 0.2146264 -0.35103701
## 5: Expenses [64,82) 545 0.17279645 398 147 0.2697248 -0.04979569
## 6: Expenses [82, Inf) 311 0.09860495 188 123 0.3954984 0.52196612
## bin_iv total_iv breaks is_special_values points
## 1: 0.013432056 0.09573024 44 FALSE -10
## 2: 0.024745163 0.09573024 46 FALSE 17
## 3: 0.004933285 0.09573024 58 FALSE -13
## 4: 0.022595674 0.09573024 64 FALSE 16
## 5: 0.000423731 0.09573024 82 FALSE 2
## 6: 0.029600335 0.09573024 Inf FALSE -24
##
## $Income
## variable bin count count_distr neg pos posprob woe
## 1: Income [-Inf,60) 216 0.06848446 102 114 0.5277778 1.0574494
## 2: Income [60,100) 752 0.23842739 454 298 0.3962766 0.5252200
## 3: Income [100, Inf) 2186 0.69308814 1716 470 0.2150046 -0.3487949
## bin_iv total_iv breaks is_special_values points
## 1: 0.08920361 0.23928 60 FALSE -79
## 2: 0.07250375 0.23928 100 FALSE -39
## 3: 0.07757263 0.23928 Inf FALSE 26
##
## $Assets
## variable bin count count_distr neg pos posprob woe
## 1: Assets [-Inf,2000) 1228 0.38934686 751 477 0.3884365 0.49233456
## 2: Assets [2000,3000) 159 0.05041218 112 47 0.2955975 0.07787245
## 3: Assets [3000, Inf) 1767 0.56024096 1409 358 0.2026033 -0.42387880
## bin_iv total_iv breaks is_special_values points
## 1: 0.103523460 0.1946558 2000 FALSE -19
## 2: 0.000310883 0.1946558 3000 FALSE -3
## 3: 0.090821442 0.1946558 Inf FALSE 16
##
## $Amount
## variable bin count count_distr neg pos posprob woe
## 1: Amount [-Inf,750) 820 0.2599873 653 167 0.2036585 -0.4173596
## 2: Amount [750,1150) 1131 0.3585923 857 274 0.2422635 -0.1940861
## 3: Amount [1150,1450) 652 0.2067216 441 211 0.3236196 0.2090370
## 4: Amount [1450, Inf) 551 0.1746988 321 230 0.4174229 0.6128619
## bin_iv total_iv breaks is_special_values points
## 1: 0.040930275 0.1365068 750 FALSE 37
## 2: 0.012915092 0.1365068 1150 FALSE 17
## 3: 0.009433194 0.1365068 1450 FALSE -19
## 4: 0.073228273 0.1365068 Inf FALSE -55
##
## $Price
## variable bin count count_distr neg pos posprob woe
## 1: Price [-Inf,950) 433 0.13728599 276 157 0.3625866 0.38206866
## 2: Price [950,1050) 183 0.05802156 127 56 0.3060109 0.12738833
## 3: Price [1050,1400) 920 0.29169309 723 197 0.2141304 -0.35398177
## 4: Price [1400,1750) 938 0.29740013 687 251 0.2675906 -0.06065763
## 5: Price [1750,2350) 500 0.15852885 347 153 0.3060000 0.12733687
## 6: Price [2350, Inf) 180 0.05707039 112 68 0.3777778 0.44723256
## bin_iv total_iv breaks is_special_values points
## 1: 0.0215966841 0.07229922 950 FALSE -20
## 2: 0.0009674094 0.07229922 1050 FALSE -7
## 3: 0.0335807715 0.07229922 1400 FALSE 18
## 4: 0.0010794790 0.07229922 1750 FALSE 3
## 5: 0.0026410321 0.07229922 2350 FALSE -7
## 6: 0.0124338393 0.07229922 Inf FALSE -23# Scorecard Points for test data set:
my_points_test = scorecard_ply(test.credit[-12], my_card, print_step = 0,
only_total_score = FALSE) %>% as.data.frame()
df_scored_test = test.credit[-12] %>%
mutate(SCORE = my_points_test$score) %>%
mutate(BAD = case_when(BAD == 1 ~ "Default", TRUE ~ "NonDefault")) head(df_scored_test)Khách hàng có tổng điểm càng cao thì rủi ro vỡ nợ càng thấp. Từ đó, người sử dụng thẻ điểm có thể phân bố điểm của cả danh mục để đưa ra quyết định phê duyệt thẻ cuối cùng cho khách hàng vay nợ từ ngân hàng của mình.
DECISION TREE VÀ RANDOM FOREST SẼ CHẠY TRÊN TẬP TRAIN TEST BAN ĐẦU VÌ NÓ CÓ THỂ TỰ KHẮC PHỤC MISSING VALUE VÀ OUTLIERS
DECISION TREE
# train 70% - test 30%
set.seed(1230000)
ind = sample(2, nrow(credit), replace = TRUE, prob = c(0.7, 0.3))
train.credit = credit [ind == 1, ]
test.credit = credit [ind == 2, ]library(rpart)
detree = rpart(BAD ~ ., data = train.credit, method = "class", control = rpart.control(cp = 0))#Dự báo tập train
predTree1 = predict(detree, train.credit, type='class')
train.credit$BAD = as.factor(train.credit$BAD)
caret::confusionMatrix(predTree1, train.credit$BAD, positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 2082 261
## 1 189 628
##
## Accuracy : 0.8576
## 95% CI : (0.8449, 0.8696)
## No Information Rate : 0.7187
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.6389
##
## Mcnemar's Test P-Value : 0.000817
##
## Sensitivity : 0.7064
## Specificity : 0.9168
## Pos Pred Value : 0.7687
## Neg Pred Value : 0.8886
## Prevalence : 0.2813
## Detection Rate : 0.1987
## Detection Prevalence : 0.2585
## Balanced Accuracy : 0.8116
##
## 'Positive' Class : 1
## Accuracy của mô hình cây quyết định trên tập train là 85.76%
#Dự báo trên tập test
predTree2 = predict(detree, test.credit, type='class')
test.credit$BAD = as.factor(test.credit$BAD)
caret::confusionMatrix(predTree2, test.credit$BAD, positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 765 160
## 1 161 200
##
## Accuracy : 0.7504
## 95% CI : (0.7258, 0.7738)
## No Information Rate : 0.7201
## P-Value [Acc > NIR] : 0.007885
##
## Kappa : 0.3814
##
## Mcnemar's Test P-Value : 1.000000
##
## Sensitivity : 0.5556
## Specificity : 0.8261
## Pos Pred Value : 0.5540
## Neg Pred Value : 0.8270
## Prevalence : 0.2799
## Detection Rate : 0.1555
## Detection Prevalence : 0.2807
## Balanced Accuracy : 0.6908
##
## 'Positive' Class : 1
## Accuracy của mô hình cây quyết định trên tập test là 75.04%
RANDOM FOREST
# train 70% - test 30%
set.seed(1230000)
ind = sample(2, nrow(credit), replace = TRUE, prob = c(0.7, 0.3))
train.credit = credit [ind == 1, ]
test.credit = credit [ind == 2, ]#Mô hình RF
library(randomForest)## Warning: package 'randomForest' was built under R version 4.3.3## randomForest 4.7-1.1## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:dplyr':
##
## combine## The following object is masked from 'package:ggplot2':
##
## marginset.seed(1230000)
RF = randomForest(BAD ~., data = train.credit, ntree = 500)## Warning in randomForest.default(m, y, ...): The response has five or fewer
## unique values. Are you sure you want to do regression?#Dự báo trên tập train
Pred_RF1 = predict(RF, train.credit, type='class')
train.credit$BAD = as.factor(train.credit$BAD)
Pred_RF1 = as.factor(ifelse(Pred_RF1 > 0.5, 1, 0))
caret::confusionMatrix(Pred_RF1, train.credit$BAD, positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 2271 10
## 1 0 879
##
## Accuracy : 0.9968
## 95% CI : (0.9942, 0.9985)
## No Information Rate : 0.7187
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.9921
##
## Mcnemar's Test P-Value : 0.004427
##
## Sensitivity : 0.9888
## Specificity : 1.0000
## Pos Pred Value : 1.0000
## Neg Pred Value : 0.9956
## Prevalence : 0.2813
## Detection Rate : 0.2782
## Detection Prevalence : 0.2782
## Balanced Accuracy : 0.9944
##
## 'Positive' Class : 1
## Accuracy của mô hình rừng cây ngẫu nhiên trên tập train là 99.68%
#Dự báo trên tập test
Pred_RF2 = predict(RF, test.credit, type='class')
test.credit$BAD = as.factor(test.credit$BAD)
Pred_RF2 = as.factor(ifelse(Pred_RF2 > 0.5, 1, 0))
caret::confusionMatrix(Pred_RF2, test.credit$BAD, positive = "1")## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 831 186
## 1 95 174
##
## Accuracy : 0.7815
## 95% CI : (0.7579, 0.8038)
## No Information Rate : 0.7201
## P-Value [Acc > NIR] : 2.954e-07
##
## Kappa : 0.4126
##
## Mcnemar's Test P-Value : 7.920e-08
##
## Sensitivity : 0.4833
## Specificity : 0.8974
## Pos Pred Value : 0.6468
## Neg Pred Value : 0.8171
## Prevalence : 0.2799
## Detection Rate : 0.1353
## Detection Prevalence : 0.2092
## Balanced Accuracy : 0.6904
##
## 'Positive' Class : 1
## Accuracy của mô hình rừng cây ngẫu nhiên trên tập test là 78.15%
KẾT LUẬN
Mô hình hồi quy logit với bộ dữ liệu với các biến đã được phân nhóm theo WOE. Độ chính xác của mô hình dự báo đạt 77.32%. Kết quả Logit không cho ra kết quả tốt nhất (chỉ sau Random Forest) nhưng độ ổn định cao, khả năng phân biệt ở mức chấp nhận được. Mô hình Logit kết hợp với phân nhóm WOE vẫn là mô hình được yêu thích và sử dụng rộng rãi bởi tính ổn định, dễ kiểm soát và dễ triển khai trong thực tế. Mô hình đánh giá nhầm 95 quan sát BAD và loại bỏ được 169 quan sát BAD.
Mô hình sử dụng cây quyết định cho kết quả tệ nhất (75.04%). Mô hình đánh giá nhầm nhiều nhất 161 quan sát BAD và loại bỏ được nhiều nhất 200 quan sát BAD.
Mô hình sử dụng rừng cây ngẫu nhiên cho kết quả chính xác nhất với độ chính xác là 78.15%. Rừng cây ngẫu nhiên loại được quan sát BAD (174 quan sát) nhưng đánh giá nhầm BAD thấp nhất (55 quan sát).