信用標準評分卡模型開發及實現

04-19

一、信用風險評級模型的類型

信用風險計量體系包括主體評級模型和債項評級兩部分。主體評級和債項評級均有一系列評級模型組成，其中主體評級模型可用「四張卡」來表示，分別是A卡、B卡、C卡和F卡；債項評級模型通常按照主體的融資用途，分為企業融資模型、現金流融資模型和項目融資模型等。

A卡，又稱為申請者評級模型，主要應用於相關融資類業務中新用戶的主體評級，適用於個人和機構融資主體。

B卡，又稱為行為評級模型，主要應用於相關融資類業務中存量客戶在續存期內的管理，如對客戶可能出現的逾期、延期等行為進行預測，僅適用於個人融資主體。

C卡，又稱為催收評級模型，主要應用於相關融資類業務中存量客戶是否需要催收的預測管理，僅適用於個人融資主體。

F卡，又稱為欺詐評級模型，主要應用於相關融資類業務中新客戶可能存在的欺詐行為的預測管理，適用於個人和機構融資主體。

我們主要討論主體評級模型的開發過程。

二、信用風險評級模型開發流程概述

典型的評級模型開發流程如圖2.1所示。該流程中各個步驟的順序可根據具體情況的不同進行適當調整，也可以根據需要重複某些步驟。

信用風險評級模型的主要開發流程如下：

（1）數據獲取，包括獲取存量客戶及潛在客戶的數據。存量客戶是指已經在證券公司開展相關融資類業務的客戶，包括個人客戶和機構客戶；潛在客戶是指未來擬在證券公司開展相關融資類業務的客戶，主要包括機構客戶，這也是解決證券業樣本較少的常用方法，這些潛在機構客戶包括上市公司、公開發行債券的發債主體、新三板上市公司、區域股權交易中心掛牌公司、非標融資機構等。

（2） EDA（探索性數據分析）與數據描述，該步驟主要是獲取樣本總體的大概情況，以便制定樣本總體的數據預處理方法。描述樣本總體情況的指標主要有缺失值情況、異常值情況、平均值、中位數、最大值、最小值、分布情況等。

（3）數據預處理，主要工作包括數據清洗、缺失值處理、異常值處理，主要是為了將獲取的原始數據轉化為可用作模型開發的格式化數據。

（4）變數選擇，該步驟主要是通過統計學的方法，篩選出對違約狀態影響最顯著的指標。

（5）模型開發，該步驟主要包括變數分段、變數的WOE（證據權重）變換和邏輯回歸估算三部分。

（6）主標尺與模型驗證，該步驟主要是開發某類主體的主標尺並進行模型的驗證與校準。

（7）模型評估，該步驟主要是根據模型驗證和主標尺設計的結果，評估模型的區分能力、預測能力、穩定性，並形成模型評估報告，得出模型是否可以使用的結論。

（8）模型實施，即模型的部署和應用。

（9）監測與報告，該步驟主要工作是定期檢測模型的使用情況，並關注和定期檢驗模型的區分能力與預測能力的變化及模型穩定性的變化，在出現模型可能不能滿足業務需求的情況時，反饋至模型開發團隊，及時進行模型更新或重新開發。

圖2.1 評級模型開發流程

三、基於Logistic回歸的標準評分卡模型開發實現

3.1 明確要解決的問題

在開發信用風險評級模型（包括個人和機構）之前，首先要明確我們需要解決的問題。因為，個人信用風險評級模型包括申請者評級、行為評級、催收評級、欺詐評級等幾類，開發每一類評級模型所需要的數據也是不同的，例如開發個人申請者評級模型需要的是個人客戶申請融資類業務時提交的數據，開發個人行為評級模型需要的是存量個人客戶的歷史行為數據，這兩部分數據及需要解決的問題，也存在較大的差異。因此，在開發信用風險評級模型之前，我們需要明確開發模型的類型。此處以開發個人客戶的申請者評級模型為例，來詳細講述此類模型的開發過程。

開發申請者評分模型所需要的數據是個人客戶申請融資類業務時所需的數據，包括反映個人還款意願的定性數據，應用申請者評分模型的目的是預測該申請客戶在未來一段時間發生違約的概率。

我們做預測模型的一個基本原理是用歷史數據來預測未來，申請者評分模型需要解決的問題是未來一段時間（如12個月）融資人出現違約（如至少一次90天或90天以上逾期）的概率。在這個需求中，「未來一段時間」為表現時間窗口（performance window），「融資人出現至少一次90天或90天以上逾期」為觀察時間窗口（sample window）。個人主體的違約跟個人行為習慣有很大的相關性，因此我們可以通過分析個人樣本總體中客戶的歷史我違約頻率來確定表現時間窗口和觀察時間窗口。這兩個窗口的確定對於我們要解決的問題，有著非常重要的影響，我們將放在第二步中結合具體的數據來分析，並講述具體的確定方法。

3.2 數據描述和探索性數據分析

數據準備和數據預處理是整個信用風險模型開發過程中最重要也是最耗時的工作了。通常情況下，數據準備和數據預處理階段消耗的時間占整個模型開發時間的80%以上，該階段主要的工作包括數據獲取、探索性數據分析、缺失值處理、數據校準、數據抽樣、數據轉換，還包括離散變數的降維、連續變數的優先分段等工作。

明確了要解決的問題後，接下來我們就要搜集相關的數據了。此處，我們以互聯網上經常被用來研究信用風險評級模型的加州大學機器學習資料庫中的german credit data為例，來詳細講述個人客戶信用風險評級模型的開發方法。

German credit data 的數據來自」klaR」包

install.packages(「klaR」)library(「klaR」)data(GermanCredit)View(GermanCredit) #查看該數據集

該數據集包含了1000個樣本，每個樣本包括了21個變數（屬性），其中包括1個違約狀態變數「credit_risk」，剩餘20個變數包括了所有的定量和定性指標，分別如表3.1所示。

接下來，我們需要檢查數據的質量，主要包括缺失值情況、異常值情況及其他處理方法。缺失值和異常值處理的基本原則是處理前後的分布總體保持一致。

3.21 用戶數據的缺失值處理：

評分卡模型開發-用戶數據缺失值處理

3.22 用戶數據的異常值處理：

評分卡模型開發-用戶數據異常值處理

需要特別說明的是，在實際的樣本搜集和數據預處理中，我們應該首先對個人客戶的違約做出定義，並根據對違約的定義對搜集的樣本進行必要的校準。一般情況下，我們搜集的數據為非標準化的數據，如表3.2所示，該表中假設搜集的是前10個客戶在兩年內的歷史違約情況。

在表3.2所示的數據集中，如果我們假設連續出現三個月逾期可被定義為違約，則客戶6至客戶9可被確認為違約。然而，為了明確違約的概念，我們還需要確定基準時間和觀察時間窗口。如果當前時間是2016年7月末，則只有6和7兩個客戶為違約，其他客戶均屬於正常客戶，如果當前時間是2016年9月末，則只有6、7、8三個客戶為違約，客戶9已經自愈，則再次變成正常客戶。

結合上述分析，在明確評分卡要解決的實際問題時，還應該確定表現時間窗口和觀察時間窗口，而這兩個窗口的確定，需要根據我們搜集的數據來具體確定。他們的確定方法，分別如下：

在確定變現時間窗口的長度時，我們通常需要客戶從開始開立融資類業務時到最近時間點（或至少兩年以上的歷史逾期情況）的逾期表現，用圖形表示，如圖3.7所示。

按照圖3.7所示的表現時間窗口的定義方法，我們對樣本總體進行統計分析，以逾期90天定義為違約，會得出表3.3所示的統計結果。

表3.3中8月最後一列數據3.48%表示，2.1日開立的所有賬戶中，8個月後出現逾期90天以上的賬戶占樣本的比重為3.48%。我們通過這樣統計方法，並繪製樣本總體的違約狀態變化曲線，即可得到如圖3.8所示的曲線。從圖3.8所示的曲線中我們可以看出，在賬戶開立第11個月到第13個月時，客戶的違約狀態達到穩定狀態，曲線變得非常平穩。此時，我們可以確定評分卡的表現時間窗口為11個月到13個月，即我們將違約狀態變得穩定的時間段確定為表現時間窗口。這種方法可使我們開發的評分卡模型的區分能力和預測能力準確性均達到最優穩定狀態。

由圖3.8的曲線可以看出，客戶開立融資類業務的賬戶的起始階段發生違約的頻率是不斷增多的，但隨著時間的推移發生違約的客戶的佔比處於穩定狀態。那麼，我們在開發信用風險評分卡模型時，需要選擇客戶違約處於穩定狀態的時間點來作為最優表現時間窗口，這樣既可以最大限度地降低模型的不穩定性，也可以避免低估最終的違約樣本的比率。例如，當我們選擇表現時間窗口為6個月時，樣本總體中的違約樣本佔比僅為3%左右，而實際違約樣本佔比約為4.5%。

上例中，觀察時間窗口我們確定為90天，當然也可以是60天或30天，但當觀察時間窗口確定為30天時，客戶的違約狀態將會更快地達到穩定狀態。如果我們按照某個監管協議（如巴塞爾協議）的要求開發信用風險評分卡模型，則觀察時間窗口也要按照監管協議的要求確定。除此之外，觀察時間窗口的確定要根據樣本總體和證券公司的風險偏好綜合考慮確定。但在個人信用風險評級模型開發領域，大多數將逾期90天及以上定義為個人客戶的違約狀態。

以上講的都是開發申請者評分卡模型時表現時間窗口的確定方法，在開發個人客戶的行為評分卡和催收評分卡模型時，表現時間窗口的確定方法也算是類似的。但開發這兩類模型時，表現時間窗口的長度卻跟申請者評分模型有較大不同，如催收評分卡模型的表現時間窗口通常設定為2周，甚至更短的時間。因為實際業務開展過程中，通常客戶逾期超過2周，就要啟動催收程序了。

個人客戶的信用風險評級模型開發進行至此時，我們已經得到了沒有缺失值和異常值的樣本總體，違約的定義確定了，表現時間窗口和觀察時間窗口也確定了。接下來，我們將進入評分卡模型開發的第三步數據集準備階段了。

3.3 數據集準備

在缺失值和處理完成後，我們就得到了可用作信用風險評級模型開發的樣本總體。通常為了驗證評級模型的區分能力和預測準確性，我們需要將樣本總體分為樣本集和測試集，這種分類方法被稱為樣本抽樣。常用的樣本抽樣方法包括簡單隨機抽樣、分層抽樣和整群抽樣三種。

數據集準備：評分卡模型開發-數據集準備

3.4 變數篩選

模型開發的前三步主要講的是數據處理的方法，從第四步開始我們將逐步講述模型開發的方法。在進行模型開發時，並非我們收集的每個指標都會用作模型開發，而是需要從收集的所有指標中篩選出對違約狀態影響最大的指標，作為入模指標來開發模型。接下來，我們將分別介紹定量指標和定性指標的篩選方法。

3.41 定量指標的篩選方法

評分卡模型開發-定量指標篩選

3.42 定性指標的篩選方法

評分卡模型開發-定性指標篩選

3.5 WOE值計算

對入模的定量和定性指標，分別進行連續變數分段（對定量指標進行分段），以便於計算定量指標的WOE和對離散變數進行必要的降維。對連續變數的分段方法通常分為等距分段和最優分段兩種方法。等距分段是指將連續變數分為等距離的若干區間，然後在分別計算每個區間的WOE值。最優分段是指根據變數的分布屬性，並結合該變數對違約狀態變數預測能力的變化，按照一定的規則將屬性接近的數值聚在一起，形成距離不相等的若干區間，最終得到對違約狀態變數預測能力最強的最優分段。

我們首先選擇對連續變數進行最優分段，在連續變數的分布不滿足最優分段的要求時，在考慮對連續變數進行等距分段。此處，我們講述的連續變數最優分段演算法是基於條件推理樹（conditional inference trees, Ctree）的遞歸分割演算法，其基本原理是根據自變數的連續分布與因變數的二元分布之間的關係，採用遞歸的回歸分析方法，逐層遞歸滿足給定的顯著性水平，此時獲取的分段結果（位於Ctree的葉節點上）即為連續變數的最優分段。其核心演算法用函數ctree()表示。

評分卡模型開發-WOE值計算：評分法模型開發-WOE值計算

3.6 基於邏輯回歸的標準評分卡實現

由邏輯回歸的基本原理，我們將客戶違約的概率表示為p，則正常的概率為1-p。因此，可以得到：

此時，客戶違約的概率p可表示為：

評分卡設定的分值刻度可以通過將分值表示為比率對數的線性表達式來定義，即可表示為下式：

其中，A和B是常數。式中的負號可以使得違約概率越低，得分越高。通常情況下，這是分值的理想變動方向，即高分值代表低風險，低分值代表高風險。

邏輯回歸模型計算比率如下所示：

其中，用建模參數擬合模型可以得到模型參數β0，β1，…，βn。

式中的常數A、B的值可以通過將兩個已知或假設的分值帶入計算得到。通常情況下，需要設定兩個假設：

（1）給某個特定的比率設定特定的預期分值；

（2）確定比率翻番的分數（PDO）

根據以上的分析，我們首先假設比率為x的特定點的分值為P。則比率為2x的點的分值應該為P+PDO。代入式中，可以得到如下兩個等式：

假設設定評分卡刻度使得比率為{1:20}（違約正常比）時的分值為50分，PDO為10分，代入式中求得：B=14.43，A=6.78

則分值的計算公式可表示為：

評分卡刻度參數A和B確定以後，就可以計算比率和違約概率，以及對應的分值了。通常將常數A稱為補償，常數B稱為刻度。

則評分卡的分值可表達為：

式中：變數x1…xn是出現在最終模型中的自變數，即為入模指標。由於此時所有變數都用WOE轉換進行了轉換，可以將這些自變數中的每一個都寫(βiωij)δij的形式：

式中ωij 為第i行第j個變數的WOE，為已知變數；βi為邏輯回歸方程中的係數，為已知變數；δij為二元變數，表示變數i是否取第j個值。上式可重新表示為：

此式即為最終評分卡公式。如果x1…xn變數取不同行並計算其WOE值，式中表示的標準評分卡格式，如表3.20所示：

表3.20表明，變數x1有k1行，變數x2有k2行，以此類推；基礎分值等於(A?Bβ0)；由於分值分配公式中的負號，模型參數β0，β1，…，βn也應該是負值；變數xi的第j行的分值取決於以下三個數值：

（1）刻度因子B；

（2）邏輯回歸方程的參數βi；

（3）該行的WOE值，ωij

綜上，我們詳細講述了模型開發及生成標準評分卡各步驟的處理結果，自動生成標準評分卡的R完整代碼：

library(klaR)library(InformationValue)data(GermanCredit)train_kfold<-sample(nrow(GermanCredit),800,replace = F)train_kfolddata<-GermanCredit[train_kfold,] #提取樣本數據集test_kfolddata<-GermanCredit[-train_kfold,] #提取測試數據集credit_risk<-ifelse(train_kfolddata[,"credit_risk"]=="good",0,1)#將違約樣本用「1」表示，正常樣本用「0」表示。tmp<-train_kfolddata[,-21]data<-cbind(tmp,credit_risk)quant_vars<-c("duration","amount","installment_rate","present_residence","age", "number_credits","people_liable","credit_risk") #獲取定量指標quant_GermanCredit<-data[,quant_vars] #提取定量指標#逐步回歸法，獲取自變數中對違約狀態影響最顯著的指標base.mod<-lm(credit_risk~1,data = quant_GermanCredit)#獲取線性回歸模型的截距all.mod<-lm(credit_risk~.,data = quant_GermanCredit)#獲取完整的線性回歸模型stepMod<-step(base.mod,scope = list(lower=base.mod,upper=all.mod), direction = "both",trace = 0,steps = 1000)#採用雙向逐步回歸法，篩選變數shortlistedVars<-names(unlist(stepMod[[1]]))#獲取逐步回歸得到的變數列表shortlistedVars<-shortlistedVars[!shortlistedVars %in%"(Intercept)"]#刪除逐步回歸的截距print(shortlistedVars)#輸出逐步回歸後得到的變數quant_model_vars<-c("duration","amount","installment_rate","age")#完成定量入模指標#提取數據集中全部的定性指標factor_vars<-c("status","credit_history","purpose","savings","employment_duration", "personal_status_sex","other_debtors","property", "other_installment_plans","housing","job","telephone","foreign_worker") #獲取所有名義變數all_iv<-data.frame(VARS=factor_vars,IV=numeric(length(factor_vars)), STRENGTH=character(length(factor_vars)),stringsAsFactors = F) #初始化待輸出的數據框for(factor_var in factor_vars){ all_iv[all_iv$VARS==factor_var,"IV"]<-InformationValue::IV(X= data[,factor_var],Y=data$credit_risk) #計算每個指標的IV值 all_iv[all_iv$VARS==factor_var,"STRENGTH"]<-attr(InformationValue::IV(X= data[,factor_var],Y=data$credit_risk),"howgood") #提取每個IV指標的描述}all_iv<-all_iv[order(-all_iv$IV),] #排序IVqual_model_vars<-subset(all_iv,STRENGTH=="Highly Predictive")[1:5,]qual_model_vars<-c("status","credit_history","savings","purpose","property")#連續變數分段和離散變數降維#1.變數durationlibrary(smbinning)result<-smbinning(df=data,y="credit_risk",x="duration",p=0.05)result$ivtableduration_Cutpoint<-c()duration_WoE<-c()duration<-data[,"duration"]for(i in 1:length(duration)){ if(duration[i]<=8) { duration_Cutpoint[i]<-"<= 8" duration_WoE[i]<--1.5670 } if(duration[i]<=33&duration[i]>8) { duration_Cutpoint[i]<-"<= 33" duration_WoE[i]<--0.0924 } if(duration[i]> 33) { duration_Cutpoint[i]<-"> 33" duration_WoE[i]<-0.7863 }}#2.變數amountresult<-smbinning(df=data,y="credit_risk",x="amount",p=0.05)result$ivtableamount_Cutpoint<-c()amount_WoE<-c()amount<-data[,"amount"]for(i in 1:length(amount)){ if(amount[i]<= 3913) { amount_Cutpoint[i]<-"<= 3913" amount_WoE[i]<--0.2536 } if(amount[i]<= 9283&amount[i]> 3913) { amount_Cutpoint[i]<-"<= 9283" amount_WoE[i]<-0.4477 } if(amount[i]> 9283) { amount_Cutpoint[i]<-"> 9283" amount_WoE[i]<-1.3109 }}#3.變數ageresult<-smbinning(df=data,y="credit_risk",x="age",p=0.05)result$ivtableage_Cutpoint<-c()age_WoE<-c()age<-data[,"age"]for(i in 1:length(age)){ if(age[i]<= 34) { age_Cutpoint[i]<-"<= 34" age_WoE[i]<-0.2279 } if(age[i] > 34) { age_Cutpoint[i]<-" > 34" age_WoE[i]<--0.3059 }}#4.變數installment_rate等距分段install_data<-data[,c("installment_rate","credit_risk")]tb1<-table(install_data)total<-list()for(i in 1:nrow(tb1)){ total[i]<-sum(tb1[i,])}t.tb1<-cbind(tb1,total)goodrate<-as.numeric(t.tb1[,"0"])/as.numeric(t.tb1[,"total"])badrate<-as.numeric(t.tb1[,"1"])/as.numeric(t.tb1[,"total"])gb.tbl<-cbind(t.tb1,goodrate,badrate)Odds<-goodrate/badrateLnOdds<-log(Odds)tt.tb1<-cbind(gb.tbl,Odds,LnOdds)WoE<-log((as.numeric(tt.tb1[,"0"])/700)/(as.numeric(tt.tb1[,"1"])/300))all.tb1<-cbind(tt.tb1,WoE)all.tb1installment_rate_Cutpoint<-c()installment_rate_WoE<-c()installment_rate<-data[,"installment_rate"]for(i in 1:length(installment_rate)){ if(installment_rate[i]==1) { installment_rate_Cutpoint[i]<-"=1" installment_rate_WoE[i]<-0.06252036 } if(installment_rate[i]==2) { installment_rate_Cutpoint[i]<-"=2" installment_rate_WoE[i]<-0.1459539 } if(installment_rate[i]==3) { installment_rate_Cutpoint[i]<-"=3" installment_rate_WoE[i]<--0.03937517 } if(installment_rate[i]==4) { installment_rate_Cutpoint[i]<-"=4" installment_rate_WoE[i]<--0.1657562 }}#定性指標的降維和WoEdiscrete_data<-data[,c("status","credit_history","savings","purpose", "property","credit_risk")]summary(discrete_data)#對purpose指標進行降維x<-discrete_data[,c("purpose","credit_risk")]d<-as.matrix(x)for(i in 1:nrow(d)){ #合併car(new)、car(used) if(as.character(d[i,"purpose"])=="car (new)") { d[i,"purpose"]<-as.character("car(new/used)") } if(as.character(d[i,"purpose"])=="car (used)") { d[i,"purpose"]<-as.character("car(new/used)") } #合併radio/television、furniture/equipment if(as.character(d[i,"purpose"])=="radio/television") { d[i,"purpose"]<-as.character("radio/television/furniture/equipment") } if(as.character(d[i,"purpose"])=="furniture/equipment") { d[i,"purpose"]<-as.character("radio/television/furniture/equipment") } #合併others、repairs、business if(as.character(d[i,"purpose"])=="others") { d[i,"purpose"]<-as.character("others/repairs/business") } if(as.character(d[i,"purpose"])=="repairs") { d[i,"purpose"]<-as.character("others/repairs/business") } if(as.character(d[i,"purpose"])=="business") { d[i,"purpose"]<-as.character("others/repairs/business") } #合併retraining、education if(as.character(d[i,"purpose"])=="retraining") { d[i,"purpose"]<-as.character("retraining/education") } if(as.character(d[i,"purpose"])=="education") { d[i,"purpose"]<-as.character("retraining/education") }}new_data<-cbind(discrete_data[,c(-4,-6)],d)#替換原數據集中的「purpose」指標的值woemodel<-woe(credit_risk~.,data = new_data,zeroadj=0.5,applyontrain=TRUE)woemodel$woe#1.statusstatus<-as.matrix(new_data[,"status"])colnames(status)<-"status"status_WoE<-c()for(i in 1:length(status)){ if(status[i]=="... < 100 DM") { status_WoE[i]<--0.8671300 } if(status[i]=="0 <= ... < 200 DM") { status_WoE[i]<--0.4240681 } if(status[i]=="... >= 200 DM / salary for at least 1 year") { status_WoE[i]<-0.4129033 } if(status[i]=="no checking account") { status_WoE[i]<-1.2237524 }}#2.credit_historycredit_history<-as.matrix(new_data[,"credit_history"])colnames(credit_history)<-"credit_history"credit_history_WoE<-c()for(i in 1:length(credit_history)){ if(credit_history[i]=="no credits taken/all credits paid back duly") { credit_history_WoE[i]<--1.53771824 } if(credit_history[i]=="all credits at this bank paid back duly") { credit_history_WoE[i]<--1.00079000 } if(credit_history[i]=="existing credits paid back duly till now") { credit_history_WoE[i]<--0.09646414 } if(credit_history[i]=="delay in paying off in the past") { credit_history_WoE[i]<--0.01996074 } if(credit_history[i]=="critical account/other credits existing") { credit_history_WoE[i]<-0.77276102 }}#3.savingssavings<-as.matrix(new_data[,"savings"])colnames(savings)<-"savings"savings_WoE<-c()for(i in 1:length(savings)){ if(savings[i]=="... < 100 DM") { savings_WoE[i]<--0.3051490 } if(savings[i]=="100 <= ... < 500 DM") { savings_WoE[i]<--0.2267733 } if(savings[i]=="500 <= ... < 1000 DM") { savings_WoE[i]<-0.8340112 } if(savings[i]=="... >= 1000 DM") { savings_WoE[i]<-1.1739617 } if(savings[i]=="unknown/no savings account") { savings_WoE[i]<-0.7938144 }}#4.propertyproperty<-as.matrix(new_data[,"property"])colnames(property)<-"property"property_WoE<-c()for(i in 1:length(property)){ if(property[i]=="real estate") { property_WoE[i]<-0.49346566 } if(property[i]=="building society savings agreement/life insurance") { property_WoE[i]<--0.16507975 } if(property[i]=="car or other") { property_WoE[i]<-0.08054425 } if(property[i]=="unknown/no property") { property_WoE[i]<--0.65586969 }}#5.purposepurpose<-as.matrix(new_data[,"purpose"])colnames(purpose)<-"purpose"purpose_WoE<-c()for(i in 1:length(purpose)){ if(purpose[i]=="car(new/used)") { purpose_WoE[i]<--0.11260594 } if(purpose[i]=="domestic appliances") { purpose_WoE[i]<-0.53602528 } if(purpose[i]=="others/repairs/business") { purpose_WoE[i]<--0.09146793 } if(purpose[i]=="radio/television/furniture/equipment") { purpose_WoE[i]<--0.23035114 } if(purpose[i]=="retraining/education") { purpose_WoE[i]<--0.43547619 }}#入模定量和定性指標model_data<-cbind(data[,quant_model_vars],data[,qual_model_vars])#入模定量和定性指標的WOEcredit_risk<-as.matrix(data[,"credit_risk"])colnames(credit_risk)<-"credit_risk"model_data_WOE<-as.data.frame(cbind(duration_WoE,amount_WoE,age_WoE, installment_rate_WoE,status_WoE,credit_history_WoE, savings_WoE,property_WoE,purpose_WoE,credit_risk))#入模定量和定性指標「分段」model_data_Cutpoint<-cbind(duration_Cutpoint,amount_Cutpoint,age_Cutpoint, installment_rate_Cutpoint,status,credit_history, savings,property,purpose)#邏輯回歸m<-glm(credit_risk~.,data=model_data_WOE,family = binomial())alpha_beta<-function(basepoints,baseodds,pdo){ beta<-pdo/log(2) alpha<-basepoints+beta*log(baseodds) return(list(alpha=alpha,beta=beta))}coefficients<-m$coefficients#通過指定特定比率（1/20）的特定分值（50）和比率翻番的分數（10），來計算評分卡的係數alpha和betax<-alpha_beta(50,0.05,10)#計算基礎分值basepoint<-round(x$alpha-x$beta*coefficients[1])#1.duration_scoreduration_score<-round(as.matrix(-(model_data_WOE[,"duration_WoE"]* coefficients["duration_WoE"]*x$beta)))colnames(duration_score)<-"duration_score"#2.amount_scoreamount_score<-round(as.matrix(-(model_data_WOE[,"amount_WoE"]* coefficients["amount_WoE"]*x$beta)))colnames(amount_score)<-"amount_score"#3.age_scoreage_score<-round(as.matrix(-(model_data_WOE[,"age_WoE"]* coefficients["age_WoE"]*x$beta)))colnames(age_score)<-"age_score"#4.installment_rate_scoreinstallment_rate_score<-round(as.matrix(-(model_data_WOE[,"installment_rate_WoE"]* coefficients["installment_rate_WoE"]*x$beta)))colnames(installment_rate_score)<-"installment_rate_score"#5.status_scorestatus_score<-round(as.matrix(-(model_data_WOE[,"status_WoE"]* coefficients["status_WoE"]*x$beta)))colnames(status_score)<-"status_score"#6.credit_history_scorecredit_history_score<-round(as.matrix(-(model_data_WOE[,"credit_history_WoE"]* coefficients["credit_history_WoE"]*x$beta)))colnames(credit_history_score)<-"credit_history_score"#7.savings_scoresavings_score<-round(as.matrix(-(model_data_WOE[,"savings_WoE"]* coefficients["savings_WoE"]*x$beta)))colnames(savings_score)<-"savings_score"#8.property_scoreproperty_score<-round(as.matrix(-(model_data_WOE[,"property_WoE"]* coefficients["property_WoE"]*x$beta)))colnames(property_score)<-"property_score"#9.purpose_scorepurpose_score<-round(as.matrix(-(model_data_WOE[,"purpose_WoE"]* coefficients["purpose_WoE"]*x$beta)))colnames(purpose_score)<-"purpose_score"#輸出最終的CSV格式的打分卡#1.基礎分值r1<-c("","basepoint",20)m1<-matrix(r1,nrow = 1)colnames(m1)<-c("Basepoint","Basepoint","Score")#2.duration的分值duration_scoreCard<-cbind(as.matrix(c("Duration","",""),ncol=1), unique(cbind(duration_Cutpoint,duration_score)))#View(duration_scoreCard)#3.amount的分值amount_scoreCard<-cbind(as.matrix(c("Amount","",""),ncol=1), unique(cbind(amount_Cutpoint,amount_score)))#View(amount_scoreCard)#4.age的分值age_scoreCard<-cbind(as.matrix(c("Age",""),ncol=1), unique(cbind(age_Cutpoint,age_score)))#View(age_scoreCard)#5.installment_rate的分值installment_rate_scoreCard<-cbind(as.matrix(c("Installment_rate","","",""),ncol=1), unique(cbind(installment_rate_Cutpoint,installment_rate_score)))#View(installment_rate_scoreCard)#6.status的分值status_scoreCard<-cbind(as.matrix(c("Status","","",""),ncol=1), unique(cbind(status,status_score)))#View(status_scoreCard)#7.credit_history的分值credit_history_scoreCard<-cbind(as.matrix(c("Credit_history","","","",""),ncol=1), unique(cbind(credit_history,credit_history_score)))#View(credit_history_scoreCard)#8.savings的分值savings_scoreCard<-cbind(as.matrix(c("Savings","","","",""),ncol=1), unique(cbind(savings,savings_score)))#View(savings_scoreCard)#9.property的分值property_scoreCard<-cbind(as.matrix(c("Property","","",""),ncol=1), unique(cbind(property,property_score)))#View(property_scoreCard)#10.purpose的分值purpose_scoreCard<-cbind(as.matrix(c("Purpose","","","",""),ncol=1), unique(cbind(purpose,purpose_score)))#View(purpose_scoreCard)scoreCard_CSV<-rbind(m1,duration_scoreCard,amount_scoreCard,age_scoreCard, installment_rate_scoreCard,status_scoreCard,credit_history_scoreCard, savings_scoreCard,property_scoreCard,purpose_scoreCard)#將標準評分卡輸出到項目文件中，且命名為ScoreCard.CSV，調整格式即可得到標準評分卡write.csv(scoreCard_CSV,"C:/Users/ZL/Desktop/creditcard_model/ScoreCard.CSV")

需要特別說明的是，上述開發的信用風險評級模型只包含定量和定性兩部分，在實際的使用中還要充分考慮到信用風險的特定，增加綜合調整部分，以應對可能對客戶信用影響較大的突發事件，如客戶被刑事起訴、遭遇重大疾病等。完整的信用風險標準評分卡模型，如表3.21所示：

使用小樣本開發信用風險評級模型時，通常採用交叉驗證（如五折交叉驗證）的方法以提高模型的穩定性。由於上述代碼採用的是隨機抽樣，每次抽取樣本總體的80%作為樣本集，來進行模型開發，剩餘樣本總體的20%用作模型測試。模型開發過程中，只需要運行上述代碼4次，並對得到的標準評分卡、模型中每項的分值取平均值，即可得到最終的標準評分卡模型。

3.7 主標尺設計及模型驗證

在上一節中開發的信用風險評分卡模型，得到的是不同風險等級客戶對應的分數，我們還需要將分數與違約概率和評級符號聯繫起來，以便差異化管理證券公司各面臨信用風險敞口的客戶，這就需要對證券公司各面臨信用風險敞口業務中的個人客戶開發一個一致的主標尺。最容易理解、最容易操作的方式就是根據違約概率從低到高分為不同的區間，這就相當於把違約概率這把尺子標上刻度，用這把尺子可以把證券公司需承擔信用風險敞口的不同業務中的個人客戶劃分到不同的信用等級，這樣各項業務中個人客戶的信用等級分布差異、信用風險分布高低，就可以一目了然地展現出來了。這種違約概率和信用等級之間的映射關係就稱為主尺標。

由邏輯回歸方程原理的分析可知，客戶的違約概率p=Odds/(1+Odds)，由式

Score=A-Blog(Odds)中得分與違約概率和Odds之間的對應關係，我們可計算出客戶得分對應的違約概率。

由信用風險標準評分卡可知，該評分卡的最高分是89分，最低分是-41分。因此，我們可以計算出該評分卡所有得分範圍對應的違約概率：

根據表3.22的結果可見，我們可簡單地將每10分對應一個信用等級，並用每相鄰得分對應的違約概率（這種方法計算得出的違約概率只能用作風險排序，而不是客戶的真實違約概率）的算術平均值作為該信用風險等級對應的平均違約概率，得到最終的主尺標及其內部信用等級對照表3.23：

在主標尺和內部信用等級確定後，接下來我們需要進行模型的區分能力、預測準確度和穩定性等模型的驗證工作了。回顧模型開發的過程，在模型開發時我們採用隨機抽樣的方法將數據分為樣本集和測試集，並用樣本集開發模型，用測試集做模型驗證。因此，做模型驗證時，我們應當首先用開發好的模型對測試集中的每一個樣本評級一遍，並根據評級結果來計算模型的區分能力和預測準確度。

用已開發好的模型對測試集中所有樣本重新評級一遍的代碼如下：

tmp1<-test_kfolddata[,-21]credit_risk1<-ifelse(test_kfolddata[,"credit_risk"]=="good",0,1)data_tmp<-as.matrix(cbind(tmp1,credit_risk1))##降維purpose（對測試集中的樣本做同樣的降維處理）##for(i in 1:nrow(data_tmp)){ #合併car(new)、car(used) if(as.character(data_tmp[i,"purpose"])=="car (new)") { data_tmp[i,"purpose"]<-as.character("car(new/used)") } if(as.character(data_tmp[i,"purpose"])=="car (used)") { data_tmp[i,"purpose"]<-as.character("car(new/used)") } #合併radio/television、furniture/equipment if(as.character(data_tmp[i,"purpose"])=="radio/television") { data_tmp[i,"purpose"]<-as.character("radio/television/furniture/equipment") } if(as.character(data_tmp[i,"purpose"])=="furniture/equipment") { data_tmp[i,"purpose"]<-as.character("radio/television/furniture/equipment") } #合併others、repairs、business if(as.character(data_tmp[i,"purpose"])=="others") { data_tmp[i,"purpose"]<-as.character("others/repairs/business") } if(as.character(data_tmp[i,"purpose"])=="repairs") { data_tmp[i,"purpose"]<-as.character("others/repairs/business") } if(as.character(data_tmp[i,"purpose"])=="business") { data_tmp[i,"purpose"]<-as.character("others/repairs/business") } #合併retraining、education if(as.character(data_tmp[i,"purpose"])=="retraining") { data_tmp[i,"purpose"]<-as.character("retraining/education") } if(as.character(data_tmp[i,"purpose"])=="education") { data_tmp[i,"purpose"]<-as.character("retraining/education") }}##purpose變數降維結束#####用R代碼實現打分卡模型###data1<-as.data.frame(data_tmp)tot<-nrow(data1)score<-list()for(i in 1:tot){ lst<-as.matrix(data1[i,]) #duration score_duration<-NA if(lst[,"duration"]<=8) { score_duration<-14 }else if(lst[,"duration"]>8&lst[,"duration"]<=33) { score_duration<-1 }else if(lst[,"duration"]>33) { score_duration<--7 } #amount score_amount<-NA if(lst[,"amount"]<=3913) { score_amount<-3 }else if(lst[,"amount"]>3913&lst[,"amount"]<=9283) { score_amount<--5 }else if(lst[,"amount"]>9283) { score_amount<--14 } #age score_age<-NA if(lst[,"age"]<=34) { score_age<--2 }else if(lst[,"age"]>34) { score_age<-3 } #installment_rate score_installment_rate<-NA if(lst[,"installment_rate"]==1) { score_installment_rate<-2 }else if(lst[,"installment_rate"]==2) { score_installment_rate<-5 }else if(lst[,"installment_rate"]==3) { score_installment_rate<--1 }else if(lst[,"installment_rate"]==4) { score_installment_rate<--6 } #status score_status<-NA if(lst[,"status"]=="... < 100 DM") { score_status<--10 }else if(lst[,"status"]=="0 <= ... < 200 DM") { score_status<--5 }else if(lst[,"status"]=="... >= 200 DM / salary for at least 1 year") { score_status<-5 }else if(lst[,"status"]=="no checking account") { score_status<-14 } #credit_history score_credit_history<-NA if(lst[,"credit_history"]=="critical account/other credits existing") { score_credit_history<-8 }else if(lst[,"credit_history"]=="existing credits paid back duly till now") { score_credit_history<--1 }else if(lst[,"credit_history"]=="all credits at this bank paid back duly") { score_credit_history<--10 }else if(lst[,"credit_history"]=="delay in paying off in the past") { score_credit_history<-0 }else if(lst[,"credit_history"]=="no credits taken/all credits paid back duly") { score_credit_history<--16 } #savings score_savings<-NA if(lst[,"savings"]=="... < 100 DM") { score_savings<--3 }else if(lst[,"savings"]=="... >= 1000 DM") { score_savings<-13 }else if(lst[,"savings"]=="500 <= ... < 1000 DM") { score_savings<-9 }else if(lst[,"savings"]=="unknown/no savings account") { score_savings<-9 }else if(lst[,"savings"]=="100 <= ... < 500 DM") { score_savings<--2 } #property score_property<-NA if(lst[,"property"]=="unknown/no property") { score_property<--4 }else if(lst[,"property"]=="real estate") { score_property<-3 }else if(lst[,"property"]=="building society savings agreement/life insurance") { score_property<--1 }else if(lst[,"property"]=="car or other") { score_property<-1 } #purpose score_purpose<-NA if(lst[,"purpose"]=="domestic appliances") { score_purpose<-6 }else if(lst[,"purpose"]=="radio/television/furniture/equipment") { score_purpose<--3 }else if(lst[,"purpose"]=="car(new/used)") { score_purpose<--1 }else if(lst[,"purpose"]=="retraining/education") { score_purpose<--5 }else if(lst[,"purpose"]=="others/repairs/business") { score_purpose<--1 } score[i]<-sum(20,score_duration,score_amount,score_age,score_installment_rate, score_status,score_credit_history,score_savings, score_property,score_purpose) rm(lst)}###用R代碼實現打分卡模型結束####合併處理測試集樣本得分，並輸出到指定的CSV文件中#score_M<-as.matrix(score,ncol=1)score_data<-cbind(data1,score_M)score_risk<-score_data[,c("credit_risk1","score_M")]write.csv(as.matrix(score_risk),"C:/Users/ZL/Desktop/creditcard_model/2.csv")

運行上述代碼後，我們整理測試集中200個樣本的評級計算結果，如下：

從理論上說，信用評級無法給出主體是否違約的判斷，只能給出主體違約的概率，而評級符號對應的就是主體發生違約的平均違約概率。但對評級結果的實際應用中，實在存在評級結果是否「準確」的質疑。那麼，通常情況下如果某主體被評級為投資級（BBB及以上），但發生了違約，則被認為「不準確」或者「誤判」。如果某主體被評級為投機級（BB及以下），且發生了違約，則被認為「預測準確」。如果被評級為投機級的主體沒發生違約事件（並不是每個被評級為投機級的主體都會發生違約），則可以用概率去解釋，那就是「大概率事件並不一定發生，小概率事件也並不一定不發生」。

我們採用ROC作為模型區分能力的驗證指標，採用AR（accuracy ratio，準確率）作為模型預測準確性的驗證指標，並且兩者存在AR=2×ROC-1的關係式。驗證模型的穩定性需要多年的歷史數據，由於數據原因此處略去。

由內部等級與主尺標的對應關係可知，投資級和投機級的分界點為20分，即大於20分的主體發生了違約，我們認為是「誤判」，小於20分的主體為發生違約，我們也認為是「誤判」。則經統計圖中的數據可知，誤判的主體總數為50個，則AR=1-50/200=0.75，此時ROC=(1+AR)/2=0.875。此時模型的預測準確度和區分能力均達到了較好地要求，可以進行部署使用。

上述模型的驗證方法採用的是將測試樣本集中的所有樣本在生成的評分卡中全部評級一遍的方法，當然也可以採用直接將WOE變數的邏輯回歸方程作為評級模型的方法。此時，也需要將測試樣本集中的所有入模變數計算其WOE，並代入上述邏輯回歸方程。

3.8 模型實施

待模型開發和驗證完畢後，緊接著就是模型的實施了。有條件的券商可藉助業內先進的信用風險管理系統，來實現整個公司的信用風險統一管理。在對客戶做信用評級時，應當遵守一個最基本的原則，那就是同一個客戶在不同業務部門開展業務時，只能對應一個統一的評級結果。

3.9 模型監測與報告

在模型部署和實施完畢後，我們還需要定期監測模型的運行情況並形成模型監測報告。因為開發的模型是基於某一時間的特定樣本的，隨著時間的推移，證券公司的經驗戰略可能會發生變化，這將會導致樣本發生變化，從而造成模型的區分能力和穩定性變差。因此，我們需要定期（通常每年至少一次）對模型的使用情況進行檢測並報告模型區分能力和穩定性的變化情況，必要時應採取包括修正模型或重建模型等措施。

我們通常使用模型穩定性指數來衡量模型穩定性變化的情況，模型穩定性指數是計算實際的和預期的分數分布之間差異的一個衡量指標，具體的計算方法如表3.25所示。

表3.25中，列A（%）表示驗證數據集中每十分位間距中記錄的百分比，列E（%）表示建模數據集中每十分位間距中記錄的百分比。列（A-E）和Ln（A/E）分別表示這兩個值的差以及這兩個值的比率的自然對數，指數列示（A-E）列和Ln（A/E）列的乘積，模型穩定性指數是最後一列的和。

模型穩定性指數I的定義為：

模型穩定性指數衡量的是兩個離散變數間的關聯性，較低的取值表明這兩個變數的類別分布相似。有卡方檢驗的定義可知，我們可以使用自由度為r-1的卡方分布檢驗模型穩定性指數的顯著性。R語言中可使用pchisq()函數計算出兩個變數分布不同的概率：

pchisq(0.0699,df=9) #模型穩定性指數為0.0699，自由度為9[1] 5.178963e-09

由輸出結果可知，變數A和變數E分布的不同的概率為5.178963e-09，非常非常小，這說明變數A和變數E的分布是相同的。

為了得到使用模型穩定性指數衡量真實（變數A）和預期（變數E）的分值分布之間的顯著性差異的準則，我們可以使用R函數qchisq()，即pchisq()函數的逆，獲取顯著性水平為0.65和0.997時的指數水平。結果如下所示，這兩個值分別為I=0.10和I=0.25。

qchisq(0.65,df=9) #結果為百分數[1] 10.006qchisq(0.997,df=9) #結果為百分數[1] 24.97407

根據上述計算，信用風險評級模型使用模型穩定性指數的最優實踐準則如表3.26所示。

表3.26表明，根據卡方顯著性計算，穩定性指數高於0.25時，兩個數據集的分值分布顯著不同的概率為99.7%。此時，我們需要對出現這種變化的原因進入深入調查，甚至需要新建評分卡。同樣，穩定性指數小於0.1時，連個數據集的分值分布顯著不同的概率為65%。此時，我們不需要採取任何行動。穩定性指數在上述兩個極端值之間時，表明模型的穩定性發生了某些變化，需要對模型進行回歸測試，並檢查原因。