写在前面:本人纯种萌新小白,这篇文章纯属照葫芦画瓢。
是对作业要求及网上参考文章进行整理,用于自己学习的记录,方便和同学们的探讨。
思路如下:
· 开始前准备
· Pre-step1
· Pre-step2
· ERROR警告
一、数据预处理
1.导入数据、了解各变量
2.缺失值处理
3.异常值处理
4.变量相关分析,避免多重线性
二、建立信用评分模型
1.从数据中随机切分出train集和test集
2.利用train集,通过logistics回归建立模型
3.根据个解释变量回归系数显著性,删减解释变量,调整模型
三、模型评估
1.将test集中x1,x2,x3···x10应用于上述模型,对y值进行预测。
2.根据predict的y和test集里的y做出ROC曲线,利用AUC值,测量精准度。
开始前准备
Pre-step1
在进入R studio之前,我们可以先将变量数据类型列表分析,知道各变量的意义及属性,如下:
对应图中的变量可以重新命名为id、y、x1~x10共12个变量。
自己可以列个小表,有助于后续方便查询(相关性等)
- Id =编号
- y = 2年内是否逾期超90天
- x1 = 信用额度总额度
- x2 = 年龄
- x3 = 2年内逾期30-59天次数
- x4 = 负债比率
- x5 = 月收入
- x6 = 开放式贷款的数量
- x7 = 最近90天(超)预期次数
- x8 = 房产等不动产贷款数量
- x9 = 2年内逾期60-89天次数
- x10 = 家属数量(除本人外)
Pre-step2
进入R Studio后,在我们操作之前,对于可能要用到的packages逻辑包预先下载。
一共五个,如下:
"mice" ; "VIM" ; "corrplot" ; "caret" ; "pROC"
在右下角按顺序,将对应逻辑包进行搜索并下载即可。
ERROR警告
下载逻辑包可能会弹出报错
Error in install.packages : error reading from connection
连接失败导致无法下载
解决方案:
多个镜像都可以尝试,选择离自己最近的就没啥问题
做好准备,我们就可以开始正式开始建模啦。
一、数据预处理
1. 导入数据、了解各变量
# 载入当前位置
setwd("~/Desktop/数据评分模型")
# 导入数据
train.data = read.csv("training.csv")
# 通过head()可以预览每列数据前6行
head(train.data)
# 给列名重新命名
# colnames(train.data)
colnames(train.data)<-c("id","y","x1","x2","x3","x4","x5","x6","x7","x8","x9","x10")
summary(train.data) # 统计变量
数据大致了解完了,我们下一步就可以处理数据中可能存在的缺失值。
2.缺失值处理
2.1缺失值可视化
# 调用 “mice”包-查看缺失值的逻辑包
library(mice)
# 查看缺失值个数及分布
md.pattern(train.data)
由导出plot图可以发现缺失值集中在x10和x5上
对应参照表,可以发现:
x5 = 月收入
x10 = 家属数量(除本人外)
其中,x5存在29731个缺失值;x10存在3924个缺失值。
接下来,对缺失值再进行更深度分析,来确定如何处理这些缺失值。
2.2确定缺失值分布及比例,选择缺失值处理方法
· 比例分析法-针对x5(月收入)
# 调用“VIM”包-缺失值可视化逻辑包-线箱法
library(VIM)
# 线箱法查看缺失值与数据关系
aggr_plot <- aggr(train.data,col=c('blue','red'),numbers=TRUE,
sortvars=TRUE,labels=names(train.data),cex.axis=.7,
gap=3,vlab=c("Histogram of missing data","missing value pattern"))
可以得出如下的plot图:
从图中可以明显看出x5(月收入)的缺失值过多,不可以直接删除缺失值所对应的数据。
· 相关性分析法-针对x10(家属数量)
# 调用“corrplot”包-变量相关性可视化逻辑包
library(corrplot)
# 计算第3-12列(x1-x10)数据的相关系数,有缺失值时使用“complete.obs”
# 空值的地方会被casewise deletion/成对删除
correlations <- cor(train.data[,3:12],use = "complete.obs")
# 用圈圈方式表示变量相关性
corrplot(correlations,method = "circle")
由图可知,x10和x2存在较明显的负相关。
x2年龄越大,x10家属越少
符合逻辑,因此,x10的缺失值也不可以直接忽略掉。
选择平均值填补法来补全缺失值NA
· 对于x5
# 对x5缺失处理
x5<-train.data$x5
x5_var<-c(
var="x5",
mean=mean(x5,na.rm=TRUE) , # na.rm=TRUE去除NA的影响
median=median(x5,na.rm=TRUE) ,
quantile(x5,c(0,0.01,0.1,0.25,0.5,0.75,0.9,0.99,1),na.rm=TRUE),
max=max(x5,na.rm=TRUE),
missing=sum(is.na(x5))
)
View(t(x5_var))
# 用mean填补缺失值
train.data$x5<-ifelse(is.na(train.data$x5)==T,6670.2,train.data$x5)
· 对于x10
# 对x10缺失处理
x10<-train.data$x10
x10_var<-c(
var="x10",
mean=mean(x10,na.rm=TRUE) , # na.rm=TRUE去除NA的影响
median=median(x10,na.rm=TRUE) ,
quantile(x10,c(0,0.01,0.1,0.25,0.5,0.75,0.9,0.99,1),na.rm=TRUE),
max=max(x10,na.rm=TRUE),
missing=sum(is.na(x10))
)
View(t(x10_var))
# 用mean填补缺失值
train.data$x10<-ifelse(is.na(train.data$x10)==T,0.75,train.data$x10)
处理完之后重新命名下,以便区分数据。
# 重新命名train.imput.data(已经用mean值填补了NA值)
train.imput.data <- train.data
3.异常值处理
缺失值是搞定了,但数据中常常还会存在异常值。
让我们再看看对照表,看看哪些数据可能存在异常值。
x2 = 年龄
x5 = 月收入
最后找到两个可疑的变量,需要对他们进深入了解
3.1年龄异常值
# 对异常值进行处理,对变量属性分析,发现x2-年龄变量、x5-月收入变量均可能存在异常值
# 先查看x2年龄这个column里的unique变量
unique(train.imput.data$x2)
明显可以发现年龄为0和100+的不太正常,对这些异常值的数据进行删除处理。
# 删除大于100岁的数据,命名data2
train.data2 <- train.imput.data[-which(train.imput.data$x2 > 100),]
# 删除等于0岁的数据,命名data3
train.data3 <- train.data2[-which(train.data2$x2 == 0),]
3.2月收入异常值
# 查看x5月收入这个colum里的unqiye变量
unique(train.data3$x5)
# 存在收入0、1、2等异常值,但不适合删除
可以发现月收入中存在0,1这样的异常值。
但是通过分析,我们可以发现:
月收入低同时也可以拥有高资产净值。
月收入低不代表无法进行贷款,
月收入也不代表会造成违约。
最后,我选择接纳这样的异常值。
此外,对于异常值,为了更客观、精确也可以选择用盖帽法对异常值进行修改
方法如下:
##异常值处理
#盖帽法
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)
}
(使用盖帽法的话,可以选择对x1~x10的数据都进行一次处理,我这里没使用盖帽法进行一一处理异常值,就不过多介绍)
关于盖帽法:https://blog.csdn.net/sinat_26917383/article/details/51210793
4.变量相关分析,避免多重线性。
# 计算相关第2-12(y-x10)列相关系数,由于缺失值都填补了,cor时默认使用"pearson", "kendall", "spearman"
cor1 <- cor(train.data3[,2:12])
# 用数字方式表示变量相关性
corrplot(cor1,method = 'number')
用系数来展示变量相关性的plot图:
分析如下:
X3、X7、X9相互高度正相关-逾期概率之间
X6和x8高度正相关-贷款数量之间
X2和x10负相关-年龄越大,家属越少
相关性均合理
二、建立信用评分模型
1.从数据中随机切分出train集和test集
# 响应量-y-是否逾期;自变量-x1~x10-自变量
# 1.查看数据响应变量的取值情况
table(train.data3$y)
# 比例约为14:1 数据明显失衡(暂时不知道处理方式)
# 调用caret包,划分数据为train和test:
library(caret)
# 设立随机数?意义不明
set.seed(123)
# 创立数据集,分为train和test两类
splitNumber <-createDataPartition(train.data3$y, time = 1, p=0.5,list = F)
train <-train.data3[splitNumber,]
test <-train.data3[-splitNumber,]
*如代码中所示,老师在此处的set.seed(123)是建立一个随机数,每次输入123时都可以重复这个随机数(任意数字都可以,666,520)。
但是在此和之后都没有对这个随机数进行处理,并且删除掉也不影响流程,所以还是没有弄明白这个设立随机数在此的意义。(跪求大神)
2.利用train集,通过logistics回归建立模型
# 建logistics模型
glm.fit <- glm(y~x1+x2+x3+x4+x5+x6+x7+x8+x9+x10, data = train, family = binomial())
# 会产生报错,大意是y非0即1概率过高
summary(glm.fit)
summary之后,回归模型表示如下:
Call:
glm(formula = y ~ x1 + x2 + x3 + x4 + x5 + x6 + x7 + x8 + x9 +
x10, family = binomial(), data = train)
Deviance Residuals:
Min 1Q Median 3Q Max
-3.2231 -0.3903 -0.3147 -0.2531 4.4916
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) -1.345e+00 5.952e-02 -22.602 < 2e-16 ***
x1 -1.350e-05 7.047e-05 -0.192 0.848
x2 -2.824e-02 1.177e-03 -23.998 < 2e-16 ***
x3 5.066e-01 1.582e-02 32.028 < 2e-16 ***
x4 -1.718e-05 1.410e-05 -1.218 0.223
x5 -3.888e-05 4.416e-06 -8.804 < 2e-16 ***
x6 -2.565e-03 3.539e-03 -0.725 0.469
x7 4.916e-01 2.165e-02 22.702 < 2e-16 ***
x8 6.063e-02 1.554e-02 3.901 9.57e-05 ***
x9 -9.623e-01 2.513e-02 -38.288 < 2e-16 ***
x10 9.096e-02 1.300e-02 6.999 2.58e-12 ***
---
Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 36802 on 74992 degrees of freedom
Residual deviance: 33642 on 74982 degrees of freedom
AIC: 33664
Number of Fisher Scoring iterations: 6
可以发现在Coefficients系数中,Pr(>|z|)列,x1,x4,x6显著性过高,需要对其进行删减处理。
3.根据个解释变量回归系数显著性,删减解释变量,调整模型
# 从Pr(>|z|)找到,显著性过高的x值剔除:x1、x4、x6 均>0.2
glm.fit2 <- glm(y~x2+x3+x5+x7+x8+x9+x10, data = train, family = binomial())
summary(glm.fit2)
三、模型评估
1.将test集中x1,x2,x3···x10应用于上述模型,对y值进行预测。
# 根据tset的模型进行预测
predict <-predict(glm.fit2,test)
2.根据predict的y和test集里的y做出ROC曲线,利用AUC值,测量精准度。
# 调用roc包
library(pROC)
# 求出roc
roc1 <- roc(test$y,predict)
# 画出roc图像,得出auc值
plot(roc1,,col='blue',print.auc=T,auc.ploygan=T,grid=c(0.1,0.2))
参考文献:
《构建信用评分卡模型——R》LPYsnake,知乎
链接:https://zhuanlan.zhihu.com/p/45506654
《R语言 packages安装失败:Error in install.packages : error reading from connection》sunny前,CSDN
链接:https://blog.csdn.net/binma2542/article/details/79947153
《R语言︱异常值检验、离群点分析、异常值处理》悟乙己,CSDN
链接:https://blog.csdn.net/sinat_26917383/article/details/51210793