注：
- 本篇是机器学习/数据挖掘在互联网金融行业的应用，只是一个模型建立的流程介绍，不涉及详细的数据清洗逻辑，不涉及模型的调优。
- 本篇你需要知道的：逻辑回归、WOE、IV值、ROC、KS值。
- 适用人群：想入门或者想转型成互金风控建模的朋友。
- 如有任何疑问或建议请在下面留言或者联系我😎
- 背景：在银行业悠久的历史中，信用评分卡(ScoreCard)模型广泛使用，来判别贷款申请者的逾期概率。现在成为互联网金融行业最火爆的最核心的风控模型。
- 模型类别：
申请卡模型 = A卡(Application Card)，场景：贷前
行为卡模型 = B卡(Behaviour Card)， 场景：贷中
催收卡模型 = C卡(Collection Card)， 场景：贷后
反欺诈模型 = F卡(Anti-Fraud Card)， 场景：反欺诈 - 特征维度：
A卡：用户的基本信息 + 自有app操作行为数据 + 第三方数据
B卡：用户的基本信息 + 自有app操作行为数据 + 第三方数据 + 历史还款行为数据
C卡：用户的基本信息 + 自有app操作行为数据 + 第三方数据 + 历史还款行为数据 + 催款行为数据 - 本质：（二/多）分类模型
- 申请卡模型为互金行业最重要、应用最广泛的一张卡，以下介绍以A卡展开。
正文：评分卡(A卡)制作流程
传统评分卡使用的算法：逻辑回归(Logistics Regression)
传统评分卡构建步骤：
- 样本收集、数据清洗、时窗切割
- 分箱、计算WOE和IV值、WOE的性质、变量筛选、循环以上步骤(如需要)
- 构建逻辑回归模型
- 评分卡Scaling
- 评估信用评分卡
- 选择Cut-Off分数
1. 样本收集、数据清洗、时窗切割
样本收集：导入样本数据 = data0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40# 包的下载使用
packages<-c("ggplot2","dplyr","smbinning","data.table","woe","gmodels","ROCR","knitr","reshape2","Information","corrgram","corrplot","varhandle","ROCR","stringr","DT","partykit","tcltk","Daim","vcd","caret")
UsePackages<-function(p){
if (!is.element(p,installed.packages()[,1])){
install.packages(p)}
require(p,character.only = TRUE)}
for(p in packages){
UsePackages(p)
}
library(data.table)
library(dplyr)
library(ggplot2)
library(reshape2)
library(corrgram)
library(corrplot)
library(stats)
library(smbinning)
library(woe)
library(gmodels)
library(Information)
library(knitr)
library(varhandle)
library(ROCR)
library(stringr)
library(DT)
library(partykit)
library(tcltk)
library(Daim)
library(vcd)
library(caret)
options(warn=-1)
# 源数据 data0 在data目录下
load("data/data0_LR.RData")
# 根据历史逾期天数overduedays 增加y变量bad ：逾期超过30天为坏客户，否则好客户
data0$bad = ifelse(data0$overduedays>30, 1, 0)数据清洗：本篇为假造数据，只为跑通程序做演示，不适合做数据清洗教程，故此步骤直接用清洗好的数据。
1
2
3
4
5
6
7
8
9
10
11
12
13
14> names(data0) # 所有特征名
# [1] "extration_amount" "ApplyHour" "AGE_Value"
# [4] "CALL_RECORD_FLAG_Value" "CONTACTS_RELATIVES_COUNT_Value" "DEGREE_Value"
# [7] "IDENTIFICATION_RESULT_Value" "MARITAL_STATUS_Value" "MONTH_INCOME_Value"
# [10] "POSITION_Value" "REJECT_COUNT_Value" "GENDER_Value_ID_CARD"
# [13] "WORK_MONTH" "dt_7day" "dt_1month"
# [16] "dt_3month" "FINAL_SCORE" "ZM_SCORE"
# [19] "state" "bad" "ZM_SCORE_EXIST"
# [22] "MISSING_COUNT"
> nrow(data0) # 样本数量
# [1] 23610
> ncol(data0) # 特征数量
# [1] 22时窗切割：信用评等最主要的功能为预测客户未来的违约行为，因此必须针对预测时间点进行明确的定义。这个就是时窗切割(Time Windows)。时窗的时间根据每个产品的业务逻辑确定。在此我回溯过去半年数据来预测未来新用户的逾期概率。
抽样时窗(Sample Windows)：进行预测时，必须回溯多久以前的客户历史行为数据。
观察时窗(Performance Windows)：进行预测时，要预估未来多久客户的行为结果。
2. 分箱、计算WOE和IV值、WOE的性质、变量筛选、循环以上步骤(如需要)
- 分箱(Binning)：对连续变量离散化(Discretization),对离散变量也可进行重新分箱、组合。
分箱方式：等宽分箱、等频分箱、最优分箱等。本文使用最优分箱，基于最小熵原则。 WOE(Weight of Evidence)和IV(Infomation Value)：逻辑回归是线性的统计模式，因此遇到非线性趋势的变数会造成无法有效的建立预测模型,因此需要WOE。
计算逻辑点击这里WOE = ln(Odds) = ln(%Good/%Bad) = ln(p/(1-p))
IV= ∑(%Good-%Bad)*WOE = ∑(%Good-%Bad)*ln(%Good/%Bad)🌝WOE的性质(划重点!)：
(1) WOE与风险正相关，WOE越大，风险越高，代表该层级的客户品质越差。如果WOE接近０，表示接近平均水平。（正负相关可以调节）
(2)进行WOE检定时，观察WOE分布的变动趋势是否符合逻辑(Logical Trend).
所谓Logical Trend指的是WOE变动趋势必须呈现递增、递减，或者是单纯转折模式(u型或n型)。
(3)如果WOE趋势呈现不稳定的锯齿状波动(W型或M型)或者是不同时窗呈现不一致的趋势，此时就必须通过重新分箱来调整，否则就必须放弃此变量。
(4)WOE不会因为抽样误差造成数值大幅变化。而且WOE制作的评分卡可解释性强，也是这套评分卡永流传的精髓之一。
- 变量筛选：根据每个变量的分箱结果计算IV值，留下IV>0.1的变量。这个0.1的数值可以改变。
1
2
3
4
5
6# 计算dataframe里所有特征的IV值
IV <- create_infotables(data=data0,
y="bad",bins = 10, ncore = NULL,
parallel=FALSE)
# 显示IV计算结果
(Summary<-IV$Summary)
绘制每个变量的WOE分箱柱状图1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25# 筛选变量：留下IV>0.1的变量
Summary=Summary%>%
filter(Summary$IV>0.1)%>%
as.data.frame()
(selected_names<-Summary$Variable) # 显示筛选后的变量名
# [1] "ZM_SCORE" "IDENTIFICATION_RESULT_Value"
# [3] "extration_amount" "CONTACTS_RELATIVES_COUNT_Value"
# [5] "POSITION_Value" "ZM_SCORE_EXIST"
num<-length(selected_names) # 筛选后的变量个数
# 绘制每个变量的WOE分箱柱状图
names <- selected_names # LOOP for ALL: names<-names(IV$Tables)
plots <- list()
IVtable<- IV$Tables
for (i in 1:length(selected_names)){
plots[[i]] <- plot_infotables(IV, names[i],same_scales=FALSE,show_values = TRUE)
IVtable[i]<-IV$Tables$names[i]
}
# Showing the variables whose iv >0.1
plots[1:length(selected_names)]
# MultiPlot(IV, IV$Summary$Variable[1:num]) # 绘制综合图code
IVtable[selected_names]
根据上文提到的(Logical Trend)来观察上面6个WOE分布图，ZM_SCORE, IDENTIFICATION_RESULT_Value, CONTACTS_RELATIVES_COUNT_Value, POSITION_Value, ZM_SCORE_EXIST都符合Logical Trend。
只有extration_amount的WOE分布呈现波浪不规则型，需要整改。
- 相关性分析(CORRplot):这里只先示范协方差矩阵图
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17col1 <- colorRampPalette(c("#7F0000","red","#FF7F00","yellow","white",
"cyan", "#007FFF", "blue","#00007F"))
col2 <- colorRampPalette(c("#67001F", "#B2182B", "#D6604D", "#F4A582", "#FDDBC7",
"#FFFFFF", "#D1E5F0", "#92C5DE", "#4393C3", "#2166AC", "#053061"))
col3 <- colorRampPalette(c("red", "white", "blue"))
col4 <- colorRampPalette(c("#7F0000","red","#FF7F00","yellow","#7FFF7F",
"cyan", "#007FFF", "blue","#00007F"))
wb <- c("white","black")
par(ask = TRUE)
data0= data0%>%
select(selected_names,bad)%>%
as.data.frame()
M=data0[complete.cases(data0),]
M<-cor(M)
corrplot(M, method="color", col=col1(20), cl.length=21,order = "AOE",tl.cex = 0.6,addCoef.col="grey")
删去CONTACTS_RELATIVES_COUNT_Value
- 循环分箱步骤（分箱调整）
(1)extration_amount1
2
3
4
5
6
7
8
9
10
11data0$extration_amount=as.numeric(data0$extration_amount)
data_tmp=data0%>%
select(c(extration_amount,bad))%>%
apply(2,as.numeric)%>%
data.frame()
IV <- create_infotables(data_tmp, y='bad', ncore=2,bins=5) # bins的数值随意定，一般2~10
data0$extration_amount=cut(data0$extration_amount,breaks=c(-Inf,475,671,771,971,Inf),labels = IV$Tables$v$WOE[1:length(IV$Tables$extration_amount$WOE)])
ggplot(IV$Tables$extration_amount,aes(x=extration_amount,y=WOE))+
geom_bar(stat='identity',fill='lightblue')
1
2
3
4
5# WOE计算结果保留，在步骤4-Scaling会再次用到
IV$Tables$extration_amount$WOE
# [1] -0.4414730 -0.2142640 0.4596698 0.4386113 -0.3501923
IV$Summary
# 0.1327355 #IV值
(2)POSITION_Value1
2
3
4
5
6
7
8
9
10data0$POSITION_Value=as.numeric(data0$POSITION_Value)
data_tmp=data0%>%
select(c(POSITION_Value,bad))%>%
apply(2,as.numeric)%>%
data.frame()
IV <- create_infotables(data_tmp, y='bad', ncore=2,bins=6)
ggplot(IV$Tables$POSITION_Value,aes(x=POSITION_Value,y=WOE))+
geom_bar(stat='identity',fill='lightblue')
data0$POSITION_Value=cut(data0$POSITION_Value,breaks=c(-Inf,0,1,5),labels = IV$Tables$POSITION_Value$WOE[1:length(IV$Tables$POSITION_Value$WOE)])
1
2
3
4
5# WOE计算结果保留，在步骤4-Scaling会再次用到
IV$Tables$POSITION_Value$WOE
# [1] 0.5817640 -0.2522849 -0.2905931
IV$Summary
# 0.1528563
(3)ZM_SCORE1
2
3
4
5
6
7
8
9
10
11data0$ZM_SCORE=as.numeric(data0$ZM_SCORE)
data_tmp=data0%>%
select(c(ZM_SCORE,bad))%>%
apply(2,as.numeric)%>%
data.frame()
IV <- create_infotables(data_tmp, y='bad', ncore=2,bins=10)
ggplot(IV$Tables$ZM_SCORE,aes(x=ZM_SCORE,y=WOE))+
geom_bar(stat='identity',fill='lightblue')
data0$ZM_SCORE=cut(data0$ZM_SCORE,breaks=c(-Inf,549,569,592,609,635,Inf),labels = IV$Tables$ZM_SCORE$WOE[1:length(IV$Tables$ZM_SCORE$WOE)])
1
2
3
4
5
6# WOE计算结果保留，在步骤4-Scaling会再次用到
IV$Tables$ZM_SCORE$WOE
# [1] 0.40926664 0.30817452 -0.01635135
# [4] -0.38743811 -0.74663108 -1.52210534
IV$Summary
# 0.2749328
(4)ZM_SCORE_EXIST1
2
3
4
5
6
7
8
9
10
11data0$ZM_SCORE_EXIST=as.numeric(data0$ZM_SCORE_EXIST)
data_tmp=data0%>%
select(c(ZM_SCORE_EXIST,bad))%>%
apply(2,as.numeric)%>%
data.frame()
IV <- create_infotables(data_tmp, y='bad', ncore=2,bins=2)
ggplot(IV$Tables$ZM_SCORE_EXIST,aes(x=ZM_SCORE_EXIST,y=WOE))+
geom_bar(stat='identity',fill='lightblue')
data0$ZM_SCORE_EXIST=cut(data0$ZM_SCORE_EXIST,breaks=c(-Inf,0,1),labels = IV$Tables$ZM_SCORE_EXIST$WOE[1:length(IV$Tables$ZM_SCORE_EXIST$WOE)])
1
2
3
4
5# WOE计算结果保留，在步骤4-Scaling会再次用到
IV$Tables$ZM_SCORE_EXIST$WOE
# [1] 0.2976555 -0.3847163
IV$Summary
# 0.1134327
(5)IDENTIFICATION_RESULT_Value1
2
3
4
5
6
7
8
9
10
11data0$IDENTIFICATION_RESULT_Value=as.numeric(data0$IDENTIFICATION_RESULT_Value)
data_tmp=data0%>%
select(c(IDENTIFICATION_RESULT_Value,bad))%>%
apply(2,as.numeric)%>%
data.frame()
IV <- create_infotables(data_tmp, y='bad', ncore=2,bins=5)
ggplot(IV$Tables$IDENTIFICATION_RESULT_Value,aes(x=IDENTIFICATION_RESULT_Value,y=WOE))+
geom_bar(stat='identity',fill='lightblue')
data0$IDENTIFICATION_RESULT_Value=cut(data0$IDENTIFICATION_RESULT_Value,breaks=c(-Inf,2,3,4),labels = IV$Tables$IDENTIFICATION_RESULT_Value$WOE[1:length(IV$Tables$IDENTIFICATION_RESULT_Value$WOE)])
1
2
3
4
5# WOE计算结果保留，在步骤4-Scaling会再次用到
IV$Tables$IDENTIFICATION_RESULT_Value$WOE
# [1] 0.6084594 -0.2568459 -0.4399638
IV$Summary
# 0.1897237
以上的5个变量的IV>0.1,且WOE分布呈Logical Trend，保存数据1
data1 = data0 #备份数据，以下都对data1进行处理
3. 构建逻辑回归模型
1 | data1[, c(1:length(data1))] <- sapply(data1[, c(1:length(data1))], as.numeric) |
1
2
3
4通过检验
截距为0.72215
各个系数为-0.39815, -0.42831, 0.08642, -0.24813, 0.25519
这些参数都十分重要，在Scaling中再次用到
1 | anova(m1,test="Chisq") # ANOVA 检验通过 |
4. 评分卡Scaling
- 将WOE值转换为信用风险分数
1
2
3
4
5
6
7
8data2 = data1 #数据备份
odds=sum(data2$bad==1)/sum(data2$bad==0)
log(odds,base=exp(1))
B=40/log(2,base=exp(1))
A=200-B*log(odds,base=exp(1))
score=yhat_test*B+A #Score=258.152490+57.707802*yhat
1 | summary(score) |
- 好/坏客户分数分布
分数越高，客户的逾期风险越高，因此坏客户应该集中在分数偏高区域，反之，好客户应该集中在风险分数低分区域。1
2
3
4
5
6index=which(data_test$bad==1)
m=seq(260,300,by=5) #260，300是根据分数值域定的，5为间隔数值
bad=cut(score[index],m)%>%table%>%data.frame
colnames(bad)=c('level','count')
ggplot(data = bad,aes(x =level,y=count)) + geom_bar(stat = 'identity')
1
2
3
4index=which(data_test$bad==0)
good=cut(score[index],m)%>%table%>%data.frame
colnames(good)=c('level','count')
ggplot(data = good,aes(x =level,y=count)) + geom_bar(stat = 'identity')
5. 评估信用评分卡
- KS检验：模型区分好坏客户的力度
KS>0.3时，模型才能用。
- ROC检验：模型判别真假的准确度
AUC>0.7时，模型才能用。
此模型因为数据质量和分箱质量，所以不具有参考性，仅做跑通模型之用，具体的模型调优将另外写。我的天真的是不知不觉写那么长，其实还有很多还没说，后续会慢慢写后续的。那么恭喜你，到此，你的评分卡已经做完啦~~
每个客户只要填写根据你筛选出来的变量的相关信息，就能得到每个人专属的信用风险分啦！🖖6. 选择Cut-Off分数
模型做完，下一步就是要跟业务结合啦~
模型的作用就是评估贷款申请者的未来逾期概率。风险高的拒掉，风险低的通过申请，那么如何划定这个决策的分数界限呢？多少分数应该通过，多少分数应该拒绝？ - 画出每阶层的KS值，最高值对应阶层为决策阈值
根据上图可以看出是第三阶层的KS=0.2637最大。按照之前分层的结果，这层级的客户的分数区间是(270,275]
(1)270分以下客户：通过
(2)270-275分：人工审核
(3)275分以上客户：拒绝但是，KS只是做决策的某方面根据而已，也可根据每阶层的违约率决定决策阈值，同时也要观察每阶层的人数分布。
最极端的例子就是，一下子拒绝掉所有申请者，这样逾期率就是0了，但是也就关门大吉啦~
感谢看到这里的朋友，A卡制作就在此告一段落啦😊
课后题😉
计算下面每个变量的WOE值对应的信用风险分数：
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20# 伪代码...
extration_amount
[WOE] -0.4414730 -0.2142640 0.4596698 0.4386113 -0.3501923
[系数b] 0.08642
POSITION_Value
[WOE] 0.5817640 -0.2522849 -0.2905931
[系数b] -0.24813
ZM_SCORE
[WOE] 0.40926664 0.30817452 -0.01635135 -0.38743811 -0.74663108 -1.52210534
[系数b] -0.39815
ZM_SCORE_EXIST
[WOE] 0.2976555 -0.3847163
[系数b] 0.25519
IDENTIFICATION_RESULT_Value$WOE
[WOE] 0.6084594 -0.2568459 -0.4399638
[系数b] -0.42831思考分数换算的Scaling中，A与B的作用
提示：在第四大步骤Scaling中，有计算逻辑
福利❤
源数据下载👍
打赏者在备注留下邮箱都会赠予相关材料
之后会增加基于大杀器XGBOOST制作的评分卡，而且有R有Python！
敬请期待~
