1. 程式人生 > >信用卡評分模型(R語言)

信用卡評分模型(R語言)

eric 線圖 樣本 tag 匯總 lines lan 識別 param

信用卡評分

一、數據準備

1、 問題的準備

  ? 目標:要完成一個評分卡,通過預測某人在未來兩年內將會經歷財務危機的可能性來提高信用評分的效果,幫助貸款人做出最好的決策。

  ? 背景:

    – 銀行在市場經濟中起到至關重要的作用。他們決定誰在什麽條件下可以得到融資,並且可以創造或打破投資決策。而市場、社會,以及個人和企業都需要獲得貸款。

    – 信用評分算法,對默認可能性進行猜測,這是銀行用來判斷貸款是否應該被授予的方法。

  ? 準備:

    – 首先是基於個人借貸的場景,確定“違約”的定義: 根據新的Basel II Capital Accord(巴塞爾二資本協議),一般逾期90天算作違約。

    – 在判別指標上,選擇使用歷史最大違約天數。

2、數據的獲取與整合

  ? 數據來源:數據來自Kaggle,cs-training.csv是有15萬條的樣本數據,下圖可以看到這份數據的大致情況。下載地址為:https://www.kaggle.com/c/GiveMeSomeCredit/data

  ? 數據描述:數據屬於個人消費類貸款,只考慮評分卡最終實施時能夠使用到的數據應從如下一些方面獲取數據:

    – 基本屬性:包括了借款人當時的年齡。

    – 償債能力:包括了借款人的月收入、負債比率。

    – 信用往來:兩年內35-59天逾期次數、兩年內60-89天逾期次數、兩年內90天或高於90天逾期的次數。

    – 財產狀況:包括了開放式信貸和貸款數量、不動產貸款或額度數量。

    – 貸款屬性:暫無。

    – 其他因素:包括了借款人的家屬數量(不包括本人在內)。

  ? 原始變量:

變量名

變量類型

變量描述

SeriousDlqin2yrs

Y/N

超過90天或更糟的逾期拖欠

Revolving Utilization Of

UnsecuredLines

percentage

無擔保放款的循環利用:除了不動產和像車貸那樣除以信用額度總和的無分期付款債務的信用卡和個人信用額度總額

age

integer

借款人當時的年齡

NumberOfTime30-59DaysPastDueNotWorse

integer

35-59天逾期但不糟糕次數

DebtRatio

percentage

負債比率

MonthlyIncome

real

月收入

NumberOf

OpenCreditLinesAndLoans

integer

開放式信貸和貸款數量,開放式貸款(分期付款如汽車貸款或抵押貸款)和信貸(如信用卡)的數量

NumberOfTimes90DaysLate

integer

90天逾期次數:借款者有90天或更高逾期的次數

NumberRealEstateLoans

OrLines

integer

不動產貸款或額度數量:抵押貸款和不動產放款包括房屋凈值信貸額度

NumberOfTime60-89DaysPastDueNotWorse

integer

60-89天逾期但不糟糕次數:借款人在在過去兩年內有60-89天逾期還款但不糟糕的次數

NumberOfDependents

integer

家屬數量:不包括本人在內的家屬數量

  ? 時間窗口:自變量的觀察窗口為過去兩年,因變量表現窗口為未來兩年。

二、數據處理

  首先去掉原數據中的順序變量,即第一列的id變量。由於要預測的是SeriousDlqin2yrs變量,因此將其設為響應變量y,其他分別設為x1~x10變量。

1、缺失值分析及處理

  在得到數據集後,我們需要觀察數據的分布情況,因為很多的模型對缺失值敏感,因此觀察是否有缺失值是其中很重要的一個步驟。在正式分析前,我們先通過圖形進行對觀測字段的缺失情況有一個直觀的感受。

matrixplot(traindata)

技術分享

md.pattern(traindata)
##        y x1 x2 x3 x4 x6 x7 x8 x9  x10    x5      
## 120269 1  1  1  1  1  1  1  1  1    1     1     0
##  25807 1  1  1  1  1  1  1  1  1    1     0     1
##   3924 1  1  1  1  1  1  1  1  1    0     0     2
##        0  0  0  0  0  0  0  0  0 3924 29731 33655

  利用matrixplot函數對缺失值部分進行可視化展示,上圖中淺色表示值小,深色表示值大,而默認缺失值為紅色。因此可以看到x5變量和x10變量,即MonthlyIncome變量和NumberOfDependents兩個變量存在缺失值,具體確實情況可以見上表,monthlyincome列共有缺失值29731個,numberofdependents有3924個。

  對於缺失值的處理方法非常多,例如基於聚類的方法,基於回歸的方法,基於均值的方法,其中最簡單的方法是直接移除,但是在本文中因為缺失值所占比例較高,直接移除會損失大量觀測,因此並不是最合適的方法。在這裏,我們使用KNN方法對缺失值進行填補。

traindata<-knnImputation(traindata,k=10,meth = "weighAvg")

2、異常值分析及處理

  關於異常值的檢測,這裏簡單介紹以下一些檢測方法:

  ? 單變量異常值檢測:在R語言中使用函數boxplot.stats()可以實現單變量檢測,該函數根據返回的統計數據生成箱線圖。在上述函數的返回結果中,有一個參數out,它是由異常值組成的列表。更明確的說就是裏面列出了箱線圖中箱須線外面的數據點。比如我們可以查看月收入分布,第一幅圖為沒有刪除異常值的箱線圖。第二幅箱線圖刪除異常值後,可以發現月收入主要集中分布在3000-8000之間。但是在這份分析報告中,因為我們對業務尚不熟悉,不好將大於8000的數據直接歸為異常值,因此對該變量未做處理。

技術分享

  ? 使用LOF(局部異常因子)檢測異常值:LOF(局部異常因子)是一種基於密度識別異常值的算法。算法實現是:將一個點的局部密度與分布在它周圍的點的密度相比較,如果前者明顯的比後者小,那麽這個點相對於周圍的點來說就處於一個相對比較稀疏的區域,這就表明該點事一個異常值。LOF算法的缺點是它只對數值型數據有效。包‘DMwR’和包‘dprep’中的lofactor()可以計算LOF算法中的局部異常因子。

  ? 通過聚類檢測異常值:檢測異常值的另外一種方式就是聚類。先把數據聚成不同的類,選擇不屬於任何類的數據作為異常值。例如,基於密度的聚類DBSCAN算法的實現就是將與數據稠密區域緊密相連的數據對象劃分為一個類,因此與其他對象分離的數據就會作為異常值。也可以使用K均值算法實現異常值的檢測。首先通過把數據劃分為k組,劃分方式是選擇距離各自簇中心最近的點為一組;然後計算每個對象和對應的簇中心的距離(或者相似度),並挑出擁有最大的距離的點作為異常值。

  首先對於x2變量,即客戶的年齡,我們可以定量分析,發現有以下值:

unique(traindata$x2)
##  [1]  45  40  38  30  49  74  57  39  27  51  46  76  64  78  53  43  25
## [18]  32  58  50  69  24  28  62  42  75  26  52  41  81  31  68  70  73
## [35]  29  55  35  72  60  67  36  56  37  66  83  34  44  48  61  80  47
## [52]  59  77  63  54  33  79  65  86  92  23  87  71  22  90  97  84  82
## [69]  91  89  85  88  21  93  96  99  94  95 101  98 103 102 107 105   0
## [86] 109

  可以看到年齡中存在0值,顯然是異常值,予以剔除。

traindata<-traindata[-which(traindata$x2==0),]

  而對於x3,x7,x9三個變量,由下面的箱線圖可以看出,均存在異常值,且由unique函數可以得知均存在96、98兩個異常值,因此予以剔除。同時會發現剔除其中一個變量的96、98值,其他變量的96、98兩個值也會相應被剔除

##  [1]  2  0  1  3  4  5  7 10  6 98 12  8  9 96 13 11
##  [1]  0  1  3  2  5  4 98 10  9  6  7  8 15 96 11 13 14 17 12
##  [1]  0  1  2  5  3 98  4  6  7  8 96 11  9

  

技術分享

  其它變量暫不作處理。

三、變量分析

1、單變量分析

  我們可以簡單地看下部分變量的分布,比如對於age變量,如下圖:

ggplot(traindata, aes(x = x2, y = ..density..)) + geom_histogram(fill = "blue", colour = "grey60", size = 0.2, alpha = 0.2) + geom_density()

  

技術分享

  可以看到年齡變量大致呈正態分布,符合統計分析的假設。再比如月收入變量,也可以做圖觀察觀察,如下:

ggplot(traindata, aes(x = x5, y = ..density..)) + geom_histogram(fill = "blue", colour = "grey60", size = 0.2, alpha = 0.2) + geom_density() + xlim(1, 20000)

  

技術分享

  月收入也大致呈正態分布,符合統計分析的需要。

2、變量之間的相關性

  建模之前首先得檢驗變量之間的相關性,如果變量之間相關性顯著,會影響模型的預測效果。下面通過corrplot函數,畫出各變量之間,包括響應變量與自變量的相關性。

cor1<-cor(traindata[,1:11])

corrplot(cor1)

技術分享

corrplot(cor1,method = "number")

技術分享

  由上圖可以看出,各變量之間的相關性是非常小的。其實Logistic回歸同樣需要檢驗多重共線性問題,不過此處由於各變量之間的相關性較小,可以初步判斷不存在多重共線性問題,當然我們在建模後還可以用VIF(方差膨脹因子)來檢驗多重共線性問題。如果存在多重共線性,即有可能存在兩個變量高度相關,需要降維或剔除處理。

四、切分數據集

table(traindata$y)
## 
##      0      1 
## 139851   9879

  由上表看出,對於響應變量SeriousDlqin2yrs,存在明顯的類失衡問題,SeriousDlqin2yrs等於1的觀測為9879,僅為所有觀測值的6.6%。因此我們需要對非平衡數據進行處理,在這裏可以采用SMOTE算法,用R對稀有事件進行超級采樣。

我們利用caret包中的createDataPartition(數據分割功能)函數將數據隨機分成相同的兩份。

set.seed(1234) 

splitIndex<-createDataPartition(traindata$y,time=1,p=0.5,list=FALSE) 

train<-traindata[splitIndex,] 

test<-traindata[-splitIndex,] 

  對於分割後的訓練集和測試集均有74865個數據,分類結果的平衡性如下:

prop.table(table(train$y)) 

## 
##          0          1 
## 0.93314633 0.06685367
prop.table(table(test$y)) 
## 
##          0          1 
## 0.93489615 0.06510385

  兩者的分類結果是平衡的,仍然有6.6%左右的代表,我們仍然處於良好的水平。因此可以采用這份切割的數據進行建模及預測。

五、Logistic回歸

  Logistic回歸在信用評分卡開發中起到核心作用。由於其特點,以及對自變量進行了證據權重轉換(WOE),Logistic回歸的結果可以直接轉換為一個匯總表,即所謂的標準評分卡格式。

技術分享

2、建立模型

  首先利用glm函數對所有變量進行Logistic回歸建模,模型如下

fit<-glm(y~.,train,family = "binomial")
summary(fit)
## 
## Call:
## glm(formula = y ~ ., family = "binomial", data = train)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -4.6144  -0.3399  -0.2772  -0.2240   3.6997  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -1.812e+00  6.411e-02 -28.268  < 2e-16 ***
## x1          -1.846e-05  8.972e-05  -0.206 0.836948    
## x2          -2.861e-02  1.276e-03 -22.428  < 2e-16 ***
## x3           5.767e-01  1.564e-02  36.867  < 2e-16 ***
## x4          -2.321e-05  1.538e-05  -1.509 0.131224    
## x5          -1.355e-05  3.845e-06  -3.524 0.000425 ***
## x6          -2.769e-03  3.798e-03  -0.729 0.466051    
## x7           8.468e-01  2.429e-02  34.855  < 2e-16 ***
## x8           8.620e-02  1.599e-02   5.393 6.94e-08 ***
## x9           8.294e-01  3.338e-02  24.848  < 2e-16 ***
## x10          5.126e-02  1.388e-02   3.694 0.000221 ***
## ---
## Signif. codes:  0 ‘***‘ 0.001 ‘**‘ 0.01 ‘*‘ 0.05 ‘.‘ 0.1 ‘ ‘ 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 36747  on 74864  degrees of freedom
## Residual deviance: 29793  on 74854  degrees of freedom
## AIC: 29815
## 
## Number of Fisher Scoring iterations: 6

  可以看出,利用全變量進行回歸,模型擬合效果並不是很好,其中x1,x4,x6三個變量的p值未能通過檢驗,在此直接剔除這三個變量,利用剩余的變量對y進行回歸。

fit2<-glm(y~x2+x3+x5+x7+x8+x9+x10,train,family = "binomial")
summary(fit2)
## 
## Call:
## glm(formula = y ~ x2 + x3 + x5 + x7 + x8 + x9 + x10, family = "binomial", 
##     data = train)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -4.6223  -0.3402  -0.2777  -0.2239   3.5868  
## 
## Coefficients:
##               Estimate Std. Error z value Pr(>|z|)    
## (Intercept) -1.825e+00  6.320e-02 -28.873  < 2e-16 ***
## x2          -2.894e-02  1.252e-03 -23.120  < 2e-16 ***
## x3           5.742e-01  1.544e-02  37.187  < 2e-16 ***
## x5          -1.185e-05  3.513e-06  -3.373 0.000744 ***
## x7           8.500e-01  2.401e-02  35.397  < 2e-16 ***
## x8           7.494e-02  1.420e-02   5.276 1.32e-07 ***
## x9           8.306e-01  3.338e-02  24.883  < 2e-16 ***
## x10          5.169e-02  1.386e-02   3.730 0.000192 ***
## ---
## Signif. codes:  0 ‘***‘ 0.001 ‘**‘ 0.01 ‘*‘ 0.05 ‘.‘ 0.1 ‘ ‘ 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 36747  on 74864  degrees of freedom
## Residual deviance: 29797  on 74857  degrees of freedom
## AIC: 29813
## 
## Number of Fisher Scoring iterations: 6

   第二個回歸模型所有變量都通過了檢驗,甚至AIC值(赤池信息準則)更小,所有模型的擬合效果更好些。

3、模型評估

  通常一個二值分類器可以通過ROC(Receiver Operating Characteristic)曲線和AUC值來評價優劣。

  很多二元分類器會產生一個概率預測值,而非僅僅是0-1預測值。我們可以使用某個臨界點(例如0.5),以劃分哪些預測為1,哪些預測為0。得到二元預測值後,可以構建一個混淆矩陣來評價二元分類器的預測效果。所有的訓練數據都會落入這個矩陣中,而對角線上的數字代表了預測正確的數目,即true positive + true nagetive。同時可以相應算出TPR(真正率或稱為靈敏度)和TNR(真負率或稱為特異度)。我們主觀上希望這兩個指標越大越好,但可惜二者是一個此消彼漲的關系。除了分類器的訓練參數,臨界點的選擇,也會大大的影響TPR和TNR。有時可以根據具體問題和需要,來選擇具體的臨界點。

  如果我們選擇一系列的臨界點,就會得到一系列的TPR和TNR,將這些值對應的點連接起來,就構成了ROC曲線。ROC曲線可以幫助我們清楚的了解到這個分類器的性能表現,還能方便比較不同分類器的性能。在繪制ROC曲線的時候,習慣上是使用1-TNR作為橫坐標即FPR(false positive rate),TPR作為縱坐標。這是就形成了ROC曲線。

  而AUC(Area Under Curve)被定義為ROC曲線下的面積,顯然這個面積的數值不會大於1。又由於ROC曲線一般都處於y=x這條直線的上方,所以AUC的取值範圍在0.5和1之間。使用AUC值作為評價標準是因為很多時候ROC曲線並不能清晰的說明哪個分類器的效果更好,而作為一個數值,對應AUC更大的分類器效果更好。

技術分享

  下面首先利用模型對test數據進行預測,生成概率預測值

pre <- predict(fit2,test)

  在R中,可以利用pROC包,它能方便比較兩個分類器,還能自動標註出最優的臨界點,圖看起來也比較漂亮。在下圖中最優點FPR=1-TNR=0.845,TPR=0.638,AUC值為0.8102,說明該模型的預測效果還是不錯的,正確較高。

modelroc <- roc(test$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)

  


技術分享

## ## Call:
## roc.default(response = test$y, predictor = pre)
## 
## Data: pre in 69991 controls (test$y 0) < 4874 cases (test$y 1).
## Area under the curve: 0.8102

六、WOE轉換

  證據權重(Weight of Evidence,WOE)轉換可以將Logistic回歸模型轉變為標準評分卡格式。引入WOE轉換的目的並不是為了提高模型質量,只是一些變量不應該被納入模型,這或者是因為它們不能增加模型值,或者是因為與其模型相關系數有關的誤差較大,其實建立標準信用評分卡也可以不采用WOE轉換。這種情況下,Logistic回歸模型需要處理更大數量的自變量。盡管這樣會增加建模程序的復雜性,但最終得到的評分卡都是一樣的。

  用WOE(x)替換變量x。WOE()=ln[(違約/總違約)/(正常/總正常)]。

  通過上述的Logistic回歸,剔除x1,x4,x6三個變量,對剩下的變量進行WOE轉換。

1、進行分箱

  age變量(x2):

cutx2= c(-Inf,30,35,40,45,50,55,60,65,75,Inf)
plot(cut(train$x2,cutx2))

  

技術分享

  NumberOfTime30-59DaysPastDueNotWorse變量(x3):

cutx3 = c(-Inf,0,1,3,5,Inf)
plot(cut(train$x3,cutx3))

 技術分享

  MonthlyIncome變量(x5):

cutx5 = c(-Inf,1000,2000,3000,4000,5000,6000,7500,9500,12000,Inf)

plot(cut(train$x5,cutx5))

  技術分享

  NumberOfTimes90DaysLate變量(x7):

cutx7 = c(-Inf,0,1,3,5,10,Inf)
plot(cut(train$x7,cutx7))

  技術分享

NumberRealEstateLoansOrLines變量(x8):

cutx8= c(-Inf,0,1,2,3,5,Inf)
plot(cut(train$x8,cutx8))

技術分享

NumberOfTime60-89DaysPastDueNotWorse變量(x9):

cutx9 = c(-Inf,0,1,3,5,Inf)
plot(cut(train$x9,cutx9))

技術分享

NumberOfDependents變量(x10):

cutx10 = c(-Inf,0,1,2,3,5,Inf)
plot(cut(train$x10,cutx10))

  

技術分享

2、計算WOE值

  計算WOE的函數

totalgood = as.numeric(table(train$y))[1]
totalbad = as.numeric(table(train$y))[2]
getWOE <- function(a,p,q)
{
   Good <- as.numeric(table(train$y[a > p & a <= q]))[1]
   Bad <- as.numeric(table(train$y[a > p & a <= q]))[2]
   WOE <- log((Bad/totalbad)/(Good/totalgood),base = exp(1))
   return(WOE)
}

  比如age變量(x2)

Agelessthan30.WOE=getWOE(train$x2,-Inf,30)
Age30to35.WOE=getWOE(train$x2,30,35)
Age35to40.WOE=getWOE(train$x2,35,40)
Age40to45.WOE=getWOE(train$x2,40,45)
Age45to50.WOE=getWOE(train$x2,45,50)
Age50to55.WOE=getWOE(train$x2,50,55)
Age55to60.WOE=getWOE(train$x2,55,60)
Age60to65.WOE=getWOE(train$x2,60,65)
Age65to75.WOE=getWOE(train$x2,65,75)
Agemorethan.WOE=getWOE(train$x2,75,Inf)
age.WOE=c(Agelessthan30.WOE,Age30to35.WOE,Age35to40.WOE,Age40to45.WOE,Age45to50.WOE,
         Age50to55.WOE,Age55to60.WOE,Age60to65.WOE,Age65to75.WOE,Agemorethan.WOE)
age.WOE
##  [1]  0.57432879  0.52063157  0.34283924  0.24251193  0.22039521
##  [6]  0.07194294 -0.25643603 -0.55868003 -0.94144504 -1.28914527

  NumberOfTime30-59DaysPastDueNotWorse變量(x3)

## [1] -0.5324915  0.9106018  1.7645290  2.4432903  2.5682332

  MonthlyIncome變量(x5)

##  [1] -1.128862326  0.448960482  0.312423080  0.350846777  0.247782295
##  [6]  0.114417168 -0.001808106 -0.237224039 -0.389158800 -0.462438653

  NumberOfTimes90DaysLate變量(x7)

## [1] -0.3694044  1.9400973  2.7294448  3.3090003  3.3852925  2.3483738

  NumberRealEstateLoansOrLines變量(x8)

## [1]  0.21490691 -0.24386987 -0.15568385  0.02906876  0.41685234  1.12192809

  NumberOfTime60-89DaysPastDueNotWorse變量(x9)

## [1] -0.2784605  1.8329078  2.7775343  3.5805174  3.4469860

  NumberOfDependents變量(x10)

## [1] -0.15525081  0.08669961  0.19618098  0.33162486  0.40469824  0.76425365

3、對變量進行WOE變換

  如age變量(x2)

tmp.age <- 0
    for(i in 1:nrow(train)) {
      if(train$x2[i] <= 30)
        tmp.age[i] <- Agelessthan30.WOE
      else if(train$x2[i] <= 35)
        tmp.age[i] <- Age30to35.WOE
      else if(train$x2[i] <= 40)
        tmp.age[i] <- Age35to40.WOE
      else if(train$x2[i] <= 45)
        tmp.age[i] <- Age40to45.WOE
      else if(train$x2[i] <= 50)
        tmp.age[i] <- Age45to50.WOE
      else if(train$x2[i] <= 55)
        tmp.age[i] <- Age50to55.WOE
      else if(train$x2[i] <= 60)
        tmp.age[i] <- Age55to60.WOE
      else if(train$x2[i] <= 65)
        tmp.age[i] <- Age60to65.WOE
      else if(train$x2[i] <= 75)
        tmp.age[i] <- Age65to75.WOE
      else
        tmp.age[i] <- Agemorethan.WOE
    }
    
    table(tmp.age)
## tmp.age
##   -1.2891452711972 -0.941445039519045 -0.558680027962495 
##               5063               9196               8180 
## -0.256436029353835 0.0719429392949312  0.220395209955515 
##               8472               9009               9465 
##  0.242511934081286  0.342839240194068   0.52063156705216 
##               8008               6784               5390 
##  0.574328792863984 
##               5298

  

tmp.age[1:10]

##  [1] 0.34283924 0.57432879 0.34283924 0.57432879 0.07194294 0.22039521
##  [7] 0.07194294 0.24251193 0.34283924 0.52063157

train$x2[1:10]
##  [1] 38 30 39 30 51 46 53 43 39 32

  NumberOfTime30-59DaysPastDueNotWorse變量(x3)

## tmp.NumberOfTime30.59DaysPastDueNotWorse
## -0.53249146131578 0.910601840444591  1.76452904024992  2.44329031065646 
##             62948              8077              3160               562 
##  2.56823323027274 
##               118
##  [1]  0.9106018 -0.5324915 -0.5324915 -0.5324915 -0.5324915 -0.5324915
##  [7] -0.5324915 -0.5324915 -0.5324915 -0.5324915
##  [1] 1 0 0 0 0 0 0 0 0 0

  MonthIncome變量(x5)

## tmp.MonthlyIncome
##    -1.12886232582259   -0.462438653207328   -0.389158799506996 
##                10201                 5490                 5486 
##   -0.237224038650003 -0.00180810632297072    0.114417167554772 
##                 7048                 8076                 7249 
##    0.247782294610166    0.312423079500641    0.350846777249291 
##                 9147                 8118                 9680 
##    0.448960482499888 
##                 4370
##  [1]  0.350846777  0.350846777  0.350846777  0.312423080 -0.001808106
##  [6] -0.462438653 -0.237224039  0.350846777  0.312423080 -0.237224039
##  [1]  3042  3300  3500  2500  6501 12454  8800  3280  2500  7916

  NumberOfTime90DaysPastDueNotWorse變量(x7)

## tmp.NumberOfTimes90DaysLate
## -0.369404425455224   1.94009728631401   2.34837375415972 
##              70793               2669                  7 
##   2.72944477623793   3.30900029985393   3.38529247382249 
##               1093                222                 81
##  [1]  1.9400973 -0.3694044 -0.3694044 -0.3694044 -0.3694044 -0.3694044
##  [7] -0.3694044 -0.3694044 -0.3694044 -0.3694044
##  [1] 1 0 0 0 0 0 0 0 0 0

  NumberRealEstateLoansOrLines變量(x8)

## tmp.NumberRealEstateLoansOrLines
## -0.243869874062293 -0.155683851792327 0.0290687559545721 
##              26150              15890               3130 
##  0.214906905417014   1.12192809398173 
##              27901               1794
##  [1]  0.2149069  0.2149069  0.2149069  0.2149069 -0.1556839 -0.1556839
##  [7]  0.2149069 -0.2438699  0.2149069  0.2149069
##  [1] 0 0 0 0 2 2 0 1 0 0

  NumberOfTime60.89DaysPastDueNotWorse變量(x9)

## tmp.NumberOfTime60.89DaysPastDueNotWorse
## -0.278460464730538   1.83290775083723   2.77753428092856 
##              71150               2919                708 
##   3.44698604282783   3.58051743545235 
##                 13                 75
##  [1] -0.2784605 -0.2784605 -0.2784605 -0.2784605 -0.2784605 -0.2784605
##  [7] -0.2784605 -0.2784605 -0.2784605 -0.2784605
##  [1] 0 0 0 0 0 0 0 0 0 0

  NumberOfDependents變量(x10)

## tmp.NumberOfDependents
## -0.155250809857344 0.0866996065110081  0.196180980387687 
##              43498              14544              10102 
##  0.331624863227172  0.404698242905824   0.76425364970991 
##               4771               1815                135
##  [1] -0.1552508 -0.1552508 -0.1552508 -0.1552508  0.1961810  0.1961810
##  [7] -0.1552508  0.1961810 -0.1552508 -0.1552508
##  [1] 0 0 0 0 2 2 0 2 0 0

4、WOE DataFrame構建:

 trainWOE =cbind.data.frame(tmp.age,tmp.NumberOfTime30.59DaysPastDueNotWorse,tmp.MonthlyIncome,tmp.NumberOfTime60.89DaysPastDueNotWorse
,tmp.NumberOfTimes90DaysLate,tmp.NumberRealEstateLoansOrLines,tmp.NumberOfDependents)

七、評分卡的創建和實施

  標準評分卡采用的格式是評分卡中的每一個變量都遵循一系列IF-THEN法則,變量的值決定了該變量所分配的分值,總分就是各變量分值的和。

技術分享

  知道線性表達式的兩個參數A,B後就可以求每條記錄(申請人)的分值。為了求得A,B,需要設定兩個假設(分數的給定,很主觀)。

  以上就是推斷,實際代碼中,習慣用了q、p來代表A、B.

  通俗來說就是,評分需要自己預設一個閥值,比如:

    這個人預測出來“不發生違約”的幾率為0.8,設定這個人為500分;

    另一個人預測出來“不發生違約”的幾率為0.9,設定這個人為600分。

    閥值的設定需根據行業經驗不斷跟蹤調整,下面的分數設定僅代表個人經驗。

  下面開始設立評分,假設按好壞比15為600分,每高20分好壞比翻一倍算出P,Q。如果後期結果不明顯,可以高30-50分好壞比才翻一倍。

    Score = q - p * log(odds)

  即有方程:

    620 = q - p * log(15)

    600 = q - p * log(15/2)

  邏輯回歸建模:

#因為數據中“1”代表的是違約,直接建模預測,求的是“發生違約的概率”,log(odds)即為“壞好比”。為了符合常規理解,分數越高,信用越好,所有就調換“0”和“1”,使建模預測結果為“不發生違約的概率”,最後log(odds)即表示為“好壞比”。
trainWOE$y = 1-train$y
glm.fit = glm(y~.,data = trainWOE,family = binomial(link = logit))
summary(glm.fit)
coe = (glm.fit$coefficients)
p <- 20/log(2)
q <- 600-20*log(15)/log(2)
Score=q + p*{as.numeric(coe[1])+as.numeric(coe[2])*tmp.age +as.numeric(coe[3])*tmp.NumberOfTime30.59DaysPastDueNotWorse+p*as.numeric(coe[4])*tmp.MonthlyIncome+p*as.numeric(coe[5])*tmp.NumberOfTime60.89DaysPastDueNotWorse+p*as.numeric(coe[6])*tmp.NumberOfTimes90DaysLate+p*as.numeric(coe[7])*tmp.NumberRealEstateLoansOrLines+p*as.numeric(coe[8])*tmp.NumberOfDependents

  個人總評分=基礎分+各部分得分

  基礎分為:

base <- q + p*as.numeric(coe[1])
base
## [1] 446.2841

1、對各變量進行打分

  比如age變量(x2)

Agelessthan30.SCORE = p*as.numeric(coe[2])*Agelessthan30.WOE
Age30to35.SCORE = p*as.numeric(coe[2])*Age30to35.WOE
Age35to40.SCORE = p*as.numeric(coe[2])*Age35to40.WOE
Age40to45.SCORE = p*as.numeric(coe[2])*Age40to45.WOE
Age45to50.SCORE = p*as.numeric(coe[2])*Age45to50.WOE
Age50to55.SCORE = p*as.numeric(coe[2])*Age50to55.WOE
Age55to60.SCORE = p*as.numeric(coe[2])*Age55to60.WOE
Age60to65.SCORE = p*as.numeric(coe[2])*Age60to65.WOE
Age65to75.SCORE = p*as.numeric(coe[2])*Age65to75.WOE
Agemorethan.SCORE=p*as.numeric(coe[2])*Agemorethan.WOE
Age.SCORE =c(Age30to35.SCORE,Age35to40.SCORE,Age40to45.SCORE,Age45to50.SCORE,Age50to55.SCORE,Age55to60.SCORE,Age60to65.SCORE,Age65to75.SCORE,Agemorethan.SCORE)
Age.SCORE
## [1]  10.498828   6.913546   4.890389   4.444393   1.450770  -5.171176
## [7] -11.266096 -18.984767 -25.996338

  NumberOfTime30-59DaysPastDueNotWorse變量(x3)

## [1] -10.29843  17.61112  34.12614  47.25344  49.66985

  MonthlyIncome變量(x5)

##  [1] -24.92797904   9.91412083   6.89904854   7.74753565   5.47162546
##  [6]   2.52660461  -0.03992731  -5.23847393  -8.59355669 -10.21175106

  NumberOfTimes90DaysLate變量(x7)

## [1] -5.19482 27.28299 38.38333 46.53344 47.60632 33.02445

  NumberRealEstateLoansOrLine變量(x8)

## [1]  4.022310 -4.564396 -2.913860  0.544066  7.802025 20.998590

  NumberOfTime60-89DaysPastDueNotWorse變量(x9)

## [1] -4.820833 31.732126 48.085927 61.987533 59.675778

  NumberOfDependents變量(x10)

## [1] -1.5734012  0.8786638  1.9882112  3.3608775  4.1014453  7.7453871

  構造計算分值函數:

getscore<-function(i,x){
  score = round(p*as.numeric(coe[i])*x,0)
  return(score)
}

2、計算各變量分箱得分:

  age變量(x2)

Agelessthan30.SCORE = getscore(2,Agelessthan30.WOE)
Age30to35.SCORE = getscore(2,Age30to35.WOE)
Age35to40.SCORE = getscore(2,Age35to40.WOE)
Age40to45.SCORE = getscore(2,Age40to45.WOE)
Age45to50.SCORE = getscore(2,Age45to50.WOE)
Age50to55.SCORE = getscore(2,Age50to55.WOE)
Age55to60.SCORE = getscore(2,Age55to60.WOE)
Age60to65.SCORE = getscore(2,Age60to65.WOE)
Age65to75.SCORE = getscore(2,Age65to75.WOE)
Agemorethan.SCORE = getscore(2,Agemorethan.WOE)
Age.SCORE = c(Agelessthan30.SCORE,Age30to35.SCORE,Age35to40.SCORE,Age40to45.SCORE,Age45to50.SCORE,Age50to55.SCORE,Age55to60.SCORE,Age60to65.SCORE,Age65to75.SCORE,Agemorethan.SCORE)
Age.SCORE
##  [1]  12  10   7   5   4   1  -5 -11 -19 -26

  NumberOfTime30-59DaysPastDueNotWorse變量(x3)

## [1] -10  18  34  47  50

  MonthlyIncome變量(x5)

##  [1] -25  10   7   8   5   3   0   0  -9 -10

  NumberOfTimes90DaysLate變量(x7)

## [1] -5 27 38 47 48 33

  NumberRealEstateLoansOrLine變量(x8)

## [1]  4 -5 -3  1  8 21

  NumberOfTime60-89DaysPastDueNotWorse變量(x9)

## [1] -5 32 48 62 60

  NumberOfDependents變量(x10)

## [1] -2  1  2  3  4  8

3、最終生成的評分卡如下:

age X2 <=30 (30,35] (35,40] (40,45] (45,50] (50,55] (55,60] (60,65] (65,75] (75,100]
Score 12 10 7 5 4 1 -5 -11 -19 -26
NumberOfTime30-59DaysPastDueNotWorse X3 <=0 (0,1] (1,3] (3,5] >5
Score -10 18 34 47 50
MonthlyIncome X5 <=1000 (1000,2000] (2000,3000] (3000,4000] (4000,5000] (5000,6000] (6000,7500] (7500,9500] (9500,12000] >12000
Score -25 10 7 8 6 3 0 0 -9 -10
NumberOfTimes90DaysLate X7 <=0 (0,1] (1,3] (3,5] (5,10] >10
Score -5 27 38 47 48 33
NumberRealEstateLoansOrLines X8 <=0 (0,1] (1,2] (2,3] (3,5] >5
Score 4 -5 -3 1 8 21
NumberOfTime60-89DaysPastDueNotWorse X9 <=0 (0,1] (1,3] (3,5] >5
Score -5 32 48 62 60
NumberOfDependents X10 <=0 (0,1] (1,2] (2,3] (3,5] >5
Score -2 1 2 3 4 8

   個人評分計算案例:

特征 數據 分數
Age 38 7
NumberOfTime30-59DaysPastDueNotWorse 4 47
MonthlyIncome 1500 10
NumberOfTimes90DaysLate 2 38
NumberRealEstateLoansOrLines 1.5 -3
NumberOfTime60-89DaysPastDueNotWorse 4 62
NumberOfDependents 1.5 2

  所以這個人的總評分 = 基礎分(base)+ 各特征分數

  總評分 = 446.2841+7+47+10+38-3+62+2 = 609.2841

轉載:http://blog.csdn.net/csqazwsxedc/article/details/51225156

信用卡評分模型(R語言)