一、项目背景
本项目使用R语言对银行的个人金融业务数据进行分析，以对个人贷款是否违约进行预测。帮助业务部门及时发现问题，以避免损失。
二、数据说明
本项目数据集来自《数据科学实战：Python篇》。数据集包含8个表：账户表accounts、信用卡表card、客户信息表clients、权限分配表disp、人口地区统计表district、贷款表loans、支付订单表order、交易表trans。此数据集数据较为丰富，通过分析这份数据可以获取与银行服务相关的业务知识。
- 账户表（Accounts）：4500条记录
- 信用卡表（card）：892条记录
- 顾客信息表（clients）：5369条记录
- 权限分配表（Disp）：5369条记录
- 地区表（district）：77条记录
- 贷款表（loans）：682条记录
- 订单表（order）：6471条记录
- 交易表（trans）：1056320条记录
各表间关系详见关系实体图（E-R图）：
三、数据处理
该项目问题是典型的二分类问题，被解释变量为二分类变量，因此选择分类模型中最常使用的算法逻辑回归构建模型。
用贷款（Loans）表中的还款状态（status）变量构建被解释变量（目标变量），还款状态（status）变量记录了客户的贷款偿还情况，其中A代表合同终止且正常还款，B代表合同终止但是未还款，C代表合同未结束且正常还款，D代表合同未结束但是已经拖欠贷款了。出现贷款拖欠则用1标识，如果始终没有出现违约，则设置为0。
#数据导入 loans<-read.csv("E:\\存档\\数据科学实战：Python篇\\案例\\loans.csv",header=TRUE,stringsAsFactors=F) accounts<-read.csv("E:\\存档\\数据科学实战：Python篇\\案例\\accounts.csv",header=TRUE) card<-read.csv("E:\\存档\\数据科学实战：Python篇\\案例\\card.csv",header=TRUE,stringsAsFactors=F) clients<-read.csv("E:\\存档\\数据科学实战：Python篇\\案例\\clients.csv",header=TRUE,stringsAsFactors=F) disp<-read.csv("E:\\存档\\数据科学实战：Python篇\\案例\\disp.csv",header=TRUE,stringsAsFactors=F) district<-read.csv("E:\\存档\\数据科学实战：Python篇\\案例\\district.csv",header=TRUE,stringsAsFactors=F) trans<-read.csv("E:\\存档\\数据科学实战：Python篇\\案例\\trans.csv",header=TRUE,stringsAsFactors=F) order<-read.csv("E:\\存档\\数据科学实战：Python篇\\案例\\order.csv",header=TRUE,stringsAsFactors=F) #数据处理 #数据类型转换 accounts$date<-as.Date(accounts$date) card$issued<-as.Date(card$issued) card$type<-as.factor(card$type) clients$sex<-as.factor(clients$sex) clients$birth_date<-as.Date(clients$birth_date) disp$type<-as.factor(disp$type) loans$date<-as.Date(loans$date) loans$status<-as.factor(loans$status) trans$date<-as.Date(trans$date) #去除千分位和美元符号,然后转换成数值类型 library(stringr) trans$amount<-gsub(",","",trans$amount) trans$balance<-gsub(",","",trans$balance) trans$amount<-as.numeric(str_sub(trans$amount,2,nchar(trans$amount))) trans$balance<-as.numeric(str_sub(trans$balance,2,nchar(trans$balance))) #构建被解释变量 head(loans) str(loans) loans$New_status[loans$status=='A']<-'0' loans$New_status[loans$status=='B']<-'1' loans$New_status[loans$status=='C']<-'2' loans$New_status[loans$status=='D']<-'1' loans$New_status<-as.factor(loans$New_status)
贷款表（Loans）是该项目问题的核心数据表，每个贷款帐户只有一条记录，故将所有维度的信息归结到贷款表（LOANS）上。首先提取的自变量是客户基本信息：性别、年龄等。客户的人口信息保存在客户信息表（ClIENTS）中，但是该表是以客户为主键的，需要和权限分配表（DISP）相连接才可以获得账号级别的信息。然后提取借款人居住地情况，需要连接地区表（district）。第三步提取行为信息：账户平均余额、余额的标准差、变异系数、平均入账和平均支出的比例、贷存比等。
#构建自变量 #只有“所有者”才有权限进行贷款 data<-merge(loans,disp,by.x="account_id",by.y="account_id",all.x=TRUE) data<-data[data$type=="所有者",] data<-merge(data,clients,by.x="client_id",by.y="client_id",all.x=TRUE) data<-merge(data,district,by.x="district_id",by.y="A1",all.x=TRUE) head(data) str(data) #求交集 data_temp<-merge(loans,trans,by.x="account_id",by.y="account_id",all=FALSE) str(data_temp) #一年为窗口期来取交易行为数据，即保留贷款日期前365天至贷款前1天内的交易数据 data_temp<-data_temp[data_temp$date.x>data_temp$date.y&data_temp$date.x<data_temp$date.y+365,] #计算每个贷款帐户贷款前一年的平均帐户余额（代表财富水平）、帐户余额的标准差（代表财富稳定情况）和变异系数（代表财富稳定情况的另一个指标） mean<-aggregate(data_temp[,14], by = list(data_temp[,1]), mean) sd<-aggregate(data_temp[,14], by = list(data_temp[,1]), sd) names(mean)<-c("account_id","mean") names(sd)<-c("account_id","sd") data_temp1<-merge(mean,sd,by.x="account_id",by.y="account_id",all=TRUE) data_temp1$cv<-data_temp1$sd/data_temp1$mean head(data_temp1) #计算平均入账和平均支出的比例。首先按照上一步时间窗口取数得到的数据集，按照每个帐户的“借-贷”类型分别汇总交易金额 amount<-aggregate(data_temp[,13], by = list(data_temp[,1],data_temp[,11]), sum) names(amount)<-c("account_id","type","amount") out<-amount[amount$type=="借",] income<-amount[amount$type=="贷",] names(out)<-c("account_id","type","out") names(income)<-c("account_id","type","income") data_temp2<-merge(income,out,by.x="account_id",by.y="account_id",all=TRUE) #缺失值的处理，赋值0 data_temp2[is.na(data_temp2$out)==TRUE,5]<-0 data_temp2$r_out_in<-data_temp2$out/data_temp2$income head(data_temp2) #将计算平均帐户余额、帐户余额的标准差、变异系数、平均入账和平均支出的比例等变量与之前的data合并 data1<-merge(data,data_temp1,by.x="account_id",by.y="account_id",all=TRUE) data1<-merge(data1,data_temp2,by.x="account_id",by.y="account_id",all=TRUE) #计算贷存比、贷收比 data1$r_lb<-data1$amount/data1$mean data1$r_lincome<-data1$amount/data1$income #缺失值处理 #判断缺失值的个数 sapply(data1,function(x) sum(is.na(x))) #缺失值作图 #install.packages("Amelia") library(Amelia) missmap(data1, main = "Missing values vs observed") #缺失值用均值替代 data1$A12[is.na(data1$A12)] <- mean(data1$A12,na.rm=T) data1$A15[is.na(data1$A15)] <- mean(data1$A15,na.rm=T)
四、构建逻辑回归模型
1）提取状态为C的用于预测。其它样本随机抽样，建立训练集与测试集
#逻辑回归 #提取状态为C的用于预测。其它样本随机抽样，建立训练集与测试集 data2<-data1[,c(6,7,10,15,16,17,18,19,20,21,22,23,24,25,26,28,30,31,32,33)] data_model<-data2[data2$New_status!=2,] for_predict<-data2[data2$New_status==2,] n<-nrow(data_model) rnd<-sample(n,n*.70) train<-data_model[rnd,] test<-data_model[-rnd,]
2）逻辑回归建模
#使用向前逐步法进行逻辑回归建模 formula<-New_status~GDP+A4+A10+A11+A12+amount+duration+A13+A14+A15+a16+mean+sd+cv+income+out+r_out_in+r_lb+r_lincome model<-glm(formula,data=train,family = binomial(link=logit)) forward_model<-step(model,direction="forward") summary(forward_model) #向后法 backward_model<-step(model,direction="backward") summary(backward_model) #逐步回归 both_model<-step(model,direction="both") summary(both_model)
尝试使用向前法、向后法、逐步回归三种方法进行逻辑回归，部分结果如下：
> forward_model<-step(model,direction="forward") Start: AIC=155.4 New_status ~ GDP + A4 + A10 + A11 + A12 + amount + duration + A13 + A14 + A15 + a16 + mean + sd + cv + income + out + r_out_in + r_lb + r_lincome > summary(forward_model) Call: glm(formula = New_status ~ GDP + A4 + A10 + A11 + A12 + amount + duration + A13 + A14 + A15 + a16 + mean + sd + cv + income + out + r_out_in + r_lb + r_lincome, family = binomial(link = logit), data = train) Deviance Residuals: Min 1Q Median 3Q Max -2.0882 -0.4193 -0.2039 0.1940 2.8449 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) 5.548e+00 7.609e+00 0.729 0.46594 GDP -3.639e-05 4.170e-05 -0.873 0.38292 A4 9.072e-06 9.688e-06 0.936 0.34910 A10 -2.213e-02 2.285e-02 -0.968 0.33283 A11 -2.585e-04 6.516e-04 -0.397 0.69162 A12 -1.209e+00 9.801e-01 -1.233 0.21746 amount 2.860e-06 7.312e-06 0.391 0.69566 duration 6.456e-02 2.407e-02 2.682 0.00732 ** A13 7.894e-01 8.564e-01 0.922 0.35662 A14 -4.568e-02 2.487e-02 -1.837 0.06628 . A15 -6.978e-02 2.396e-01 -0.291 0.77088 a16 1.825e-01 2.513e-01 0.726 0.46755 mean -1.850e-04 1.313e-04 -1.410 0.15866 sd 1.989e-04 2.759e-04 0.721 0.47098 cv 5.356e+00 1.039e+01 0.515 0.60632 income -4.791e-06 6.459e-06 -0.742 0.45825 out 9.703e-06 7.811e-06 1.242 0.21411 r_out_in -1.657e+00 2.653e+00 -0.624 0.53231 r_lb -5.178e-02 2.397e-01 -0.216 0.82899 r_lincome 7.186e-01 7.040e-01 1.021 0.30734 --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 (Dispersion parameter for binomial family taken to be 1) Null deviance: 235.64 on 194 degrees of freedom Residual deviance: 115.40 on 175 degrees of freedom AIC: 155.4 Number of Fisher Scoring iterations: 7 > summary(backward_model) Call: glm(formula = New_status ~ A12 + duration + A14 + a16 + mean + sd + out + r_lincome, family = binomial(link = logit), data = train) Deviance Residuals: Min 1Q Median 3Q Max -1.9673 -0.4474 -0.2351 0.1689 2.7168 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) 4.080e+00 2.880e+00 1.417 0.156561 A12 -3.257e-01 2.143e-01 -1.520 0.128574 duration 6.168e-02 1.792e-02 3.442 0.000577 *** A14 -4.490e-02 2.131e-02 -2.107 0.035145 * a16 5.511e-02 3.597e-02 1.532 0.125487 mean -2.357e-04 4.698e-05 -5.016 5.27e-07 *** sd 3.473e-04 6.630e-05 5.239 1.62e-07 *** out 3.161e-06 1.662e-06 1.902 0.057179 . r_lincome 1.001e+00 4.895e-01 2.046 0.040764 * --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 (Dispersion parameter for binomial family taken to be 1) Null deviance: 235.64 on 194 degrees of freedom Residual deviance: 119.49 on 186 degrees of freedom AIC: 137.49 Number of Fisher Scoring iterations: 7 > summary(both_model) Call: glm(formula = New_status ~ A12 + duration + A14 + a16 + mean + sd + out + r_lincome, family = binomial(link = logit), data = train) Deviance Residuals: Min 1Q Median 3Q Max -1.9673 -0.4474 -0.2351 0.1689 2.7168 Coefficients: Estimate Std. Error z value Pr(>|z|) (Intercept) 4.080e+00 2.880e+00 1.417 0.156561 A12 -3.257e-01 2.143e-01 -1.520 0.128574 duration 6.168e-02 1.792e-02 3.442 0.000577 *** A14 -4.490e-02 2.131e-02 -2.107 0.035145 * a16 5.511e-02 3.597e-02 1.532 0.125487 mean -2.357e-04 4.698e-05 -5.016 5.27e-07 *** sd 3.473e-04 6.630e-05 5.239 1.62e-07 *** out 3.161e-06 1.662e-06 1.902 0.057179 . r_lincome 1.001e+00 4.895e-01 2.046 0.040764 * --- Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1 (Dispersion parameter for binomial family taken to be 1) Null deviance: 235.64 on 194 degrees of freedom Residual deviance: 119.49 on 186 degrees of freedom AIC: 137.49 Number of Fisher Scoring iterations: 7
从模型结果可知，三种方法的模型结果基本保持一致，其中申请贷款前一年的贷收比（r_lincome）、存款余额的标准差（sd）、贷款期限（duration）与违约正相关。存款余额的均值（mean）、贷款者当地1000人中有多少企业家（A14）与违约负相关。以上这些回归系数的正负号均符合预期，而且均显著。
五、模型评估
使用测试数据进行模型效果评估。此项目选取了逐步逻辑回归模型，且计算了准确率和ROC曲线下面积（AUC）。
#用测试集做模型评估 pre<-predict(both_model,test,type="response") #在预测数据集中，概率大于0.5,违约，概率小于0.5，不违约 test$pre_New_status<-ifelse(predict(both_model,test,type="response")>0.5,1,0) table(test$New_status,test$pre_New_status) #准确率计算 sum_diag<-sum(diag(table(test$New_status,test$pre_New_status))) sum<-sum(table(test$New_status,test$pre_New_status)) accuracy<-sum_diag/sum accuracy #ROC曲线评估 library(pROC) library(sjmisc) roc_curve<-roc(test$New_status~pre) x<-1-roc_curve$specificities y<-roc_curve$sensitivities plot(x=x,y=y,xlim=c(0,1),ylim=c(0,1),xlab = '1-specificity',ylab = 'Sensitivity',main='ROC Curve',type='l',lwd=2.5) abline(a=0,b=1,col='gray') auc<-roc_curve$auc text(0.5,0.4,paste('AUC:',round(auc,digits = 2)),col='blue')
可以看到模型的准确率为0.87，模型的ROC曲线非常接近左上角，其曲线下面积（AUC）为0.9，这说明模型的分类能力较强。
六、模型预测及应用
在这个项目中，贷款状态为C的帐户是尚没有出现违约的合同未到期客户。我们可以通过该模型得到每笔贷款的违约预测概率。根据概率可以知道这些贷款客户中有些人的违约可能性较高，需要业务人员重点关注。一旦发现问题时，可以及时处理，挽回损失。
#预测 for_predict$predict<-predict(both_model,for_predict,type="response")
本文由花花_Angel 创作，采用 知识共享署名-相同方式共享 3.0 中国大陆许可协议 进行许可。
转载、引用前需联系作者，并署名作者且注明文章出处。
本站文章版权归原作者及原出处所有 。内容为作者个人观点， 并不代表本站赞同其观点和对其真实性负责。本站是一个个人学习交流的平台，并不用于任何商业目的，如果有任何问题，请及时联系我们，我们将根据著作权人的要求，立即更正或者删除有关内容。本站拥有对此声明的最终解释权。
以上就是本文的全部内容，希望对大家的学习有所帮助，也希望大家多多支持 码农网
本站部分资源来源于网络，本站转载出于传递更多信息之目的，版权归原作者或者来源机构所有，如转载稿涉及版权问题，请联系我们。
Probability and Computing
Michael Mitzenmacher、Eli Upfal / Cambridge University Press / 2005-01-31 / USD 66.00
Assuming only an elementary background in discrete mathematics, this textbook is an excellent introduction to the probabilistic techniques and paradigms used in the development of probabilistic algori......一起来看看 《Probability and Computing》 这本书的介绍吧!
