基于R的信用评级/评分卡模型制作教程

注:

  1. 本篇是机器学习/数据挖掘在互联网金融行业的应用,只是一个模型建立的流程介绍,不涉及详细的数据清洗逻辑,不涉及模型的调优。
  2. 本篇你需要知道的:逻辑回归、WOE、IV值、ROC、KS值。
  3. 适用人群:想入门或者想转型成互金风控建模的朋友。
  4. 如有任何疑问或建议请在下面留言或者联系我😎
  • 背景:在银行业悠久的历史中,信用评分卡(ScoreCard)模型广泛使用,来判别贷款申请者的逾期概率。现在成为互联网金融行业最火爆的最核心的风控模型。
  • 模型类别
    申请卡模型 = A卡(Application Card),场景:贷前
    行为卡模型 = B卡(Behaviour Card), 场景:贷中
    催收卡模型 = C卡(Collection Card), 场景:贷后
    反欺诈模型 = F卡(Anti-Fraud Card), 场景:反欺诈
  • 特征维度
    A卡:用户的基本信息 + 自有app操作行为数据 + 第三方数据
    B卡:用户的基本信息 + 自有app操作行为数据 + 第三方数据 + 历史还款行为数据
    C卡:用户的基本信息 + 自有app操作行为数据 + 第三方数据 + 历史还款行为数据 + 催款行为数据
  • 本质:(二/多)分类模型
  • 申请卡模型为互金行业最重要、应用最广泛的一张卡,以下介绍以A卡展开

正文:评分卡(A卡)制作流程

传统评分卡使用的算法:逻辑回归(Logistics Regression)
传统评分卡构建步骤:

  1. 样本收集、数据清洗、时窗切割
  2. 分箱、计算WOE和IV值、WOE的性质、变量筛选、循环以上步骤(如需要)
  3. 构建逻辑回归模型
  4. 评分卡Scaling
  5. 评估信用评分卡
  6. 选择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接近0,表示接近平均水平。(正负相关可以调节)
    (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
    17
    col1 <- 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_amount
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    data0$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_Value

1
2
3
4
5
6
7
8
9
10
data0$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_SCORE

1
2
3
4
5
6
7
8
9
10
11
data0$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_EXIST

1
2
3
4
5
6
7
8
9
10
11
data0$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_Value

1
2
3
4
5
6
7
8
9
10
11
data0$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
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
data1[, c(1:length(data1))] <- sapply(data1[, c(1:length(data1))], as.numeric)
cbind(apply(data1,2,function(x)length(unique(x))),sapply(data1,class))

#拆分训练集与测试集,建模
#----------------------------------------------------------
# train & test(80%-20%) select randomly
#----------------------------------------------------------
nrow(data1)
a = round(nrow(data1)*0.8)
b = sample(nrow(data1), a, replace = FALSE, prob = NULL)

data_train= data1[b,]
data_test = data1[-b,]

# 逻辑回归建模
m1=glm(bad~., data=data_train,binomial(link='logit'))
summary(m1)


1
2
3
4
通过检验
截距为0.72215
各个系数为-0.39815, -0.42831, 0.08642, -0.24813, 0.25519
这些参数都十分重要,在Scaling中再次用到

1
2
3
4
5
6
anova(m1,test="Chisq") # ANOVA 检验通过

model=m1
# y值预测
yhat_train = fitted(model)
yhat_test = predict(model,newdata=data_test,type='response')

4. 评分卡Scaling
  • 将WOE值转换为信用风险分数

    1
    2
    3
    4
    5
    6
    7
    8
    data2 = 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
2
3
4
summary(score)
# Min. 1st Qu. Median Mean 3rd Qu. Max.
# 261 268 273 274 278 295
#这批客户的信用风险分值已经得出
  • 好/坏客户分数分布
    分数越高,客户的逾期风险越高,因此坏客户应该集中在分数偏高区域,反之,好客户应该集中在风险分数低分区域。
    1
    2
    3
    4
    5
    6
    index=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
4
index=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分为间隔将信用风险分数分成8级,客户人数在各层级的分布

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卡制作就在此告一段落啦😊


课后题😉

  1. 计算下面每个变量的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
  2. 思考分数换算的Scaling中,A与B的作用

    提示:在第四大步骤Scaling中,有计算逻辑


福利❤
源数据下载👍

打赏者在备注留下邮箱都会赠予相关材料
之后会增加基于大杀器XGBOOST制作的评分卡,而且有R有Python!
敬请期待~

would you buy me a coffee☕~
0%