有一段時間沒來寫博了，一直忙我司申請評分卡、催收評分卡的上線工作，那么我們的評分卡上線后，如何對評分卡的效果進行有效監測，監測哪些指標，監測的指標閾值達到多少我們需要對現有評分卡進行調整更新？這是我們在評分卡上線后需要持續性監測、關注的問題，今天就來跟大家分享一下互金行業評分卡監測的常用手段。

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, "名下物業數量_所有聯名人"] <- 0index <- 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$主貸人分數/100PSI <- 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_levelmodeldata1$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_noData2016 <- 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$逾期天數), "逾期天數"] <- 0data$overdue60 <- ifelse(data$逾期天數>=60, TRUE, FALSE)index <- !is.na(data$賬戶狀態) & data$賬戶狀態 %in% c("ACCOOA","RWOCOOA", "RWOCORA", "RWOCOXX","WOCOOA", "WOCORA", "WOCOXX")data[index, "overdue60"] <- TRUEindex <- data$overdue60 == FALSEdata[index, "貸款剩余本金"] <- 0data <- 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,]# 新版評分卡KSb_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# 舊版評分卡 KSb_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")

關于監測頻率，對于一般金融產品，以每月一次的監測頻率進行監測；對于催收評分卡或某些特殊需求的金融產品，需每周做一次監測。監測結果需定時上傳，在監測指標明顯波動的情況下需考慮更新或重建評分卡。

總結

以上是生活随笔為你收集整理的评分卡上线后如何进行评分卡的监测的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。