R语言建立信用评分模型

最新推荐文章于 2023-03-26 17:49:42 发布

weixin_33994429

最新推荐文章于 2023-03-26 17:49:42 发布

阅读量797

点赞数

文章标签： r语言 python 数据结构与算法

原文链接：https://my.oschina.net/hblt147/blog/1575207

版权

2019独角兽企业重金招聘Python工程师标准>>>

How to master a skill

Jump into the middle of things, get your hands dirty, fall flat on your face, and then reach for the stars.

—— Ben Stein

语言选择

一般而言，咨询公司为商业银行搭建统计评分卡模型，采用的语言大多是SAS，这是因为SAS语言背后，有SAS公司（SAS Institute）提供很完备的产品方案和售后服务。对于程序安全性和稳定性要求较高的银行，自然会将SAS作为第首选方案。

而对于个人用户，要想搭建一个评分卡模型，会更多考虑搭建开发环境的容易度、统计包或库的获取的容易程度(accessablity)、代码风格等。开源易懂的R语言自然会成为个人用户小试牛刀的首选。

数据准备

我们将会使用在信用评级建模中非常常用的德国信贷数据（German credit dataset）作为建模的数据集，具体的数据下载源请见文末的引用。

德国信贷数据共有1000条数据，每条数据20个特征。这些特征包括AccountBalance（Checking账户余额）、Duration (Duration of Credit in month 借款期限）、Paymentstatus（还款记录）等。其中比较难以理解的指标是Instalmentpercent，其代表着 Installment rate in percentage of disposable income （分期付款占可支配收入的百分比）。

模型指标汇总

而数据集中需要预测的指标是（response variable）其中的Creditability变量，其中 1代表好客户（会还本付息），0则是代表坏客户。

以下是载入数据及训练集划分部分的R代码：

library(caret)
train1 <-createDataPartition(y=german_credit$Creditability,p=0.75,list=FALSE)
train <- german_credit[train1, ]
test <- german_credit[-train1, ]


建模过程

通常来讲，建构一个信用评分卡，要如下几个步骤：

在本文，因我们使用的数据是现有的数据集，所以不必进行指标选取和一些数据清洗的过程（如缺失值插补）。接下来，我们会根据以上步骤，一步步构建自己的评分卡模型。

探索性数据分析

在建立模型之前，我们一般会对现有的数据进行 探索性数据分析（Exploratory Data Analysis）。 EDA是指对已有的数据(特别是调查或观察得来的原始数据)在尽量少的先验假定下进行探索。常用的探索性数据分析方法有：直方图、散点图和箱线图等。

首先让我们用直方图看一下Duration的分布情况：

require(caret)
data(GermanCredit)
ggplot(GermanCredit, aes(x = duration,y = ..count..,)) + geom_histogram(fill = "blue", colour = "grey60", size = 0.2, alpha = 0.2,binwidth = 5)

从上面的频率分布直方图中，可以看出German Credit Data中的贷款期限，大都在40个月以内。而申请人数最多的期限，则是6-10个月的短期贷款。

让我们再看一下CreditAmount的分布情况

ggplot(GermanCredit, aes(x = Amount,y = ..count..,)) + geom_histogram(fill = "blue", colour = "grey60", size = 0.2, alpha = 0.2,binwidth = 1000)

就贷款金额而言，大多数申请人将其控制在5000马克之内。其中以申请1000-3000马克的小额贷款最多。

最后再来看一下违约人数在总人数的占比，也就是Creditability这部分的数据。

ggplot(GermanCredit, aes(x =Creditability,y = ..count..,)) + geom_histogram(fill = "blue", colour = "grey60" , alpha = 0.2,stat="count")

从图中可以看出，数据集中30%的申请人被划分为违约的坏用户。而剩下70%的人则是会还本付息的好用户。

变量分箱

在评分卡建模中，变量分箱（binning）是对连续变量离散化（discretization）的一种称呼。要将logistic模型转换为标准评分卡的形式，这一环节是必须完成的。信用评分卡开发中一般有常用的等距分段、等深分段、最优分段。

其中等距分段（Equval length intervals）是指分段的区间是一致的，比如年龄以十年作为一个分段；等深分段（Equal frequency intervals）是先确定分段数量，然后令每个分段中数据数量大致相等；最优分段（Optimal Binning）又叫监督离散化（supervised discretizaion），使用递归划分（Recursive Partitioning）将连续变量分为分段，背后是一种基于条件推断查找最佳分组的算法（Conditional Inference Tree）。

我们将使用最优分段对于数据集中的Duration、age和CreditAmount进行分类。首先，需要在R中安装smbinning包。

对三者进行最优分箱：

library(smbinning)
Durationresult=smbinning(df=train,y="Creditability",x="Duration",p=0.05)
CreditAmountresult=smbinning(df=train2,y="Creditability",x="CreditAmount",p=0.05) 
Ageresult=smbinning(df=train2,y="Creditability",x="Age",p=0.05)

查看分箱后变量各箱的WoE变化：

smbinning.plot(CreditAmountresult,option="WoE",sub="CreditAmount")

smbinning.plot(Durationresult,option="WoE",sub="Duration")

smbinning.plot(Ageresult,option="WoE",sub="Age")

通过最优分段，我们将CreditAmount贷款数额这一连续变量分为了[0,6742]和(6742, +∞]两段。Duration借款期限变量被分为了[0,11]、（11，30] 和（30, +∞]三段。而Age申请人年龄被分为[0, 25]和（25， +∞]两段。变量的分段都对应差异较大WoE值，说明分段区分效果较好，且无违背Business Sense的现象出现，可以接受最优分段提供的分箱结果。

Reference：

德国信贷数据（German credit dataset）， https://onlinecourses.science.psu.edu/stat857/sites/onlinecourses.science.psu.edu.stat857/files/german_credit.csv

单变量分析

在风险建模的过程中，变量选择可以具体细化为单变量变量筛选 (Univariate Variable Selection）和多变量变量筛选 (Multivariate Variable Selection)。多变量变量筛选一般会利用Stepwise算法在变量池中选取最优变量。而单变量筛选，或者说单变量分析，是通过比较指标分箱和对应分箱的违约概率来确定指标是否符合经济意义。

具体的单变量分析方法有很多种，如我在《信用评级建模中的数据清洗与变量选择》中介绍的的AR值分析、《信用评分模型中应不应该包括“歧视变量”》中的 好坏比分析（Goods/Bads）都可以看作单变量分析的具体体现。在本文，我会介绍另一种常见的单变量分析方法：WoE分析。

这三种方法，本质的方法论都是一致的：去比较变量分箱和违约水平的相关关系。一般来讲，正向指标（如公司评级模型中的利润率，零售评级模型中的抵押品价值）要和分箱内违约率呈反向关系，反向指标要同分箱内违约率呈正向关系。当然也有特殊的U型指标，这里不再详述，详情请见《信用评级建模中的数据清洗与变量选择》中的介绍。但这三者不同的是其中分箱内代表违约水平的指标，在不同的方法中指标计算有所不同（AR值/好坏比/WoE）。

WoE分析，是对指标分箱、计算各个档位的WoE值并观察WoE值随指标变化的趋势。其中WoE的数学定义是:

WoE定义，另一种WoE定义不包括 rescale factor（×100）

在进行分析时，我们需要对各指标从小到大排列，并计算出相应分档的WoE值。其中正向指标越大，WoE值越小；反向指标越大，WoE值越大。正向指标的WoE值负斜率越大，反响指标的正斜率越大，则说明指标区分能力好。WoE值趋近于直线，则意味指标判断能力较弱。若正向指标和WoE正相关趋势、反向指标同WoE出现负相关趋势，则说明此指标不符合经济意义，则应当予以去除。

首先来看一下AccountBalance（支票账户余额）：

AccountBalancewoe=woe(train, "AccountBalance",Continuous = F, "Creditability",C_Bin = 4,Good = "1",Bad = "0")
ggplot(AccountBalancewoe, aes(x = BIN, y = -WOE)) + geom_bar(stat = "identity",fill = "blue", colour = "grey60",size = 0.2, alpha = 0.2)+labs(title = "AccountBalance")

一般来讲，支票账户余额越多，借款人还款能力越强，所以这个指标是一个正向指标。可以看出AccountBalance同WoE程强负相关关系，且没有跳点（个别分箱不符合总体趋势则被称为跳点）。所以接受AccountBalance作为进入模型的变量之一。

接下来分析一下ValueSavings（储蓄账户余额）

以下是分箱标准：

ValueSavings
1 : ... < 100 DM
2 : 100 <= ... < 500 DM
3 : 500 <= ... < 1000 DM
4 : .. >= 1000 DM
5 : unknown/ no savings account

其中，第五个分箱（unknown/ no savings account ）同前四项并无可比性，所以在比较中可以忽略此分箱。

R代码：

ValueSavingswoe=woe(train2, "ValueSavings",Continuous = F, "Creditability",C_Bin = 5,Good = "1",Bad = "0")
ggplot(ValueSavingswoe, aes(x = BIN, y = -WOE)) + geom_bar(stat = "identity",fill = "blue", colour = "grey60",size = 0.2, alpha = 0.2)+labs(title = "ValueSavings")

输出后的R图形：

从上图看出，在 分箱2 出现了轻微的跳点现象。因为跳点幅度并不大，我们可以保留此分箱，或者对分箱1和分箱2进行合并。

for(i in 1:750){
  if(train$ValueSavings[i]==1){train2$ValueSavings[i]=2}
}

分箱标准：

ValueSavings
2 : < 500 DM
3 : 500 <= ... < 1000 DM
4 : .. >= 1000 DM
5 : unknown/ no savings account

重新输出：

可以看出，通过合并前两个分箱，ValueSavings（储蓄账户余额）指标和WoE呈明显的负相关关系，且无跳点。因而，可以接受这一指标。

最后一个进入单变量分析的指标是Lengthofcurrentemployment（受雇佣年限），下面是具体分箱标准：

1 : unemployed
2 : ... < 1 year
3 : 1 <= ... < 4 years
4 : 4 <= ... < 7 years
5 : .. >= 7 years

运行R代码：

Lengthofcurrentemploymentwoe=woe(train, "Lengthofcurrentemployment",Continuous = F, "Creditability",C_Bin = 4,Good = "1",Bad = "0")
ggplot(Lengthofcurrentemploymentwoe, aes(x = BIN, y = -WOE)) + geom_bar(stat = "identity",fill = "blue", colour = "grey60",size = 0.2, alpha = 0.2)+labs(title = "Lengthofcurrentemployment")

输出R图形：

同样， Lengthofcurrentemployment（受雇佣年限）出现了跳点现象。因而，我们将分箱4 和分箱5 进行合并。

for(i in 1:750){
  if(train2$Lengthofcurrentemployment[i]==5){train2$Lengthofcurrentemployment[i]=4}
}

重分箱标准：

1 : unemployed
2 : ... < 1 year
3 : 1 <= ... < 4 years
4 : .. >= 4 years

重新输出：

经过合并后，Lengthofcurrentemployment（受雇佣年限）指标呈现明显的负相关关系，且无跳点现象。可以接受指标进入下一步的筛选。

相关性分析 & IV（信息值）筛选

我们在上一篇变量筛选专题中，使用WoE完成了单变量分析的部分。接下来，我们会用经过清洗后的数据看一下变量间的相关性。注意，这里的相关性分析只是初步的检查，进一步检查模型的多重共线性还需要通过 VIF(variance inflation factor）也就是方差膨胀因子进行检验。

R代码：

require(corrplot)

cor1<-cor(train)

corrplot(cor1,tl.cex = 0.5)

输出图像：

从相关矩阵图中可以看出， CreditAmount和Duration的相关性较强（0.37），以及NoofCreditatthisBank和PaymentStatusofPreviousCredit相关性较强（0.42）。

接下来，我进一步计算每个变量的Infomation Value（IV）。IV指标是一般用来确定自变量的预测能力。其公式为：

通过IV值判断变量预测能力的标准是：

< 0.02: unpredictive
0.02 to 0.1: weak
0.1 to 0.3: medium
0.3 to 0.5: strong
> 0.5: suspicious

因这部分代码较多，我会将更为详尽的代码放在文章末尾。这里是输出各个变量IV值的语句：

ggplot(infovalue, aes(x = va, y = iv)) + geom_bar(stat = "identity",fill = "blue", colour = "grey60",size = 0.2, alpha = 0.2)+labs(title = "Information value")+ theme(axis.text.x=element_text(angle=90,colour="black",size=10));

输出图像：

可以看出，DuratioCurrentAddress, Guarantors, Instalmentpercent,NoofCreditatthisBank,Occupation,Noofdependents,Telephone变量的IV值明显较低。所以予以删除。其中相关性分析中NoofCreditatthisBank和PaymentStatusofPreviousCredit相关性较强（0.42）的问题也因NoofCreditatthisBank变量被删除而解决。而CreditAmount和Duration的相关性（0.37）并不显著，可以在这部分忽略不计。

StepWise多变量分析 & Logistic模型建立

在进行StepWise分析前，我们需要将筛选后的变量转换为WoE值并建立Logistic模型。

首先，让先去除在筛选过程中删除的因子：

german_credit$DurationinCurrentaddress=NULL

german_credit$Guarantors=NULL

german_credit$Instalmentpercent=NULL

german_credit$NoofCreditatthisBank=NULL

german_credit$Occupation=NULL

german_credit$Noofdependents=NULL

german_credit$Telephone=NULL

然后计算变量对应的WoE值：

AccountBalancewoe=woe(train2, "AccountBalance",Continuous = F, "Creditability",C_Bin = 4,Good = "1",Bad = "0")

Durationwoe=woe(train2, "Duration",Continuous = F, "Creditability",C_Bin = 2,Good = "1",Bad = "0")

PaymentStatusofPreviousCreditwoe=woe(train2, "PaymentStatusofPreviousCredit",Continuous = F, "Creditability",C_Bin = 4,Good = "1",Bad = "0")

Purposewoe = woe(train2, "Purpose",Continuous = F, "Creditability",C_Bin = 11,Good = "1",Bad = "0")

CreditAmountwoe= woe(train2, "CreditAmount",Continuous = F, "Creditability",C_Bin = 2,Good = "1",Bad = "0")

(全部代码请参见文末）

对变量对应的取值进行WoE替换：

for(i in 1:1000){

for(s in 1:4){

if(german_credit$AccountBalance[i]==s){

german_credit$AccountBalance[i]=-AccountBalancewoe$WOE[s]

}

for(s in 1:3){

if(german_credit$Duration[i]==s){

german_credit$Duration[i]=-Durationwoe$WOE[s]

}

for(s in 0:4){

if(german_credit$PaymentStatusofPreviousCredit[i]==s){

german_credit$PaymentStatusofPreviousCredit[i]=-PaymentStatusofPreviousCreditwoe$WOE[s+1]

}

(全部代码请参见文末）

通过View(german_credit)，我们可以看出全部数据已经替换成功：

将经过WoE转换的数据放入Logistic模型中建模，并使用向后逐步回归方法（backward stepwise）筛选变量：

fit<-glm(Creditability~ AccountBalance + Duration +PaymentStatusofPreviousCredit +Purpose + CreditAmount + ValueSavings + Lengthofcurrentemployment +Sex.Marital.Status+ Mostvaluableavailableasset + Age + ConcurrentCredits + Typeofapartment + ForeignWorker,train2,family = "binomial")

backwards = step(fit)

输出结果：

可以看出，通过逐步回归，模型删除了 Typeofapartment、 Mostvaluableavailableasset 、Sex.Marital.Status等变量。

我们再用逐步回归筛选后的的变量进行建模：

fit2<-glm(Creditability~ AccountBalance + Duration +PaymentStatusofPreviousCredit +Purpose + CreditAmount + ValueSavings + Lengthofcurrentemployment + Age + ConcurrentCredits + ForeignWorker,train2,family = "binomial")

summary(fit2)

输出结果：

其中ConcurrentCredits这一变量并不显著，我们在这一步将此变量删除。继续建立logistic模型：

fit3<-glm(Creditability~ AccountBalance + Duration +PaymentStatusofPreviousCredit +Purpose + CreditAmount + ValueSavings + Lengthofcurrentemployment + Age + ForeignWorker,train2,family = "binomial")

为防止多重共线性问题的出现，我们对模型进行VIF检验：

library(car)

vif(fit3, digits =3 )

输出结果：

从上图可知，所有变量VIF均小于4，可以判断模型中不存在多重共线性问题。

模型检验

到这里，我们的建模部分基本结束了。我们需要验证一下模型的预测能力如何。我们使用在建模开始阶段预留的250条数据进行检验:

prediction <- predict(fit3,newdata=test2)

for (i in 1:250) {

if(prediction[i]>0.99){

prediction[i]=1}

else

{prediction[i]=0}

}

confusionMatrix(prediction, test2$Creditability)

输出结果：

模型的精度达到了0.72，模型表现一般。这同Logistic模型本身的局限性有关。传统的回归模型精度一般都会弱于决策树、SVM等机器挖掘算法。

未完待续，欢迎分享

http://weixin.qq.com/r/QDj27j-EwWK_rXuN921S (二维码自动识别)

完整代码：frankhlchi/R-scorecard

german_credit$DurationinCurrentaddress=NULL
german_credit$Guarantors=NULL
german_credit$Instalmentpercent=NULL
german_credit$NoofCreditatthisBank=NULL
german_credit$Occupation=NULL
german_credit$Noofdependents=NULL
german_credit$Telephone=NULL

AccountBalancewoe=woe(train2, "AccountBalance",Continuous = F, "Creditability",C_Bin = 4,Good = "1",Bad = "0")
Durationwoe=woe(train2, "Duration",Continuous = F, "Creditability",C_Bin = 2,Good = "1",Bad = "0")
PaymentStatusofPreviousCreditwoe=woe(train2, "PaymentStatusofPreviousCredit",Continuous = F, "Creditability",C_Bin = 4,Good = "1",Bad = "0")
Purposewoe = woe(train2, "Purpose",Continuous = F, "Creditability",C_Bin = 11,Good = "1",Bad = "0")
CreditAmountwoe= woe(train2, "CreditAmount",Continuous = F, "Creditability",C_Bin = 2,Good = "1",Bad = "0")
ValueSavingswoe =woe(train2, "ValueSavings",Continuous = F, "Creditability",C_Bin = 4,Good = "1",Bad = "0")
Lengthofcurrentemploymentwoe=woe(train2, "Lengthofcurrentemployment",Continuous = F, "Creditability",C_Bin = 4,Good = "1",Bad = "0")
Sex.Marital.Statuswoe=woe(train2, "Sex.Marital.Status",Continuous = F, "Creditability",C_Bin = 4,Good = "1",Bad = "0")
Mostvaluableavailableassetwoe=woe(train2, "Mostvaluableavailableasset",Continuous = F, "Creditability",C_Bin = 4,Good = "1",Bad = "0")
Agewoe=woe(train2, "Age",Continuous = F, "Creditability",C_Bin = 2,Good = "1",Bad = "0")
ConcurrentCreditswoe=woe(train2, "ConcurrentCredits",Continuous = F, "Creditability",C_Bin = 3,Good = "1",Bad = "0")
Typeofapartmentwoe=woe(train2, "Typeofapartment",Continuous = F, "Creditability",C_Bin = 3,Good = "1",Bad = "0")
ForeignWorkerwoe=woe(train2, "ForeignWorker",Continuous = F, "Creditability",C_Bin = 2,Good = "1",Bad = "0")

for(i in 1:1000){
  
  for(s in 1:4){
  if(german_credit$AccountBalance[i]==s){
    german_credit$AccountBalance[i]=-AccountBalancewoe$WOE[s]
  }
  }

  for(s in 1:3){
    if(german_credit$Duration[i]==s){
      german_credit$Duration[i]=-Durationwoe$WOE[s]
    }
  }
  
  for(s in 0:4){
    if(german_credit$PaymentStatusofPreviousCredit[i]==s){
      german_credit$PaymentStatusofPreviousCredit[i]=-PaymentStatusofPreviousCreditwoe$WOE[s+1]
    }
  }
  
  for(s in 0:10){
    if(s<=6){
    if(german_credit$Purpose[i]==s){
      german_credit$Purpose[i]=-Purposewoe$WOE[s+1]
    }
    }else{
      if(german_credit$Purpose[i]==s){
        german_credit$Purpose[i]=-Purposewoe$WOE[s]
      }
    }
  }
  
  for(s in 1:2){
    if(german_credit$CreditAmount[i]==s){
      german_credit$CreditAmount[i]=-CreditAmountwoe$WOE[s]
    }
  }
  
  for(s in 2:5){
    if(german_credit$ValueSavings[i]==s){
      german_credit$ValueSavings[i]=-ValueSavingswoe$WOE[s-1]
    }
  }
  
  for(s in 1:5){
    if(german_credit$Lengthofcurrentemployment[i]==s){
      german_credit$Lengthofcurrentemployment[i]=-Lengthofcurrentemploymentwoe$WOE[s]
    }
  }
  
  for(s in 1:5){
    if(german_credit$Sex.Marital.Status[i]==s){
      german_credit$Sex.Marital.Status[i]=-Sex.Marital.Statuswoe$WOE[s]
    }
  }
  
  for(s in 1:4){
    if(german_credit$Mostvaluableavailableasset[i]==s){
      german_credit$Mostvaluableavailableasset[i]=-Mostvaluableavailableassetwoe$WOE[s]
    }
  }
  
  for(s in 1:2){
    if(german_credit$Age[i]==s){
      german_credit$Age[i]=-Agewoe$WOE[s]
    }
  }
  
  for(s in 1:5){
    if(german_credit$ConcurrentCredits[i]==s){
      german_credit$ConcurrentCredits[i]=-ConcurrentCreditswoe$WOE[s]
    }
  }
  
  for(s in 1:5){
    if(german_credit$Typeofapartment[i]==s){
      german_credit$Typeofapartment[i]=-Typeofapartmentwoe$WOE[s]
    }
  }
  
  for(s in 1:2){
    if(german_credit$ForeignWorker[i]==s){
      german_credit$ForeignWorker[i]=-ForeignWorkerwoe$WOE[s]
    }
  }
}

fit<-glm(Creditability~ AccountBalance + Duration +PaymentStatusofPreviousCredit +Purpose + CreditAmount + ValueSavings + Lengthofcurrentemployment +Sex.Marital.Status+ Mostvaluableavailableasset + Age + ConcurrentCredits + Typeofapartment + ForeignWorker,train2,family = "binomial")
backwards = step(fit)
summary(backwards)

fit2<-glm(Creditability~ AccountBalance + Duration +PaymentStatusofPreviousCredit +Purpose + CreditAmount + ValueSavings + Lengthofcurrentemployment + Age + ConcurrentCredits  + ForeignWorker,train2,family = "binomial")
summary(fit2)

fit3<-glm(Creditability~ AccountBalance + Duration +PaymentStatusofPreviousCredit +Purpose + CreditAmount + ValueSavings + Lengthofcurrentemployment + Age  + ForeignWorker,train2,family = "binomial")
summary(fit3)
library(car)
vif(fit3, digits =3 )

prediction <- predict(fit3,newdata=test2)
for (i in 1:250) {
  if(prediction[i]>0.99){
    prediction[i]=1}
  else
  {prediction[i]=0}
}
confusionMatrix(prediction, test2$Creditability)

转载于:https://my.oschina.net/hblt147/blog/1575207