谢谢体贴天善智能，走好数据之路↑↑↑
迎接体贴天善智能，咋们是专注于商业智能BI，人-工智能AI，大数据剖析与挖掘领域的垂直社区，学习，.求职一站式搞定！
做者推荐
黄升，普兰金融数据剖析师，从事数据剖析相关工做，善于R语言，亲爱统计和挖掘建模拉。
纲领
运用Logistic和NaiveBayes建模
Score Card理由
Naive Bayes评分卡
Logistics评分卡
简介
信誉评分是指依照客户的信誉史书原料，使用一定的信誉评分模子，获得不一样级的信誉分数拉。依照客户的信誉分数， 授信者能够剖析客户定时还款的应该性拉。据此， 授信者能够决定是否允许授信和授信的额度和利率拉。
只管授信者通过火析客户的信誉史书原料，一样能够获得这样的剖析结局，但使用信誉评分却越发迅速.越发主观.更拥有一样性拉。
运用logistic和NaiveBayes建模
本文中建模所用到的数据是关于德国农民的信誉相关数据，接下去咋们针对这个数据集举行模子拉。
加载第三方包library(ggplot2)library(klaR)library(sqldf) 数据读取german_credit <- read.csv(file.choose(),stringsAsFactors = TRUE) 数据结构展现str(german_credit)
数据中的字段主要包罗信誉（模子中的因变量1为宜客户，0为坏客户），账户余额，信誉月数，借贷目的等拉。由于上面的数据多数全是数值型的，故需要依照现实情形将数值变量转换成因子型变量拉。
自界说函数fun <- function(x) 数据种别转换for( i in 1:21) german_credit[,i] <- fun(german_credit[,i]) 个体数据再转换为数值型german_credit$Duration.of.Credit..month. <- as.numeric(german_credit$Duration.of.Credit..month.) german_credit$Credit.Amount <- as.numeric(german_credit$Credit.Amount) german_credit$Age..years. <- as.numeric(german_credit$Age..years.)
接下去，咋们把读取进去的数据集区分为两部-分，一部-分为宜客户（变量Creditability为1）的信息，另一部-分为坏客户（变量Creditability为0）的信息拉。
good <- german_credit[german_credit$Creditability==1,] bad <- german_credit[german_credit$Creditability==0,] 取出数据集的变量名a <- colnames(german_credit)
为了领会数据，咋们对数据会合的各变量绘制条形图，这里仅以客户的存款余额为例，如果想领会更多其余变量的疏散信息，能够稍做修正下方的代码拉。
所有用户的存款余额条形图ggplot(german_credit,aes(german_credit[,2])) + 条形图 geom_bar(aes(fill = as.factor(german_credit[,2]))) + 填充色 scale_fill_discrete(name=a[2]) + 主题设置 theme(axis.text.x=element_blank(),axis.ticks.x=element_blank()) + 增添轴标签和题目 labs(x= a[2],y= "Frequency" , title = "german_credit")
好客户的条形图ggplot(good, aes(good[,2]) ) + geom_bar(aes(fill = as.factor(good[,2]))) + scale_fill_discrete(name=a[2]) + theme(axis.text.x=element_blank(), axis.ticks.x=element_blank()) + labs(x= a[2],y= "Frequency", title = "good" )
坏客户的条形图ggplot(bad, aes(bad[,2]) ) + geom_bar(aes(fill = as.factor(bad[,2]))) + scale_fill_discrete(name=a[2]) + theme(axis.text.x=element_blank(), axis.ticks.x=element_blank()) + labs(x= a[2],y= "Frequency", title = "bad" )
Logistic模子
在建模以前，需要大部-分据集举行拆分，一部-分用做建模，另一部-分用做模子的尝试拉。
设置抽样的随机种子set.seed(1234)抽样（训练集和尝试集的含量为7:3）index <- sample(1:2, size = nrow(german_credit), replace = TRUE, prob = c(0.7,0.3)) train_data <- german_credit[index == 1,] test_data <- german_credit[index == 2,] 建模model1 <- glm(formula = train_data$Creditability ~ ., data =train_data, family = 'binomial') 模子信息概览summary(model1)
从上图的模子结局来看，Logistic模子中许多自变量都有无通过火明性检查，接下去，咋们使用逐步回归的办法，重新对模子举行建模拉。
重新建模model2 <- step(object = model1, trace = 0) 模子信息概览summary(model2)
通过逐步回归之后，模子效果获得了一定的提升（留下去了许多分明的自变量，同时AIC信息也着落了许多）拉。咋们知道，通过Logistc模子能够获得每逐一位样本的几率值prob，该几率值是能够依照现实的营业举行调治的，如果风控乞求的对比严酷，那么就需要将prob值调治的更大拉。
下面，咋们对模子的效果做一位评价，这里就运用混淆矩阵做为评价标-准
返回模子在尝试集上的几率值prob = 0.8, 'yes','no') 将pred变量设置为因子pred <- factor(pred, levels =c('no','yes'), order = TRUE)混淆矩阵f <- table(test_data$Creditability, pred) f
结局展现，模子的准确率为62.9%【(68+122)/(68+122+19+93)】，这个内里19指的是现实为坏客户，预料为宜客户的数目啦；93指的是现实为宜客户，预料为坏客户的数目拉。上面是将prob的阈值设置为0.8时的结局，下面再将阈值设置为0.5时，看看是什么结局拉。
返回模子在尝试集上的几率值prob = 0.5, 'yes','no') 将pred变量设置为因子pred <- factor(pred, levels =c('no','yes'), order = TRUE)混淆矩阵f <- table(test_data$Creditability, pred) f
通过更改几率的阈值，模子的准确率有所提升，到达73.8%【(183+40)/(183+40+32+47)】，这个内里47指的是现实为坏客户，预料为宜客户的数目啦；32指的是现实为宜客户拉。固然，咋们还能够替换模子，依照现实的营业举行变量的挑选，这个历程会对比繁琐，咋们就如下面这个模子为例
建设新的模子model3= 0.8, 'yes','no') pred <- factor(pred, levels =c('no','yes'), order = TRUE) f <- table(test_data$Creditability, pred) f
上图展现，对比于model2模子对应的0.8的阈值，这次新建的模子要比逐步回归的准确率提升了一丁点(0.3%)，我信赖模子的变换应当还会使准确率提升拉。上面的这些模子结局全全是基于Logistic获得的，下面咋们再用贝叶斯模子做一次效果的对比拉。
贝叶斯模子
贝叶斯模子model4= 0.8, 'yes','no') f <- table(test_data$Creditability, pred) f
Well Done，同为0.8的阈值，对比于model2和model3，贝叶斯模子获得的尝试效果最好，准确率到达了64%【(69+124)/(69+124+18+91)】拉。由于在风控领域，人们看待过错的判断会有区别的感受，比如一开始一位好客户被判为了坏客户和一开始一位坏客户被判为了好客户，或者者你会对后者的错判带来的坏账损失而悔恨，对前者的错判只会感觉遗憾拉。不妨咋们依照这类感受来划定一位错判的损失讲明式
lost=5*（坏预料为宜的数目）+（好客户预料为坏客户的数目）
Model2在prob>0.8的 lost=19*5+93=188
Model2在prob>0.5的 lost2=47*5+32=267
Model3在prob>0.8的 lost3=19*5+92=187
Model4在prob>0.8的 lost5=18*5+91=181
只管在建模历程中觉察model2在0.5的阈值情形下准确率最高，但她带来的的损失值也是最高的，损失值最低的模子则是贝叶斯模子拉。
Score Card理由
评分卡模子在海外是一种成熟的预料办法，尤为在信誉危害评价和金融危害掌控领域更是获得了对比普遍的运用，其理由是将模子变量分散化之后用WOE编码，在建设模子拉。ScoreCard用IV值来挑选变量，而且ScoreCard输入为分值拉。
对IV的直观领会
IV的全称是Information Value，中文意义是信息价，或者者信息量拉。从直观思维上大要能够这样领会“用IV去衡质变量预料才气拉”这件事件咋们假设在一位分类疑中，目的变量的种别有两类Y1，Y2拉。关于一位待预料的私人A，要判断A属于Y1仍然Y2，咋们是需要一定的信息的，假设这个信息总量是I，而这些所需要的信息，就包罗在一切的自变量C1，C2，C3，……，Cn中，那么，关于这个内里的一位变量Ci来说，其包罗的信息越多，那么她关于判断A属于Y1仍然Y2的奉献就越大，Ci的信息价就越大，Ci的IV就越大，她就越应当进去到入模变量列表中拉。
IV，WOE的盘算
前面咋们从理性角度和思维层面临IV举行理诠释和描写，那么回到数学层面，关于一位待评价变量，他的IV值终究怎么样盘算呢？为了推荐IV的盘算办法，咋们一最先的时刻需要熟悉和领会另一位观点——WOE，由于IV的盘算是以WOE为基本的拉。
WOE的盘算
WOE的全称是“Weight of Evidence拉”，即证-据权重拉。WOE是对本始自变量的一种编码形势拉。要对一位变量举行WOE编码，需要一最先的时刻把这个变量举行分组处置（也叫分散化.分箱等等，说的全是一位意义）拉。分组后，关于第i组，WOE的盘算公式以下
这个内里，pyi是这个组中照应客户（危害模子中，对应的是失约客户，总之，指的是模子中预料变量取值为“是拉”或者者说1的私人）占一切样本中一切照应客户的含量，pni是这个组中未照应客户占样本中一切未照应客户的含量，yi是这个组中照应客户的数目，ni是这个组中未照应客户的数目，yT是样本中一切照应客户的数目，nT是样本中一切未照应客户的数目拉。
从这个公式中咋们能够仔细品味到，WOE表现的现实上是“现在分组中照应客户占一切照应客户的含量拉”和“现在分组中有无照应的客户占一切无照应的客户的含量拉”的差异拉。对这个公式做一位简易变换，能够获得
有了前面的推荐，咋们能够正式给出IV的盘算公式拉。
IV的盘算
一样，关于分组i，也会有一位对应的IV值，盘算公式以下
有了一位变量的各分组IV值，咋们就能够盘算所有变量的IV值，办法很简易，即是把各分组的IV相加
这个内里，n为变量分组个数拉。
分数的盘算
咋们将客户失约的几率表现为1-p，则平时的几率为p,能够获得优势比
评分卡设定的分值刻度能够通过将分值表现为比率对数的线性讲明式来界说，即可表现为下式
这个内里，A和B是常数拉。式中的负号可以使得失约几率越低，得分越高拉。平时情形下，这是分值的理想变更方向，即高分值代表低危害，低分值代表高危害拉。
思维回归的盘算比率公式
思维回归的分数盘算式中变量x1…xn是出-现在最终模子中的自变量，即为入模指-标拉。由于这个时候一切变量都用WOE举行了转换，能够将这些自变量中的每逐一位都写成以下形势
上式中ωij 为第i行第j个变量的WOE，为已知变量啦；βi为思维回归方程中的系数，为已知变量啦；δij为两元变量，表现变量i是否取第j个值拉。上式可重新表现为
贝叶斯的盘算比率公式
式中变量x1…xn是出-现在最终模子中的自变量，即为入模指-标拉。由于这个时候一切变量都用WOE举行了转换，能够将这些自变量中的每逐一位都写成以下形势(同思维回归模子，只可是β0=0其余β都为1）
式中ωij 为第i行第j个变量的WOE，为已知变量啦；βi为思维回归方程中的系数，为已知变量啦；δij为两元变量，表现变量i是否取第j个值拉。上式可重新表现为
Naive Bayes评分卡
一最先的时刻需要对部-分变量做重编码的操做，这个操做在现实工做中需要不停的调试才气获得对比理想的效果拉。
条件挑选（分箱）index1 40) index230) index320) index4 <- which(german_credit$Duration.of.Credit..month. <=20 ) 重编码german_credit$Duration.of.Credit..month.[index1] <- '1'german_credit$Duration.of.Credit..month.[index2] <- '2'german_credit$Duration.of.Credit..month.[index3] <- '3'german_credit$Duration.of.Credit..month.[index4] <- '4'german_credit$Purpose[german_credit$Purpose==8] <- 1german_credit$Purpose[german_credit$Purpose==10] <- 0german_credit$Purpose[german_credit$Purpose==4] <- 3german_credit$Purpose[german_credit$Purpose==9] <- 5对month变量举行分组统计a1=sqldf("select `Duration.of.Credit..month.`,count(1) from train_data where `Creditability`=1 group by `Duration.of.Credit..month.` ") a2=sqldf("select `Duration.of.Credit..month.`,count(1) from train_data where `Creditability`=0 group by `Duration.of.Credit..month.` ") 合并数据集b1=cbind(a1,a2) 增添一列变量称呼b1[,5]=colnames(b1)[1] 种别转换b1=as.matrix(b1) 对Balance变量举行分组统计a1=sqldf("select `Account.Balance`,count(1) from train_data where `Creditability`=1 group by `Account.Balance` ") a2=sqldf("select `Account.Balance`,count(1) from train_data where `Creditability`=0 group by `Account.Balance` ") b2=cbind(a1,a2) b2[,5]=colnames(b2)[1] b2=as.matrix(b2)
这样以这类推，把这些分组变量举行分组统计，这里就再也不重复编辑代码了拉。最终，需要把每逐一位分组变量的统计结局举行合并拉。
合并结局c=rbind(b1,b2,b3,b4,b5,b6,b7,b8,b9,b10,b11,b12,b13,b14,b15,b16,b17) 结构种别转换c <- as.data.frame(c)字段重命名colnames(c) <- c('Bin','Good','Bin','Bad','Variable') 结局展现c
接下去还需要把数据框c中的Good变量和Bad变量的数据种别转换为数值型，用于以后的盘算拉。
现在字符串再转数值c$'Good' <- as.character(c$'Good') c$'Good' <- as.numeric(c$'Good') c$'Bad' <- as.character(c$'Bad') c$'Bad' <- as.numeric(c$'Bad') 各组利害客户之和c$'Total Number of Loans' <- c$Good+ c$Bad 各组坏客户的含量c$'% Bad Loans' <- c$Bad/c$'Total Number of Loans' train_data数据会合好客户和坏客户的数目分-别是485和213 盘算每一组好客户占总的好客户的含量c$'Distibution Good P(G)' <- c$Good/485 盘算每一组坏客户占总的好客户的含量c$'Distibution Bad P(B)' <- c$Bad/213 利害客户含量差异c$'P(G) - P(B)' <- c$'Distibution Good P(G)'-c$'Distibution Bad P(B)'盘算WOEc$WOE <- log(c$'Distibution Good P(G)'/c$'Distibution Bad P(B)')盘算IVc$IV <- c$WOE*c$'P(G) - P(B)' 检察统计的c数据集c
依照上面获得的数据框，对每一组举行投降盘算，获得总的IV值
会总盘算aggregate(x=c[,c("IV")],by=list(c$Variable),FUN=sum)取出IV值对比大的变量index5 <- which(c$Variable %in% c('Account.Balance','Duration.of.Credit..month.','Payment.Status.of.Previous.Credit','Purpose', 'Most.valuable.available.asset','Value.Savings.Stocks')) d <- c[index5,]算每逐一位变量的最大，与最小WOE与其差值f1 <- aggregate(x=d[,c("WOE")],by=list(d$Variable),FUN=max) f2 <- aggregate(x=d[,c("WOE")],by=list(d$Variable),FUN=min) f3 <- cbind(f1,f2) colnames(f3) <- c(1,'max',1,'min') f3
接下去咋们再盘算贝叶斯模子的评分
f3$deff <- f3$max-f3$min将分数1设置为最大与最小差800分，分数1是用一位常量乘以WOEad <- 800/sum(f3$deff) d$Score1 <- d$WOE*ad d
最终预料的总分为每逐一位变量地址的Score1的和加之400分拉。
Logistic评分卡
一样，咋们能够根据上面的思维，对Logistic模子构建评分卡
数据种别转换german_credit$Account.Balance <- as.character(german_credit$Account.Balance) german_credit$Duration.of.Credit..month. <- as.character.Date(german_credit$Duration.of.Credit..month.) german_credit$Payment.Status.of.Previous.Credit <- as.character(german_credit$Payment.Status.of.Previous.Credit) german_credit$Value.Savings.Stocks <- as.character(german_credit$Value.Savings.Stocks) german_credit$Purpose <- as.character(german_credit$Purpose) german_credit$Most.valuable.available.asset <- as.character(german_credit$Most.valuable.available.asset) 取出用IV值较大的变量riskdata <- german_credit[,c('Creditability','Account.Balance','Duration.of.Credit..month.','Payment.Status.of.Previous.Credit','Purpose', 'Most.valuable.available.asset','Value.Savings.Stocks')]取出WOE变量d1<- d[,c('Bin','WOE','Variable')] d1$Bin <- as.character(d1$Bin) name<-c ('Account.Balance','Duration.of.Credit..month.','Payment.Status.of.Previous.Credit','Purpose', 'Most.valuable.available.asset','Value.Savings.Stocks')将变量举行WOE转换e1 <- d1[which(d1$Variable=='Account.Balance'),] riskdata <- merge(riskdata,e1,by.y='Bin',by.x='Account.Balance') e1 e2 <- d1[which(d1$Variable=='Duration.of.Credit..month.'),] riskdata <- merge(riskdata,e2,by.y='Bin',by.x='Duration.of.Credit..month.') e2 e3 <- d1[which(d1$Variable=='Payment.Status.of.Previous.Credit'),] riskdata <- merge(riskdata,e3,by.y='Bin',by.x='Payment.Status.of.Previous.Credit') e4 <- d1[which(d1$Variable=='Purpose'),] riskdata <- merge(riskdata,e4,by.y='Bin',by.x='Purpose') e5 <- d1[which(d1$Variable=='Most.valuable.available.asset'),] riskdata <- merge(riskdata,e5,by.y='Bin',by.x='Most.valuable.available.asset') e6 <- d1[which(d1$Variable=='Value.Savings.Stocks'),] 合并riskdata <- merge(riskdata,e6,by.y='Bin',by.x='Value.Savings.Stocks') 获得WOE矩阵riskdata <- riskdata[,c(7,8,10,12,14,16,18)] 重命名names(riskdata) <-c ('Creditability','Account.Balance','Duration.of.Credit..month.','Payment.Status.of.Previous.Credit','Purpose','Most.valuable.available.asset','Value.Savings.Stocks') riskdata
接下去，咋们针对上面WOE矩阵（riskdata）构建Logistic模子
model_WOE<- glm(formula=Creditability~Account.Balance+Duration.of.Credit..month.+Payment.Status.of.Previous.Credit+Purpose+Value.Savings.Stocks+ Most.valuable.available.asset,data=riskdata,family = 'binomial') summary(model_WOE)
咋们可以使用刚刚获得的Logistic模子盘算评分
取出回归系数coefficients<-model_WOE$coefficients 盘算分值e1$Score2 <- e1$WOE*coefficients[2] e2$Score2 <- e2$WOE*coefficients[3] e3$Score2 <- e3$WOE*coefficients[4] e4$Score2 <- e4$WOE*coefficients[5] e5$Score2 <- e5$WOE*coefficients[6] e6$Score2 <- e6$WOE*coefficients[7] 和前面的NaiveScore分数盘算办法维持一样f <- rbind(e1,e2,e3,e4,e5,e6) f$Score2 <- f$Score2*ad f
小结
OK，今天关于怎么样结构评分卡模子的内容就推荐到这里，希望对有需要的同伴能够或者者带来帮-助拉。关于本文涉及到的数据集和R语言脚-本，能够从文末的链接获取拉。体贴“每一天提高一点点2015拉”，与小编同提高！
发表评论