評分卡模型開發--上線監測
轉自：https://cloud.tencent.com/developer/article/1016299
那麼我們的評分卡上線後，如何對評分卡的效果進行有效監測，監測哪些指標，監測的指標閾值達到多少我們需要對現有評分卡進行調整更新？這是我們在評分卡上線後需要持續性監測、關注的問題，今天就來跟大家分享一下互金行業評分卡監測的常用手段。
1. 模型穩定性
包括評分卡得分分佈的PSI(Population Stability Index), 評分卡所有涉及變數的PSI. 模型分數分佈穩定性：監測模型的打分結果的分佈是否有變化，主要將評分卡上線後的樣本RealData與建模時的樣本Train_Data比較。使用的統計指標為PSI(Population Stability Index).使用的指標是PSI.
變數穩定性：監測模型的輸入變數的分佈是否有變化，主要將評分卡上線後的樣本RealData與建模時的樣本Train_Data比較。使用的指標也是PSI.
PSI 計算步驟： 假設我們要比較樣本A與樣本B中某一變數Y的分佈，首先按照同一標準將Y分為幾個區間（通常分為10段），計算樣本A和樣本B中每個區間的佔比。在每個區間段上，將兩個樣本的各自佔比相除再取對數，然後乘以各自佔比之差，最後將各個區間段的計算值相加，得到最終PSI.
以“聯名貸”產品申請評分卡監測過程為例，程式碼實現：
realdata<-read.csv("C:/Users/5609/Desktop/每日定時報表/20171023/CacheData_LMD.csv",header = TRUE)
modeldata<-read.csv("D:/sissi/聯名貸/聯名貸分數_建模樣本.csv",header=TRUE)
realdata$申請日期<-as.Date(realdata$time)
modeldata$申請日期<-as.Date(modeldata$申請日期)
vars <- read.table("variable list.txt", sep = "\t")
vars <- as.character(vars[,1])
for (i in vars){
if(is.character(modeldata[,i]) | is.logical(modeldata[,i])){
modeldata[,i] <- as.factor(modeldata[,i])
}
}
modeldata1<-modeldata[,c("申請編號","申請日期",vars,"pred","groups","groups_n")]
realdata1<-realdata[,c("申請編號","申請日期",vars,"final_score","group")]
# 聯名貸評分卡分組
breaks_g <- c( 0, 3.67,
4.49,
5.21,
5.99,
6.83,
8.02,
9.59,
12.44,
19.90,
100.00
)
realdata1$groups <- cut(realdata1$final_score, breaks = breaks_g, include.lowest = FALSE, right = TRUE)
realdata1$groups_n<-as.numeric(realdata1$groups)
####建模資料
tab <- summary(modeldata$groups)
write.table(tab, "clipboard", sep = "\t")
t1 <- summary(modeldata$groups)/dim(modeldata)[1]
write.table(t1, "clipboard", sep = "\t", row.names = FALSE, col.names = FALSE)
# 每組樣本量 更新至excel
tab <- summary(realdata1$groups)
write.table(tab, "clipboard", sep = "\t")
# 每組佔比 更新至excel
t2 <- summary(realdata1$groups)/dim(realdata1)[1]
write.table(t2, "clipboard", sep = "\t", row.names = FALSE, col.names = FALSE)
PSI <- sum((t2-t1)*log(t2/t1))
PSI
# 變數 PSI ----------------------------------------------------------------
vars <- read.table("variable list.txt", sep = "\t")
vars <- as.character(vars[,1])
# 調整變數值 （評分卡對輸入變數的值有調整，將調整後的值與建模時的資料做比較）
#loan_query_12MA_level
realdata1$loan_query_12MA_level <- cut(realdata1$loan_query_12MA, breaks = c(0, 1.5,Inf),
include.lowest = TRUE)
realdata1$loan_query_12MA_level <- as.character(realdata1$loan_query_12MA_level)
index <- is.na(realdata1$loan_query_12MA_level)
realdata1[index, "loan_query_12MA_level"] <- "NA"
realdata1$loan_query_12MA_level <- as.factor(realdata1$loan_query_12MA_level)
levels(realdata1$loan_query_12MA_level) <- c( "2_(1.5,Inf]", "1_[0,1.5] & NA","1_[0,1.5] & NA" )
realdata1$loan_query_12MA_level <- as.character(realdata1$loan_query_12MA_level)
# 未結清貸款筆數
realdata1$未結清貸款筆數_level <- cut(realdata1$未結清貸款筆數_level,
breaks = c(0, 5, Inf),
include.lowest = TRUE, right = FALSE)
realdata1$未結清貸款筆數_level <- as.factor(as.character(realdata1$未結清貸款筆數_level))
index <- is.na(realdata1$未結清貸款筆數_level)
realdata1[index, "未結清貸款筆數_level"] <- "[0,5)"
#貸款類別
realdata1$貸款類別 <- as.factor(as.character(realdata1$貸款類別))
levels(realdata1$貸款類別) <- c( "新貸款", "再貸","續貸" )
modeldata1[, "貸款類別"] <- ordered(
modeldata1[, "貸款類別"],
levels=c("新貸款", "再貸", "續貸"),
labels=c('新貸款', '再貸', '續貸')
);
table(modeldata1[, "貸款類別"])
#modeldata1[order(modeldata1[, "貸款類別"]),]
#名下物業數量_所有聯名人
index <- is.na(realdata1$名下物業數量_所有聯名人)
realdata1[index, "名下物業數量_所有聯名人"] <- 0
index <- realdata1$名下物業數量_所有聯名人 > 3
realdata1[index, "名下物業數量_所有聯名人"] <- 3
#要求貸款期限_level
realdata1$要求貸款期限_level <- cut(realdata1$要求貸款期限, breaks = c(0,18,36),
include.lowest = FALSE, right = TRUE)
realdata1$HZ_score<-realdata1$HZ_score/100
realdata1$主貸人分數<-realdata1$主貸人分數/100
PSI <- NULL
########"HZ_score"
var_name <- "HZ_score"
breaks_v <- unique(quantile(modeldata1[,var_name], seq(0,1,.2), na.rm = TRUE))
N <- length(breaks_v)
breaks_v <- c(-99,breaks_v[2:(N-1)], Inf)
breaks_v
modeldata1$groups_v <- cut(modeldata1[, var_name], breaks = breaks_v, include.lowest = TRUE, right = FALSE)
index <- !is.na(modeldata1[,var_name])
t1 <- summary(modeldata1[index,"groups_v"])/sum(index)
realdata1$groups_v <- cut(realdata1[, var_name], breaks = breaks_v, include.lowest = TRUE, right = FALSE)
index <- !is.na(realdata1[,var_name])
t2 <- summary(realdata1[index,"groups_v"])/sum(index)
sum((t2-t1)*log(t2/t1))
PSI[1] <- sum((t2-t1)*log(t2/t1))
########"主貸人分數"
var_name <- "主貸人分數"
breaks_v <- unique(quantile(modeldata1[,var_name], seq(0,1,.2), na.rm = TRUE))
N <- length(breaks_v)
breaks_v <- c(-99,breaks_v[2:(N-1)], Inf)
breaks_v
modeldata1$groups_v <- cut(modeldata1[, var_name], breaks = breaks_v, include.lowest = TRUE, right = FALSE)
index <- !is.na(modeldata1[,var_name])
t1 <- summary(modeldata1[index,"groups_v"])/sum(index)
realdata1$groups_v <- cut(realdata1[, var_name], breaks = breaks_v, include.lowest = TRUE, right = FALSE)
index <- !is.na(realdata1[,var_name])
t2 <- summary(realdata1[index,"groups_v"])/sum(index)
sum((t2-t1)*log(t2/t1))
PSI[2] <- sum((t2-t1)*log(t2/t1))
########loan_query_12MA_level
modeldata1$loan_query_12MA_level<-as.character(modeldata1$loan_query_12MA_level)
var_name <- "loan_query_12MA_level"
index <- !is.na(modeldata1[,var_name])
t1 <- table(modeldata1[index,var_name])/sum(index)
index <- !is.na(realdata1[,var_name])
t2 <- table(realdata1[index,var_name])/sum(index)
sum((t2-t1)*log(t2/t1))
PSI[3] <- sum((t2-t1)*log(t2/t1))
#######未結清貸款筆數_level
#modeldata1$未結清貸款筆數_level<-as.character(modeldata1$未結清貸款筆數_level)
var_name <- "未結清貸款筆數_level"
index <- !is.na(modeldata1[,var_name])
t1 <- table(modeldata1[index,var_name])/sum(index)
index <- !is.na(realdata1[,var_name])
t2 <- table(realdata1[index,var_name])/sum(index)
sum((t2-t1)*log(t2/t1))
PSI[4] <- sum((t2-t1)*log(t2/t1))
########名下物業數量_所有聯名人
#modeldata1$名下物業數量_所有聯名人<-as.character(modeldata1$名下物業數量_所有聯名人)
#realdata1$名下物業數量_所有聯名人<-as.character(realdata1$名下物業數量_所有聯名人)
var_name <- "名下物業數量_所有聯名人"
index <- !is.na(modeldata1[,var_name])
t1 <- table(modeldata1[index,var_name])/sum(index)
index <- !is.na(realdata1[,var_name])
t2 <- table(realdata1[index,var_name])/sum(index)
sum((t2-t1)*log(t2/t1))
PSI[5] <- sum((t2-t1)*log(t2/t1))
########要求貸款期限_level
modeldata1$要求貸款期限_level<-as.character(modeldata1$要求貸款期限_level)
var_name <- "要求貸款期限_level"
index <- !is.na(modeldata1[,var_name])
t1 <- table(modeldata1[index,var_name])/sum(index)
index <- !is.na(realdata1[,var_name])
t2 <- table(realdata1[index,var_name])/sum(index)
sum((t2-t1)*log(t2/t1))
PSI[6] <- sum((t2-t1)*log(t2/t1))
###########最近1_3月信用卡是否逾期
var_name <- "最近1_3月信用卡是否逾期"
index <- !is.na(modeldata1[,var_name])
t1 <- table(modeldata1[index,var_name])/sum(index)
index <- !is.na(realdata1[,var_name])
t2 <- table(realdata1[index,var_name])/sum(index)
sum((t2-t1)*log(t2/t1))
PSI[7] <- sum((t2-t1)*log(t2/t1))
###########貸款類別
var_name <- "貸款類別"
index <- !is.na(modeldata1[,var_name])
t1 <- table(modeldata1[index,var_name])/sum(index)
index <- !is.na(realdata1[,var_name])
t2 <- table(realdata1[index,var_name])/sum(index)
sum((t2-t1)*log(t2/t1))
PSI[8] <- sum((t2-t1)*log(t2/t1))
PSI<0.1 樣本分佈有微小變化 PSI 0.1~0.2 樣本分佈有變化 PSI>0.2 樣本分佈有顯著變化
計算完建模變數的PSI值，需要重點關注PSI>0.2的變數，說明這幾項的分佈較建模時已經發生比較顯著的變化，需要考慮是否是客戶質量變化引起的PSI變動。
##### 觀測PSI大於0.2的變數#####
xx<-tapply(Data$未結清貸款筆數, substr(aa$申請日期,1,7),mean, na.rm = TRUE)
write.table(xx, "clipboard", sep = "\t", col.names = FALSE, row.names = TRUE)
yy<-tapply(Data$名下物業數量_所有聯名人, substr(aa$申請日期,1,7),mean, na.rm = TRUE)
write.table(yy, "clipboard", sep = "\t", col.names = FALSE, row.names = TRUE)
zz<-tapply(Data$要求貸款期限, substr(aa$申請日期,1,7),mean, na.rm = TRUE)
write.table(zz, "clipboard", sep = "\t", col.names = FALSE, row.names = TRUE)
此為例項資料，可以看到PSI>0.2的變數較建模初期存在較大波動，風控部門提供監測資料，業務部門需總結變數出現異常性或趨勢性波動的原因。
2. 壞賬變現
以9個月內逾期60天為壞賬標準，或12個月內逾期90天為壞賬標準，觀測模型的表現。（壞賬標準具體需根據不同產品來定義） 我常用的壞賬監測標準：60days/9m；90days/12m；30+監測（適用於續貸產品或催收評分卡） 監測所使用的統計量：可使用AUC,KS來監測評分卡模型在樣本上的預測效果。
以後置評分卡監測過程為例，程式碼實現：
# 模型表現 60d/9M --------------------------------------------------------------
# 讀取資料 合併
Data2016 <- read.csv("d:/sissi/Data/2016Data/HZ_score_201601_201606.csv", header = TRUE)
Data201607 <- read.csv("d:/sissi/Data/2016Data/HZ_score_201607_201612.csv", header = TRUE)
index <- Data2016$app_no %in% Data201607$app_no
Data2016 <- Data2016[!index,]
Data2016 <- rbind(Data2016, Data201607)
# 對資料進行新版分組
breaks_g <- c(0,
3.73,
4.45 ,
5.05 ,
5.61 ,
6.21 ,
6.87 ,
7.54 ,
8.25 ,
9.14 ,
10.02 ,
11.09 ,
12.13 ,
13.24 ,
14.66 ,
16.67 ,
19.20 ,
22.96 ,
28.73 ,
39.24 ,
100.00
)
Data2016$groups <- cut(Data2016$score, breaks = breaks_g, include.lowest = FALSE, right = TRUE)
# 讀取Data Source需更新至最新
DS <- read.csv("D:/sissi/ds201710/DataSource-2017年10月10日.csv", header = TRUE)
Data2016 <- merge(Data2016, DS[,c("申請編號", "合同起始日", "狀態.貸前.","錄單營業部","貸款產品")], by.x = "app_no", by.y = "申請編號", all.x = TRUE)
Data2016 <- Data2016[Data2016$合同起始日!="",]
Data2016$合同起始日 <- as.Date(Data2016$合同起始日)
# 讀取2015年資料
Data2015 <- read.csv("D:/sissi/後置/Score_HZ_201206_201512.csv", header = TRUE)
Data2015 <- Data2015[!duplicated(Data2015$app_no),]
Data2015 <- merge(Data2015, DS[,c("申請編號", "狀態.貸前.", "合同起始日","是否聯名貸款","實際貸款額度","要求貸款額度","錄單營業部","貸款產品")], by.x = "app_no", by.y = "申請編號", all.x = TRUE)
Data2015 <- Data2015[Data2015$合同起始日!="",]
Data2015$合同起始日 <- as.Date(Data2015$合同起始日)
Data2015$groups <- cut(Data2015$pred_refitted*100, breaks = breaks_g, include.lowest = FALSE, right = TRUE)
Data2016$pred_refitted <- Data2016$score/100
# 合併資料
vars <- c( "app_no" , "合同起始日" ,"pred_refitted","狀態.貸前.","groups","錄單營業部","貸款產品")
Data_all <- rbind(Data2015[,vars], Data2016[,vars])
# 讀取舊評分卡分數
old_score_card1 <- read.csv("D:/sissi/評分卡監測/20170206/舊版評分卡分數_201510_201608.csv")
old_score_card2<-SCORE_CARD_RESULT[,c("申請編號","後置評分卡計算結果")]
old_score_card<-rbind(old_score_card1,old_score_card2)
old_score_card<-old_score_card[!(duplicated(old_score_card$申請編號)),]
breaks_g_old <- c(0,6.84, 8.97, 10.58, 12.12, 13.4, 14.75,
16.19, 17.56, 19.02, 20.46, 22, 23.93, 26.14,
28.58, 31.46, 35.16, 39.76, 45.86, 54.97, 100)
old_score_card$後置評分卡計算結果<-as.numeric(old_score_card$後置評分卡計算結果)
old_score_card$分組 <- cut(old_score_card$後置評分卡計算結果, breaks = breaks_g_old, include.lowest = FALSE, right = TRUE)
old_score_card <- old_score_card[!duplicated(old_score_card$申請編號),]
# 從OverDueDate報表中讀取9個月時的逾期狀態 Dates中日期需更新至最新一月一號 OverDueDate報表需儲存成csv格式
data_out <- NULL
Dates <- c("2012-01-01","2012-02-01","2012-03-01","2012-04-01","2012-05-01","2012-06-01",
"2012-07-01","2012-08-01","2012-09-01","2012-10-01","2012-11-01","2012-12-01",
"2013-01-01","2013-02-01","2013-03-01","2013-04-01","2013-05-01","2013-06-01",
"2013-07-01","2013-08-01","2013-09-01","2013-10-01","2013-11-01","2013-12-01",
"2014-01-01","2014-02-01","2014-03-01","2014-04-01","2014-05-01","2014-06-01",
"2014-07-01","2014-08-01","2014-09-01","2014-10-01","2014-11-01","2014-12-01",
"2015-01-01","2015-02-01","2015-03-01","2015-04-01","2015-05-01","2015-06-01",
"2015-07-01","2015-08-01","2015-09-01","2015-10-01","2015-11-01","2015-12-01",
"2016-01-01","2016-02-01","2016-03-01","2016-04-01","2016-05-01","2016-06-01",
"2016-07-01","2016-08-01","2016-09-01","2016-10-01","2016-11-01","2016-12-01",
"2017-01-01","2017-02-01","2017-03-01","2017-04-01","2017-05-01","2017-06-01",
"2017-07-01","2017-08-01","2017-09-01","2017-10-01")
Table <- matrix(nrow = 100, ncol = 7)
for (i in 1:(length(Dates)-10)) {
StartDate <- Dates[i]
EndDate <- Dates[i+1]
Date1 <- Dates[i+10]
file1 <- paste("D:/sissi/OverdueDaily/OverDueDate",Date1,".csv",sep = "")
overdue <- read.csv(file1, header = TRUE, sep = ",")
data <- subset(Data_all, Data_all$合同起始日 < EndDate & Data_all$合同起始日 >= StartDate)
if (dim(data)[1]==0) {next }
data <- merge(data, overdue[, c("申請編號","逾期天數","逾期日期","貸款剩餘本金","賬戶狀態")],
by.x = "app_no", by.y = "申請編號", all.x = TRUE)
data[is.na(data$逾期天數), "逾期天數"] <- 0
data$overdue60 <- ifelse(data$逾期天數>=60, TRUE, FALSE)
index <- !is.na(data$賬戶狀態) & data$賬戶狀態 %in% c("ACCOOA","RWOCOOA", "RWOCORA", "RWOCOXX","WOCOOA", "WOCORA", "WOCOXX")
data[index, "overdue60"] <- TRUE
index <- data$overdue60 == FALSE
data[index, "貸款剩餘本金"] <- 0
data <- data[,c("app_no","逾期日期","逾期天數","overdue60","貸款剩餘本金")]
if (is.null(data_out)) {
data_out <- data
} else {
data_out <- rbind(data_out,data)
}
}
Data_all <- merge(Data_all, data_out[,c("app_no", "overdue60","貸款剩餘本金")], by = "app_no", all.x = TRUE)
Data_all <- merge(Data_all, DS[,c("申請編號", "實際貸款額度", "貸款類別","申請日期","合作方")], by.x = "app_no", by.y = "申請編號", all.x = TRUE)
Data_all$申請日期 <- as.Date(Data_all$申請日期)
Data_all <- subset(Data_all, Data_all$狀態.貸前.=="AC" & Data_all$貸款類別 != "續貸")
Data_all <- merge(Data_all, old_score_card[, c("申請編號", "後置評分卡計算結果","分組")],
by.x = "app_no", by.y = "申請編號", all.x = TRUE)
# 有2筆債務重組無評分卡分數
index <- !is.na(Data_all$後置評分卡計算結果) & !is.na(Data_all$overdue60) &
Data_all$合同起始日 >= "2015-11-01" & Data_all$申請日期 >= "2015-11-01" & !is.na(Data_all$overdue60)
# 舊版評分卡AUC
gbm.roc.area(Data_all[index,"overdue60"],Data_all[index,"後置評分卡計算結果"]/100)
# 新版評分卡AUC
gbm.roc.area(Data_all[index,"overdue60"],Data_all[index,"pred_refitted"])
subData1 <- Data_all[index,]
# 新版評分卡KS
b_points <- quantile(subData1$pred_refitted, seq(0,1,.01))
C_R <- NULL
C_N <- NULL
for (i in 1:100){
index <- subData1$pred_refitted<=b_points[i+1]
C_R[i] <- sum(subData1[index, "overdue60"]==1)/sum(subData1[,"overdue60"]==1)
C_N[i] <- sum(subData1[index, "overdue60"]==0)/sum(subData1[,"overdue60"]==0)
}
KS <- max(C_N - C_R)
KS
# 舊版評分卡 KS
b_points <- quantile(subData1$後置評分卡計算結果/100, seq(0,1,.01))
C_R <- NULL
C_N <- NULL
for (i in 1:100){
index <- subData1$後置評分卡計算結果/100<=b_points[i+1]
C_R[i] <- sum(subData1[index, "overdue60"]==1)/sum(subData1[,"overdue60"]==1)
C_N[i] <- sum(subData1[index, "overdue60"]==0)/sum(subData1[,"overdue60"]==0)
}
KS <- max(C_N - C_R)
KS
# 新版每組壞賬 (A/C)
tab <- tapply(subData1$overdue60, subData1$groups, mean)
write.table(tab, "clipboard", sep = "\t", row.names = FALSE, col.names = FALSE)
# 新版每組樣本量
tab <- tapply(subData1$overdue60, subData1$groups, length)
write.table(tab, "clipboard", sep = "\t", row.names = FALSE, col.names = FALSE)
#新版每組佔比
tab <- tapply(subData1$overdue60, subData1$groups, length)/dim(subData1)[1]
write.table(tab, "clipboard", sep = "\t", row.names = FALSE, col.names = FALSE)
# 新版每組逾期金額
tab <- tapply(subData1$貸款剩餘本金, subData1$groups, sum)
write.table(tab, "clipboard", sep = "\t", row.names = FALSE, col.names = FALSE)
# 新版每組合同金額
tab <- tapply(subData1$實際貸款額度, subData1$groups, sum)
write.table(tab, "clipboard", sep = "\t", row.names = FALSE, col.names = FALSE)
# 舊版每組壞賬 (A/C)
tab <- tapply(subData1$overdue60, subData1$分組, mean)
write.table(tab, "clipboard", sep = "\t", row.names = FALSE, col.names = FALSE)
# 舊版每組樣本量
tab <- tapply(subData1$overdue60, subData1$分組, length)
write.table(tab, "clipboard", sep = "\t", row.names = FALSE, col.names = FALSE)
#舊版每組佔比
tab <- tapply(subData1$overdue60, subData1$分組, length)/dim(subData1)[1]
write.table(tab, "clipboard", sep = "\t", row.names = FALSE, col.names = FALSE)
# 舊版每組逾期金額
tab <- tapply(subData1$貸款剩餘本金, subData1$分組, sum)
write.table(tab, "clipboard", sep = "\t", row.names = FALSE, col.names = FALSE)
# 舊版每組合同金額
tab <- tapply(subData1$實際貸款額度, subData1$分組, sum)
write.table(tab, "clipboard", sep = "\t", row.names = FALSE, col.names = FALSE)
# 按新版每組比例對舊版進行重新分組 將新版cumulative佔比結果更新至下面quantile函式
breaks_g <- quantile(subData1$後置評分卡計算結果, c(0, 0.0626,
0.1170 ,
0.1749 ,
0.2244 ,
0.2863 ,
0.3463 ,
0.3997 ,
0.4527 ,
0.5158 ,
0.5744 ,
0.6339 ,
0.6783 ,
0.7214 ,
0.7686 ,
0.8232 ,
0.8691 ,
0.9108 ,
0.9522 ,
0.9835 ,
1.0000
))
subData1$分組_new <- cut(subData1$後置評分卡計算結果, breaks = breaks_g, include.lowest = TRUE, right = FALSE )
# 舊版新分組 壞賬率(A/C)
tab <- tapply(subData1$overdue60, subData1$分組_new, mean)
write.table(tab, "clipboard", sep = "\t")
# 舊版新分組 樣本量
tab <- tapply(subData1$overdue60, subData1$分組_new, length)
write.table(tab, "clipboard", sep = "\t", row.names = FALSE)
# 舊版新分組 逾期金額
tab <- tapply(subData1$貸款剩餘本金, subData1$分組_new, sum)
write.table(tab, "clipboard", sep = "\t")
# 舊版新分組 合同金額
tab <- tapply(subData1$實際貸款額度, subData1$分組_new, sum)
write.table(tab, "clipboard", sep = "\t", row.names = FALSE, col.names = FALSE)
3. 拒絕原因
針對每個變數，根據其取值，按照樣本量平均分為3~5組，計算每一組中的平均得分。對每一個客戶的各個變數，根據實際值落入的組判斷對應的平均分X, 再減去該變數各組平均分的最小值X_min, X-X_min為該變數對應的差值。將每個變數對應的差值從高到低排序，輸出頭三個不同的拒絕原因。例如，最近120天內查詢這個變數，根據其樣本中的取值，可以分為5組，每組中的平均分數如下：
某客戶，其最近120天內查詢次數為4次，落入第四組，該組平均得分為14.36，全部5組中，最低分為7.3，所以該客戶這個變數對應的差值為7.06. 對應的拒絕原因為“近期徵信查詢過多”。將該客戶的所有變數按照同樣的方法計算差值，再排序，可得到輸出的拒絕原因。
該部分程式碼主要監測被拒絕客戶的拒絕原因，以及被評分卡拒絕的客戶的拒絕原因明細。
# 讀取拒絕原因 需更新至最新
RJ_REASON <- read.table("D:/sissi/評分卡監測/20171017/V_RJ_REASON_DETAIL.txt", header = TRUE,stringsAsFactors=FALSE)
RJ_REASON1 <- read.table("D:/sissi/評分卡監測/20171017/V_RJ_REASON_DETAIL1.txt", header = TRUE,stringsAsFactors=FALSE)
RJ_REASON<-rbind(RJ_REASON,RJ_REASON1)
RJ_REASON<-RJ_REASON[!(duplicated(RJ_REASON$申請編號)),]
RJ_REASON <- RJ_REASON[RJ_REASON$申請編號!="null" & !is.na(RJ_REASON$申請編號),]
RealData <- merge(RealData, SCORE_CARD_RESULT[, c("申請編號", "後置評分卡計算結果", "後置評分卡分組")],
by.x = "app_no", by.y = "申請編號", all.x = TRUE)
RealData <- merge(RealData, RJ_REASON[, c("申請編號", "狀態","拒絕原因","貸款型別","貸款產品")],
by.x = "app_no", by.y = "申請編號", all.x = TRUE)
RealData <- merge(RealData, DS[, c("申請編號", "狀態.貸前.", "主拒絕原因" )], by.x = "app_no", by.y = "申請編號", all.x = TRUE)
index <- is.na(RealData$狀態)
RealData[index, "狀態"] <- RealData[index, "狀態.貸前."]
# 拒絕原因 --------------------------------------------------------------------
index <- is.na(RealData$拒絕原因) | RealData$拒絕原因 == "null"
RealData$拒絕原因 <- as.character(RealData$拒絕原因)
RealData[index, "拒絕原因"] <- as.character(RealData[index, "主拒絕原因"])
index <- RealData$狀態.貸前.=="RJ"
subData <- RealData[index,]
summary(subData)
# 整體被拒絕原因
library(stringr)
temp <- unlist(str_split(subData[,"拒絕原因"], ","))
tab <- summary(as.factor(temp))
write.table(tab, "clipboard", sep = "\t")
# 被評分卡拒絕的
index <- RealData$狀態.貸前.=="RJ" & grepl("綜合評分差", RealData$拒絕原因)
subData <- RealData[index,]
# 拒絕原因1
tab <- summary(subData$RJ_reason1)
write.table(tab, "clipboard", sep = "\t")
# 拒絕原因2
tab <- summary(subData$RJ_reason2)
write.table(tab, "clipboard", sep = "\t")
# 拒絕原因3
tab <- summary(subData$RJ_reason3)
write.table(tab, "clipboard", sep = "\t")
關於監測頻率，對於一般金融產品，以每月一次的監測頻率進行監測；對於催收評分卡或某些特殊需求的金融產品，需每週做一次監測。監測結果需定時上傳，在監測指標明顯波動的情況下需考慮更新或重建評分卡。
相關文章
- 評分卡模型開發--總體流程模型
- 評分卡模型的評分標準模型
- 關於評分卡模型那些事兒，看這篇就對了模型
- 如何更好評估信用貸風險？看這場評分卡模型直播就可以了模型
- 申請評分模型模型
- Z評分模型(轉載)模型
- 小程式 · 雲開發已上線，公測申請中
- 聊一聊評分模型校準模型
- 流失預測 & 分類模型（一）[轉發自石頭]模型
- 這場評分卡模型直播解答了我對於信貸風險的大部分疑問模型
- 評估指標與評分（上）：二分類指標指標
- 如何開發和評估Vanilla LSTM模型？（附程式碼）模型
- 巨人網路《帕斯卡契約》上線 次世代手遊開發能力獲蘋果認證蘋果
- Android開發之SD卡上檔案操作 （轉）AndroidSD卡
- 應用模型開發指南上新介紹模型
- 如何評價我們分類模型的效能？模型
- 雲開發 CloudBase 已上線觸發器能力Cloud觸發器
- 工廠園區能耗監測系統開發方案,線上監測平臺搭建
- 微信卡券開發
- 【新特性速遞】評分，評分，評分
- Web 金字塔式開發框架分層模型概述Web框架模型
- 小愛同學語音模型評測 - 董沐模型
- 能耗監測管控系統開發解決方案,能源線上監測網站搭建網站
- Python線性分類模型簡介Python模型
- oppo R17遊戲效能評測 oppo r17玩吃雞卡不卡？遊戲
- 開發及上線中的注意事項
- 開發不慎ERP上線擱淺(轉)
- 軟體測評報告做為招標評分項
- 中國軟體評測中心急聘測試開發工程師工程師
- 百分點大資料評測報告：開源OLAP引擎綜評（HAWQ、Presto、ClickHouse）大資料REST
- 重點高耗能企業能耗監測管理系統開發,線上監測平臺搭建
- 敏捷開發--Scrum開發模型敏捷Scrum模型
- Pebble Time 2評測：增加可監測心率使用體驗更好
- 第四章 線性分類模型模型
- 10分鐘能讓小白訓練出ML模型的 Amazon SageMaker 已在中國區上線模型
- 經緯恆潤智慧駕駛開發、測試評估平臺—智慧駕駛測評工具系列（ICVT）
- 數字資產交易所開發快速上線
- HarmonyOS 後臺任務管理開發指南上線！