소품집

[Kaggle] 채무 불이행자 본문

AI

[Kaggle] 채무 불이행자

sodayeong 2020. 9. 1. 16:17

모델링 부터 오류가 나서 

(아직 해결치 못함 ..) 그 전의 code까지 업뎃 해둡니다.

 

ㅠ ㅠ 

 

 

 

 

getwd()
setwd('/Users/dayeong/Desktop/reserch/data')

Encoding('UTF-8')

# Kaggle - DAY4
# Kaggle Loan data binary classification

# Data import 
library(readr)         # Data input with readr::read_csv()

# EDA : 탐색적 데이터 분석, 데이터 확인
library(VIM)           # Missing values with VIM::aggr()
library(descr)         # descr::CrossTable() - Factor data의 범주별 빈도수, 비율 확인 
library(DT)            # DT::datatable() - All data assesment with web chart 
library(corrplot)      # Correlation coefficient 확인 

# Visuallization : 시각화 
library(GGally)        # 모든 변수에 대한 다양한 시각화
library(ggplot2)       # Visuallization 
library(RColorBrewer)  # plot의 color 설정 
library(scales)        # plot setting - x, y 축 설정

# Feature engineering, Pre-processing : 데이터 전처리 
# library(tidyverse)   # ggplot2, dplyr, purrr, etc ...
library(dplyr)         # Used for almost all data handling 
library(lubridate)     # Time series data Pre-processing 

# Machine learning modeling : 기계학습 모델 생성
library(e1071)         # Support Vector Machine
library(rpart)         # Decision Tree
library(rpart.plot)    # Decision Tree plotting 
library(randomForest)  # Random Forest
library(glmnet)        # LASSO, Ridge 

# Model validation : 모델 검증, 성능 확인 
library(caret)         # confusionM


multiplot <- function(..., plotlist = NULL, file, cols = 1, layout = NULL) {
  library(grid)
  
  # Make a list from the ... arguments and plotlist
  plots <- c(list(...), plotlist)
  
  numPlots = length(plots)
  
  # If layout is NULL, then use 'cols' to determine layout
  if (is.null(layout)) {
    # Make the panel
    # ncol: Number of columns of plots
    # nrow: Number of rows needed, calculated from # of cols
    layout <- matrix(seq(1, cols * ceiling(numPlots/cols)),
                     ncol = cols, nrow = ceiling(numPlots/cols))
  }
  
  if (numPlots==1) {
    print(plots[[1]])
    
  } else {
    # Set up the page
    grid.newpage()
    pushViewport(viewport(layout = grid.layout(nrow(layout), ncol(layout))))
    
    # Make each plot, in the correct location
    for (i in 1:numPlots) {
      # Get the i,j matrix positions of the regions that contain this subplot
      matchidx <- as.data.frame(which(layout == i, arr.ind = TRUE))
      
      print(plots[[i]], vp = viewport(layout.pos.row = matchidx$row,
                                      layout.pos.col = matchidx$col))
    }
  }
}

##
loan <- read.csv('Loan payments data.csv')
summary(loan)

loan <- loan %>%
  mutate(Loan_ID = factor(Loan_ID), # 이번 분석시, 사용하지 않음 
         loan_status = factor(loan_status), # 이번 분석의 target feature
         effective_date = factor(effective_date),
         due_date = factor(due_date),
         paid_off_time = factor(paid_off_time),
         education = factor(education),
         Gender = factor(Gender))

summary(loan)

# Time serise인 due_date와 effective_date를 제외하고는, summary의 결과가 정확하게 나오는 것을 알 수 이싿. 

# 2.4 Simple operation 
# Binary classification에 사용할 변수만 택한 뒤, 추출한 후에 변수속성을 변환하자. 
loan <- loan %>%
  select("loan_status", "Principal", "terms", "effective_date",
         "due_date", "age", "education", "Gender") %>%
  mutate(loan_status = factor(ifelse(loan_status == 'PAIDOFF', 'Success', 'Faulure')),
         # Date 속성으롤 변환할 변수들 - due date, effective_date)
         due_date = mdy(due_date),
         effective_date = mdy(effective_date), 
         # 학력과 성별 -> 범주형으로 변환
         Gender = factor(Gender), 
         education = factor(education)) 

# 3. EDA - 탐색적 데이터 분석
# Feature engineering과 data pre-processing 이전에 분석할 데이터에 대한 탐색 및 시각화.

# 3.1 summary()
summary(loan) # (2.과정에서 모든 feature에 대해 변환해주었음.)

# 3.2 str()
str(loan)

# 3.3 Missing values
# 결측치가 없는 것으로 확인됨. 
aggr(loan, 
     prop = F, # 빈도수 출력?
     combined = T, # 결측치가 있는 플랏과 없는 플랏 두 개를 하나로 결합할지? 
     number = T, # count number 출력할 건지? 
     sortVars=T, # missing value 출력할 건지?
     sortCombs = T) # 결합한 플랏의 아웃풋에서 NA 개수를 우선해서 출력할 것인지? 


# 3.4 Visualization 
# 각 변수들의 빈도수, 비율, 분포 등을 확인하는 과정 

# 3.4.1 loan_status
# 정해진 기간 내, 대출금을 상환하는 데 성공한 고객은 300/200으로 알 수 있음. 
loan %>%
  ggplot(aes(x=loan_status)) +
  geom_bar() +
  labs(title='Bar plot', subtitle = '대출금 상환에 성공한 고객과 실패한 고객은?') +
  theme_bw(base_family = 'AppleGothic')
  
# 3.4.2 Principal (대출금)
loan %>%
  ggplot(aes(x=Principal)) +
  geom_histogram(breaks= seq(from=300, to =1000, by =10),
                 col = 'yellow', fill = 'blue', alpha= .5) +
  labs(title = 'First histogram of principal', 
       subtitle = '고객들이 빌린 대출금은 얼마나 되나요?') +
  theme_bw(base_family = 'AppleGothic')

# 300~1000까지 10을 간격으로 히스토그램을 그렸는데 최소 100씩 차이가남.
# Prinicipal을 factor로 변환한 뒤 대출금별로 그룹 & 빈도수 -> 시각화하자.

# factor 변환 및 빈도수 카운트 
loan %>% 
  mutate(Principal = factor(Principal)) %>%
  group_by(Principal) %>% 
  summarize(Count=n()) %>%
  arrange(desc(Count))

# 시각화 
loan %>% 
  mutate(Principal = factor(Principal)) %>%
  group_by(Principal) %>%
  summarize(Count=n()) %>%
  ggplot(aes(Principal, Count)) +
  geom_col() +
  geom_text(aes(label=Count), size=5, hjust=0.5, vjust=-0.3) +
  labs(title = 'Bar plot bt Prinicipal', subtitle = '고객들이 빌린 대출금은 얼마?') +
  theme_bw(base_family = 'AppleGothic')

##  multiplot() function을 활용해 대춝므별로 상환에 성공한 고객과 실패한 고객들의 빈도수와 비율 나타내기.
principal.p1 <- loan %>% 
  # Dbl 속성인 Principal feature를 Factor 속성으로 변환 
  mutate(Principal = factor(Principal)) %>% 
  # ggplot aesthetic setting - x = Principal, y = loan_status
  ggplot(aes(Principal, fill = loan_status)) +
  # loan_status 별로 따로 빈도수 막대 그래프 그리게 설정 
  geom_bar(position = "dodge") + 
  # Bar 내부의 색상 설정 
  scale_fill_brewer(palette = "Set1") + 
  # Plots x, y axis, main title and sub title setting 
  labs(x = "Principal", y = "Count",
       title = "Frequency bar plot", subtitle = "대출금, 상환 여부 빈도수 막대 그래프") +
  theme_bw(base_family = 'AppleGothic')

principal.p2 <- loan %>% 
  mutate(Principal = factor(Principal)) %>% 
  ggplot(aes(Principal, fill = loan_status)) +
  geom_bar(position = "fill") + 
  scale_fill_brewer(palette = "Set1") +
  # Y axis output을 %로 나오게 설정 
  scale_y_continuous(labels = percent) +
  labs(x = "Principal", y = "Rate",
       title = "Ratio bar plot", subtitle = "대출금, 상환 여부 비율 막대 그래프",
       caption = "Source : Kaggle Loan data") +
  theme_bw(base_family = 'AppleGothic')

# Multiplots layout setting with matrix(), rep()
multi.lay = matrix(rep(c(1, 2), each = 2, times = 2), 2, 4, byrow = T)

# Plotting 
multiplot(principal.p1, principal.p2, layout = multi.lay)


# 3.4.3 terms (고객이 은행과 계약한 이후에 대출금을 지급받기까지 걸린 시간)
loan %>%
  ggplot(aes(x=terms)) +
  geom_histogram(breaks = seq(from=7, to=30, by=1),
                 col='yellow', fill='blue', alpha=.8)

# 대출금을 지급받기까지 7, 14, 30일이 걸린 고객들만 존재함을 알 수 있다. 
# -> term을 factor형으로 변환한 뒤, 막대 그래프와 비율 그래프로 나타내보자. 

loan %>%
  mutate(terms = factor(terms)) %>%
  group_by(terms) %>%
  summarize(Count=n()) %>%
  arrange(desc(Count))

# terms 1st 시각화 - 빈도수 막대 그래프
terms.p1 <- loan %>%
  mutate(terms = factor(terms)) %>%
  ggplot(aes(terms, fill = loan_status)) +
  geom_bar(position = 'dodge') +
  scale_fill_brewer(palette = 'Set1') +
  labs(title = 'Frequency bar plot by terms', subtitle = '범주별 성공/실패 빈도수 막대그래프') +
  theme_bw(base_family = 'AppleGothic')

# terms 2st 시각화 - 비율 막대 그래프
terms.p2 <- loan %>% 
  mutate(terms= factor(terms)) %>% 
  ggplot(aes(terms, fill=loan_status)) +
  geom_bar(position = 'fill') +
  scale_fill_brewer(palette = 'Set1') +
  scale_y_continuous(labels = percent) +
  labs(title = 'Ration bar plot by terms', subtitle = '범주별 성공/실패 비율 막대 그래프') +
  theme_bw(base_family = 'AppleGothic')

multiplot(terms.p1,terms.p2, layout = multi.lay)
# 시각화 결과를 살펴보니, 14일과 30일 걸린 고객들이 가장 많고, 대출금 지급이 늦어질수록 기한 내에
# 상환할 가능성이 낮아짐을 알 수 있다. 


# 3.4.4 effective_date (고객이 은행으로부터 대출금을 지급받아, 계약 효력이 발생한 날짜를 의미.)
# 2016년 9월 8일 목요일부터 2016년 9월 14일 수요일까지 7개 범주를 가진 변수.
#
# 빈도수 막대 그래프
loan %>% 
  ggplot(aes(effective_date, fill = loan_status)) + 
  geom_bar(position = "dodge") +
  scale_fill_brewer(palette = "Set1") +
  labs(x = "Effective date", y = "Count",
       title = "Frequency bar plot by effective date",
       subtitle = "2016-09-08 Thursday ~ 2016-09-14 Wednesday",
       caption = "Source : Kaggle Loan data")

# 비율 막대 그래프
loan %>%
  ggplot(aes(effective_date, fill=loan_status)) +
  geom_bar(position = 'fill') +
  scale_fill_brewer(palette = 'Set1') +
  scale_y_continuous(labels = percent)
  labs(x='Effective date', y='Rate',
       title = 'Ration bar plot by effective date',
       subtitle = '2016-09-08 Thursday ~ 2016-09-14 Wendsday')
# 시각화 결과 일요일과 월요일에 대출금을 지급받은 고객이 가장 많고,
# 주말에 가까울 수록(금,토, 일, 월) 대출금 상환에 실패한 고객들이 많음을 알 수 있다. 
  
# 3.4.5 due_date (대출금을 모두 상환하기로 계약한 날짜를 의미)
# 빈도수 막대그래프로 500명의 고객이 언제까지 상환하기로 했는지 확인해보자.
loan %>%
  mutate(due_date = factor(due_date)) %>%
  ggplot(aes(due_date, fill=loan_status)) +
  geom_bar(position = 'dodge') +
  scale_fill_brewer(palette = 'Set1') +
  labs(title='Frequency bar plot by due date', 
       subtitle = "2016.09.15.Thursday ~ 2016.11.12.Saturday")
# 시각화 결과 별다른 규칙성(주기)는 보이지 않으며 빈도수 또한 일정치 않음.
# due_date variable을 사용하기 위해 월/요일 데이터를 생성하여 연관성을 확인해보자.

# 3.4.6 age
age.p1 <- loan %>% 
  ggplot(aes(age, fill=loan_status)) +
  geom_bar() +
  scale_fill_brewer(palette = 'Set1') +
  labs(title = 'Bar plot by Age 18 to 51')

age.p2 <- loan %>%
  ggplot(aes(age, fill=loan_status)) +
  geom_density(alpha=.7) +
  scale_fill_brewer(palette = 'Set1') +
  labs(title='밀도(Density) plot bu customer age') +
  theme_bw(base_family = 'AppleGothic')

# age feature multiplot layout setting
multi.lay2 = matrix(rep(c(1,2), each = 2), 2, 2, byrow = T)

# multiplot
multiplot(age.p1,age.p2, layout=multi.lay2)


# 3.4.7 education (교육 수준)
loan <- loan %>%
  mutate(education = factor(education, 
                            levels = c('High School or Below', # 고졸 또는 그 이하  
                                       'college', # 학부 졸업
                                       'Bechalor', # 석사 졸업 
                                       'Master or Above')))# 박사 졸업 

table(loan$education)

# 빈도수 막대그래프 
edu.p1 <- loan %>%
  ggplot(aes(education, fill=loan_status)) +
  geom_bar() + 
  scale_fill_brewer(palette = 'Set1') +
  theme(axis.text.x = element_text(angle=45, vjust = 0.6)) + 
  labs(title = 'Frequecy bar plot by education')

# 비율 막대그래프 
edu.p2 <- loan %>%
  ggplot(aes(education, fill=loan_status)) +
  geom_bar(position = 'fill') +
  scale_fill_brewer(palette = 'Set1') +
  scale_y_continuous(labels= percent) +
  theme(axis.text.x = element_text(angle=45, vjust = 0.6)) + 
  labs(title='Ration bar plot bu education')
  
multiplot(edu.p1, edu.p2, layout = multi.lay)
# 시각화 결과 석, 박사 과정을 이수한 고객들의 빈도수가 현저히 적으며 학력이 높을수록 성공할 가능성도
# 높음을 알 수 있다. 

# 3.4.8 Gender 
gender.p1 <- loan %>%
  ggplot(aes(Gender, fill=loan_status)) +
  geom_bar() +
  scale_fill_brewer(palette = 'Set1') +
  labs(title='Frequency bar plot by gender') 

gender.p2 <- loan %>%
  ggplot(aes(Gender, fill= loan_status)) +
  geom_bar(position = 'fill') +
  scale_fill_brewer(palette = 'Set1') +
  labs(title='Ration bar plot by gender')

multiplot(gender.p1, gender.p2, layout = multi.lay)
# 남성 고객이 여성 고객보다 많지만, 상환율은 여성 고객이 더 높은 것으로 파악됨.
# 하지만, 성별간의 무슨 차이인줄 파악할 수 있어야 함.
# 이때 고객간의 큰 차이가 없다면 성별은 큰 의미가 없어짐. 


#
# 4. 데이터 전처리 (Data Pre-processing)

# 4.1 terms -> Factor feature 'Term'
# terms는 Ddl 속성이지만 모든 고객들이 일주일, 격주, 한 달이라는 값만 갖고 있음.
# 따라서 이것을 factor형으로 변환해 Term이라는 파생 변수를 만들것!
# 바로 factor로 바꿔, 다시 term에 저장하지 않는 이유는 연속형 변수 terms를 사용해 상관계쑤를 확인할 것임.
loan <- loan %>%
  mutate(terms = factor(terms))

# 4.2 'YYYY-MM-DD' effective_date -> 'MMDD.Day' effective_day
# 추가로 날짜 feature 생성 !! 
loan <- loan %>%
  # effective_date feature의 날짜를 월일.요일 형식으로 수정한 'effective_day' 파생변수 생성
  mutate(effective_day = case_when(effective_date == "2016-09-08" ~ "0908.Thu",
                                    effective_date == "2016-09-09" ~ "0909.Fri",
                                    effective_date == "2016-09-10" ~ "0910.Sat",
                                    effective_date == "2016-09-11" ~ "0911.Sun",
                                    effective_date == "2016-09-12" ~ "0912.Mon",
                                    effective_date == "2016-09-13" ~ "0913.Tue",
                                    effective_date == "2016-09-14" ~ "0914.Wed"),
         # 그대로 두면 chr 속성이기 때문에 factor로 변환
          effective_day = factor(effective_day))

# 4.3 due_date(상환기한) -> due_month & due_day
loan <- loan %>%
  # 9~11월 이라는 범주형 변수로 사용할 것. 추출한 후 factor 변환
  mutate(due_month = factor(month(due_date)),
        # 무슨 요일인지 추출하는 wday function에서 label =T로 주로 알아서 라벨링 해주기.
         due_day = wday(due_date, label = T))

# 4.4 due_date - effective_date -> lenght.due
# 대출금을 지급받은 날짜부터 상환하기로 한 날짜 까지의 기간을 나타내는 변수 생성. 
# 그러니까 effective_date ~ due_date 까지의 기한. 

loan <- loan %>%
  # 'effective_date' 부터 'due_date' 까지의 기간을 추출해서 'length.due' 생성해보자.
  mutate(length.due = days(.$due_date-.$effective_date)@day)

# 4.5 education -> 3 labels feature education 
# 교육 수준이 네 가지였는데, feature를 세 개로 줄이면서 각 범주의 이름도 변환해보자. 
 
library(dplyr)
loan <- loan %>%
  mutate(education = dplyr::case_when(education == "High School or Below" ~ "Low",
                                      education %in% c("college", "Bechalor") ~ "Normal",
                                      education == "Master or Above" ~ "High"),
         # Chr 속성인 education을 factor로 변환하면서 순서에 맞게 levels 수정 
         education = factor(education, levels = c("Low", "Normal", "High")))

# 4.6 Variable descroption table after date pre-processing
# 원본 데이터에서 사용한 변수와 전처리를 통해 만들어진 파생 변수들에 대한 설명.
summary(loan)


# 5. Second EDA, Feature selection
# 전처리를 통해 만든 파생변수와 변환된 변수들이 종속 변수와 어떤 연관이 있는가 확인.

# 5.1 due_date, due_month, due_day
loan %>% 
  mutate(due_date = factor(due_date)) %>%
  ggplot(aes(due_date), fill='dodge') +
  theme(axis.text.x = element_text(angle = 45, vjust = 0.6)) +
  scale_fill_brewer(palette = 'Set1')  +
  labs(title = 'Frequency Bar plot by due daye', 
       subtitle = '2016.09.15.Thursday ~ 2016.11.12.Saturday')


due.p1 <- loan %>%
  ggplot(aes(due_month, fill=loan_status)) +
  geom_bar(position = 'dodge') +
  scale_fill_brewer(palette = 'Set1') +
  labs(title = 'Frequency bar plot by due month') +
  theme_bw(base_family = 'AppleGothic')

due.p2 <- loan %>%
  ggplot(aes(due_day, fill=loan_status)) +
  geom_bar(position = 'dodge') +
  scale_fill_brewer(palette = 'Set1') +
  labs(ttitle = 'Frequency bar plot by due day') +
  theme_bw(base_family = 'AppleGothic')

due.p3 <- loan %>%
  ggplot(aes(due_month, fill=loan_status)) +
  geom_bar(position = 'fill') +
  scale_fill_brewer(palette = 'Set1') +
  scale_y_continuous(labels = percent) +
  labs(title = 'Ration bar plot by due month') +
  theme_bw(base_family = 'AppleGothic')

due.p4 <- loan %>%
  ggplot(aes(due_day, fill=loan_status)) +
  geom_bar(position = 'fill') +  
  scale_fill_brewer(palette = 'Set1') +
  scale_y_continuous(labels = percent) +
  labs(title = 'Ration bar plot by due day') + 
  theme_bw(base_family = 'AppleGothic')

# age features multiplot layout setting
due.lay = matrix(1:4,2,2, byrow = T)
multiplot(due.p1,due.p2,due.p3,due.p4, layout = due.lay)


# 5.2 Education 
# 기존에 4개 범주 -> 3개의 범주로 바꾼 뒤, 종속변수와 얼마나 연관이 있는지 확인하는 과정. 

# 막대 그래프 - edu.p1
edu.p1 <- loan %>%
  ggplot(aes(education, fill=loan_status)) +
  geom_bar(position = 'dodge') +
  scale_fill_brewer(palette = 'Set1') +
  labs(title='Frequenvy bar plot by education')

# 비율 막대그래프 - edu.p2
edu.p2 <- loan %>%
  ggplot(aes(education, fill= loan_status)) +
  geom_bar(position = 'fill') +
  scale_fill_brewer(palette = 'Set1') +
  scale_y_continuous(labels = percent) +
  labs(title='Ration bar plot by education')

multiplot(edu.p1, edu.p2, layout = multi.lay)


# 5.3  length.due
ldue.p1 <- loan %>%
  mutate(length.due = factor(length.due)) %>%
  ggplot(aes(length.due, fill=loan_status)) +
  geom_bar(position = 'dodge') +
  scale_fill_brewer(palette = 'Set1') +
  labs(title='Frequency bar plot by length.due')

# 비율 막대그래프 - ldue.p2 
ldue.p2 <- loan %>% 
  mutate(length.due = factor(length.due)) %>%
  ggplot(aes(length.due, fill = loan_status)) +
  geom_bar(position = 'fill') +
  scale_fill_brewer(palette = 'Set1') +
  scale_y_continuous(labels = percent) +
  labs(title='Ration bar plot by length.due')

multiplot(ldue.p1, ldue.p2, layout = multi.lay2)


# 5.4 Feature Selection 
# 지금까지의 바탕으로 Classification Model을 생성하는데 사용할 변수를 도출해보자. 
# 주의점은! 모델 생성 후에 입력변수가 변경될 수 있으니, 다른 객체명으로 저장해야한다. 

read.loan <- loan %>%
  mutate(loan_status = factor(loan_status, levels = c('Success', 'Failure'))) %>%
  select("loan_status",
         "Principal", "terms", "effective_day", "due_mon")

# 6. Model generation and validation 

# 6.1 Date set splite (7:3)
# 모델 생성에 들어가기 앞서, 학습 셋과 검증 셋을 비율로 random sampling 하자. 

set.seed(1901) # YYMM - 2번째로 다시 분석한 년, 월

# 전체 관측치 개수 추출
n <- nrow(real.loan)
ind <- 1:n

# 전체 데이터엥서 70%의 index number 먼저 추출
training.ind <- sample(ind, n*.70)

# Training data index 제외 => 비복원 추출을 진행하기 위해.
ind <- setdiff(ind, training.ind)

# 남은 index에서 validation data index 추출
validation.ind <- sample(ind, n*.30)

# 위 2개의 index를 이용해 training : validation = 7:3 비율로 splite
training <- real.loan[training.ind,]
validation <- real.loan[validation.ind, ]


# 6.2  SVM (Support Vector Machine)
# Linear SVM 
set.seed(1901)
svm.linear <- svm(loan_status~., data = training, kernel = 'linear')

svm.sigmoid <- svm(loan_status~., data= training, kernel= 'sigmoid')

# 6.3 Model generation
set.seed(1901)
loan.tree <- rpart(formula = loan_status~., data = training,
                   method = 'class', parms=list(split='gini'),
                   control = rpart.control(minsplit = 20, cp=0.01, maxdepth = 10))













728x90
Comments