Identifying Risky Credit Loans - Credit Rating Model
Andrew Jang
9/16/2018
1 Introduction
기본적으로 금융기관에서는 한국은행을 비롯한 다양한 곳에서 자금을 조달하여 이를 관리하고 있다가 자금을 필요로 하는 곳에 자금을 빌려주고 이에 상응하는 이자를 받아 수익을 얻는 것으로 볼 수 있다. 근본적으로 많은 금액을 빌려주고 이를 나누어서 자금을 사용한 곳에서 갚아 나가는 구조다.
물론 다수의 고객에게 자금을 빌려주다보니 제때 돈을 갚지 못하거나, 불의의 사고, 실직 등 다양한 이유로 인해서 돈을 갖지 못하는 위험이 발생된다. 이때 기대손실(Expected Loss)을 다음 구성요소를 가지고 정량화한다.
- 채무 불이행 위험 : Probability of default
- 채무 불이행 노출 : Exposure at default
- 채무 불이행에 대한 손실 : Loss given default
기대손실=채무 불이행 위험×채무 불이행 노출×채무 불이행에 대한 손실
따라서 금융기관에서 자금을 빌려주기 전에 다양한 정보를 활용하여 채무 불이행 위험이 적은 고객을 선별하여 가능한 많은 금액을 빌려주어 매출과 수익을 극대화한다. 신용 모델의 이면의 아이디어는 채무불이행될 위험이 높은지를 예측할 수 있는 요소를 식별하는 것이다. 따라서 과거 은행 대출에 대한 대량 데이터,
대출의 채무불이행 여부, 신청자에 대한 정보를 입수해야 한다.
- Application 정보: 나이, 결혼여부, 소득, 자가/전세 등
- Behaviour 정보: 현재 은행잔고, 연체금액 등
1.0.1 Classification using Machine Learning
기업 금융과 마찬가지로 소매 금융도 리스크 관리가 중요하다. 2007~2008년의 세계 금융 위기(리먼브라더스 사태)는 대출 업무의 투명성과 엄격함의 중요성을 부각시켰다. 기존 신용(시스템)의 유효성이 제한되면서 신용 평점에 따라 엄격하게 관리하는 것이 필요해졌고, 은행은 대출 시스템을 강화하고 위험 대출을 더 정확하게 찾아내기 위해 신용평점모형(Credit Scoring Model)을 머신 러닝(Machine Learing - Logistic Regression, Decision Tree, Random Forest)으로 전환했다.
많은 나라의 정부기관은 대출 업무를 면밀히 감시하고 있기 때문에 경영진은 대출이 승인되고 거절되는 사유를 설명할 수 있어야만 한다. 이런 정보는 신용 평가가 만족스럽지 않은 이유를 확인하려는 고객들에게도 유용하다. 의사결정트리는 다른 알고리즘 모델에 비해 정확도는 떨어지지만 설명력이 높다. 이 때문에 은행 업계에서 널리 사용되고 있다.
자동화된 신용 평가 모델을 이용해 전화나 웹에서 대출 신청을 즉시 승인할 수 있다. Python은 컴퓨팅에 많은 라이브러리가 구축되어 있는 반면, R은 상대적으로 통계 기반이라 금융 위험 관리 분야에 라이브러리가 많다. 현실과 밀접한 신용 점수 할당 문제를 기계학습에서 대규모로 적용할 경우 풀어가는 방식을 R로 살펴보고(C5.0 의사결정 트리를 이용해 간단한 대출 승인 모델을 개발한다. 또한 기관의 재정적 손실을 야기하는 오류를 최소화하기 위해 모델의 성능을 개선할 예정), 추후 파이썬으로 확장도 고려할 예정이다.
1.0.2 Dataset
2007-2015까지 LendingClub 대출자료
- database.sqlite (134.64 MB) : sqlite 데이터베이스 파일 형식 대출 데이터 전체
- LCDataDictionary.xlsx (20.5 KB) : 데이터 사전 (변수 설명)
- loan.csv (105.01 MB) : csv 파일 형식 대출 데이터 전체
2 Preparing the data
2.1 Import libary
# 전처리 관련 라이브러리
library(dplyr)
library(DescTools)
library(readxl)
library(readr)
# 시각화 관련 라이브러라
library(ggplot2)
library(ggthemes)
library(hexbin)
library(graphics)
library(maps)
library(plotly)
# NA 관련 라이브러리
library(mice)
library(VIM)
library(DMwR)
# Correlation 관련 라이브러리
library(corrplot)
library(psych)
# Standardization 관련 라이브러리
library(caret)
# Knn algorithm 관련 라이브러리
library(class)
# Decision Tree 관련 라이브러리
library(DT)
library(rpart)
library(rattle)
library(rpart.plot)
library(RColorBrewer)
# ANN 관련 라이브러리
library(neuralnet)
# SVM 관련 라이브러리
library(e1071)
# 출판 관련 라이브러리
library(knitr)
# 텍스트 분석 관련 라이브러리
library(tm)
library(RColorBrewer)
library(wordcloud)
library(kableExtra)
# 날짜 관련 라이브러리
library(xts)
library(lubridate)
# sql 관련 라이브러리
library(sqldf)
library(readr)
library(data.table)
library(lattice)
library(funModeling)
library(vcd)
library(vcdExtra)
library(zoo)
library(latticeExtra)
## 주소, 지도 관련 라이브러리
library(choroplethr)
library(zipcode)
library(choroplethrMaps)2.2 Load & Overview data
loan <- read_csv("/Users/mac/codebox_modified/dev/data/lendingclub/loan.csv", col_names = TRUE)
dim(loan)## [1] 887379 74colnames(loan)## [1] "id" "member_id"
## [3] "loan_amnt" "funded_amnt"
## [5] "funded_amnt_inv" "term"
## [7] "int_rate" "installment"
## [9] "grade" "sub_grade"
## [11] "emp_title" "emp_length"
## [13] "home_ownership" "annual_inc"
## [15] "verification_status" "issue_d"
## [17] "loan_status" "pymnt_plan"
## [19] "url" "desc"
## [21] "purpose" "title"
## [23] "zip_code" "addr_state"
## [25] "dti" "delinq_2yrs"
## [27] "earliest_cr_line" "inq_last_6mths"
## [29] "mths_since_last_delinq" "mths_since_last_record"
## [31] "open_acc" "pub_rec"
## [33] "revol_bal" "revol_util"
## [35] "total_acc" "initial_list_status"
## [37] "out_prncp" "out_prncp_inv"
## [39] "total_pymnt" "total_pymnt_inv"
## [41] "total_rec_prncp" "total_rec_int"
## [43] "total_rec_late_fee" "recoveries"
## [45] "collection_recovery_fee" "last_pymnt_d"
## [47] "last_pymnt_amnt" "next_pymnt_d"
## [49] "last_credit_pull_d" "collections_12_mths_ex_med"
## [51] "mths_since_last_major_derog" "policy_code"
## [53] "application_type" "annual_inc_joint"
## [55] "dti_joint" "verification_status_joint"
## [57] "acc_now_delinq" "tot_coll_amt"
## [59] "tot_cur_bal" "open_acc_6m"
## [61] "open_il_6m" "open_il_12m"
## [63] "open_il_24m" "mths_since_rcnt_il"
## [65] "total_bal_il" "il_util"
## [67] "open_rv_12m" "open_rv_24m"
## [69] "max_bal_bc" "all_util"
## [71] "total_rev_hi_lim" "inq_fi"
## [73] "total_cu_tl" "inq_last_12m"head(loan)## # A tibble: 6 x 74
## id member_id loan_amnt funded_amnt funded_amnt_inv term int_rate
## <int> <int> <dbl> <dbl> <dbl> <chr> <dbl>
## 1 1077501 1296599 5000 5000 4975 36 mon… 10.6
## 2 1077430 1314167 2500 2500 2500 60 mon… 15.3
## 3 1077175 1313524 2400 2400 2400 36 mon… 16.0
## 4 1076863 1277178 10000 10000 10000 36 mon… 13.5
## 5 1075358 1311748 3000 3000 3000 60 mon… 12.7
## 6 1075269 1311441 5000 5000 5000 36 mon… 7.9
## # ... with 67 more variables: installment <dbl>, grade <chr>,
## # sub_grade <chr>, emp_title <chr>, emp_length <chr>,
## # home_ownership <chr>, annual_inc <dbl>, verification_status <chr>,
## # issue_d <chr>, loan_status <chr>, pymnt_plan <chr>, url <chr>,
## # desc <chr>, purpose <chr>, title <chr>, zip_code <chr>,
## # addr_state <chr>, dti <dbl>, delinq_2yrs <dbl>,
## # earliest_cr_line <chr>, inq_last_6mths <dbl>,
## # mths_since_last_delinq <dbl>, mths_since_last_record <dbl>,
## # open_acc <dbl>, pub_rec <dbl>, revol_bal <dbl>, revol_util <dbl>,
## # total_acc <dbl>, initial_list_status <chr>, out_prncp <dbl>,
## # out_prncp_inv <dbl>, total_pymnt <dbl>, total_pymnt_inv <dbl>,
## # total_rec_prncp <dbl>, total_rec_int <dbl>, total_rec_late_fee <dbl>,
## # recoveries <dbl>, collection_recovery_fee <dbl>, last_pymnt_d <chr>,
## # last_pymnt_amnt <dbl>, next_pymnt_d <chr>, last_credit_pull_d <chr>,
## # collections_12_mths_ex_med <dbl>, mths_since_last_major_derog <chr>,
## # policy_code <dbl>, application_type <chr>, annual_inc_joint <chr>,
## # dti_joint <chr>, verification_status_joint <chr>,
## # acc_now_delinq <dbl>, tot_coll_amt <chr>, tot_cur_bal <chr>,
## # open_acc_6m <chr>, open_il_6m <chr>, open_il_12m <chr>,
## # open_il_24m <chr>, mths_since_rcnt_il <chr>, total_bal_il <chr>,
## # il_util <chr>, open_rv_12m <chr>, open_rv_24m <chr>, max_bal_bc <chr>,
## # all_util <chr>, total_rev_hi_lim <chr>, inq_fi <chr>,
## # total_cu_tl <chr>, inq_last_12m <chr>2.2.1 Find character & numeric & integer types
is.chr <- sapply(loan, is.character)
is.num <- sapply(loan, is.numeric)
is.int <- sapply(loan, is.integer)
chr.df <- loan[, is.chr]
num.df <- loan[, is.num]
int.df <- loan[, is.int]2.3 Collaborating with lendigclub data
데이터와 참고 문서 대조작업
dataDictionary <- read_excel("/Users/mac/codebox_modified/dev/data/lendingclub/LCDataDictionary.xlsx")
dd.names <- as.character(na.omit(dataDictionary$LoanStatNew))
loandata.names <- names(loan)
setdiff(dd.names, loandata.names)## [1] "fico_range_high" "fico_range_low" "is_inc_v"
## [4] "last_fico_range_high" "last_fico_range_low" "verified_status_joint"
## [7] "total_rev_hi_lim "렌딩클럽 데이터(csv 혹은 sqlite)와 데이터 사전에 문서화된 것 사이에 차이가 남을 알 수 있다. 즉, “fico_range_high”, “fico_range_low”, “is_inc_v”, “last_fico_range_high”, “last_fico_range_low”, “verified_status_joint”, “total_rev_hi_lim” 변수는 데이터 사전에 등재되어 있지만, 실제 렌딩클럽 데이터에는 없다. 사실 이런 경우는 흔하게 발생되고 있는 문제로 나중에 심각한 문제가 될 수 있다. 즉, 이런 비용이 쌓이게 되면 정말 되돌이킬 수 없는 시스템이 되어 재앙이 될 수 있다.
3 EDA
3.1 Loan amount distribution
대출금액 분포
Desc(loan$loan_amnt, main = "Loan amount distribution", plotit = TRUE)## -------------------------------------------------------------------------
## Loan amount distribution
##
## length n NAs unique 0s mean
## 887'379 887'379 0 1'372 0 14'755.26
## 100.0% 0.0% 0.0%
##
## .05 .10 .25 median .75 .90
## 3'600.00 5'000.00 8'000.00 13'000.00 20'000.00 28'000.00
##
## range sd vcoef mad IQR skew
## 34'500.00 8'435.46 0.57 8'599.08 12'000.00 0.68
##
## meanCI
## 14'737.71
## 14'772.82
##
## .95
## 32'000.00
##
## kurt
## -0.26
##
## lowest : 500.0 (11), 550.0, 600.0 (6), 700.0 (3), 725.0
## highest: 34'900.0 (14), 34'925.0 (9), 34'950.0 (18), 34'975.0 (31), 35'000.0 (36'368)
3.2 Increase status in loan amount
대출금액 현황 (기준일자 : 각 해당년도 1월)
suppressMessages(library(ggplot2))
suppressMessages(library(lubridate))
loan$issue_d <- parse_date_time(gsub("^", "01-", loan$issue_d), orders = c("d-m-y", "d-B-Y", "m/d/y"))
amnt_df <- sqldf("
select
issue_d
, sum(loan_amnt) as Amount
from loan
group by 1
")
ts_amnt <- ggplot(amnt_df, aes(x = issue_d, y = Amount))
ts_amnt + geom_line() + xlab("Date of loan origination") + ylab("Loan")
3.3 Year of Loan Issue
연도별, 등급별 대출금액 현황
loan$issue_year <- year(as.yearmon(loan$issue_d,"%b-%Y"))
d <- sqldf("
select
avg(loan_amnt) as avg_amnt
, grade
, issue_year
from loan
group by grade, issue_year
")
g <- ggplot(d, aes(x = issue_year , y = avg_amnt, color=grade)) + geom_line(alpha = 0.4) + labs(x = "Year of Loan Issue", y="Average of Loan Amount issued") + theme_solarized()
ggplotly(g, tooltip = c("grade")) 3.4 Loans amount by loan status
대출 상태별 대출금
box_status <- ggplot(loan, aes(loan_status, loan_amnt))
box_status + geom_boxplot(aes(fill = loan_status)) +
theme(axis.text.x = element_blank()) +
labs(list(
title = "Loans by loan status",
x = "Loan status",
y = "Loan"))
3.5 Loan trend by loan rating
대출 등급별 대출금 추이
#amnt_df_grade <- loan %>%
# select(issue_d, loan_amnt, grade) %>%
# group_by(issue_d, grade) %>%
# summarise(Amount = sum(loan_amnt))
amnt_df_grade <- sqldf("
select
issue_d
, grade
, sum(loan_amnt) as Amount
from loan
group by 1, 2
")
ts_amnt_grade <- ggplot(amnt_df_grade,
aes(x = issue_d, y = Amount))
ts_amnt_grade + geom_area(aes(fill=grade)) + xlab("loan date")
3.6 Geographic information analysis
지리정보 분석
우편번호 zipcode 패키지가 있어 편리하게 우편번호를 지리정보와 붙여 데이터를 분석하는데 장점을 갖고 있다. 주별 대출금과 대출횟수를 정량화하는데 state_choropleth 함수를 사용해야 한다. 지리정보가 잘 매칭이 되려면 choroplethr 패키지에 region 즉, 주 명칭을 일치시켜야 한다. 이를 위해 2자리 주 명칭 축약어를 choroplethr 패키지에 region에 매칭하는데 있어, state.regions 데이터셋의 정보를 활용한다.
3.7 Loan amount by region
주별 대출 금액
data(zipcode.civicspace)
zipcode.civicspace$zip_code <- substr(zipcode.civicspace$zip,1,3)
zipcode.dic <- zipcode.civicspace %>% group_by(zip_code) %>%
dplyr::select(zip_code, region=state) %>% unique
loan$zip_code <- substr(loan$zip_code,1,3)
loan <- left_join(loan, zipcode.dic, by="zip_code")
# region 각주 명칭정보와 축약 두자리 정보 데이터 가져오기
suppressMessages(library(choroplethrMaps))
data(state.regions)
## 주별 대출 금액
state_by_value <- loan %>% group_by(region) %>%
dplyr::summarise(value = sum(loan_amnt, na.rm=TRUE)) %>% dplyr::select(abb=region, value) %>% ungroup
state_region_by_value <- left_join(state.regions, state_by_value, by="abb") %>%
dplyr::select(region, value)
state_choropleth(state_region_by_value, title = "Loan amount by region")
3.8 Number of loans by state
주별 대출 횟수
## 주별 대출 횟수
state_by_volume <-
loan %>% group_by(region) %>% dplyr::summarise(value = n()) %>% dplyr::select(abb=region, value) %>% ungroup
state_region_by_volume <- left_join(state.regions, state_by_volume, by="abb") %>%
dplyr::select(region, value)
state_choropleth(state_region_by_volume, title = "State-Region by volume")
a=data.table(table(loan$addr_state))
setnames(a,c("region","count"))
a$region=sapply(state.name[match(a$region,state.abb)],tolower)
all_states <- map_data("state")
Total <- merge(all_states, a, by="region")
ggplot(Total, aes(x=long, y=lat, map_id = region)) +
geom_map(aes(fill= count), map = all_states)+
labs(title="Loan counts in respective states",x="",y="")+
scale_fill_gradientn("",colours=terrain.colors(10),guide = "legend")+
theme_bw()
3.9 Loan reasons
- What’s the reason for taking a loan with LendingClub?
- 대출 목적(Loan Purpose)과 대출 상품(Loan Title) 시각화
Desc(loan$purpose, main = "Loan purpose", plotit = TRUE)## -------------------------------------------------------------------------
## Loan purpose
##
## length n NAs unique levels dupes
## 924'934 924'934 0 14 14 y
## 100.0% 0.0%
##
## level freq perc cumfreq cumperc
## 1 debt_consolidation 546'630 59.1% 546'630 59.1%
## 2 credit_card 214'880 23.2% 761'510 82.3%
## 3 home_improvement 53'750 5.8% 815'260 88.1%
## 4 other 44'605 4.8% 859'865 93.0%
## 5 major_purchase 18'066 2.0% 877'931 94.9%
## 6 small_business 10'852 1.2% 888'783 96.1%
## 7 car 9'206 1.0% 897'989 97.1%
## 8 medical 8'896 1.0% 906'885 98.0%
## 9 moving 5'721 0.6% 912'606 98.7%
## 10 vacation 4'988 0.5% 917'594 99.2%
## 11 house 3'857 0.4% 921'451 99.6%
## 12 wedding 2'444 0.3% 923'895 99.9%
## ... etc.
## [list output truncated]
suppressMessages(library(tm))
suppressMessages(library(RColorBrewer))
suppressMessages(library(wordcloud))
docs <- Corpus(VectorSource(loan$purpose))
# inspect(docs)
toSpace <- content_transformer(
function(x, pattern) gsub(pattern, " ", x))
docs <- docs %>%
tm_map(toSpace, "/") %>%
tm_map(toSpace, "@") %>%
tm_map(toSpace, "\\|")
docs <- docs %>%
tm_map(content_transformer(tolower)) %>% # Convert it to lower case
tm_map(removeNumbers) %>% # Remove numbers
tm_map(removeWords, stopwords("english")) %>% # Remove english common stopwords
tm_map(removeWords, c("blabla1", "blabla2")) %>% # Remove your own stop word
tm_map(removePunctuation) %>% # Remove punctuations
tm_map(stripWhitespace) # Eliminate extra white spaces
# inspect(docs)
term_mat <- TermDocumentMatrix(docs)
term_table <- as.matrix(term_mat)
freq_table <- data.frame(word = rownames(term_table),
freq = rowSums(term_table),
row.names = NULL)
freq_table <- freq_table %>% arrange(desc(freq))
freq_table %>% head()## word freq
## 1 debtconsolidation 546630
## 2 creditcard 214880
## 3 homeimprovement 53750
## 4 majorpurchase 18066
## 5 smallbusiness 10852
## 6 car 9206ggplot(data = head(freq_table, 20)) +
geom_bar(aes(x = reorder(word, freq), y = freq), stat="identity") +
coord_flip() +
theme(axis.text = element_text(size = 16)) +
labs(title = "Loan purpose", x = "Word", y = "Frequency")
# for original
#wordcloud(words = freq_table$word, freq = freq_table$freq,
# min.freq = 100, max.words=10, random.order=FALSE, rot.per=0.35,
# colors=brewer.pal(8, "Paired"), scale = c(10, 3))
# for html
#library(wordcloud2)
#wordcloud2(freq_table, color = "random-light", backgroundColor = "grey")Desc(loan$title, main = "Loan titles", plotit = TRUE)## -------------------------------------------------------------------------
## Loan titles
##
## length n NAs unique levels dupes
## 924'934 924'775 159 61'452 61'452 y
## 100.0% 0.0%
##
## level freq perc cumfreq cumperc
## 1 Debt consolidation 431'965 46.7% 431'965 46.7%
## 2 Credit card refinancing 171'231 18.5% 603'196 65.2%
## 3 Home improvement 41'664 4.5% 644'860 69.7%
## 4 Other 33'156 3.6% 678'016 73.3%
## 5 Debt Consolidation 17'088 1.8% 695'104 75.2%
## 6 Major purchase 12'621 1.4% 707'725 76.5%
## 7 Business 7'050 0.8% 714'775 77.3%
## 8 Medical expenses 6'963 0.8% 721'738 78.0%
## 9 Consolidation 5'939 0.6% 727'677 78.7%
## 10 Car financing 5'788 0.6% 733'465 79.3%
## 11 debt consolidation 5'301 0.6% 738'766 79.9%
## 12 Moving and relocation 4'133 0.4% 742'899 80.3%
## ... etc.
## [list output truncated]
title_freq_table <- sqldf("
select
title
, count(*) as freq
from loan
group by 1
order by 2 desc
")
ggplot(data = head(title_freq_table, 20)) +
geom_bar(aes(x = reorder(title, freq), y = freq), stat="identity") +
coord_flip() +
theme(axis.text = element_text(size = 16)) +
labs(title = "Loan title", x = "Title", y = "Frequency")
3.10 Loan grades
Here is the overview of the occurrence of loans of different grades:
Desc(loan$grade, main = "Loan grades", plotit = TRUE)## -------------------------------------------------------------------------
## Loan grades
##
## length n NAs unique levels dupes
## 924'934 924'934 0 7 7 y
## 100.0% 0.0%
##
## level freq perc cumfreq cumperc
## 1 B 265'215 28.7% 265'215 28.7%
## 2 C 256'134 27.7% 521'349 56.4%
## 3 A 154'343 16.7% 675'692 73.1%
## 4 D 145'665 15.7% 821'357 88.8%
## 5 E 73'782 8.0% 895'139 96.8%
## 6 F 24'063 2.6% 919'202 99.4%
## 7 G 5'732 0.6% 924'934 100.0%
grade_freq_table <- sqldf("
select
grade
, count(*) as freq
from loan
group by 1
order by 2 desc
")
ggplot(data = grade_freq_table) +
geom_bar(aes(x = reorder(grade, freq), y = freq), stat="identity") +
coord_flip() +
theme(axis.text = element_text(size = 16)) +
labs(title = "Loan grade", x = "grade", y = "Frequency")
3.11 Interest rates are dependent on the loan grade
- The last step (so far) was checking whether the interest rates are dependent on the loan grade.
- 등급별 이자율
Desc(int_rate ~ grade, loan, digits = 1, main = "Interest rate by grade", plotit = TRUE) ## -------------------------------------------------------------------------
## Interest rate by grade
##
## Summary:
## n pairs: 924'934, valid: 924'934 (100.0%), missings: 0 (0.0%), groups: 7
##
##
## A B C D E F G
## mean 7.2 10.8 14.0 17.2 19.9 23.6 25.6
## median 7.3 11.0 14.0 17.0 20.0 23.8 25.8
## sd 1.0 1.4 1.2 1.2 1.5 1.5 2.0
## IQR 1.4 2.1 1.7 1.6 2.4 1.5 0.3
## n 154'343 265'215 256'134 145'665 73'782 24'063 5'732
## np 16.7% 28.7% 27.7% 15.7% 8.0% 2.6% 0.6%
## NAs 0 0 0 0 0 0 0
## 0s 0 0 0 0 0 0 0
##
## Kruskal-Wallis rank sum test:
## Kruskal-Wallis chi-squared = 839310, df = 6, p-value < 2.2e-16
3.12 Bar plot for loan grades based on purpose
ggplot(data=loan, aes(x=grade, fill=purpose)) +
geom_bar() +
labs(list(
title = "Loan grades based on purpose",
x = "Grade",
y = "Count")) +
coord_flip()
3.13 Box plot for interest rate according to purpose
ggplot(data=loan, aes(x=reorder(purpose,int_rate), y=int_rate)) +
geom_boxplot(fill="lightgreen", outlier.color = "red") +
theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
labs(list(
title = "Interest rate according to purpose",
x = "purpose",
y = "int_rate")) +
coord_flip()