贷款风险预测-信用评分卡模型(R语言)
时间:2018年10月9日
本次的分析数据来自Kaggle数据竞赛平台的“give me some credit”竞赛项目。下载地址为:https://www.kaggle.com/c/GiveMeSomeCredit/data
本次分析主要做了两件事:
一、用逻辑回归预测用户未来两年违约的概率
二、根据违约概率制作评分卡
分析步骤:
1.变量的描述
2.数据预处理
3.变量分析
3.模型建立
4.模型评估
5.制作评分卡
一、变量的描述
SeriousDlqin2yrs:超过90天或更糟的逾期拖欠
RevolvingUtilizationOfpercentage :无担保放款的循环利用:除了不动产和像车贷那样除以信用额度总和的无分期付款债务的信用卡和个人信用额度总额
UnsecuredLines age :借款人当时的年龄
NumberOfTime30-59DaysPastDueNotWorse :35-59天逾期但不糟糕次数
DebtRatio percentage:负债比率
MonthlyIncome real:月收入
NumberOf OpenCreditLinesAndLoans:开放式信贷和贷款数量,开放式贷款(分期付款如汽车贷款或抵押贷款)和信贷(如信用卡)的数量
NumberOfTimes90DaysLate:90天逾期次数:借款者有90天或更高逾期的次数
NumberRealEstateLoans :不动产贷款或额度数量:抵押贷款和不动产放款包括房屋净值信贷额度
OrLinesNumberOfTime60-89DaysPastDueNotWorse :60-89天逾期但不糟糕次数:借款人在在过去两年内有60-89天逾期还款但不糟糕的次数
NumberOfDependents:家属数量:不包括本人在内的家属数量
二、数据预处理
1.导入数据并预览数据
cstraining<-read.csv('D:\\A\\score-card\\cs-training.csv')
View(cstraining)
2. 删除 X
变量
cstraining$X<-NULL
3. 更改变量名称
colnames(cstraining)<-c("y" ,"RUOUL","age","D30Past","DR","Income","OCAL" ,"D90Late" ,"RealEstate" ,"D60Past","Dependents" )
names(train)
4. 处理样本均衡
> prop.table(table(cstraining$y))
0 1
0.93316 0.06684
违约客户样本量只占了6.7%,样本不均衡。这里,我采用的方法是把违约客户重复放进样本里:
bad<-cstraining[which(cstraining$y==1),]
all<-rbind(cstraining,bad)
> prop.table(table(all$y))
0 1
0.8746954 0.1253046
此时,违约客户占比达到了12.5%,在可接受范围内。
5. 异常值和缺失值的处理
dat1<-all
(1)查看数据缺失情况
library(mice)
md.pattern(dat1)
由图可以看出字段的缺失值个数Income
:31400 , Dependents
:4103
查看缺失比例:
library(VIM)
aggr_plot <- aggr(all, col=c('navyblue','red'), numbers=TRUE, sortVars=TRUE, labels=names(dat1), cex.axis=.7, gap=3, ylab=c("Histogram of missing all","Pattern"))
Variables sorted by number of missings:
Variable Count
Income 0.19621811
Dependents 0.02563958
y 0.00000000
RUOUL 0.00000000
age 0.00000000
D30.59Past 0.00000000
DR 0.00000000
OCAL 0.00000000
D90Late 0.00000000
RealEstate 0.00000000
D60.89Past 0.00000000
(2)对各变量进行异常值与缺失值处理
##盖帽法函数
block<-function(x,lower=T,upper=T){
if(lower){
q1<-quantile(x,0.01)
x[x<=q1]<-q1
}
if(upper){
q99<-quantile(x,0.99)
x[x>q99]<-q99
}
return(x)
}
(i). 对变量RUOUL
进行处理
dat1$RUOUL<-block(dat1$RUOUL)
boxplot(RUOUL~y,data=dat1,horizontal=T, frame=F,
col="lightgray",main="RUOUL")
(ii). 对变量age
进行处理
> summary(dat1$age)
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.0 41.0 51.0 51.9 62.0 109.0
> which(dat1$age==0)
[1] 65696
> dat1<-dat1[-which(dat1$age==0),]
年龄为0的肯定是异常值,而且只有一个数据是0,我采用的是直接删除这个记录。
boxplot(age~y,data=dat1,horizontal=T, frame=F,
col="lightgray",main="age")
由图可看出,年龄这个变量,是大年龄段存在异常值
QLa <- quantile(dat1$age, probs = 0.25)
QUa <- quantile(dat1$age, probs = 0.75)
QUa_QLa <- QUa-QLa
QLa;QUa;QUa_QLa
dat1$age[which(dat1$age> (QUa+1.5*QUa_QLa))]<-1.5*QUa_QLa
boxplot(dat1$age,col="lightgray",main="age")
(iii). 对变量D30Past
进行处理
> table(dat1$D30Past )
0 1 2 3 4 5 6 7 8 9
131059 18441 5817 2372 1065 496 214 82 33 16
10 11 12 13 96 98
7 2 3 2 9 407
> table(dat1$D90Late )
0 1 2 3 4 5 6 7 8 9
148215 7008 2331 1052 486 214 128 69 36 33
10 11 12 13 14 15 17 96 98
13 8 3 6 3 2 2 9 407
> table(dat1$D60Past )
0 1 2 3 4 5 6 7 8 9
149651 7508 1679 498 170 55 28 14 3 1
11 96 98
2 9 407
显然值为96,98 的是异常值。我采用的方法是直接删除。而且D30Past
这个变量的96,98的记录删除之后,后面D90Late
D60Past
两个变量的96,98的记录也同时被删除了。
> dat1<-dat1[-which(dat1$D30Past %in% c(96,98)),]
> table(dat1$D30Past )
0 1 2 3 4 5 6 7 8 9 10 11
131059 18441 5817 2372 1065 496 214 82 33 16 7 2
12 13
3 2
> table(dat1$D90Late )
0 1 2 3 4 5 6 7 8 9 10 11
148215 7008 2331 1052 486 214 128 69 36 33 13 8
12 13 14 15 17
3 6 3 2 2
> table(dat1$D60Past )
0 1 2 3 4 5 6 7 8 9 11
149651 7508 1679 498 170 55 28 14 3 1 2
盖帽法处理异常值
dat1$D30.59Past<-block(dat1$D30.59Past)
> table(dat1$D30.59Past )
0 1 2 3 4
131059 18441 5817 2372 1920
(iv).对变量 "DR"进行处理
> summary(dat1$DR)
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.0 0.2 0.4 350.3 0.9 329664.0
盖帽法处理
dat1$DR<-block(dat1$DR)
(v). 对变量Income
进行处理
因为已经做过多次模型对比,对这个变量分别采用KNN填补和均值填补,发现采用均值填补,模型效果更好,因此我采用的是用均值填补缺失值,然而均值容易受到极端值的影响,所以先对少数过于极端的异常值作处理,再填补缺失值
存在大量0,1,2这样的异常值,当作缺失值处理
dat1$Income[which(dat1$Income %in% c(0,1,2))]<-NA
boxplot(dat1$Income,col="lightgray",main="Income",range =1.5)
红色框里的值对应的记录直接删除,调range参数,找出想删除的值
boxplot(dat1$Income,col="lightgray",main="Income",range =100)
> sort(boxplot.stats(dat1$Income,coef =100)$out)
[1] 562466 582369 629000 649587 699530 702500 730483 835040
[9] 1072500 1560100 1794060 3008750`
dat1<-dat1[-which(dat1$Income>=562466),]
均值填补缺失值
dat1$Income[is.na(dat1$Income)]<-mean(dat1$Income,na.rm=TRUE)
盖帽法处理异常值