信用评分卡模型(R语言)

贷款风险预测-信用评分卡模型(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)

盖帽法处理异常值

  • 4
    点赞
  • 41
    收藏
    觉得还不错? 一键收藏
  • 1
    评论
评论 1
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值