信用卡评分模型（R语言）
信用卡评分
2018年3月22日
一、数据准备
1、 问题的准备
• 目标：要完成一个评分卡，通过预测某人在未来两年内将会经历财务危机的可能性来提高信用评分的效果，帮助贷款人做出最好的决策。
• 背景：
– 银行在市场经济中起到至关重要的作用。他们决定谁在什么条件下可以得到融资，并且可以创造或打破投资决策。而市场、社会，以及个人和企业都需要获得贷款。
– 信用评分算法，对默认可能性进行猜测，这是银行用来判断贷款是否应该被授予的方法。
• 准备：
– 首先是基于个人借贷的场景，确定“违约”的定义： 根据新的Basel II Capital Accord（巴塞尔二资本协议），一般逾期90天算作违约。
– 在判别指标上，选择使用历史最大违约天数。
2、数据的获取与整合
• 数据来源：数据来自Kaggle，cs-training.csv是有15万条的样本数据，下图可以看到这份数据的大致情况。下载地址 为：https://www.kaggle.com/c/GiveMeSomeCredit/data
如果下载出现问题，可以在此下载数据：http://download.csdn.net/download/csqazwsxedc/10228999
• 数据描述：数据属于个人消费类贷款，只考虑评分卡最终实施时能够使用到的数据应从如下一些方面获取数据：
– 基本属性：包括了借款人当时的年龄。
– 偿债能力：包括了借款人的月收入、负债比率。
– 信用往来：两年内35-59天逾期次数、两年内60-89天逾期次数、两年内90天或高于90天逾期的次数。
– 财产状况：包括了开放式信贷和贷款数量、不动产贷款或额度数量。
– 贷款属性：暂无。
– 其他因素：包括了借款人的家属数量（不包括本人在内）。
• 原始变量：
变量名 |
变量类型 |
变量描述 |
SeriousDlqin2yrs |
Y/N |
超过90天或更糟的逾期拖欠 |
RevolvingUtilizationOf UnsecuredLines |
percentage |
无担保放款的循环利用：除了不动产和像车贷那样除以信用额度总和的无分期付款债务的信用卡和个人信用额度总额 |
age |
integer |
借款人当时的年龄 |
NumberOfTime30-59DaysPastDueNotWorse |
integer |
35-59天逾期但不糟糕次数 |
DebtRatio |
percentage |
负债比率 |
MonthlyIncome |
real |
月收入 |
NumberOf OpenCreditLinesAndLoans |
integer |
开放式信贷和贷款数量，开放式贷款（分期付款如汽车贷款或抵押贷款）和信贷（如信用卡）的数量 |
NumberOfTimes90DaysLate |
integer |
90天逾期次数：借款者有90天或更高逾期的次数 |
NumberRealEstateLoans OrLines |
integer |
不动产贷款或额度数量：抵押贷款和不动产放款包括房屋净值信贷额度 |
NumberOfTime60-89DaysPastDueNotWorse |
integer |
60-89天逾期但不糟糕次数：借款人在在过去两年内有60-89天逾期还款但不糟糕的次数 |
NumberOfDependents |
integer |
家属数量：不包括本人在内的家属数量 |
• 时间窗口：自变量的观察窗口为过去两年，因变量表现窗口为未来两年。
二、数据处理
首先去掉原数据中的顺序变量，即第一列的id变量。由于要预测的是SeriousDlqin2yrs变量，因此将其设为响应变量y，其他分别设为x1~x10变量。
1、缺失值分析及处理
在得到数据集后，我们需要观察数据的分布情况，因为很多的模型对缺失值敏感，因此观察是否有缺失值是其中很重要的一个步骤。在正式分析前，我们先通过图形进行对观测字段的缺失情况有一个直观的感受。
观察数据：
> xyk <- read.csv(file.choose())
> dim(xyk)
[1] 150000 12
> head(xyk)
X SeriousDlqin2yrs RevolvingUtilizationOfUnsecuredLines age
1 1 1 0.7661266 45
2 2 0 0.9571510 40
3 3 0 0.6581801 38
4 4 0 0.2338098 30
5 5 0 0.9072394 49
6 6 0 0.2131787 74
NumberOfTime30.59DaysPastDueNotWorse DebtRatio MonthlyIncome
1 2 0.80298213 9120
2 0 0.12187620 2600
3 1 0.08511338 3042
4 0 0.03604968 3300
5 1 0.02492570 63588
6 0 0.37560697 3500
NumberOfOpenCreditLinesAndLoans NumberOfTimes90DaysLate
1 13 0
2 4 0
3 2 1
4 5 0
5 7 0
6 3 0
NumberRealEstateLoansOrLines NumberOfTime60.89DaysPastDueNotWorse
1 6 0
2 0 0
3 0 0
4 0 0
5 1 0
6 1 0
NumberOfDependents
1 2
2 1
3 0
4 0
5 0
6 1
> matrixplot(xyk)
> md.pattern(xyk)
y x1 x2 x3 x4 x6 x7 x8 x9 x10 x5
120269 1 1 1 1 1 1 1 1 1 1 1 0
25807 1 1 1 1 1 1 1 1 1 1 0 1
3924 1 1 1 1 1 1 1 1 1 0 0 2
0 0 0 0 0 0 0 0 0 3924 29731 33655缺失值占比较多，直接删除损失大量观察值，使用KNN方法对缺失值进行填补：
xyk <- knnImputation(xyk,k=10,meth = "weighAvg")2、异常值分析及处理
首先对于x2变量，即客户的年龄，我们可以定量分析，发现有以下值：
> unique(xyk$x2)
[1] 45 40 38 30 49 74 57 39 27 51 46 76 64 78
[15] 53 43 25 32 58 50 69 24 28 62 42 75 26 52
[29] 41 81 31 68 70 73 29 55 35 72 60 67 36 56
[43] 37 66 83 34 44 48 61 80 47 59 77 63 54 33
[57] 79 65 86 92 23 87 71 22 90 97 84 82 91 89
[71] 85 88 21 93 96 99 94 95 101 98 103 102 107 105
[85] 0 109可以看到年龄中存在0值，显然是异常值，予以剔除:
> xyk <- xyk[-which(xyk$x2==0),]对于x3,x7,x9三个变量，均存在异常值，由unique函数可以得知均存在96、98两个异常值，因此予以剔除。同时会发现剔除其中一个变量的96、98值，其他变量的96、98两个值也会相应被剔除:
> unique(xyk$x3)
[1] 2 0 1 3 4 5 7 10 6 98 12 8 9 96 13 11
> unique(xyk$x7)
[1] 0 1 3 2 5 4 98 10 9 6 7 8 15 96 11 13 14 17 12
> unique(xyk$x9)
[1] 0 1 2 5 3 98 4 6 7 8 96 11 9> xyk <- xyk[-which(xyk$x3==96),]
> unique(xyk$x3)
[1] 2 0 1 3 4 5 7 10 6 98 12 8 9 13 11
> xyk <- xyk[-which(xyk$x3==98),]
> unique(xyk$x3)
[1] 2 0 1 3 4 5 7 10 6 12 8 9 13 11
> unique(xyk$x7)
[1] 0 1 3 2 5 4 10 9 6 7 8 15 11 13 14 17 12
> unique(xyk$x9)
[1] 0 1 2 5 3 4 6 7 8 11 9三、变量分析
1、单变量分析
我们可以简单地看下部分变量的分布，比如对于age变量，如下图：
> ggplot(xyk,aes(x = x2,y=..density..))+geom_histogram(
+ fill="blue",colours="grey60",size= 0.2,alpha= 0.2) +
+ geom_density()
可以看到年龄变量大致呈正态分布，符合统计分析的假设。再比如月收入变量，也可以做图观察观察，如下：
> ggplot(xyk,aes(x=x5,y=..density..))+geom_histogram(
+ fill="blue",colour="grey60",size = 0.2,alpha=0.2) +
+ geom_density()+xlim(1,20000)
月收入也大致呈正态分布，符合统计分析的需要。
2、变量之间的相关性
建模之前首先得检验变量之间的相关性，如果变量之间相关性显著，会影响模型的预测效果。下面通过corrplot函数，画出各变量之间，包括响应变量与自变量的相关性。
> cor1 <-cor(xyk[,1:11])
> corrplot(cor1)
> corrplot(cor1,method = "number")
四、切分数据集
> table(xyk$y)
0 1
139851 9879 由上表看出，对于响应变量SeriousDlqin2yrs，存在明显的类失衡问题，SeriousDlqin2yrs等于1的观测为9879，仅为所有观测值的6.6%。因此我们需要对非平衡数据进行处理，在这里可以采用SMOTE算法，用R对稀有事件进行超级采样。
我们利用caret包中的createDataPartition（数据分割功能）函数将数据随机分成相同的两份：
> splitIndex <- createDataPartition(xyk$y,time=1,p=0.5,list=FALSE)
> train <- xyk[splitIndex,]
> test <- xyk[-splitIndex,]对于分割后的训练集和测试集均有74865个数据，分类结果的平衡性如下：
> prop.table(table(train$y))
0 1
0.9339077 0.0660923 > prop.table(table(test$y))
0 1
0.93413478 0.06586522 两者的分类结果是平衡的，仍然有6.6%左右的代表，我们仍然处于良好的水平。因此可以采用这份切割的数据进行建模及预测。
五、Logistic回归
Logistic回归在信用评分卡开发中起到核心作用。由于其特点，以及对自变量进行了证据权重转换（WOE），Logistic回归的结果可以直接转换为一个汇总表，即所谓的标准评分卡格式。
2、建立模型
首先利用glm函数对所有变量进行Logistic回归建模，模型如下
> fit <- glm(y~.,train,family = "binomial")
Warning message:
glm.fit:拟合機率算出来是数值零或一
> summary(fit)
Call:
glm(formula = y ~ ., family = "binomial", data = train)
Deviance Residuals:
Min 1Q Median 3Q Max
-4.6199 -0.3395 -0.2779 -0.2244 3.0860
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.873e+00 6.447e-02 -29.048 < 2e-16
x1 -2.996e-04 2.649e-04 -1.131 0.25792
x2 -2.788e-02 1.278e-03 -21.810 < 2e-16
x3 5.645e-01 1.584e-02 35.645 < 2e-16
x4 -2.471e-05 1.567e-05 -1.577 0.11487
x5 -9.821e-06 3.495e-06 -2.810 0.00495
x6 -3.755e-03 3.771e-03 -0.996 0.31934
x7 8.486e-01 2.406e-02 35.275 < 2e-16
x8 9.171e-02 1.546e-02 5.933 2.98e-09
x9 7.886e-01 3.287e-02 23.990 < 2e-16
x10 6.282e-02 1.383e-02 4.543 5.54e-06
(Intercept) ***
x1
x2 ***
x3 ***
x4
x5 **
x6
x7 ***
x8 ***
x9 ***
x10 ***
---
Signif. codes:
0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 36446 on 74864 degrees of freedom
Residual deviance: 29740 on 74854 degrees of freedom
AIC: 29762
Number of Fisher Scoring iterations: 7
可以看出，利用全变量进行回归，模型拟合效果并不是很好，其中x1,x4,x6三个变量的p值未能通过检验，在此直接剔除这三个变量，利用剩余的变量对y进行回归。
> fit2 <- glm(y~x2+x3+x5+x7+x8+x9+x10,train,family = "binomial")
> summary(fit2)
Call:
glm(formula = y ~ x2 + x3 + x5 + x7 + x8 + x9 + x10, family = "binomial",
data = train)
Deviance Residuals:
Min 1Q Median 3Q Max
-4.6303 -0.3396 -0.2785 -0.2244 3.0822
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.890e+00 6.357e-02 -29.731 < 2e-16
x2 -2.825e-02 1.254e-03 -22.520 < 2e-16
x3 5.621e-01 1.566e-02 35.901 < 2e-16
x5 -8.391e-06 3.194e-06 -2.627 0.00861
x7 8.529e-01 2.378e-02 35.864 < 2e-16
x8 7.901e-02 1.377e-02 5.737 9.66e-09
x9 7.897e-01 3.288e-02 24.015 < 2e-16
x10 6.343e-02 1.380e-02 4.596 4.31e-06
(Intercept) ***
x2 ***
x3 ***
x5 **
x7 ***
x8 ***
x9 ***
x10 ***
---
Signif. codes:
0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 36446 on 74864 degrees of freedom
Residual deviance: 29747 on 74857 degrees of freedom
AIC: 29763
Number of Fisher Scoring iterations: 6
3、模型评估
通常一个二值分类器可以通过ROC（Receiver Operating Characteristic）曲线和AUC值来评价优劣。
很多二元分类器会产生一个概率预测值，而非仅仅是0-1预测值。我们可以使用某个临界点（例如0.5），以划分哪些预测为1，哪些预测为0。得到二元预测值后，可以构建一个混淆矩阵来评价二元分类器的预测效果。所有的训练数据都会落入这个矩阵中，而对角线上的数字代表了预测正确的数目，即true positive + true nagetive。同时可以相应算出TPR（真正率或称为灵敏度）和TNR（真负率或称为特异度）。我们主观上希望这两个指标越大越好，但可惜二者是一个此消彼涨的关系。除了分类器的训练参数，临界点的选择，也会大大的影响TPR和TNR。有时可以根据具体问题和需要，来选择具体的临界点。
如果我们选择一系列的临界点，就会得到一系列的TPR和TNR，将这些值对应的点连接起来，就构成了ROC曲线。ROC曲线可以帮助我们清楚的了解到这个分类器的性能表现，还能方便比较不同分类器的性能。在绘制ROC曲线的时候，习惯上是使用1-TNR作为横坐标即FPR（false positive rate），TPR作为纵坐标。这是就形成了ROC曲线。
而AUC（Area Under Curve）被定义为ROC曲线下的面积，显然这个面积的数值不会大于1。又由于ROC曲线一般都处于y=x这条直线的上方，所以AUC的取值范围在0.5和1之间。使用AUC值作为评价标准是因为很多时候ROC曲线并不能清晰的说明哪个分类器的效果更好，而作为一个数值，对应AUC更大的分类器效果更好
下面首先利用模型对test数据进行预测，生成概率预测值
> pre <- predict(fit2,test)利用pROC包，它能方便比较两个分类器，还能自动标注出最优的临界点，图看起来也比较漂亮。在下图中最优点FPR=1-TNR=0.845，TPR=0.638，AUC值为0.8102，说明该模型的预测效果还是不错的，正确较高。
> modelroc <- roc(test$y,pre)
> plot(modelroc,print.auc=TRUE,auc.polygon=TRUE,grid=
+ c(0.1,0.2),grid.col=c("green","red"),max.auc.polygon=TRUE,auc.polygon.col="skyblue",print.thres=TRUE)
> modelroc
Call:
roc.default(response = test$y, predictor = pre)
Data: pre in 69934 controls (test$y 0) < 4931 cases (test$y 1).
Area under the curve: 0.813六、WOE转换
证据权重（Weight of Evidence,WOE）转换可以将Logistic回归模型转变为标准评分卡格式。引入WOE转换的目的并不是为了提高模型质量，只是一些变量不应该被纳入模型，这或者是因为它们不能增加模型值，或者是因为与其模型相关系数有关的误差较大，其实建立标准信用评分卡也可以不采用WOE转换。这种情况下，Logistic回归模型需要处理更大数量的自变量。尽管这样会增加建模程序的复杂性，但最终得到的评分卡都是一样的。
用WOE(x)替换变量x。WOE()=ln[(违约/总违约)/(正常/总正常)]。
通过上述的Logistic回归，剔除x1,x4,x6三个变量，对剩下的变量进行WOE转换
> cutx2= c(-Inf,30,35,40,45,50,55,60,65,75,Inf)
> cutx3= c(-Inf,0,1,3,5,Inf)
> cutx5= c(-Inf,1000,2000,3000,4000,5000,6000,7500,9500,12000,Inf)
> cutx7= c(-Inf,0,1,3,5,10,Inf)
> cutx8= c(-Inf,0,1,2,3,5,Inf)
> cutx9= c(-Inf,0,1,3,5,Inf)
> cutx10= c(-Inf,0,1,2,3,5,Inf)2、计算WOE值
计算WOE的函数
> totalgood= as.numeric(table(train$y))[1]
> totalbad= as.numeric(table(train$y))[2]
> getWOE <- function(a,p,q)
+ {
+ Good <- as.numeric(table(train$y[a > p & a <= q]))[1]
+ Bad <- as.numeric(table(train$y[a > p & a <= q]))[2]
+ WOE <- log((Bad/totalbad)/(Good/totalgood),base = exp(1))
+ return(WOE)
+ }比如age变量(x2）
> Agelessthan30.WOE=getWOE(train$x2,-Inf,30)
> Age30to35.WOE=getWOE(train$x2,30,35)
> Age35to40.WOE=getWOE(train$x2,35,40)
> Age40to45.WOE=getWOE(train$x2,40,45)
> Age45to50.WOE=getWOE(train$x2,45,50)
> Age50to55.WOE=getWOE(train$x2,50,55)
> Age55to60.WOE=getWOE(train$x2,55,60)
> Age60to65.WOE=getWOE(train$x2,60,65)
> Age65to75.WOE=getWOE(train$x2,65,75)
> Agemorethan.WOE=getWOE(train$x2,75,Inf)
> age.WOE=c(Agelessthan30.WOE,Age30to35.WOE,Age35to40.WOE,Age40to45.WOE,Age45to50.WOE,
+ Age50to55.WOE,Age55to60.WOE,Age60to65.WOE,Age65to75.WOE,Agemorethan.WOE)
> age.WOE
[1] 0.54687647 0.51495440 0.32776554 0.23644765
[5] 0.21757805 0.07574932 -0.24655090 -0.47126668
[9] -0.93731092 -1.297495024、WOE DataFrame构建：
trainWOE =cbind.data.frame(tmp.age, tmp.PastDue, tmp.MonthIncome,
+ tmp.Days90PastDue, tmp.RealEstate,
+ tmp.Days60.89PastDue, tmp.Dependents)
七、评分卡的创建和实施
标准评分卡采用的格式是评分卡中的每一个变量都遵循一系列IF-THEN法则，变量的值决定了该变量所分配的分值，总分就是各变量分值的和。
知道线性表达式的两个参数A，B后就可以求每条记录（申请人）的分值。为了求得A，B，需要设定两个假设（分数的给定，很主观）。
以上就是推断，实际代码中，习惯用了q、p来代表A、B.
通俗来说就是，评分需要自己预设一个阀值，比如：
这个人预测出来“不发生违约”的几率为0.8，设定这个人为500分；
另一个人预测出来“不发生违约”的几率为0.9，设定这个人为600分。
阀值的设定需根据行业经验不断跟踪调整，下面的分数设定仅代表个人经验。
下面开始设立评分，假设按好坏比15为600分，每高20分好坏比翻一倍算出P,Q。如果后期结果不明显，可以高30-50分好坏比才翻一倍。
Score = q - p * log(odds)
即有方程：
620 = q - p * log(15)
600 = q - p * log(15/2)
逻辑回归建模：
#因为数据中“1”代表的是违约，直接建模预测，求的是“发生违约的概率”，log(odds)即为“坏好比”。为了符合常规理解，分数越高，信用越好，所有就调换“0”和“1”，使建模预测结果为“不发生违约的概率”，最后log(odds)即表示为“好坏比”。
> trainWOE$y = 1-train$y
> glm.fit = glm(y~.,data = trainWOE,family = binomial(link = logit))
> summary(glm.fit)
Call:
glm(formula = y ~ ., family = binomial(link = logit), data = trainWOE)
Deviance Residuals:
Min 1Q Median 3Q Max
-3.0918 0.1859 0.2503 0.3222 2.8311
Coefficients:
Estimate Std. Error z value
(Intercept) 2.64441 0.01764 149.89
tmp.age -0.74569 0.03714 -20.08
tmp.PastDue -0.64815 0.01827 -35.47
tmp.MonthIncome -0.85184 0.04490 -18.97
tmp.Days90PastDue -0.67686 0.01596 -42.42
tmp.RealEstate -0.67198 0.06601 -10.18
tmp.Days60.89PastDue -0.48428 0.02011 -24.08
tmp.Dependents -0.95193 0.08577 -11.10
Pr(>|z|)
(Intercept) <2e-16 ***
tmp.age <2e-16 ***
tmp.PastDue <2e-16 ***
tmp.MonthIncome <2e-16 ***
tmp.Days90PastDue <2e-16 ***
tmp.RealEstate <2e-16 ***
tmp.Days60.89PastDue <2e-16 ***
tmp.Dependents <2e-16 ***
---
Signif. codes:
0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 36446 on 74864 degrees of freedom
Residual deviance: 28367 on 74857 degrees of freedom
AIC: 28383
Number of Fisher Scoring iterations: 6
> coe = (glm.fit$coefficients)p <- 20/log(2)
q <- 600-20*log(15)/log(2)> Score=q + p*{as.numeric(coe[1])+as.numeric(coe[2])*tmp.age +as.numeric(coe[3])*tmp.PastDue+p*as.numeric(coe[4])*tmp.MonthIncome+p*as.numeric(coe[5])*tmp.Days60.89PastDue+p*as.numeric(coe[6])*tmp.Days90PastDue+p*as.numeric(coe[7])*tmp.RealEstate+p*as.numeric(coe[8])*tmp.Dependents
+ }个人总评分=基础分+各部分得分
基础分为:
> base <- q+p*as.numeric(coe[1])
> base
[1] 598.1638构造计算分值函数：
> getscore<-function(i,x){
+
+ score = round(p*as.numeric(coe[i])*x,0)
+ return(score)
+ }2、计算各变量分箱得分：
> Agelessthan30.SCORE = getscore(2,Agelessthan30.WOE)
> Age30to35.SCORE = getscore(2,Age30to35.WOE)
> Age35to40.SCORE = getscore(2,Age35to40.WOE)
> Age40to45.SCORE = getscore(2,Age40to45.WOE)
> Age45to50.SCORE = getscore(2,Age45to50.WOE)
> Age50to55.SCORE = getscore(2,Age50to55.WOE)
> Age55to60.SCORE = getscore(2,Age55to60.WOE)
> Age60to65.SCORE = getscore(2,Age60to65.WOE)
> Age65to75.SCORE = getscore(2,Age65to75.WOE)
> Agemorethan.SCORE = getscore(2,Agemorethan.WOE)
> Age.SCORE = c(Agelessthan30.SCORE,Age30to35.SCORE,Age35to40.SCORE,
+ Age40to45.SCORE,Age45to50.SCORE,Age50to55.SCORE,
+ Age55to60.SCORE,Age60to65.SCORE,Age65to75.SCORE,
+ Agemorethan.SCORE)
> Age.SCORE
[1] -12 -11 -7 -5 -5 -2 5 10 20 28
最终生成的评分卡：
3.4.3一个示例：
