摘要
信用评分卡模型在国外是一种成熟的预测方法,尤其在信用风险评估以及金融风险控制领域更是得到了比较广泛的使用,其原理是将模型变量WOE编码方式离散化之后运用logistic回归模型进行的一种二分类变量的广义线性模型。本文首先对数据进行预处理,即解决缺失值、异常值问题,同时分析了数据的相关性,之后采用K-折交叉验证将数据划分为训练集和测试集,通过建立逻辑回归模型对数据进行训练,得出10-折交叉验证的平均AUC为0.8010,实验表明模型检测效果较好。
客户申请评分卡由一系列特征项组成,每个特征项相当于申请表上的一个问题(例如,年龄、银行流水、收入等)。每一个特征项都有一系列可能的属性,相当于每一个问题的一系列可能答案(例如,对于年龄这个问题,答案可能就有30岁以下、30到45等)。在开发评分卡系统模型中,先确定属性与申请人未来信用表现之间的相互关系,然后给属性分配适当的分数权重,分配的分数权重要反映这种相互关系。分数权重越大,说明该属性表示的信用表现越好。一个申请的得分是其属性分值的简单求和。如果申请人的信用评分大于等于金融放款机构所设定的界限分数,此申请处于可接受的风险水平并将被批准;低于界限分数的申请人将被拒绝或给予标示以便进一步审查。
逻辑回归模型是一种广义的线性回归分析模型,常用于数据挖掘,疾病自动诊断,经济预测等领域。逻辑回归从本质来说属于二分类问题。
kaggle的数据集:https://www.kaggle.com/c/GiveMeSomeCredit,通过对消费者的人口特征、信用历史记录、交易记录等大量数据进行系统的分析、挖掘数据蕴含的行为模式、信用特征,发展出预测行的模式,结合信用卡评分的构建原理,采用R语言完成数据的清洗,主要包括缺失数据的填充、异常的删除和数据的分箱;调用Logistic回归模型建立信用卡评分的基础模型,借助自变量的证据权重转换(WOE)创建信用卡评分卡,并开发一个简单的信用评分系统。
Give Me Some Credit项目中的训练集在cs-training.csv文件中,有150000条数据,12个变量,测试集在cs-test.csv文件中,有101503条数据,12个变量,训练集和测试集中的数据结构类型如图1所示:
图1 训练集数据结构类型
每个变量的含义如下所示:
在通常情况下,原始数据集中会存在缺失值、异常值、分布不均衡等问题,它会影响后期的程序处理及模型预测的结果,而且对于原始数据中的不同变量需要进行相关性研究,以此来确定要选用那些数据进行模型拟合,所以需要进行数据预处理,在保证数据集的数据分布和数据类型不变的情况下,来优化数据集,提高数据集的有效性。通过R语言中的以下函数读取并显示数据,数据显示结果如图1所示:
credit_data <- read.csv('cs-training.csv',stringsAsFactors = FALSE)
str(credit_data) #显示数据结构
为了方便以后的程序计算将数据中的变量进行重命名,故将SeriousDlqin2yrs作为因变量重命名为y,其余列作为自变量以此设置为x1, x2, …, x10。而SeriousDlqin2yrs变量中原本1表示违约,0表示没有违约,但是这样分析后得出的分数会与这个值呈负相关,所以为了方便后续分析,使一个人的信用程度与其分数大小正相关,将y作变换,令0表示违约,1表示没有违约。
图像预处理操作首先要识别出缺失数据,可以通过R语言中的mice包中分pattern函数来生成矩形框,用颜色深浅来表示缺失值的多少,通过一下代码显示通过图3所示缺失值信息:
> library(mice)
> md.pattern(cr_data)
图3 数据集中的缺失值信息
图3中红色表示缺失值,颜色越深表示缺失值越多,从图中可以看到x5变量(月收入)缺失值为29731个,x10(家属数量)缺失值为3924个。因为x10的缺失值数量所占比列较小,故直接将缺失值删除,但是x5的缺失值较多,直接删除缺失值会影响整个数据的分布,影响真实数据情况,所以通过采用中位数/均值/众数等方式填充缺失数据,如图4所示是x5的数据分布情况,由图4可知,x5服从正太分布情况,故此采用中位数的方式进行缺失值的填充。
图4 x5变量(月收入)数据分布情况
异常值(outlier)指样本中的个别值的数值明显偏离它(或它们)所属样本的其余观测值,也称异常数据或离群值。剔除异常值更有利于对数据的分析和观察,也可以提高模型拟合的稳定性,防止模型过拟合。R语言中常用的异常值检测方法如下:
本文通过单变量异常值检测方法对异常值进行检测,首先对x2(Age)进行异常值检测,如图5所示是基于Age数据生成的箱型图,由图中结果并结合现实中的信用卡申请的条件可知,申请人的年龄必须在18~65岁之间,因此将小于18和大于65的数据进行删除,并用boxplot.stats()检查删除后的异常值是否为0。
图5 基于Age数据的箱型图
然后分析x3, x7, x9的异常值,通过boxplot(cr_data$x3,cr_data$x7,cr_data$x9)可以得到相应数据的箱型图如图6所示,由图可知到异常值均为接近100的值,将这些异常值都删除。
图6 x3, x7, x9数据的箱型图
在建模之前需要对不同维度的数据进行相关性分析,如果变量之间具有强相关性,则会影响模型的准确性。调用R中的cor()函数来计算不同变量之间的相关性系数,并且调用corrplot包中的corrplot()函数来将相关系数可视化,如图7所示:
图7 不同维度间的相关性分析
由图7可知:各个变量之间的相关系数较小,相关性较弱,不存在明显的多重共线问题。由于采用logistic回归需要考虑多重共线问题,而在此处由于各变量之间的相关性较小,初步判断不存在多重共线问题。在建模之后也可以通过VIF(方差膨胀因子)来检验多重共线问题。若存在多维共线问题时,需要进行降维或剔除处理。
通过函数table(cr_data$y)统计y中的标签类别的数量,如表所示:
表1 y(逾期拖欠)标签统计
y类别 | 数量 |
0 | 9044 |
1 | 109785 |
由表1可知:因变量y存在着明显的类别不均衡问题,y等于0的观测值为9044,仅占所有观测值的7.6%,因此,需要对非平衡数据进行基于smote算法处理,smote算法的思想是合成新的少数类样本,合成的策略是对每个少数类样本a,从它的最近邻中随机选一个样本b,然后在a、b之间的连线上随机选一点作为新合成的少数类样本。经过smote算法均衡后的标签类别数量如表所示:
表2 smote算法均衡后的标签类别数量
y类别 | 数量 |
0 | 36176 |
1 | 27132 |
为了提高模型的准确率和鲁棒性,对数据进行k-折交叉验证(k-fold crossValidation),将Give Me Some Credit数据集分为训练集(training set)和测试集(testing set),为了充分利用数据集对算法效果进行测试,将样本集分为k份,其中k-1份作为训练数据集,而另外的1份作为验证数据集。用验证集来验证所得分类器或者模型的错误率。一般需要循环k次,直到所有k份数据全部被选择一遍为止。如图8所示为k-折交叉验证示意图,根据本文使用数据的分布,将k折交叉验证中的k值设置为10,即使用10-折交叉验证对模型进行训练,最后对每一次交叉验证的AUC求平均值,作为模型的评估结果。
图8:k-折交叉验证示意图
Logistic回归模型也称为逻辑斯谛回归模型,是一种分类模型,由条件概率分布
表示,形式为参数化的逻辑斯蒂分布,其中,随机变量X取值为实数,随机变量Y取值为0或1,通过监督学习的方式来估计模型参数。二项逻辑斯蒂回归模型是如下的条件概率分布:
这里的
是输入,
是输出,
和
是参数,
和
分别为权重和偏置,“
”是内积运算。逻辑斯蒂回归模型学习时,设:
那么,假设
的极大似然函数是
,那么训练学习到的逻辑斯蒂回归模型为:
为了建模分析可以先将数据进行训练集、测试集7:3的切分:
splitindex <- createDataPartition(cr_data$y,times = 1,p=0.7,list = FALSE)
切分结果如表3所示是切分数据中不同类别所占比例。
表3 数据集切分
数据集切分 | y类别 | 比例 |
训练集 | 0 | 0.5714286 |
1 | 0.4285714 | |
测试集 | 0 | 0.5714286 |
1 | 0.4285714 |
由表3可知:切分后的训练集和测试集的两者分类后的结果是平衡的,y等于0的概率均为7.6%左右,处于良好的水平,可以采用切割后的数据进行建模和预测分析。
Logistic回归模型可以根据其自身的特点以及对自变量进行证据权重转换(WOE),可以用在信用卡评分开发中,它的结果可以直接转换为一个汇总表,即标准评分卡格式。调用R语言中glm()函数对所有变量进行logistic回归建模。通过如下代码训练逻辑斯蒂回归模型:
fit=glm(y~.,data=traindata,family = "binomial")
summary(fit)
输出如图8所示的实验结果,图中的Estimate列:包含由普通最小二乘法计算出来的估计回归系数;Std. Error列:估计的回归系数的标准误差;。z value列:也叫标准分数(standard score)是一个数与平均数的差再除以标准差的过程。在统计学中,标准分数是一个观测或数据点的值高于被观测值或测量值的平均值的标准偏差的符号数。在平均数之上的分数会得到一个正的标准分数,在平均数之下的分数会得到一个负的标准分数。z分数是一种可以看出某分数在分布中相对位置的方法;Pr列:表示估计系数不显著的可能性,有较大P值的变量是可以从模型中移除的候选变量。
图8 fit的Logistic回归训练结果
由图8结果可知,变量x1,x4,x6的Pr值较大,对响应变量y的贡献不显著,因此直接删除这三个变量,利用剩下的变量来进行logistic回归。即:
fit2 <- glm(y~x2+x3+x5+x7+x8+x9+x10,data=traindata,family = "binomial")
由逻辑斯蒂回归模型训练得到如图9所示的结果,模型训练与第一次用十个维度的数据训练循环的次数相同都是6次。
图9 fit2的Logistic回归训练结果
由图8、9的AIC值可知,第一次训练的AIC为26489,第二次训练的AIC为26488。AIC值指的是衡量统计模型拟合优良性的一种标准,由日本统计学家赤池弘次在1974年提出,它建立在熵的概念上,提供了权衡估计模型复杂度和拟合数据优良性的标准。通常情况下AIC的定义为:
其中k是模型参数个数,L是似然函数。
AIC不仅要提高模型拟合度(极大似然),而且引入了惩罚项,使模型参数尽可能少,有助于降低过拟合的可能性。而一般情况下AIC越小的模型,拟合程度越小,模型复杂度越小。故此第二次训练的逻辑斯蒂回归模型全部通过了检验,并且模型复杂度也相对小。
在计算机科学特别是机器学习领域中,对模型的评估同样至关重要,只有选择与问题相匹配的评估方法,才能快速地发现模型选择或训练过程中出现的问题,迭代地对模型进行优化。针对分类、排序、回归、序列预测等不同类型的机器学习问题,评估指标的选择也有所不同。本文模型主要是通过逻辑斯蒂回归模型实现对消费者信用数据进行二分类,所以主要选用的指标有受试者工作特征曲线(Receiver Operating Characteristic, ROC)曲线和AUC值。
ROC的全称是受试者工作特征(Receiver Operating Characteristic)曲线,用来评判分类、检测结果的好坏。它是非常重要和常见的统计分析方法。由表混淆矩阵可知,正确检测出正样本为真阳性(True Positives,TP),错误检测出正样本为假阳性(False Positives,FP),错误检测出负样本为假阴性(False Negatives,FN),正确检测出负样本为真阴性(True Negatives,TN)。
表4 混淆矩阵
真实值 预测值 | Positive | Negative |
True | True Positive(TP) | True Negative(TN) |
False | False Positive(FP) | False Negative(FN) |
而ROC曲线的横坐标与纵坐标分别是假正率(FPR, False Positive rate)和真正率(TPR, True Positive rate),二者的定义如下:
绘制ROC曲线时,根据学习器的预测结果对样例进行排序,按此顺序逐个把样本作为正例进行预测,每次计算出两个重要量的值(TPR、FPR),分别以它们为横、纵坐标作图。AUC为ROC曲线下的面积,这个值越接近1,模型的效果越好,体现在ROC曲线中,即是曲线越接近坐标系左上角,性能越好。
10-折交叉验证的AUC评估结果如下表所示:
表5 10-折交叉验证的AUC
k | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 | 10 | max | mean |
AUC | 0.8018 | 0.8006 | 0.8007 | 0.7998 | 0.7998 | 0.8034 | 0.8009 | 0.8025 | 0.7984 | 0.7984 | 0.8034 | 0.8010 |
由表可知,10-折交叉验证的平均AUC为0.8010,而在第六次得到的AUC最大。因此采用第六次的数据切分方法进行进一步测试验证,调用R语言中pROC包中的roc函数计算逻辑斯蒂回归模型分类器的AUC值,并且自动标注出最优的临界点。如下图所示:最优点FPR=1-TNR=0.661,TPR=0.823,AUC值为0.803,说明该模型的预测效果不错,正确率较高。
图10 roc函数计算结果
尽管本实验结果的AUC指标水平符合要求,已经达到0.8010,但仍可以通过数据预处理、数据特征构建、优化训练模型等来进一步提高AUC指标,从而使得模型的精确度更高,未来将从以上三个方面对模型进行改进,以达到更好的预测效果。
install.packages('lattice', repos = 'https://mirror.lzu.edu.cn/CRAN/')
install.packages('mice', repos = 'https://mirror.lzu.edu.cn/CRAN/')
install.packages('corrplot', repos = 'https://mirror.lzu.edu.cn/CRAN/')
install.packages('pROC', repos = 'https://mirror.lzu.edu.cn/CRAN/')
install.packages('DMwR', repos = 'https://mirror.lzu.edu.cn/CRAN/')
install.packages('grid', repos = 'https://mirror.lzu.edu.cn/CRAN/')
install.packages('Metrics', repos = 'https://mirror.lzu.edu.cn/CRAN/')
install.packages('measures', repos = 'https://mirror.lzu.edu.cn/CRAN/')
install.packages('randomForest', repos = 'https://mirror.lzu.edu.cn/CRAN/')
install.packages('plyr', repos = 'https://mirror.lzu.edu.cn/CRAN/')
# 读取数据
credit_data <- read.csv('./GiveMeSomeCredit/cs-training.csv',stringsAsFactors = FALSE)
#credit_test_data <- read.csv('./GiveMeSomeCredit/cs-test.csv',stringsAsFactors = FALSE)
str(credit_data)
#显示数据结构
cr_data <- credit_data[,2:12]
# 更换变量名称
names(cr_data) <- c('y','x1','x2','x3','x4','x5','x6','x7','x8','x9','x10')
head(cr_data)
# SeriousDlqin2yrs变量中原本1表示违约,0表示没有违约,
#但是这样分析后得出的分数会与这个
#值呈负相关,所以为了方便后续分析,
#使一个人的信用程度与其分数大小正相关变换变量
cr_data$y <- 1-cr_data$y
#0表示违约,1表示不违约
# 运行一下代码:x5变量(月收入)缺失值为29731个,x10(家属数量)缺失值为3924个
library(lattice)
library(mice)
md.pattern(cr_data)
# x5的缺失值较多,直接删除可能会影响结果,可以采用中位数/均值/众数等方式填充缺失数据,
# 由于x5呈明显的正态分布,因此用中位数去填充x5的缺失数据
library(ggplot2)
ggplot(data = cr_data,aes(x5))+geom_density(fill="lightskyblue")+xlim(0,25000)+geom_vline(aes(xintercept=median(cr_data$x5[!is.na(cr_data$x5)])),colour="red",linetype="dashed",lwd=1)
dev.new()
cr_data$x5[is.na(cr_data$x5)]=median(cr_data$x5[!is.na(cr_data$x5)])
# 用KNN填补缺失值
library(grid)
library(DMwR)
#cr_data <- knnImputation(cr_data,k=12,meth="weighAvg")
cr_data <- na.omit(cr_data)
# 处理age异常值
boxplot(cr_data$x2)
# 信用卡申请条件,申请人的年龄必须在18~65岁之间,
# 因此将小于18和大于65的数据进行删除,并用boxplot.stats()
#检查删除后的异常值为0
cr_data <- cr_data[cr_data$x2 <= 65 & cr_data$x2 >= 18,]
boxplot.stats(cr_data$x2)
#`stats`
# 处理x3,x7,x9的异常值
# 异常值均为接近100的值,删除
boxplot(cr_data$x3,cr_data$x7,cr_data$x9)
boxplot(cr_data$x3,cr_data$x7,cr_data$x9)
unique(cr_data$x3)
unique(cr_data$x7)
unique(cr_data$x9)
cr_data <- cr_data[-which(cr_data$x3==96),]
cr_data <- cr_data[-which(cr_data$x3==98),]
unique(cr_data$x7)
unique(cr_data$x9)
# 变量的相关性分析
# 建模之前需要先检验变量之间的相关性
# 如果变量之间具有强相关性,则会影响模型的准确性.
# 调用R中的cor()函数来计算不同变量之间的相关系数,同时,
# 调用corrplot包中的corrplot()函数来将相关系数可视化
library(corrplot)
cor1 <- cor(cr_data)
corrplot(cor1,method = 'number')
# 以上三行代码的结构可以证明:各个变量之间的相关系数较小,
# 相关性较弱,不存在明显的多重共线问题,
# 采用logistic回归需要考虑多重共线问题,
# 在此处由于个变量之间的相关性较小,可以初步判断不存在多重共线问题.在建模之后也可以通过VIF(方差膨胀因子)来检验多重共线问题.当存在多维共线问题时,需要进行降维或剔除处理.
# 切分数据集,
table(cr_data$y)
cr_data$y <- factor(cr_data$y)
cr_data$y <- as.factor(ifelse(cr_data$y == 0 , "yes" , "no"))
cr_data <- SMOTE(y ~ ., cr_data)
table(cr_data$y)
# 以上结果:响应变量y存在着明显的类失衡问题,y等于0的观测值为9044,
# 仅占所有观测值的7.6%,因此,我们需要对非平衡数据进行处理,基于smote算法,
# 调用R语言中caret包中的createDataPartition对稀有数据进行超级采样。
library(caret)
set.seed(500)
splitindex <- createDataPartition(cr_data$y,times = 1,p=0.5,list = FALSE)
print(splitindex)
traindata <- cr_data[splitindex,]
print(traindata)
testdata <- cr_data[-splitindex,]
prop.table(table(traindata$y))
prop.table(table(testdata$y))
# 以上结果:两者分类后的结果是平衡的,y等于1的概率均为7.6%左右,
# 处于良好的水平,因此,可以采用切割后的数据进行建模和预测分析。
# 建模分析:Logistic回归模型在信用卡评分开发的基础模型,由于其自身的特点以及对自变量进行证据权重转换(WOE),logistic回归的结果可以直接转换为一个汇总表,即所谓的标准评分卡格式。
# 调用R语言中glm()函数对所有变量进行logistic回归建模.
fit=glm(y~.,data=traindata,family = "binomial")
summary(fit)
# 由运行结果可知,变量x1,x4,x6对响应变量y的贡献不显著,
# 因此直接删除这三个变量,利用剩下的变量来进行logistic回归
fit2 <- glm(y~x2+x3+x5+x7+x8+x9+x10,data=traindata,family = "binomial")
summary(fit2)
# 模型评估,画出ROC曲线,计算AUC
pre=predict(fit2,testdata)
print(pre)
library(pROC)
modelroc=roc(testdata$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)
library(randomForest)
#十次交叉验证
#数据切块
k_data <- createFolds(y=cr_data$y, k=10,list = TRUE, returnTrain = TRUE)
print(cr_data[k_data[[1]],])
#fold_test <- cr_data[k_data[2],]
auc_l <- as.numeric()
for(i in 1:10){
fold_test <- cr_data[k_data[[i]],]
fold_train <- cr_data[-k_data[[i]],]
#print(fold_train)
#print(fold_test)
fit2 <- glm(y~x2+x3+x5+x7+x8+x9+x10,data=fold_train,family = "binomial")
summary(fit2)
pre=predict(fit2,fold_test)
modelroc=roc(fold_test$y,pre)
print(auc(modelroc))
auc_l <- append(auc_l, auc(modelroc))
}
print((auc_l))
print(max(auc_l))
print(mean(auc_l))
fit_res <- glm(y~x2+x3+x5+x7+x8+x9+x10,data=cr_data[-k_data[[6]],],family = "binomial")
summary(fit2)
pre_res=predict(fit_res,cr_data[k_data[[6]],])
modelroc=roc(cr_data[k_data[[6]],]$y,pre_res)
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)