Ứng dụng mô hình ScoreCard trong phân loại hồ sơ bảo hiểm
Pham Dinh Khanh
April 7, 2017
Ngày nay phương pháp chấm điểm Scorecard đã khá phổ biến trong các tổ chức tài chính trong việc xếp loại hồ sơ, xếp hạng khách hàng, đánh giá rủi ro tín dụng,….Lợi thế của Scorecard là có tính phân loại cao, có thể lượng hóa được các thuộc tính như rủi ro, mức độ tiềm năng của khách hàng dựa trên điểm số. Trên thế giới có rất nhiều những tài liệu nghiên cứu về phương pháp này và các phần mềm thống kê như SA,R đều có những gói ứng dụng rất mạnh thiết kế riêng để xây dựng model Scorecard. Tại Việt Nam nói chung những năm gần đây hoạt động quản trị rủi ro hầu hết đều gắn liền với model Scorecard. Các tổ chức tài chính chủ yếu xây dựng model trên SAS do đặc thù là đây là phần mềm thương mại, có tính an toàn cao hơn R và lý do khác là SAS được nhiều tổ chức, chuyên gia nước ngoài tư vấn sử dụng. Tuy nhiên nếu vì thế mà bỏ qua việc sử dụng R là một sai lầm vì R cực kì mạnh để xây dựng model Scorecard. Bài viết này nhằm mục đích đưa ra một cách tiếp cận mới và trả lời câu hỏi làm sao để có thể xây dựng một model Scorecard trên R.
Tập dữ liệu được sử dụng là các 3681 quan sát về các hợp đồng bảo hiểm. Mục đích nghiên cứu là phân loại các hợp đồng này thành 2 nhóm:Mang lại lợi nhuận (phí bảo hiểm cao hơn phí claim) và không mang lại lợi nhuận (phí bảo hiểm thấp hơn phí claim).
I. Xử lý dữ liệu
setwd("D:/Rcode")
data <- read.csv("insurance_test.csv",header = TRUE, row.names = 1)
##Chuyển biến factor về numeric
data$INCOME <- as.numeric(data$INCOME)
data$COST <- as.numeric(data$COST)
##check NA value
sapply(data, function(x)(sum(is.na(x))))## BUSINESS_CODE CAR_MODEL CAR_FIRM NO_SEAT
## 0 0 0 0
## MANUFACTURE_YEAR AGE POLICIES YEAR
## 0 0 0 0
## NO_POLICIES PREMIUM INSURANCE COST
## 0 0 0 0
## DAY_POLICY INCOME LOST
## 0 0 0##Model không có NA valueII. Chia tập train và test
Lấy ra tập train và test theo kích thước là 50:50.
##Tạo tỷ lệ mẫu training là 5/10 so với toàn bộ tập dữ liệu
library(caret)
set.seed(123)
indxTrain <- createDataPartition(y = data$LOST, p=5/10, list = FALSE)
train <- data[indxTrain,]
test <- data[-indxTrain,]Kiểm tra tỷ lệ Profitable và Non-Profitable trong từng tập:
##LOST rate of data:
round(table(data$LOST)*100/nrow(data),2)##
## 0 1
## 95.49 4.51##LOST rate of train:
round(table(train$LOST)*100/nrow(train),2)##
## 0 1
## 95.06 4.94##LOST rate of test:
round(table(test$LOST)*100/nrow(test),2)##
## 0 1
## 95.92 4.08III. Tính hệ số WOE
WOE (weight of evidence) cho biết khả năng dự báo của một biến độc lập lên biến phụ thuộc. WOE thường được sử dụng trong các bài toán Scorecard. Tư tưởng của WOE là chia mẫu thành các nhóm có số quan sát bằng nhau với biến liên tục hoặc thành các nhóm định danh với biến định danh. Trên từng nhóm tính ra tỷ lệ %Good, %Bad so với toàn bộ mẫu. Dựa trên %Good và %Bad để tìm ra sự phân phối của chúng trong mẫu và WOE sẽ phát huy tác dụng trong việc ước lượng mức độ chênh lệch của phân phối Good và Bad. Công thức và ý nghĩa cụ thể hơn của WOE có thể tìm ở link sau: WOE
Sử dụng thư viện Information để tính IV cho các biến.
##Gọi thư viện Information
library(Information)
##Tính WOE cho toàn bộ các biến
IV <- Information::create_infotables(data=train, y="LOST", parallel=FALSE)## [1] "Variable POLICIES was removed because it is a non-numeric variable with >1000 categories"
## [1] "Variable YEAR was removed because it has only 1 unique level"print(IV$Summary)## Variable IV
## 10 COST 1.9561680
## 12 INCOME 1.6809319
## 8 PREMIUM 1.4922236
## 9 INSURANCE 0.8731451
## 2 CAR_MODEL 0.7307066
## 3 CAR_FIRM 0.4633079
## 11 DAY_POLICY 0.2881642
## 7 NO_POLICIES 0.2806939
## 1 BUSINESS_CODE 0.1672531
## 5 MANUFACTURE_YEAR 0.1275213
## 4 NO_SEAT 0.1096445
## 6 AGE 0.1012610Bảng IV thể hiện sức mạnh phân loại của các biến theo thứ tự từ cao xuống thấp. Điểm benchmark đánh giá sức mạnh phân loại cho các khoảng giá trị của IV như sau:
- <0.02: useless for prediction
- 0.02 to 0.1: Weak predictor
- 0.1 to 0.3: Medium predictor
- 0.3 to 0.5:Strong predictor
- ’>0.5:Suspicious or good to be true
Đối với các biến có IV quá cao (>0.5) thì cần phải nghi ngờ vì trong những tình huống như thế các biến này có thể là những biến định nghĩa nên biến dự báo. Trên thực tế các biến được sử dụng để xác định một hợp đồng LOST hay không bao gồm: COST, INCOME nên ta sẽ loại những biến này. Sau khi tính được IV, chúng ta cần tạo ra các biến định danh là các khoảng giá trị của biến liên tục và hồi qui mô hình trên các biến định danh này. Lý do cần tạo ra biến định danh là vì các biến định danh mang tính phân loại nhóm cao hơn là biến liên tục, đối với lớp mô hình phân loại được hồi qui trên các biến định danh sẽ mang lại kết quả mạnh hơn là chưa xử lý biến và hồi qui trực tiếp trên biến liên tục.
IV.Tạo giá trị biến định danh cho biến liên tục.
Sau đây ta sẽ đi vào ví dụ xử lý biến liên tục INSURANCE bằng cách tạo biến định danh fINSURANCE cho nó.
Bảng các giá trị WOE
print(IV$Tables$INSURANCE)## INSURANCE N Percent WOE IV
## 1 [0,7020000] 227 0.12330255 0.0000000 0.0000000
## 2 [1.3e+07,7.8e+07] 223 0.12112982 -2.4461658 0.2834327
## 3 [9.1e+07,253338092] 645 0.35035307 -0.8517370 0.4595082
## 4 [2.6e+08,649600000] 193 0.10483433 0.7418952 0.5406438
## 5 [6.51e+08,900200000] 176 0.09560022 1.1106849 0.7371008
## 6 [9.1e+08,1.363e+09] 192 0.10429115 0.9117556 0.8689547
## 7 [1373150000,14021500000] 185 0.10048886 0.1953515 0.8731451Ở bảng trên ta gọi các khoảng ở cột INSURANCE là các lable được gán cho các quan sát.Nếu một quan sát có giá trị rơi vào khoảng nào thì fINSURANCE của nó sẽ nhận labels đó. Chẳng hạn giá trị INSURANCE của một hợp đồng là 6,000,000 thì fINSURANCE của nó là [0,7020000].
Vẽ biểu đồ WOE đối với biến INSURANCE
##INSURANCE
Information::plot_infotables(IV,"INSURANCE")
Ta có thể thấy đồ thị đã có tính motonious (là tính chất các giá trị WOE của những khoảng liền kề phải cùng tăng, giảm theo một quĩ đạo lên hoặc xuống). Trong trường hợp đồ thị không có tính motonious thì cần phải nhóm các khoảng liền kề lại với nhau nhằm mục đích loại bỏ một số giá trị thiểu số làm cho xu hướng của đồ thị bị biến động.Để đơn lại với nhau, chúng ta lấy ví dụ: Trong các giá trị INSURANCE từ [0,7.8e+07] đều có WOE < 0 ngoại trừ có một vài giá trị trong khoảng từ [1e+07,2e+07] có WOE > 0. Nếu chia khoảng [0,7.8e+07] thành 3 khoảng:[0,1e+07]; [1e+07,2e+07];[2e+07,7.8e+07] thì đồ thị WOE sẽ bị biến động theo chiều -,+,- và giá trị của khoảng [0,7.8e+07] sẽ không được đại diện. Việc ta nhóm 3 khoảng lại với nhau cũng giống như vote cho những giá trị thiểu số cá biệt bằng các giá trị đa số đại diện.
##Lấy độ dài vector cut
n <- length(IV$Tables$INSURANCE$INSURANCE)
cut_INSURANCE <- rep(0,n)
##Tạo vector cut
for(i in 1:n){
start_char <- regexpr(",",IV$Tables$INSURANCE$INSURANCE[i])
end_char <- nchar(IV$Tables$INSURANCE$INSURANCE[i])
print(substring(IV$Tables$INSURANCE$INSURANCE[i],start_char+1,end_char-1))
cut_INSURANCE[i] <- as.numeric(substring(IV$Tables$INSURANCE$INSURANCE[i],start_char+1,end_char-1))
}## [1] "7020000"
## [1] "7.8e+07"
## [1] "253338092"
## [1] "649600000"
## [1] "900200000"
## [1] "1.363e+09"
## [1] "14021500000"cut_INSURANCE <- append(-Inf,cut_INSURANCE,1)
cut_INSURANCE <- append(cut_INSURANCE,Inf,n+2)
##cut_INSURANCE
data$fINSURANCE <- cut(data$INSURANCE,
breaks = cut_INSURANCE,
right = TRUE)
library(dplyr)
data %>% distinct(fINSURANCE)## fINSURANCE
## 1 (7.8e+07,2.53e+08]
## 2 (9e+08,1.36e+09]
## 3 (2.53e+08,6.5e+08]
## 4 (7.02e+06,7.8e+07]
## 5 (6.5e+08,9e+08]
## 6 (1.36e+09,1.4e+10]
## 7 (-Inf,7.02e+06]Áp dụng tương tự cho các biến còn lại gồm NO_SEAT, DAY_POLICY,PREMIUM, AGE.
## NO_SEAT N Percent WOE IV
## 1 [2,2] 61 0.03313417 -1.137833002 0.02650776
## 2 [3,3] 170 0.09234112 0.000000000 0.02650776
## 3 [4,4] 193 0.10483433 -0.482837587 0.04626696
## 4 [5,6] 714 0.38783270 0.370252416 0.10921801
## 5 [7,7] 302 0.16404128 0.005079546 0.10922225
## 6 [8,49] 401 0.21781640 -0.044470069 0.10964447
## [1] "2"
## [1] "3"
## [1] "4"
## [1] "6"
## [1] "7"
## [1] "49"## [1] -Inf 3 4 6 7 Inf## DAY_POLICY N Percent WOE IV
## 1 [0,41] 365 0.19826181 -0.6130211 0.05699076
## 2 [42,78] 185 0.10048886 0.3739664 0.07365897
## 3 [79,120] 181 0.09831613 0.6898585 0.13788404
## 4 [122,161] 179 0.09722977 0.3234244 0.14966948
## 5 [162,197] 177 0.09614340 -0.2333767 0.15438831
## 6 [198,241] 197 0.10700706 -0.5040024 0.17616564
## 7 [242,297] 187 0.10157523 0.5874367 0.22205026
## 8 [298,343] 150 0.08147746 -0.4107843 0.23351611
## 9 [344,365] 220 0.11950027 -0.8046886 0.28816419
## [1] "41"
## [1] "78"
## [1] "120"
## [1] "161"
## [1] "197"
## [1] "241"
## [1] "297"
## [1] "343"
## [1] "365"## [1] -Inf 41 161 241 297 Inf## PREMIUM N Percent WOE IV
## 1 [0,27828] 367 0.19934818 -2.9461218 0.5837854
## 2 [28636,72534] 184 0.09994568 -1.1433732 0.6643492
## 3 [73352,238037] 184 0.09994568 -2.2529746 0.8751880
## 4 [239827,540506] 182 0.09885932 -0.8389776 0.9236459
## 5 [547383,1148581] 185 0.10048886 -0.2793618 0.9305716
## 6 [1152170,3295479] 186 0.10103205 0.8402560 1.0355390
## 7 [3319672,6273050] 184 0.09994568 1.3207563 1.3547266
## 8 [6282623,10541096] 184 0.09994568 0.8523774 1.4621823
## 9 [10600686,55160384] 185 0.10048886 -0.6270074 1.4922236
## [1] "27828"
## [1] "72534"
## [1] "238037"
## [1] "540506"
## [1] "1148581"
## [1] "3295479"
## [1] "6273050"
## [1] "10541096"
## [1] "55160384"## [1] -Inf 238037 1148581 10541096 55160384 Inf## AGE N Percent WOE IV
## 1 [0,1] 153 0.08310701 0.183922838 0.003055949
## 2 [2,2] 285 0.15480717 -0.006549931 0.003062571
## 3 [3,3] 272 0.14774579 -0.309247850 0.015378111
## 4 [4,4] 127 0.06898425 -0.765157717 0.044370021
## 5 [5,5] 105 0.05703422 0.317454231 0.051012141
## 6 [6,6] 319 0.17327539 -0.285429537 0.063445577
## 7 [7,8] 334 0.18142314 0.030823131 0.063620354
## 8 [9,25] 246 0.13362303 0.476000522 0.101261011
## [1] "1"
## [1] "2"
## [1] "3"
## [1] "4"
## [1] "5"
## [1] "6"
## [1] "8"
## [1] "25"## [1] -Inf 1 2 3 4 6 8 25 InfĐối với các biến đã là định danh ta cũng cần nhóm những giá trị có WOE gần bằng nhau lại thành giá các nhóm giá trị đại diện nhằm làm giảm số lượng nhóm và tăng tính phân loại cho mô hình. Phương pháp thực hiện tương tự như biến liên tục, chúng ta cũng tính WOE, vẽ biểu đồ và thực hiện nhóm. Bảng giá trị WOE của CAR_FIRM:
################################################Character Variable################################################
library(dplyr)
##CAR_FIRM
as.data.frame(IV$Tables$CAR_FIRM) %>%
arrange(desc(as.numeric(.$WOE)))## CAR_FIRM N Percent WOE IV
## 1 AUDI 18 0.0097772949 0.87707002 0.2579691
## 2 HONDA 67 0.0363932645 0.80807715 0.3080854
## 3 NISSAN 20 0.0108636611 0.75928698 0.3673816
## 4 DAEWOO 32 0.0173818577 0.68782802 0.2731902
## 5 TOYOTA 556 0.3020097773 0.50237657 0.4633079
## 6 CHEVROLET 26 0.0141227594 0.47160491 0.2619128
## 7 MAZDA 32 0.0173818577 0.24846136 0.3309403
## 8 BMW 19 0.0103204780 0.06613980 0.2580156
## 9 BENTLEY 1 0.0005431831 0.00000000 0.2579691
## 10 CADILLAC 1 0.0005431831 0.00000000 0.2580156
## 11 DAIHATSHU 1 0.0005431831 0.00000000 0.2731902
## 12 DODGE 2 0.0010863661 0.00000000 0.2731902
## 13 FERRARI 2 0.0010863661 0.00000000 0.2731902
## 14 HUMMER 1 0.0005431831 0.00000000 0.3080854
## 15 LAND ROVER 5 0.0027159153 0.00000000 0.3297390
## 16 LEXUS 20 0.0108636611 0.00000000 0.3297390
## 17 MASERATI 2 0.0010863661 0.00000000 0.3297390
## 18 MINI-COOPER 1 0.0005431831 0.00000000 0.3505164
## 19 SUBARU 1 0.0005431831 0.00000000 0.3673816
## 20 SUZUKI 21 0.0114068441 0.00000000 0.3673816
## 21 TRUNG QUOC 4 0.0021727322 0.00000000 0.4633079
## 22 FORD 152 0.0825638240 -0.07431203 0.2736312
## 23 ISUZU 50 0.0271591526 -0.22154227 0.3250727
## 24 KIA 108 0.0586637697 -0.30158498 0.3297390
## 25 HYUNDAI 258 0.1401412276 -0.36371676 0.3238651
## 26 MITSUBISHI 40 0.0217273221 -0.70705009 0.3585037
## 27 MERCEDED-BENZ 85 0.0461705595 -0.76918187 0.3505164
## 28 ACURA 316 0.1716458446 -1.69107934 0.2467118Đồ thị WOE của CAR_FIRM:
Information::plot_infotables(IV,"CAR_FIRM")
Tạo biến định danh fCAR_FIRM
data <- data %>%
mutate(fCAR_FIRM = ifelse(CAR_FIRM %in% c("HONDA","DAEWOO","NISSAN","TOYOTA","CHEVROLET","MAZDA"),"CAR1",
ifelse(CAR_FIRM %in% c("ISUZU","KIA","HYUNDAI","MITSUBISHI","MERCEDED-BENZ","ACURA"),"CAR3",
"CAR2")))Tương tự đối với BUSINESS_CODE
##BUSINESS_CODE
as.data.frame(IV$Tables$BUSINESS_CODE) %>%
arrange((desc(.$WOE)))## BUSINESS_CODE N Percent WOE IV
## 1 KDBP 22 0.01195003 0.65392647 0.082449853
## 2 KD2 344 0.18685497 0.49344665 0.066354702
## 3 KD3 122 0.06626833 0.15748958 0.068119970
## 4 HH 217 0.11787072 0.11840823 0.008663103
## 5 KD1 364 0.19771863 0.05740612 0.009331790
## 6 TSKT 194 0.10537751 -0.18979357 0.167253063
## 7 PHH 145 0.07876154 -0.37569295 0.163765867
## 8 DA 65 0.03530690 -0.49347599 0.006919509
## 9 KD5 66 0.03585008 -0.50922434 0.075551288
## 10 KDPN 302 0.16404128 -0.78455365 0.154352901data <- data %>%
mutate(fBUSINESS_CODE = ifelse(BUSINESS_CODE %in% c("KD2","KDBP"),"BUS1",
ifelse(BUSINESS_CODE %in% c("KD1","HH","KD3","TSKT"),"BUS2",
"BUS3")))##Tạo lable cho biến LOST:
data$LOST <- factor(data$LOST,levels = c("0","1"),
labels = c("Profitable","Non.Profitable"))
data <- data %>%
mutate(LOST_NUMERIC = ifelse(.$LOST == "Profitable",1,0))Truyền lại tập dataset train và test
train <- data[indxTrain,]
test <- data[-indxTrain,]
##test %>% distinct(BUSINESS_CODE)
##fix data for all BUSINESS_CODE level in train dataset.
##c <- test[test$BUSINESS_CODE == "KD6",]
##train <- rbind(train,c)
##save(all,file = "Analytical_test.rda")V.Hồi qui mô hình
Sử dụng gói caret hồi qui mô hình logistic với 10 lớp, mỗi lớp lặp lại 10 lần.
##################################################Logistic model#############################################
library(caret)
ctr <- trainControl(method = "repeatedcv", number = 10, repeats = 10,
classProbs = TRUE, summaryFunction = defaultSummary)
logistTrain <- train(LOST~fINSURANCE+fNO_SEAT+fDAY_POLICY+fPREMIUM+fAGE+
fCAR_FIRM+fBUSINESS_CODE,data=train,method="glm",family = "binomial",trControl = ctr)
#summary(logistTrain)Ma trận confusion trên tập train
pred <- predict(logistTrain,newdata = train)
confusionMatrix(data=pred,train$LOST)## Confusion Matrix and Statistics
##
## Reference
## Prediction Profitable Non.Profitable
## Profitable 1750 90
## Non.Profitable 0 1
##
## Accuracy : 0.9511
## 95% CI : (0.9402, 0.9605)
## No Information Rate : 0.9506
## P-Value [Acc > NIR] : 0.485
##
## Kappa : 0.0207
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 1.00000
## Specificity : 0.01099
## Pos Pred Value : 0.95109
## Neg Pred Value : 1.00000
## Prevalence : 0.95057
## Detection Rate : 0.95057
## Detection Prevalence : 0.99946
## Balanced Accuracy : 0.50549
##
## 'Positive' Class : Profitable
## Như vậy trên tập train model dự báo đúng 1750 trường hợp Profitable và 1 trường hợp Non.Profitable; Dự báo sai 90 trường hợp Non.Profitable thành Profitable.Tỷ lệ dự báo chính xác là 95.11%.
Ma trận confusion trên tập test
##Test accuracy level for testing set
pred <- predict(logistTrain,newdata = test)
confusionMatrix(data = pred,test$LOST)## Confusion Matrix and Statistics
##
## Reference
## Prediction Profitable Non.Profitable
## Profitable 1765 75
## Non.Profitable 0 0
##
## Accuracy : 0.9592
## 95% CI : (0.9492, 0.9678)
## No Information Rate : 0.9592
## P-Value [Acc > NIR] : 0.5307
##
## Kappa : 0
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 1.0000
## Specificity : 0.0000
## Pos Pred Value : 0.9592
## Neg Pred Value : NaN
## Prevalence : 0.9592
## Detection Rate : 0.9592
## Detection Prevalence : 1.0000
## Balanced Accuracy : 0.5000
##
## 'Positive' Class : Profitable
## Như vậy trên tập train model dự báo đúng 1765 trường hợp Profitable Dự báo sai 75 trường hợp Non.Profitable thành Profitable.Tỷ lệ dự báo chính xác là 95.92%, khá sát với tập training.
Ma trận confusion trên toàn data
## Confusion Matrix and Statistics
##
## Reference
## Prediction Profitable Non.Profitable
## Profitable 3515 165
## Non.Profitable 0 1
##
## Accuracy : 0.9552
## 95% CI : (0.948, 0.9616)
## No Information Rate : 0.9549
## P-Value [Acc > NIR] : 0.489
##
## Kappa : 0.0114
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 1.000000
## Specificity : 0.006024
## Pos Pred Value : 0.955163
## Neg Pred Value : 1.000000
## Prevalence : 0.954904
## Detection Rate : 0.954904
## Detection Prevalence : 0.999728
## Balanced Accuracy : 0.503012
##
## 'Positive' Class : Profitable
## Như vậy trên tập train model dự báo đúng 3515 trường hợp Profitable và 1 trường hợp Non.Profitable; Dự báo sai 165 trường hợp Non.Profitable thành Profitable và 1 trường hợp Profitable thành Non.Profitable.Tỷ lệ dự báo chính xác là 95.52%.
VI.Validation model.
Đường cong ROC (receiver operating characteristic) cho biết sức mạnh phân loại của một model. Khi đồ thị của ROC càng cong và tiệm cận với đường viền trên của hình chữ nhật thì model phân loại càng tốt. Định nghĩa về đường cong ROC có thể xem ở link sau: ROC
Đường cong ROC trên tập train:
##results <- data.frame(data$POLICIES,pred,data$LOST,data$INCOME)
##Contract right non-profitable predict
##results %>% filter(.$pred =="Non-Profitable", .$data.LOST =="Non-Profitable")
##Contract wrong non-profitable predict
##results %>% filter(.$pred =="Non-Profitable", .$data.LOST =="Profitable")
library(ROCR)
model <- train(LOST_NUMERIC ~ fINSURANCE+fNO_SEAT+fDAY_POLICY+fPREMIUM+fAGE+
fCAR_FIRM+fBUSINESS_CODE,data=train,method="glm",family = "binomial")
p <- predict(model, newdata = train)
pr <- prediction(p,train$LOST_NUMERIC)
prf <- performance(pr,measure = "tpr",x.measure = "fpr")
plot(prf)
Đường cong ROC trên tập test:
library(ROCR)
p <- predict(model, newdata = test)
pr <- prediction(p,test$LOST_NUMERIC)
prf <- performance(pr,measure = "tpr",x.measure = "fpr")
plot(prf)
Tỷ lệ AURC là diện tích nằm dưới đường cong ROC và phía trên trục hoành. Diện tích này càng gần 1 thì mô hình phân loại càng tốt.
auc <- performance(pr,measure = "auc")
auc <- auc@y.values[[1]]
auc## [1] 0.8458886Tỷ lệ AURC khá cao. Mô hình có sức mạnh phân loại rất tốt.