評分卡模型開發--總體流程

Eason.wxd發表於2018-11-23
轉自: https://blog.csdn.net/lll1528238733/article/details/76602006

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

信用風險計量體系包括主體評級模型和債項評級兩部分。主體評級和債項評級均有一系列評級模型組成,其中主體評級模型可用“四張卡”來表示,分別是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)      #檢視該資料集
  • 1
  • 2
  • 3
  • 4
  • 5

該資料集包含了1000個樣本,每個樣本包括了21個變數(屬性),其中包括1個違約狀態變數“credit_risk”,剩餘20個變數包括了所有的定量和定性指標,分別如表3.1所示。
這裡寫圖片描述

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

3.21 使用者資料的缺失值處理:

http://blog.csdn.net/lll1528238733/article/details/76599626

3.22 使用者資料的異常值處理:

http://blog.csdn.net/lll1528238733/article/details/76599792

需要特別說明的是,在實際的樣本蒐集和資料預處理中,我們應該首先對個人客戶的違約做出定義,並根據對違約的定義對蒐集的樣本進行必要的校準。一般情況下,我們蒐集的資料為非標準化的資料,如表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 資料集準備

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

資料集準備:
http://blog.csdn.net/lll1528238733/article/details/76599861

3.4 變數篩選

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

3.41 定量指標的篩選方法

http://blog.csdn.net/lll1528238733/article/details/76600019

3.42 定性指標的篩選方法

http://blog.csdn.net/lll1528238733/article/details/76600147

這裡寫圖片描述

3.5 WOE值計算

對入模的定量和定性指標,分別進行連續變數分段(對定量指標進行分段),以便於計算定量指標的WOE和對離散變數進行必要的降維。對連續變數的分段方法通常分為等距分段和最優分段兩種方法。等距分段是指將連續變數分為等距離的若干區間,然後在分別計算每個區間的WOE值。最優分段是指根據變數的分佈屬性,並結合該變數對違約狀態變數預測能力的變化,按照一定的規則將屬性接近的數值聚在一起,形成距離不相等的若干區間,最終得到對違約狀態變數預測能力最強的最優分段。
我們首先選擇對連續變數進行最優分段,在連續變數的分佈不滿足最優分段的要求時,在考慮對連續變數進行等距分段。此處,我們講述的連續變數最優分段演算法是基於條件推理樹(conditional inference trees, Ctree)的遞迴分割演算法,其基本原理是根據自變數的連續分佈與因變數的二元分佈之間的關係,採用遞迴的迴歸分析方法,逐層遞迴滿足給定的顯著性水平,此時獲取的分段結果(位於Ctree的葉節點上)即為連續變數的最優分段。其核心演算法用函式ctree()表示。

評分卡模型開發-WOE值計算:
http://blog.csdn.net/lll1528238733/article/details/76600598

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

由邏輯迴歸的基本原理,我們將客戶違約的概率表示為p,則正常的概率為1-p。因此,可以得到:
這裡寫圖片描述
此時,客戶違約的概率p可表示為:
這裡寫圖片描述
評分卡設定的分值刻度可以通過將分值表示為比率對數的線性表示式來定義,即可表示為下式:
這裡寫圖片描述
其中,A和B是常數。式中的負號可以使得違約概率越低,得分越高。通常情況下,這是分值的理想變動方向,即高分值代表低風險,低分值代表高風險。
邏輯迴歸模型計算比率如下所示:
這裡寫圖片描述
其中,用建模引數擬合模型可以得到模型引數β0β1βnβ0,β1,…,βn。為二元變數,表示變數i是否取第j個值。上式可重新表示為:
這裡寫圖片描述

此式即為最終評分卡公式。如果x1xnx1…xn的第j行的分值取決於以下三個數值:
這裡寫圖片描述

(1)刻度因子B;
(2)邏輯迴歸方程的引數βiβi
綜上,我們詳細講述了模型開發及生成標準評分卡各步驟的處理結果,自動生成標準評分卡的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),]    #排序IV
qual_model_vars<-subset(all_iv,STRENGTH=="Highly Predictive")[1:5,]
qual_model_vars<-c("status","credit_history","savings","purpose","property")

#連續變數分段和離散變數降維
#1.變數duration
library(smbinning)
result<-smbinning(df=data,y="credit_risk",x="duration",p=0.05)
result$ivtable

duration_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.變數amount
result<-smbinning(df=data,y="credit_risk",x="amount",p=0.05)
result$ivtable
amount_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.變數age
result<-smbinning(df=data,y="credit_risk",x="age",p=0.05)
result$ivtable
age_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/badrate
LnOdds<-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.tb1
installment_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
  }
}
#定性指標的降維和WoE
discrete_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.status
status<-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_history
credit_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.savings
savings<-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.property
property<-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.purpose
purpose<-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])
#入模定量和定性指標的WOE
credit_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和beta
x<-alpha_beta(50,0.05,10)
#計算基礎分值
basepoint<-round(x$alpha-x$beta*coefficients[1])
#1.duration_score
duration_score<-round(as.matrix(-(model_data_WOE[,"duration_WoE"]*
                                    coefficients["duration_WoE"]*x$beta)))
colnames(duration_score)<-"duration_score"
#2.amount_score
amount_score<-round(as.matrix(-(model_data_WOE[,"amount_WoE"]*
                                  coefficients["amount_WoE"]*x$beta)))
colnames(amount_score)<-"amount_score"
#3.age_score
age_score<-round(as.matrix(-(model_data_WOE[,"age_WoE"]*
                                  coefficients["age_WoE"]*x$beta)))
colnames(age_score)<-"age_score"
#4.installment_rate_score
installment_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_score
status_score<-round(as.matrix(-(model_data_WOE[,"status_WoE"]*
                               coefficients["status_WoE"]*x$beta)))
colnames(status_score)<-"status_score"
#6.credit_history_score
credit_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_score
savings_score<-round(as.matrix(-(model_data_WOE[,"savings_WoE"]*
                                          coefficients["savings_WoE"]*x$beta)))
colnames(savings_score)<-"savings_score"
#8.property_score
property_score<-round(as.matrix(-(model_data_WOE[,"property_WoE"]*
                                   coefficients["property_WoE"]*x$beta)))
colnames(property_score)<-"property_score"
#9.purpose_score
purpose_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")
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 27
  • 28
  • 29
  • 30
  • 31
  • 32
  • 33
  • 34
  • 35
  • 36
  • 37
  • 38
  • 39
  • 40
  • 41
  • 42
  • 43
  • 44
  • 45
  • 46
  • 47
  • 48
  • 49
  • 50
  • 51
  • 52
  • 53
  • 54
  • 55
  • 56
  • 57
  • 58
  • 59
  • 60
  • 61
  • 62
  • 63
  • 64
  • 65
  • 66
  • 67
  • 68
  • 69
  • 70
  • 71
  • 72
  • 73
  • 74
  • 75
  • 76
  • 77
  • 78
  • 79
  • 80
  • 81
  • 82
  • 83
  • 84
  • 85
  • 86
  • 87
  • 88
  • 89
  • 90
  • 91
  • 92
  • 93
  • 94
  • 95
  • 96
  • 97
  • 98
  • 99
  • 100
  • 101
  • 102
  • 103
  • 104
  • 105
  • 106
  • 107
  • 108
  • 109
  • 110
  • 111
  • 112
  • 113
  • 114
  • 115
  • 116
  • 117
  • 118
  • 119
  • 120
  • 121
  • 122
  • 123
  • 124
  • 125
  • 126
  • 127
  • 128
  • 129
  • 130
  • 131
  • 132
  • 133
  • 134
  • 135
  • 136
  • 137
  • 138
  • 139
  • 140
  • 141
  • 142
  • 143
  • 144
  • 145
  • 146
  • 147
  • 148
  • 149
  • 150
  • 151
  • 152
  • 153
  • 154
  • 155
  • 156
  • 157
  • 158
  • 159
  • 160
  • 161
  • 162
  • 163
  • 164
  • 165
  • 166
  • 167
  • 168
  • 169
  • 170
  • 171
  • 172
  • 173
  • 174
  • 175
  • 176
  • 177
  • 178
  • 179
  • 180
  • 181
  • 182
  • 183
  • 184
  • 185
  • 186
  • 187
  • 188
  • 189
  • 190
  • 191
  • 192
  • 193
  • 194
  • 195
  • 196
  • 197
  • 198
  • 199
  • 200
  • 201
  • 202
  • 203
  • 204
  • 205
  • 206
  • 207
  • 208
  • 209
  • 210
  • 211
  • 212
  • 213
  • 214
  • 215
  • 216
  • 217
  • 218
  • 219
  • 220
  • 221
  • 222
  • 223
  • 224
  • 225
  • 226
  • 227
  • 228
  • 229
  • 230
  • 231
  • 232
  • 233
  • 234
  • 235
  • 236
  • 237
  • 238
  • 239
  • 240
  • 241
  • 242
  • 243
  • 244
  • 245
  • 246
  • 247
  • 248
  • 249
  • 250
  • 251
  • 252
  • 253
  • 254
  • 255
  • 256
  • 257
  • 258
  • 259
  • 260
  • 261
  • 262
  • 263
  • 264
  • 265
  • 266
  • 267
  • 268
  • 269
  • 270
  • 271
  • 272
  • 273
  • 274
  • 275
  • 276
  • 277
  • 278
  • 279
  • 280
  • 281
  • 282
  • 283
  • 284
  • 285
  • 286
  • 287
  • 288
  • 289
  • 290
  • 291
  • 292
  • 293
  • 294
  • 295
  • 296
  • 297
  • 298
  • 299
  • 300
  • 301
  • 302
  • 303
  • 304
  • 305
  • 306
  • 307
  • 308
  • 309
  • 310
  • 311
  • 312
  • 313
  • 314
  • 315
  • 316
  • 317
  • 318
  • 319
  • 320
  • 321
  • 322
  • 323
  • 324
  • 325
  • 326
  • 327
  • 328
  • 329
  • 330
  • 331
  • 332
  • 333
  • 334
  • 335
  • 336
  • 337
  • 338
  • 339
  • 340
  • 341
  • 342
  • 343
  • 344
  • 345
  • 346
  • 347
  • 348
  • 349
  • 350
  • 351
  • 352
  • 353
  • 354
  • 355
  • 356
  • 357
  • 358
  • 359
  • 360
  • 361
  • 362
  • 363
  • 364
  • 365
  • 366
  • 367
  • 368
  • 369
  • 370
  • 371
  • 372
  • 373
  • 374
  • 375
  • 376
  • 377
  • 378
  • 379
  • 380
  • 381
  • 382
  • 383
  • 384
  • 385
  • 386
  • 387
  • 388
  • 389
  • 390
  • 391
  • 392
  • 393
  • 394
  • 395
  • 396
  • 397
  • 398
  • 399
  • 400
  • 401
  • 402
  • 403
  • 404
  • 405
  • 406
  • 407
  • 408
  • 409
  • 410
  • 411
  • 412
  • 413
  • 414
  • 415
  • 416
  • 417
  • 418
  • 419
  • 420
  • 421
  • 422
  • 423
  • 424
  • 425
  • 426
  • 427
  • 428
  • 429
  • 430
  • 431
  • 432
  • 433
  • 434
  • 435
  • 436
  • 437
  • 438
  • 439
  • 440
  • 441
  • 442
  • 443
  • 444
  • 445
  • 446
  • 447
  • 448
  • 449
  • 450
  • 451
  • 452
  • 453
  • 454
  • 455

需要特別說明的是,上述開發的信用風險評級模型只包含定量和定性兩部分,在實際的使用中還要充分考慮到信用風險的特定,增加綜合調整部分,以應對可能對客戶信用影響較大的突發事件,如客戶被刑事起訴、遭遇重大疾病等。完整的信用風險標準評分卡模型,如表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")
  • 1
  • 2
  • 3
  • 4
  • 5
  • 6
  • 7
  • 8
  • 9
  • 10
  • 11
  • 12
  • 13
  • 14
  • 15
  • 16
  • 17
  • 18
  • 19
  • 20
  • 21
  • 22
  • 23
  • 24
  • 25
  • 26
  • 27
  • 28
  • 29
  • 30
  • 31
  • 32
  • 33
  • 34
  • 35
  • 36
  • 37
  • 38
  • 39
  • 40
  • 41
  • 42
  • 43
  • 44
  • 45
  • 46
  • 47
  • 48
  • 49
  • 50
  • 51
  • 52
  • 53
  • 54
  • 55
  • 56
  • 57
  • 58
  • 59
  • 60
  • 61
  • 62
  • 63
  • 64
  • 65
  • 66
  • 67
  • 68
  • 69
  • 70
  • 71
  • 72
  • 73
  • 74
  • 75
  • 76
  • 77
  • 78
  • 79
  • 80
  • 81
  • 82
  • 83
  • 84
  • 85
  • 86
  • 87
  • 88
  • 89
  • 90
  • 91
  • 92
  • 93
  • 94
  • 95
  • 96
  • 97
  • 98
  • 99
  • 100
  • 101
  • 102
  • 103
  • 104
  • 105
  • 106
  • 107
  • 108
  • 109
  • 110
  • 111
  • 112
  • 113
  • 114
  • 115
  • 116
  • 117
  • 118
  • 119
  • 120
  • 121
  • 122
  • 123
  • 124
  • 125
  • 126
  • 127
  • 128
  • 129
  • 130
  • 131
  • 132
  • 133
  • 134
  • 135
  • 136
  • 137
  • 138
  • 139
  • 140
  • 141
  • 142
  • 143
  • 144
  • 145
  • 146
  • 147
  • 148
  • 149
  • 150
  • 151
  • 152
  • 153
  • 154
  • 155
  • 156
  • 157
  • 158
  • 159
  • 160
  • 161
  • 162
  • 163
  • 164
  • 165
  • 166
  • 167
  • 168
  • 169
  • 170
  • 171
  • 172
  • 173
  • 174
  • 175
  • 176
  • 177
  • 178
  • 179
  • 180
  • 181
  • 182
  • 183
  • 184
  • 185
  • 186
  • 187
  • 188
  • 189
  • 190
  • 191
  • 192
  • 193
  • 194
  • 195
  • 196
  • 197
  • 198
  • 199
  • 200
  • 201
  • 202
  • 203
  • 204
  • 205
  • 206
  • 207
  • 208
  • 209
  • 210
  • 211
  • 212
  • 213
  • 214
  • 215
  • 216
  • 217
  • 218
  • 219
  • 220
  • 221
  • 222
  • 223
  • 224

執行上述程式碼後,我們整理測試集中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
  • 1
  • 2
  • 3

由輸出結果可知,變數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.006
qchisq(0.997,df=9)      #結果為百分數
[1] 24.97407
  • 1
  • 2
  • 3
  • 4
  • 5

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

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

相關文章