信用卡評分模型（R語言）

04-22

信用卡評分

一、數據準備

1、問題的準備

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

　　? 背景：

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

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

　　? 準備：

　　　　– 首先是基於個人借貸的場景，確定「違約」的定義：根據新的Basel II Capital Accord（巴塞爾二資本協議），一般逾期90天算作違約。

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

2、數據的獲取與整合

　　? 數據來源：數據來自Kaggle，cs-training.csv是有15萬條的樣本數據，下圖可以看到這份數據的大致情況。下載地址為：Give Me Some Credit

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

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

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

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

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

　　　　– 貸款屬性：暫無。

　　　　– 其他因素：包括了借款人的家屬數量（不包括本人在內）。

　　? 原始變數：

變數名變數類型變數描述SeriousDlqin2yrsY/N超過90天或更糟的逾期拖欠Revolving Utilization OfUnsecuredLinespercentage無擔保放款的循環利用：除了不動產和像車貸那樣除以信用額度總和的無分期付款債務的信用卡和個人信用額度總額ageinteger借款人當時的年齡NumberOfTime30-59DaysPastDueNotWorseinteger35-59天逾期但不糟糕次數DebtRatiopercentage負債比率MonthlyIncomereal月收入NumberOfOpenCreditLinesAndLoansinteger開放式信貸和貸款數量，開放式貸款（分期付款如汽車貸款或抵押貸款）和信貸（如信用卡）的數量NumberOfTimes90DaysLateinteger90天逾期次數：借款者有90天或更高逾期的次數NumberRealEstateLoansOrLinesinteger不動產貸款或額度數量：抵押貸款和不動產放款包括房屋凈值信貸額度NumberOfTime60-89DaysPastDueNotWorseinteger60-89天逾期但不糟糕次數：借款人在在過去兩年內有60-89天逾期還款但不糟糕的次數NumberOfDependentsinteger家屬數量：不包括本人在內的家屬數量

　　? 時間窗口：自變數的觀察窗口為過去兩年，因變數表現窗口為未來兩年。

二、數據處理

　　首先去掉原數據中的順序變數，即第一列的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.06685367prop.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)<br>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<br> ,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、最終生成的評分卡如下：

ageX2<=30(30,35](35,40](40,45](45,50](50,55](55,60](60,65](65,75](75,100]Score12107541-5-11-19-26NumberOfTime30-59DaysPastDueNotWorseX3<=0(0,1](1,3](3,5]>5Score-1018344750MonthlyIncomeX5<=1000(1000,2000](2000,3000](3000,4000](4000,5000](5000,6000](6000,7500](7500,9500](9500,12000]>12000Score-2510786300-9-10NumberOfTimes90DaysLateX7<=0(0,1](1,3](3,5](5,10]>10Score-52738474833NumberRealEstateLoansOrLinesX8<=0(0,1](1,2](2,3](3,5]>5Score4-5-31821NumberOfTime60-89DaysPastDueNotWorseX9<=0(0,1](1,3](3,5]>5Score-532486260NumberOfDependentsX10<=0(0,1](1,2](2,3](3,5]>5Score-212348

　　個人評分計算案例：

特徵數據分數Age387NumberOfTime30-59DaysPastDueNotWorse447MonthlyIncome150010NumberOfTimes90DaysLate238NumberRealEstateLoansOrLines1.5-3NumberOfTime60-89DaysPastDueNotWorse462NumberOfDependents1.52

　　所以這個人的總評分 = 基礎分（base）+ 各特徵分數

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

轉載：信用卡評分模型（R語言） - 程松 - 博客頻道 - CSDN.NET