利用R语言对贷款客户作风险评估（中）——不平衡数据的分类问题

利用R语言对贷款客户作风险评估（中）——不平衡数据的分类问题

前言

上一篇是对数据简单的处理和数据探索，接下来开始对数据建立模型，本篇的内容是不平衡数据的分类问题。本文的数据中好坏数据作为因变量属于不平衡的二分类问题。

阐述不平衡分类问题

实际的数据常常会出现类分布不平衡的数据，而少数类更具有研究价值，因此人们更加关注的是少数类的正确分类。然而，传统的分类器通常由于其面向整体的准确性度量，从而忽略了少数类的正确分类。
解决不平衡问题的主流方法有：1、现有分类算法的修改；2、 数据 面的修改，旨在平衡训练任务之前数据的偏斜类分布；3，代价敏感性分析，在学习算法中赋予不同的错误分类成本。结合上述三类方法构建集成分类方法，已被证明比以前的非集成方法更准确，尤其是少数类分类精度的明显提高。
AdaBoost 和 Bagging 是最常见的通过改变数据分布构建的集成方 法。但它们本身并不能处理不平衡的问题，因为它们固有地被设计为最大化准确性测量，从而忽略了对少数类的精确分类。因此，需要结合数据抽样技术来解决类别分布不均的问题。

阐述数据采样技术

通过在不平衡问题中使用抽样方法，以期获得一个均衡的数据集分布。即通过合理的删减或者增加一些样本来实现数据均衡，按照对样本数量的影响可分为过抽样（即合理的增加少数类样本）和欠抽样（即合理的删减多数类样本）。如随机欠采样方法( RUS )、合成少数过采 样技术( SMOTE )，和进化的欠采样（EUS）。
与仅使用大多数类别的一个子集的随机欠采样不同，进化的欠采样方法 EUS用于改变数据分布和获取平衡子集，利用所有多数样本来确保样本的多样性和代表性，并且已经在实际应用中显 示出它的实用性和有效性。EUS的具体方法为：首先计算不平衡类别的不平衡比率IR（round(多数类的样本个数/少数类的样本个数)）；将多数类随机分成IR份；将全部少数类样本分别与每个多数类子集相结合，以构建𝐼𝑅个平衡的训练集。

分类性能的评价指标

如何评估分类器对于正确评估其分类性能，并指导其建模具有非常重要的意 义，特别是对不平衡分类问题的分类性能指标的选取。
本文采用特异性、 灵敏性以及 AUC 测量值作为评价指标。 特异性(1- FPR )：特异性值越大，预测正类中实际负类越少；灵敏性( TPR )： 灵敏性值越大，预测正类中实际正类越多；AUC评价分类器的整体性能。

建立模型

首先，由分层抽样划分出的训练集为𝐷1 = (𝑥1, 𝑦1),(𝑥2, 𝑦2), …,(𝑥𝑚, 𝑦𝑚)，验证集 为𝐷2 = (𝑥𝑚+1, 𝑦𝑚+1),(𝑥𝑚+2, 𝑦𝑚+2), …,(𝑥𝑘, 𝑦𝑘)，测试集为𝐷3 = (𝑥𝑘+1, 𝑦𝑘+1),(𝑥𝑘+2, 𝑦𝑘+2), …,(𝑥𝑛, 𝑦𝑛)； 并且训练集、验证集和测试集样本数目占比分别为60%，20%，20%。不平衡比例为
IR 。
使用数据采样技术 SMOTE和 EUS得到平衡数据集； 分别用于 Adaboost , bagging 和 svm 分类算法训练基分类器，算法的框架如下：
(1) 提出一个基于SMOTE或EUS抽样技术，分别与不同的集成分类算法相结合的不平衡分类任务的新框架。
(2) 加权修正算法：根据基分类器的错误率给每个分类投票赋权重，这有 助于提高不平衡情况下的分类性能。
(3) 基于AUC值的自适应阈值选择方法，找到使得精确度AUC达到最大的最优阈值。
通过R语言来实现以上算法，数据的不平衡比例𝐼𝑅为3.52，取为整数𝐼𝑅 = 4，并采用 AUC 值、特异性和灵敏性 三个指标来衡量不平衡分类器的分类性能。在实验中，由于训练集、验证集和测试 集的划分以及将样本划分为𝐼𝑅 份均具有随机性，在实验中每个模型重复50 次，结果取平均，并记录其方差。分类结果如表2.2：

由得到的结果表明：
(1) SMOTE 集成分类、EUS 集成分类器与不使用数据采样技术的分类算法相比， 在保证特异性降低不大的基础上， 较大程度的提高了分类器的灵敏性，从而提高了对少数类的精确分类。
(2) EUS集成分类算法效果要优于SMOTE 集成分类算法，尤其是对于少数类的分类精度。，
(3) 对于本文的数据，与 EUS 技术相结合的 Adaboost算法的分类性能最好，并且程序运行的时间较短。

模型代码

1、不使用抽样技术的分类算法，在此仅展示Adaboost分类算法

library(mlbench)
library(adabag)
library(rpart)
card=read.csv("card2.csv")
library(dplyr)
card$pre[which(card$pre==0)]<--1#正类为1，负类为-1
card$sex<-as.factor(card$sex)
card$mar<-as.factor(card$mar)
card$edu<-as.factor(card$edu)
card$pre<-as.factor(card$pre)
card$a<-as.factor(card$a)
card$b<-as.factor(card$b)
card$c<-as.factor(card$c)
card$d<-as.factor(card$d)
card$e<-as.factor(card$e)
card$f<-as.factor(card$f)

library(caret)
#分层抽样划分训练集和测试集
#createDataPartition会自动从y的各个level随机取出等比例的数据来
trainindex<-createDataPartition(card$pre,p=0.8,list=F,times=1)
train<-card[trainindex,] #i=1:m
test<-card[-trainindex,] #i=n-m:n

h<-boosting(pre~.,data=train ,mfinal=20,control=rpart.control(maxdepth=5))
pr<-predict.boosting(h,test)
pred<-as.numeric(pr$class)

#为了评估模型，我们用pROC包的roc函数算auc得分和画图
library(pROC)
auc<-roc(test$pre,pred)
print(auc)
plot(auc,ylim=c(0,1),print.thres=TRUE,main=paste('AUC',round(auc$auc[[1]],4)))
abline(h=1,col="blue",lwd=2)
abline(h=0,col="red",lwd=2)

2、SMOTE 集成分类算法，在此仅展示SMOTE-Adaboost集成分类算法

library(mlbench)
library(adabag)
library(rpart)
library(DMwR)
card=read.csv("card2.csv")
library(dplyr)
card$pre[which(card$pre==0)]<--1#正类为1，负类为-1
card$sex<-as.factor(card$sex)
card$mar<-as.factor(card$mar)
card$edu<-as.factor(card$edu)
card$pre<-as.factor(card$pre)
card$a<-as.factor(card$a)
card$b<-as.factor(card$b)
card$c<-as.factor(card$c)
card$d<-as.factor(card$d)
card$e<-as.factor(card$e)
card$f<-as.factor(card$f)


library(caret)
#set.seed(1234)
#分层抽样划分训练集和测试集
#createDataPartition会自动从y的各个level随机取出等比例的数据来
trainindex<-createDataPartition(card$pre,p=0.8,list=F,times=1)
train<-card[trainindex,] #i=1:m
test<-card[-trainindex,] #i=n-m:n

trainindex1<-createDataPartition(train$pre,p=0.75,list=F,times=1)
train_tra<-train[trainindex1,] #i=1:m
train_tes<-train[-trainindex1,] #i=n-m:n


alpha<-rep(0,4)#分类器的权重，标准化为W
rr<-matrix(0,6000,4)
hh<-matrix(0,5999,4)

index<-createFolds(train_tra$pre,k=4,list=FALSE)

for(i in 1:4){
  ntrain<-train_tra[which(index==i),]
  newtrain<-SMOTE(pre~.,ntrain,perc.over=100,perc.under=200)
  h<-boosting(pre~.,data=newtrain,mfinal=20,control=rpart.control(maxdepth=5))
  
  pred<-predict(h,train_tes) #对train预测
  eps<-pred$error
  alpha[i]<-1/2*log((1-eps)/eps) #权重
  rr[,i]<-as.numeric(pred$class)
  
  predd<-predict.boosting(h,test)
  hh[,i]<-as.numeric(predd$class) #对最终test预测
}

W<-alpha/sum(alpha) #各个分类器的权重  
wh<-t(W*t(rr))
r1<-rowSums(wh)
th<-seq(-1,1,by =0.01)
auc<-rep(0,199)
for(j in 2:200){
  final<-ifelse(r1>=th[j],1,-1)
  ep<-table(train_tes$pre,final)
  auc[j]<-(1+ep[2,2]/(ep[2,2]+ep[2,1])-ep[1,2]/(ep[1,1]+ep[1,2]))/2
}
thopt<-th[which.max(auc)]

Wh<-t(W*t(hh))
r<-rowSums(Wh)

#为了评估模型，我们用pROC包的roc函数算auc得分和画图
library(pROC)
finall<-ifelse(r>=thopt,1,-1)
auc<-roc(test$pre,finall)
print(auc)
plot(auc,ylim=c(0,1),print.thres=TRUE,main=paste('AUC',round(auc$auc[[1]],4)))
abline(h=1,col="blue",lwd=2)
abline(h=0,col="red",lwd=2) 

3、EUS集成分类算法，在此仅展示EUS-Adaboost集成分类算法

library(mlbench)
library(adabag)
library(rpart)
card=read.csv("card2.csv")
library(dplyr)
card$pre[which(card$pre==0)]<--1#正类为1，负类为-1
card$sex<-as.factor(card$sex)
card$mar<-as.factor(card$mar)
card$edu<-as.factor(card$edu)
card$pre<-as.factor(card$pre)
card$a<-as.factor(card$a)
card$b<-as.factor(card$b)
card$c<-as.factor(card$c)
card$d<-as.factor(card$d)
card$e<-as.factor(card$e)
card$f<-as.factor(card$f)


library(caret)
#set.seed(1234)
#分层抽样划分训练集和测试集
#createDataPartition会自动从y的各个level随机取出等比例的数据来
trainindex<-createDataPartition(card$pre,p=0.8,list=F,times=1)
train<-card[trainindex,] #i=1:m
test<-card[-trainindex,] #i=n-m:n

trainindex1<-createDataPartition(train$pre,p=0.75,list=F,times=1)
train_tra<-train[trainindex1,] #i=1:m
train_tes<-train[-trainindex1,] #i=n-m:n


alpha<-rep(0,4)#分类器的权重，标准化为W
rr<-matrix(0,6000,4)
hh<-matrix(0,5999,4)

trainp<-train_tra[which(train_tra$pre==1),] #训练集的正类
trainn<-train_tra[which(train_tra$pre==-1),] #训练集的负类
#多数类样本平分4份
index<-createFolds(trainn$pre,k=4,list=FALSE)

for(i in 1:4){
  samptrainn<-trainn[which(index==i),]
  newtrain<-rbind(trainp,samptrainn) #newtrainn1为训练集,test为测试集
  
  h<-boosting(pre~.,data=newtrain,mfinal=20,control=rpart.control(maxdepth=5))
  
  pred<-predict(h,train_tes) #对train预测
  eps<-pred$error
  alpha[i]<-1/2*log((1-eps)/eps) #权重
  rr[,i]<-as.numeric(pred$class)
  
  predd<-predict.boosting(h,test)
  hh[,i]<-as.numeric(predd$class) #对最终test预测
}

W<-alpha/sum(alpha) #各个分类器的权重  
wh<-t(W*t(rr))
r1<-rowSums(wh)
th<-seq(-1,1,by =0.01)
auc<-rep(0,199)
for(j in 2:200){
  final<-ifelse(r1>=th[j],1,-1)
  ep<-table(train_tes$pre,final)
  auc[j]<-(1+ep[2,2]/(ep[2,2]+ep[2,1])-ep[1,2]/(ep[1,1]+ep[1,2]))/2
}
thopt<-th[which.max(auc)]

Wh<-t(W*t(hh))
r<-rowSums(Wh)

#为了评估模型，我们用pROC包的roc函数算auc得分和画图
library(pROC)
finall<-ifelse(r>=thopt,1,-1)
auc<-roc(test$pre,finall)
print(auc)
plot(auc,ylim=c(0,1),print.thres=TRUE,main=paste('AUC',round(auc$auc[[1]],4)))
abline(h=1,col="blue",lwd=2)
abline(h=0,col="red",lwd=2)