基於R語言的評分卡建模（一）
1、寫在建模前
儘管，現在有很多優秀的模型已經在金融風控領域中得到廣泛應用，且效果較好，但是，經典的評分模型依然是風控的基礎，是最常見的金融風控手段，通常來對信貸使用者進行信用風險評估，據此決定是否給予授信以及授信的額度、利率。
評分卡一般分類：
貸前：申請評分卡（Application scorecard），又稱為A卡
貸中：行為評分卡（Behavior scorecard），又稱為B卡
貸後：催收評分卡（Collection scorecard），又稱為C卡
評分卡一般建模流程：
那我們先看一下，一張簡單的評分卡長什麼樣子吧。
評分卡簡略版
那麼，一個申請使用者的總得分就等於各個變數的得分之和，即總分=baseScore + score（age） +score（phoneAge） +score（incomeOfYear） +score（sex） +score（marrySate） +score（education），這樣來看，評分卡也不是那麼複雜的模型。但是，建立一張貼合業務、區分能力好的評分模型並不是一件簡單的事情，下面我們進行評分卡的建模步驟，揭開評分建模的神秘面紗！
2、評分卡模型建立
參照之前寫過的建模步驟（
），現在選取資料集進行評分卡模型建立的全過程。
這裡的資料集的好壞定義以及觀察期、表現期是參照了（
和
）文章做了滾動率分析以及賬齡分析來判定和選取的。
rm
（
list
=
ls
（））
#清除所有變數
setwd
（
“C：\\Users\\Desktop”
）
library
（
openxlsx
）
datatable
<-
read。xlsx
（
“data。xlsx”
，
1
，
colNames
=
TRUE
）
str
（
datatable
）
dim
（
datatable
）
資料集結構（部分）
從讀入的資料集結構來看，該資料共有160940條記錄，41個變數，其中cedit欄位為好壞標識欄位（0-好使用者，1-壞使用者），其餘x1~x40均為使用者屬性（欄位含義這裡不做詳細說明）。
2。1 特徵預處理
拿到資料集，瞭解了大致的資料集結構以及欄位含義之後，下面開始資料預處理階段，主要是對資料特徵進行缺失值、異常點、單一值等做相應處理，清洗資料。
缺失率統計與刪除
findNaFunc
<-
function
（
dataFrame
，
file
）{
# param：dataFrame 資料框
# param：file 把缺失情況寫出檔案中
count
<-
0
# 定義資料框，使用者儲存資料
naViewData
<-
data。frame
（
varName
=
“title”
，
count
=
0
，
rate
=
“0%”
）
# 若有缺失值，則顯示確實變數以及確實比例
for
（
i
in
1
：
ncol
（
dataFrame
））{
# 缺失值個數統計
sumT
<-
sum
（
is。na
（
dataFrame［
，
i］
）
|
dataFrame［
，
i］
==
‘’
）
# 缺失比例
rate
<-
round
（
sumT
/
length
（
dataFrame［
，
i］
），
4
）
rate
<-
paste
（
rate
*
100
，
“%”
，
sep
=
“”
）
if
（
sumT
！=
0
）{
count
=
count
+1
#要放在print或者return之前
temporaryData
<-
data。frame
（
varName
=
names
（
dataFrame［i］
），
count
=
sumT
，
rate
=
rate
）
naViewData
<-
rbind
（
naViewData
，
temporaryData
）
# print（paste（paste（names（dataFrame［i］），sumT，sep=“ ”），rate，sep=“ ”））
}
}
# 若無缺失，則顯示沒有確實變數
if
（
count
==
0
）{
（
“no variable contain NA！”
）
}
else
{
library
（
openxlsx
）
write。xlsx
（
naViewData
，
file
=
file
，
colNames
=
TRUE
，
rowNames
=
TRUE
）
（
naViewData
）
}
}
# 呼叫函式
findNaFunc
（
datatable
，
‘dataNaRate。xlsx’
）
資料集缺失統計（部分）
從缺失比例統計來看，絕大部分特徵缺失率是在30%以下的，這裡我們採取去除缺失率在30%以上的特徵的策略。
naRateDeleteFunc
<-
function
（
dataFrame
，
rate
）{
# param：dataFrame 資料集
# param：rate 缺失比例
col_num
=
ncol
（
dataFrame
）
row_num
=
nrow
（
dataFrame
）
vec
<-
vector
（
mode
=
‘integer’
，
length
=
col_num
）
# 1） 形成一個裝滿索引（缺失值比例較大列）的向量
for
（
i
in
1
：
col_num
）{
# 每列缺失值個數
sumT
<-
sum
（
is。na
（
dataFrame［
，
i］
）
|
dataFrame［
，
i］
==
‘’
）
# 每列缺失比例
NA_rate
<-
sumT
/
row_num
if
（
NA_rate
>
rate
）{
vec［i］
<-
i
}
}
# 2） 把索引向量中不為0的元素篩選出來
index
<-
vec
>
0
vec_no_zero
<-
vec［index］
# 3） 從資料框中取出缺失值比例較大的列
# 但是這裡要做一個判斷，如果vec_no_zero為空（就是說資料框沒有一個空值），
# 則-NA會把所有的變數都去掉
if
（
length
（
vec_no_zero
）
==
0
）{
dataSet
<-
dataFrame
}
else
{
dataSet
<-
dataFrame［
，
-
vec_no_zero］
}
return
（
dataSet
）
# return返回的物件要放在（）中
}
# 呼叫函式，返回資料集
dataNew30Rate
<-
naRateDeleteFunc
（
datatable
，
0。3
）
缺失比例高的變數進行刪除處理，返回dataNew30Rate資料集。
異常點檢測
在後面我們將採用均值填充的方式處理剩餘缺失變數，異常點對變數均值影響較大，因此此處先採用蓋帽法處理異常值。
# 四分位數極差（IQR）定義為Q3-Q1。比Q1小1。5倍的IQR或者比Q3大1。5倍的IQR的任何物件都視為離群點，
# 因為Q1-1。5*IQR和Q3+1。5*IQR之間的區域包含了99。3%的物件。
outlierDetectionFunc<-function（dataframe）{
ncols<-dim（dataframe）［2］
for（i in 1：ncols）{
if（is。numeric（dataframe［，i］））{
q25<-quantile（dataframe［，i］，0。25，na。rm = T）
q75<-quantile（dataframe［，i］，0。75，na。rm = T）
IQR15<-1。5*IQR（dataframe［，i］， na。rm = T）
dataframe［，i］［which（dataframe［，i］ < （q25-IQR15））］ <- quantile（dataframe［，i］，0。01， na。rm = T）
dataframe［，i］［which（dataframe［，i］ > （q75+IQR15））］ <- quantile（dataframe［，i］，0。99， na。rm = T）
}
}
return（dataframe）
}
dataWithNoOuterlier<-outlierDetectionFunc（dataNew30Rate）
缺失值填充
缺失值根據其資料型別才用合適的值來填充資料，其中，數值型變數用均值來填充，字元型變數直接給特定值‘N’單獨成一類。
missingValueMeanFillFunc<-function（dataFrame）{
v_len<-ncol（dataFrame）
for（i in 1：v_len）{
# 數值型變數用均值
if（is。numeric（dataFrame［，i］））{
dataFrame［，i］［which（is。na（dataFrame［，i］））］<-mean（dataFrame［，i］，na。rm=TRUE）
# 字元型變數，空值單獨一類
}else if（is。character（dataFrame［，i］））{
dataFrame［，i］［which（is。na（dataFrame［，i］） | dataFrame［，i］==‘’）］<-‘N’
# 因子
}else{
print（‘this is a factor ， maybe’）
}
}
return（dataFrame）
}
dataSetWithoutNa<-missingValueMeanFillFunc（dataWithNoOuterlier）
單一值處理
若一個變數有過多的單一值，那麼這個變數很難利用或者說區分效果不好，因此，這裡採取剔除單一值比例超過90%的變數。
centralizedVariableRemove<-function（dataFrame，prop）{
# apply函式族 https：//blog。csdn。net/u012398613/article/details/53906636
centors=names（which（sapply（dataFrame，function（x） max（table（x））/length（x）>prop）））
#setdiff（x，y） 從x中去除y中的元素
coln<-setdiff（colnames（dataFrame），centors）
dataSet<-dataFrame［，coln］
return（dataSet）
}
dataRemoveGatherVar<-centralizedVariableRemove（dataSetWithoutNa，0。9）
資料劃分
到此步驟，資料預處理階段基本完畢，下面將進行資料劃分，訓練集用作後面的特徵篩選，測試集用作後期驗證模型。由於這裡沒有關於字元型變數，若有的話，還要根據具體情況進行字元型變數的編碼、轉換。
library（“caTools”）
set。seed（123456）
split = sample。split（dataRemoveGatherVar$credit，SplitRatio = 0。7）
trainData = subset（dataRemoveGatherVar，split == TRUE）
testData = subset（dataRemoveGatherVar，split == FALSE）
# 各個資料集好壞佔比
table（dataRemoveGatherVar$credit）
prop。table（table（dataRemoveGatherVar$credit））
table（trainData$credit）
prop。table（table（trainData$credit））
table（testData$credit）
prop。table（table（testData$credit））
資料劃分比例統計
由各個資料集的統計比例來看，壞使用者佔比大約為20%左右，下面將進行特徵工程的第二階段：特徵篩選。
2。2、變數篩選
在建立模型之初，為了儘量減小因缺少重要自變數而出現的模型偏差，通常會選擇儘可能多的自變數，這樣無疑會增加後面建模的複雜程度。因此，建模過程需要尋找對因變數最具有強解釋力的自變數集合，也就是透過自變數選擇（指標選擇、欄位選擇）來提高模型的解釋性和預測精度。
挑選入模變數過程是個比較複雜的過程，需要考慮的因素很多，比如：變數的預測能力，變數之間的相關性，變數的簡單性（容易生成和使用），變數的強壯性，變數在業務上的可解釋性等。指標選擇在統計建模過程中是極其重要的問題，下面將通過幾種常見的演算法進行變數選擇。
隨機森林
隨機森林就是透過整合學習的思想將多棵樹整合的一種演算法，它的基本單元是決策樹，而它的本質屬於機器學習中的基於Bagging 思想的整合學習（Ensemble Learning）方法。可以透過構建簡單的隨機森林來輸出變數的重要性排序（不同的包基於的原理不同，RandomForest包是基於CART演算法）。
# 這裡重點介紹以下自己寫的這個函式，該函式先建立的一個隨機森林model。forest。all，並利用importance函式來提取變數重要性（但是，這裡傳入引數是分別設定type=1、2，是利用兩種指標來計算重要性，因此兩種輸出也是不一樣的），並寫出到檔案中，最後為了後面方便使用，這裡可以提取重要性排序在x%以上的變數，儲存返回。
randomForestVarSelect
<-
function
（
dataFrame
，
prop
，
path1
，
path2
）{
library
（
randomForest
）
model。forest。all
=
randomForest
（
credit
~
。，data
=
dataFrame
，
importance
=
TRUE
，
proximity
=
TRUE
）
（
model。forest。all
）
# 重要性指標提取1：type1
importantVarOfType1
<-
importance
（
model。forest。all
，
type
=
1
）
# write。xlsx（as。data。frame（importantType1），“RandomForest_var_imp_accuracy。xlsx”，colNames=TRUE，rowNames=TRUE）
# 把變數名和重要性合成一個數據框
importantVarOfType1
<-
as。data。frame
（
importantVarOfType1
）
write。xlsx
（
importantVarOfType1
，
file
=
path1
，
colNames
=
TRUE
，
rowNames
=
TRUE
）
varNamesType1
=
row。names
（
importantVarOfType1
）
importantVarOfType1
<-
cbind
（
importantVarOfType1
，
varNamesType1
）
# 計算重要性指標75%分位數
percent75QuantileType1
<-
round
（
quantile
（
importantVarOfType1［
，
1
］
，
prop
），
0
）
newImporatntType1varName
<-
as。vector
（
importantVarOfType1
$
varNamesType1
［which
（
importantVarOfType1［
，
1
］
>=
percent75QuantileType1
）
］
）
# 重要性指標提取2：type2
importantVarOfType2
<-
importance
（
model。forest。all
，
type
=
2
）
# 把變數名和重要性合成一個數據框
importantVarOfType2
<-
as。data。frame
（
importantVarOfType2
）
write。xlsx
（
importantVarOfType2
，
file
=
path2
，
colNames
=
TRUE
，
rowNames
=
TRUE
）
varNamesType2
=
row。names
（
importantVarOfType2
）
importantVarOfType2
<-
cbind
（
importantVarOfType2
，
varNamesType2
）
# 計算重要性指標75%分位數
percent75QuantileType2
<-
round
（
quantile
（
importantVarOfType2［
，
1
］
，
prop
），
0
）
newImporatntType2varName
<-
as。vector
（
importantVarOfType2
$
varNamesType2
［which
（
importantVarOfType2［
，
1
］
>=
percent75QuantileType2
）
］
）
# 合併type1和type2篩選的變數
varSelectVec
<-
unique
（
c
（
newImporatntType1varName
，
newImporatntType2varName
））
return
（
varSelectVec
）
}
# 呼叫函式，兩個路徑是把重要性排序寫出，這裡根據需求，取重要性排序大於70%的變數，儲存備用
RFpath1
<-
“importantVarOfType1。xlsx”
RFpath2
<-
“importantVarOfType2。xlsx”
RFvarNames
<-
randomForestVarSelect
（
trainData
，
0。7
，
RFpath1
，
RFpath2
）
注意：該randomForest包會受到資料量的限制，經常報‘Error： cannot allocate vector of size XX Gb’的錯誤，這裡也遇到了，就跳過該步驟了。
那麼，這時候RFvarNames向量中儲存的就是根據隨機森林篩選的變數重要程度在所有變數中排序70%以上的變數。
IV值計算
IV的全稱是Information Value，資訊量。它是藉助自變數和因變數之間的分類關係，分箱並統計計算的一種指標。直觀地講，可以用IV去衡量變數預測能力，尤其是在評分卡建模過程當中，IV值是衡量模型區分好壞使用者的非常重要指標。
從直觀邏輯上大體可以這樣理解“用IV去衡量變數預測能力”這件事情：我們假設在一個分類問題中，目標變數的類別有兩類：Y1，Y2。對於一個待預測的個體A，要判斷A屬於Y1還是Y2，我們是需要一定的資訊的，假設這個資訊總量是I，而這些所需要的資訊，就蘊含在所有的自變數C1，C2，C3，……，Cn中，那麼，對於其中的一個變數Ci來說，其蘊含的資訊越多，那麼它對於判斷A屬於Y1還是Y2的貢獻就越大，Ci的資訊價值就越大，Ci的IV就越大，它就越應該進入到入模變數列表中。
關於woe分箱以及IV值的原理和計算，是非常重要的知識，需要很長篇幅講解，這裡不再過多贅述。
# 該函式主要是計算所有變數的IV值，並寫出到檔案中
ivValueVarSelect<-function（dataFrame，ivValue，path）{
# 安裝github上面的安裝包
# install_github（“riv”，“tomasgreif”） or install_github（“tomasgreif/riv”）
library（woe）
library（openxlsx）
# 變數資訊量IV排序
row。names（dataFrame） <- 1：nrow（dataFrame）
IV<-iv。mult（dataFrame，‘credit’，TRUE）
iv。plot。summary（IV）
# 把變數資訊值寫出到資料框
varAndIv<-data。frame（IV$Variable，IV$InformationValue，IV$Strength）
write。xlsx（varAndIv，file = path ，colNames=TRUE，rowNames=TRUE）
varAndIv$IV。Variable<-as。character（varAndIv$IV。Variable）
varAndIv<-varAndIv［order（varAndIv$IV。InformationValue，decreasing=T），］
# 篩選出iv值大於prop的變數
VarVec<-varAndIv$IV。Variable［which（varAndIv$IV。InformationValue>=ivValue）］
# 建立列表，用來裝兩個東西：一個是全部變數iv值，另一個是iv值大於prop的變數
ivList<-list（NULL）
length（ivList）<-2
ivList$varAndIv<-varAndIv
ivList$VarVec<-VarVec
return（ivList）
}
# 呼叫函式，儲存IV值大於0。02以上的變數，備用
ivPath<-“var_iv_dataframe。xlsx”
ivVarList<-ivValueVarSelect（trainData，0。02，ivPath）
ivVarNames<-ivVarList$VarVec
在這裡介紹兩個進行變數分箱以及計算IV的R包，woe包（在github上）和scorecard包（CRAN上），都非常不錯。
變數IV值排序圖
經過IV計算以及排序，ivVarNames儲存了IV值在0。02以上的所有變數。
lasso迴歸
Lasso演算法則是一種能夠實現指標集合精簡的估計方法。Lasso（Least absolute shrinkage and selection operator， Tibshirani（1996））方法是一種壓縮估計。它透過構造一個罰函式（L1正則項）得到一個較為精煉的模型，使得它壓縮一些係數，同時設定一些係數為零。因此保留了子集收縮的優點，進而達到降維的目的。
# 該函式第二個引數，是選擇建立的lasso模型損失函式最小（type=1，變數多）還是在損失誤差可接受範圍內保持模型
最簡（type=2，變數少）
lossoRegressionVarSelect<-function（dataFrame，type，path）{
column_length=length（names（dataFrame））-1
library（glmnet）
# note alpha =1 for lasso only and can blend with ridge penalty down to alpha=0 ridge only
glmmod<-glmnet（scale（as。matrix（dataFrame［，1：column_length］）），y=dataFrame$credit，alpha=1，family=‘binomial’）
# plot variable coefficients vs。 shrinkage parameter lambda
plot（glmmod，xvar=“lambda”）
cv_glmmod<-cv。glmnet（scale（as。matrix（dataFrame［，1：column_length］）），y=dataFrame$credit，alpha=1，family=‘binomial’）
plot（cv_glmmod）
str（cv_glmmod）
# 求最佳lambda值
lambda_min <- cv_glmmod$lambda。min
lambda_lse <- cv_glmmod$lambda。1se
lambdaVce<-vector（mode = ‘numeric’，length=2）
lambdaVce［1］<-lambda_min
lambdaVce［2］<-lambda_lse
# 在求最佳lambda值，提取係數
coefficients<-coef（glmmod，s=lambdaVce［type］）
str（coefficients）
# 提取變數名稱
variables=coefficients@Dimnames［［1］］
# 係數不為0的特徵索引
Active。Index<-which（coefficients！=0）
# 係數不為0的特徵係數值
Active。coefficients<-coefficients［Active。Index］
# 係數不為0的變數
Active。variables<-coefficients@Dimnames［［1］］［Active。Index］
# 係數不為0的變數及其值
no_zero_var_dataframe<-data。frame（Active。variables，Active。coefficients）
# 寫出資料框
library（openxlsx）
write。xlsx（no_zero_var_dataframe，file = path ，colNames=TRUE）
return（c（Active。variables））
}
# 呼叫函式，返回lasso迴歸係數部位0 的變數集合
lossoPath<-“data_output\\no_zero_var_dataframe_less。xlsx”
lossoVarNames<-lossoRegressionVarSelect（trainData， 1， lossoPath）
lossoVarNames<-lossoVarNames［2：length（lossoVarNames）］
經過IV計算以及排序，ivVarNames儲存了IV值在0。02以上的所有變數。下圖是lasso迴歸結果圖，圖中有兩條豎著的虛線，代表著type1和type2選擇的變數個數，可以看出，模型損失函式最小需要35個變數，而模型最簡單且效果不差約需要27個變數。
lasso迴歸結果圖
這裡特別說一下，以上隨機森林、IV計算以及lasso迴歸三個步驟均是獨立的，沒有先後順序，針對的資料集均是trainData。因此3個變數集合（RFvarNames、ivVarNames、lossoVarNames）也是基於不同的演算法獨立得到的。下面對這個3個變數集合取交集（這裡取交集或者並集都可根據業務經驗來判定，均可）
# 變數結合取交集（由於隨機森林演算法受到記憶體報錯影響，這裡不再考慮RFvarNames集合，只整合ivVarNames和lossoVarNames）
lassoAndIvVarNames<-intersect（lossoVarNames，ivVarNames）
lassoAndIvVarNames
# 建模資料集
dataForModel<-trainData［，c（lassoAndIvVarNames，‘credit’）］
# 寫出建模資料集
library（openxlsx）
write。xlsx（no_zero_var_dataframe，file = path ，colNames=TRUE）
到此，變數篩選過程基本結束，lassoAndIvVarNames向量儲存了lasso迴歸顯著不為0且IV值大於0。02的變數，即為變數篩選的變數集合。把資料集寫出來，下一節將記錄評分卡的建立以及調優過程。
