MainCode.Rmd

---
title: "BA Project2"
author: "Diwei Zhu, Gabriela Caballero, Kunyang Que, Ullas Srivastava, Yangxin Liu"
date: "11/17/2020"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE,cache = T)
library(ggplot2)
library(dataQualityR)
library(magrittr)
library(dplyr)
library(caret)
library(rpart)
library(ROSE)
library(corrplot)
library(Hmisc)
library(gbm)
library(readr)
library(parallel)
library(psych)
library(lightgbm)
library(methods)
library(pROC)
library(e1071)
library(foreach)
library(doParallel)
```

# Part I: Data Preprocessing

## 1.1 Load Data

```{r}
data_origin<-read.csv("application_train.csv",header = T)
score_data_origin<-read.csv("applications_to_score.csv",header = T)

#external
previous_data_origin<-read.csv("previous_application.csv",header = T)
creditcard_data_origin<-read.csv("credit_card_balance.csv",header = T)
```

```{r}
data<-data_origin
score_data<-data_origin
dataLogisticModel<-data

previous_data<-previous_data_origin
creditcard_data<-creditcard_data_origin
```

### Data Exploration
```{r}
# review the "balance" of the positive class we are about to predict
table(data$TARGET)
prop.table(table(data$TARGET))
barplot(table(data$TARGET))

#CHECK DATA QUALITY 
# checkDataQuality(data=data, 
#                  out.file.num ="dq_loans_num.csv", 
#                  out.file.cat= "dq_loans_cat.csv")
# dq_num<-read.csv("dq_loans_cat.csv")
# View(dq_num)
# 
# dq_cat<-read.csv("dq_loans_cat.csv")
# View(dq_cat)
```

## 1.2 Summary

```{r}
colnames(score_data)
```

```{r}
colnames(data)
for (i in colnames(data)) {
  print(paste("========",i,"========="))
  if (is.character(data[[i]])) {
     print(unique(data[[i]]) )
  } else if (is.logical(data[[i]])) {
     print(table(data[[i]]))
  } else {
    print(summary(data[[i]]))
  }
}

```

### Reducing Data Set

```{r}
Imbalance_handle="off"

if(Imbalance_handle=="over"){

data <- ovun.sample(TARGET~., data=data,N = 540000, seed=1, method="over")$data
dataLogisticModel <- ovun.sample(TARGET~., data=dataLogisticModel,N = 540000, seed=1, method="over")$data
}else if(Imbalance_handle=="under"){
  index <- sample(1:nrow(data),(.1)*nrow(data))  # technique to reduce dataset
data <- data [index, ]
dataLogisticModel <- dataLogisticModel [index, ]
}

```

## 1.3 Data Cleaning

### Removing the XNAs from CODE_GENDER
```{r}
data<-subset(data,!data$CODE_GENDER %in% "XNA")
dataLogisticModel<-subset(dataLogisticModel,!dataLogisticModel$CODE_GENDER %in% "XNA")
```

### Calculating quartiles for AMT_INCOME_TOTAL
```{r}
Q <- quantile(data$AMT_INCOME_TOTAL, probs=c(.25, .75), na.rm = FALSE)
iqr <- IQR(data$AMT_INCOME_TOTAL)
up <- Q[2]+1.5*iqr # Upper Range
low<- Q[1]-1.5*iqr # Lower Range
# head(subset(data, data$AMT_INCOME_TOTAL < (Q[2]+1.5*iqr)))
# There are 15052 rows with "outliers" income total amount above the 75% of the data, we only removed the biggest outlier and kept the rest
data<-subset(data, data$AMT_INCOME_TOTAL!=117000000)
dataLogisticModel<-subset(dataLogisticModel, dataLogisticModel$AMT_INCOME_TOTAL!=117000000)
```

### Removing 11 NAs from AMT_ANNUITY

```{r}
data<-subset(data, !is.na(data$AMT_ANNUITY))
dataLogisticModel<-subset(dataLogisticModel, !is.na(dataLogisticModel$AMT_ANNUITY))
```

### Removing 262 NAs from AMT_GOODS_PRICE

```{r}
data<-subset(data, !is.na(data$AMT_GOODS_PRICE))
dataLogisticModel<-subset(dataLogisticModel, !is.na(dataLogisticModel$AMT_GOODS_PRICE))
```

### Removing 962 rows with empty data "" from NAME_TYPE_SUITE

```{r}
data<-subset(data, !data$NAME_TYPE_SUITE=="")
dataLogisticModel<-subset(dataLogisticModel, !dataLogisticModel$NAME_TYPE_SUITE=="")
```

### Changing the Unemployed and pensioned employed days to 0 to give less importance to the paramater but only for linear and logistic models, leaving it as it is for random forest

```{r}
dataLogisticModel$DAYS_EMPLOYED_POSITIVE<-ifelse(data$DAYS_EMPLOYED>0,1,0)
dataLogisticModel$DAYS_EMPLOYED<- ifelse(dataLogisticModel$DAYS_EMPLOYED>0,0,dataLogisticModel$DAYS_EMPLOYED)
#Creating a flag column for them
```

#### For random forest

```{r}
#Handling positive numbers DAYS_EMPLOYED
#Creating a flag column for them
data$DAYS_EMPLOYED_POSITIVE<-ifelse(data$DAYS_EMPLOYED>0,1,0)
#Replacing those values with Non numbers values
data$DAYS_EMPLOYED<-ifelse(data$DAYS_EMPLOYED>0,NA,data$DAYS_EMPLOYED)

```

### Removing outliers from OBS_30_CNT_SOCIAL_CIRCLE, DEF_30_CNT_SOCIAL_CIRCLE, OBS_60_CNT_SOCIAL_CIRCLE, DEF_60_CNT_SOCIAL_CIRCLE

```{r}
data = data[!data$OBS_30_CNT_SOCIAL_CIRCLE > 47,]
data = data[!data$DEF_30_CNT_SOCIAL_CIRCLE > 8,]
data = data[!data$OBS_60_CNT_SOCIAL_CIRCLE > 47,]
data = data[!data$DEF_60_CNT_SOCIAL_CIRCLE > 8,]

dataLogisticModel = dataLogisticModel[!dataLogisticModel$OBS_30_CNT_SOCIAL_CIRCLE > 47,]
dataLogisticModel = dataLogisticModel[!dataLogisticModel$DEF_30_CNT_SOCIAL_CIRCLE > 8,]
dataLogisticModel = dataLogisticModel[!dataLogisticModel$OBS_60_CNT_SOCIAL_CIRCLE > 47,]
dataLogisticModel = dataLogisticModel[!dataLogisticModel$DEF_60_CNT_SOCIAL_CIRCLE > 8,]
```

###  Deal with AMT_REQ_CREDIT_BUREAU

```{r}
# add the new column "AMT_REQ_CREDIT_BUREAU", which means the total Number of inquiries to Credit Bureau about the client one year before application
data$AMT_REQ_CREDIT_BUREAU<-data$AMT_REQ_CREDIT_BUREAU_HOUR + 
  data$AMT_REQ_CREDIT_BUREAU_DAY +
  data$AMT_REQ_CREDIT_BUREAU_WEEK +
  data$AMT_REQ_CREDIT_BUREAU_MON + 
  data$AMT_REQ_CREDIT_BUREAU_QRT +
  data$AMT_REQ_CREDIT_BUREAU_YEAR

dataLogisticModel$AMT_REQ_CREDIT_BUREAU<-dataLogisticModel$AMT_REQ_CREDIT_BUREAU_HOUR + 
  dataLogisticModel$AMT_REQ_CREDIT_BUREAU_DAY +
  dataLogisticModel$AMT_REQ_CREDIT_BUREAU_WEEK +
  dataLogisticModel$AMT_REQ_CREDIT_BUREAU_MON + 
  dataLogisticModel$AMT_REQ_CREDIT_BUREAU_QRT +
 dataLogisticModel$AMT_REQ_CREDIT_BUREAU_YEAR
```

```{r}
# delete columns
data<-subset(data, select = -AMT_REQ_CREDIT_BUREAU_HOUR)
data<-subset(data, select = -AMT_REQ_CREDIT_BUREAU_DAY)
data<-subset(data, select = -AMT_REQ_CREDIT_BUREAU_WEEK)
data<-subset(data, select = -AMT_REQ_CREDIT_BUREAU_MON)
data<-subset(data, select = -AMT_REQ_CREDIT_BUREAU_QRT)
data<-subset(data, select = -AMT_REQ_CREDIT_BUREAU_YEAR)

dataLogisticModel<-subset(dataLogisticModel, select = -AMT_REQ_CREDIT_BUREAU_HOUR)
dataLogisticModel<-subset(dataLogisticModel, select = -AMT_REQ_CREDIT_BUREAU_DAY)
dataLogisticModel<-subset(dataLogisticModel, select = -AMT_REQ_CREDIT_BUREAU_WEEK)
dataLogisticModel<-subset(dataLogisticModel, select = -AMT_REQ_CREDIT_BUREAU_MON)
dataLogisticModel<-subset(dataLogisticModel, select = -AMT_REQ_CREDIT_BUREAU_QRT)
dataLogisticModel<-subset(dataLogisticModel, select = -AMT_REQ_CREDIT_BUREAU_YEAR)
```

### Deleting 1 NA from CNT_FAM_MEMBERS

```{r}
data<-subset(data, !data$CNT_FAM_MEMBERS=="NA")

dataLogisticModel<-subset(dataLogisticModel, !data$CNT_FAM_MEMBERS=="NA")
```

### Changing the OCCUPATION_TYPE blanks variables to "Others"'

```{r}
data$OCCUPATION_TYPE[data$OCCUPATION_TYPE==""]<- "Others"
dataLogisticModel$OCCUPATION_TYPE[dataLogisticModel$OCCUPATION_TYPE==""]<- "Others"
```

#### Cleaning outliers for HOUR_APPR_PROCESS_START

```{r}
Q <- quantile(data$HOUR_APPR_PROCESS_START, probs=c(.25, .75), na.rm = FALSE)

iqr <- IQR(data$HOUR_APPR_PROCESS_START)

up <-  Q[2]+1.5*iqr # Upper Range  

low<- Q[1]-1.5*iqr # Lower Range

data<- subset(data, data$HOUR_APPR_PROCESS_START > (Q[1] - 1.5*iqr) & data$HOUR_APPR_PROCESS_START < (Q[2]+1.5*iqr))

dataLogisticModel<- subset(dataLogisticModel, dataLogisticModel$HOUR_APPR_PROCESS_START > (Q[1] - 1.5*iqr) & dataLogisticModel$HOUR_APPR_PROCESS_START < (Q[2]+1.5*iqr))
```

### Changing the ORGANIZATION_TYPE XNA variables to "Unknown"'

```{r}
data$ORGANIZATION_TYPE[data$ORGANIZATION_TYPE=="XNA"]<- "Unknown"

dataLogisticModel$ORGANIZATION_TYPE[dataLogisticModel$ORGANIZATION_TYPE=="XNA"]<- "Unknown"
```

### Data cleaning for building info

```{r new}
# data cleaning

temp<- data ##input
## removing avg & MEDI
remove_list<- c("APARTMENTS_AVG","BASEMENTAREA_AVG","YEARS_BEGINEXPLUATATION_AVG","YEARS_BUILD_AVG","COMMONAREA_AVG","ELEVATORS_AVG","ENTRANCES_AVG","FLOORSMAX_AVG","FLOORSMIN_AVG","LANDAREA_AVG","LIVINGAPARTMENTS_AVG","LIVINGAREA_AVG","NONLIVINGAPARTMENTS_AVG","NONLIVINGAREA_AVG","APARTMENTS_MEDI","BASEMENTAREA_MEDI","YEARS_BEGINEXPLUATATION_MEDI","YEARS_BUILD_MEDI","COMMONAREA_MEDI","ELEVATORS_MEDI","ENTRANCES_MEDI","FLOORSMAX_MEDI","FLOORSMIN_MEDI","LANDAREA_MEDI","LIVINGAPARTMENTS_MEDI","LIVINGAREA_MEDI","NONLIVINGAPARTMENTS_MEDI","NONLIVINGAREA_MEDI")
temp<-temp[,-which(names(temp) %in%remove_list)]
data<-temp ##output

temp<- dataLogisticModel ##input
## removing avg & MEDI
temp<-temp[,-which(names(temp) %in% remove_list)]
dataLogisticModel<-temp ##output
```

### Feature engineering for building info & External Source

```{r warning=FALSE}
# feature engineering
temp1 <- dataLogisticModel ##linear data
temp2 <- data ##tree data

qrtEncode <- function(x,dat) {
  if (is.na(x)) {
    return("NA")
  }
    if (x < dat[1]) {
      return("0-25%")
    } 
  if (x < dat[2]) {
      return("25-50%")
    } 
  if (x < dat[3]) {
      return("50-75%")
    } 
      return("75-100%")
}
ZeroEncode <- function(x, dat) {
  if (is.na(x)) {
    return("NA")
  }
  if (x == 0) {
    return("ZERO")
  }
  return("OVER ZERO")
}
#multithread

clus <- makeCluster(detectCores())
clusterExport(clus,"qrtEncode")
clusterExport(clus,"ZeroEncode")


temp1$APARTMENTS_MODE_FLAG <-  ifelse(is.na(temp1$APARTMENTS_MODE), 0, 1)#NA-0,else-1
temp1$APARTMENTS_MODE<-ifelse(is.na(temp1$APARTMENTS_MODE), 0, temp1$APARTMENTS_MODE)
temp2$APARTMENTS_MODE<-parLapply(clus,X=temp2$APARTMENTS_MODE,fun=qrtEncode,dat=quantile(temp2$APARTMENTS_MODE, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$APARTMENTS_MODE<-unlist(temp2$APARTMENTS_MODE)

temp1$BASEMENTAREA_MODE_FLAG <-  ifelse(is.na(temp1$BASEMENTAREA_MODE), 0, 1)#NA-0,else-1
temp1$BASEMENTAREA_MODE<-ifelse(is.na(temp1$BASEMENTAREA_MODE), 0, temp1$BASEMENTAREA_MODE)
temp2$BASEMENTAREA_MODE<-parLapply(clus,X=temp2$BASEMENTAREA_MODE,fun=qrtEncode,dat=quantile(temp2$BASEMENTAREA_MODE, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$BASEMENTAREA_MODE<-unlist(temp2$BASEMENTAREA_MODE)

temp1$YEARS_BEGINEXPLUATATION_MODE <-ifelse(is.na(temp1$YEARS_BEGINEXPLUATATION_MODE), 0, 1)#have-1,NA-0,overwrite
temp2$YEARS_BEGINEXPLUATATION_MODE <-ifelse(is.na(temp2$YEARS_BEGINEXPLUATATION_MODE), 0, 1)#have-1,NA-0,overwrite

temp1$YEARS_BUILD_MODE_FLAG <-  ifelse(is.na(temp1$YEARS_BUILD_MODE), 0, 1)#NA-0,else-1
temp1$YEARS_BUILD_MODE<-ifelse(is.na(temp1$YEARS_BUILD_MODE), 0, temp1$YEARS_BUILD_MODE)
temp2$YEARS_BUILD_MODE<-parLapply(clus,X=temp2$YEARS_BUILD_MODE,fun=qrtEncode,dat=quantile(temp2$YEARS_BUILD_MODE, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$YEARS_BUILD_MODE<-unlist(temp2$YEARS_BUILD_MODE)

temp1$COMMONAREA_MODE <-ifelse(is.na(temp1$COMMONAREA_MODE), 0, 1)#have-1,NA-0,overwrite
temp2$COMMONAREA_MODE <-ifelse(is.na(temp2$COMMONAREA_MODE), 0, 1)#have-1,NA-0,overwrite

temp1$ELEVATORS_MODE_FLAG <-  ifelse(is.na(temp1$ELEVATORS_MODE), 0, 1)#NA-0,else-1
temp1$ELEVATORS_MODE<-ifelse(is.na(temp1$ELEVATORS_MODE), 0, temp1$ELEVATORS_MODE)
temp2$ELEVATORS_MODE<-parLapply(clus,X=temp2$ELEVATORS_MODE,fun=ZeroEncode,dat=quantile(temp2$ELEVATORS_MODE, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$ELEVATORS_MODE<-unlist(temp2$ELEVATORS_MODE)

temp1$ENTRANCES_MODE_FLAG <-  ifelse(is.na(temp1$ENTRANCES_MODE), 0, 1)#NA-0,else-1
temp1$ENTRANCES_MODE<-ifelse(is.na(temp1$ENTRANCES_MODE), 0, temp1$ENTRANCES_MODE)
temp2$ENTRANCES_MODE<-parLapply(clus,X=temp2$ENTRANCES_MODE,fun=qrtEncode,dat=quantile(temp2$ENTRANCES_MODE, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$ENTRANCES_MODE<-unlist(temp2$ENTRANCES_MODE)

temp1$FLOORSMAX_MODE_FLAG <-  ifelse(is.na(temp1$FLOORSMAX_MODE), 0, 1)#NA-0,else-1
temp1$FLOORSMAX_MODE<-ifelse(is.na(temp1$FLOORSMAX_MODE), 0, temp1$FLOORSMAX_MODE)
temp2$FLOORSMAX_MODE<-parLapply(clus,X=temp2$FLOORSMAX_MODE,fun=qrtEncode,dat=quantile(temp2$FLOORSMAX_MODE, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$FLOORSMAX_MODE<-unlist(temp2$FLOORSMAX_MODE)

temp1$FLOORSMIN_MODE_FLAG <-  ifelse(is.na(temp1$FLOORSMIN_MODE), 0, 1)#NA-0,else-1
temp1$FLOORSMIN_MODE<-ifelse(is.na(temp1$FLOORSMIN_MODE), 0, temp1$FLOORSMIN_MODE)
temp2$FLOORSMIN_MODE<-parLapply(clus,X=temp2$FLOORSMIN_MODE,fun=qrtEncode,dat=quantile(temp2$FLOORSMIN_MODE, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$FLOORSMIN_MODE<-unlist(temp2$FLOORSMIN_MODE)

temp1$LANDAREA_MODE_FLAG <-  ifelse(is.na(temp1$LANDAREA_MODE), 0, 1)#NA-0,else-1
temp1$LANDAREA_MODE<-ifelse(is.na(temp1$LANDAREA_MODE), 0, temp1$LANDAREA_MODE)
temp2$LANDAREA_MODE<-parLapply(clus,X=temp2$LANDAREA_MODE,fun=qrtEncode,dat=quantile(temp2$LANDAREA_MODE, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$LANDAREA_MODE<-unlist(temp2$LANDAREA_MODE)

temp1$LIVINGAPARTMENTS_MODE_FLAG <-  ifelse(is.na(temp1$LIVINGAPARTMENTS_MODE), 0, 1)#NA-0,else-1
temp1$LIVINGAPARTMENTS_MODE<-ifelse(is.na(temp1$LIVINGAPARTMENTS_MODE), 0, temp1$LIVINGAPARTMENTS_MODE)
temp2$LIVINGAPARTMENTS_MODE<-parLapply(clus,X=temp2$LIVINGAPARTMENTS_MODE,fun=qrtEncode,dat=quantile(temp2$LIVINGAPARTMENTS_MODE, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$LIVINGAPARTMENTS_MODE<-unlist(temp2$LIVINGAPARTMENTS_MODE)

temp1$LIVINGAREA_MODE_FLAG <-  ifelse(is.na(temp1$LIVINGAREA_MODE), 0, 1)#NA-0,else-1
temp1$LIVINGAREA_MODE<-ifelse(is.na(temp1$LIVINGAREA_MODE), 0, temp1$LIVINGAREA_MODE)
temp2$LIVINGAREA_MODE<-parLapply(clus,X=temp2$LIVINGAREA_MODE,fun=qrtEncode,dat=quantile(temp2$LIVINGAREA_MODE, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$LIVINGAREA_MODE<-unlist(temp2$LIVINGAREA_MODE)

temp1$NONLIVINGAPARTMENTS_MODE <-ifelse(is.na(temp1$NONLIVINGAPARTMENTS_MODE), 0, 1)#have-1,NA-0,overwrite
temp2$NONLIVINGAPARTMENTS_MODE <-ifelse(is.na(temp2$NONLIVINGAPARTMENTS_MODE), 0, 1)#have-1,NA-0,overwrite

temp1$NONLIVINGAREA_MODE_FLAG <-  ifelse(is.na(temp1$NONLIVINGAREA_MODE), 0, 1)#NA-0,else-1
temp1$NONLIVINGAREA_MODE<-ifelse(is.na(temp1$NONLIVINGAREA_MODE), 0, temp1$NONLIVINGAREA_MODE)
temp2$NONLIVINGAREA_MODE<-parLapply(clus,X=temp2$NONLIVINGAREA_MODE,fun=ZeroEncode,dat=quantile(temp2$NONLIVINGAREA_MODE, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$NONLIVINGAREA_MODE<-unlist(temp2$NONLIVINGAREA_MODE)

# OWN_CAR_AGE
temp1$OWN_CAR_AGE <-  ifelse(is.na(temp1$OWN_CAR_AGE), 0, 1)#NA-0,else-1
temp1$OWN_CAR_AGE<-ifelse(is.na(temp1$OWN_CAR_AGE), 0, temp1$OWN_CAR_AGE)
temp2$OWN_CAR_AGE<-parLapply(clus,X=temp2$OWN_CAR_AGE,fun=ZeroEncode,dat=quantile(temp2$OWN_CAR_AGE, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$OWN_CAR_AGE<-unlist(temp2$OWN_CAR_AGE)


# EXT_SOURCE_2
temp1$EXT_SOURCE_1 <-  ifelse(is.na(temp1$EXT_SOURCE_1), 0, 1)#NA-0,else-1
temp1$EXT_SOURCE_1<-ifelse(is.na(temp1$EXT_SOURCE_1), 0, temp1$EXT_SOURCE_1)
temp2$EXT_SOURCE_1<-parLapply(clus,X=temp2$EXT_SOURCE_1,fun=qrtEncode,dat=quantile(temp2$EXT_SOURCE_1, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$EXT_SOURCE_1<-unlist(temp2$EXT_SOURCE_1)

temp1$EXT_SOURCE_2 <-  ifelse(is.na(temp1$EXT_SOURCE_2), 0, 1)#NA-0,else-1
temp1$EXT_SOURCE_2<-ifelse(is.na(temp1$EXT_SOURCE_2), 0, temp1$EXT_SOURCE_2)
temp2$EXT_SOURCE_2<-parLapply(clus,X=temp2$EXT_SOURCE_2,fun=qrtEncode,dat=quantile(temp2$EXT_SOURCE_2, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$EXT_SOURCE_2<-unlist(temp2$EXT_SOURCE_2)

temp1$EXT_SOURCE_3 <-  ifelse(is.na(temp1$EXT_SOURCE_3), 0, 1)#NA-0,else-1
temp1$EXT_SOURCE_3<-ifelse(is.na(temp1$EXT_SOURCE_3), 0, temp1$EXT_SOURCE_2)
temp2$EXT_SOURCE_3<-parLapply(clus,X=temp2$EXT_SOURCE_3,fun=qrtEncode,dat=quantile(temp2$EXT_SOURCE_3, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$EXT_SOURCE_3<-unlist(temp2$EXT_SOURCE_3)

temp1$TOTALAREA_MODE <-  ifelse(is.na(temp1$TOTALAREA_MODE), 0, 1)#NA-0,else-1
temp1$TOTALAREA_MODE<-ifelse(is.na(temp1$TOTALAREA_MODE), 0, temp1$TOTALAREA_MODE)
temp2$TOTALAREA_MODE<-parLapply(clus,X=temp2$TOTALAREA_MODE,fun=ZeroEncode,dat=quantile(temp2$TOTALAREA_MODE, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$TOTALAREA_MODE<-unlist(temp2$TOTALAREA_MODE)

temp1$AMT_REQ_CREDIT_BUREAU <-ifelse(is.na(temp1$AMT_REQ_CREDIT_BUREAU), 0, 1)#NA-0,else-1
temp1$AMT_REQ_CREDIT_BUREAU<-ifelse(is.na(temp1$AMT_REQ_CREDIT_BUREAU), 0, temp1$TOTALAREA_MODE)
temp2$AMT_REQ_CREDIT_BUREAU<-parLapply(clus,X=temp2$AMT_REQ_CREDIT_BUREAU,fun=qrtEncode,dat=quantile(temp2$AMT_REQ_CREDIT_BUREAU, prob = c(0.25,0.5,0.75),na.rm = T))
temp2$AMT_REQ_CREDIT_BUREAU<-unlist(temp2$AMT_REQ_CREDIT_BUREAU)

stopCluster(clus)
#output
dataLogisticModel<-temp1 ## linear data
data<-temp2 ## tree data
```

### Drop column FLAG_MOBIL

```{r}
data<-subset(data, select = -FLAG_MOBIL)
dataLogisticModel<-subset(dataLogisticModel, select = -FLAG_MOBIL)
```

### Deal with column FLAG_DOCUMENT

```{r warning=FALSE}
# Remove outliers
data<-subset(data, FLAG_DOCUMENT_2 == 0)
data<-subset(data, FLAG_DOCUMENT_4 == 0)
data<-subset(data, FLAG_DOCUMENT_7 == 0)
data<-subset(data, FLAG_DOCUMENT_10 == 0)
data<-subset(data, FLAG_DOCUMENT_12 == 0)
data<-subset(data, FLAG_DOCUMENT_17 == 0)
data<-subset(data, FLAG_DOCUMENT_19 == 0)
data<-subset(data, FLAG_DOCUMENT_20 == 0)
data<-subset(data, FLAG_DOCUMENT_21 == 0)

dataLogisticModel<-subset(dataLogisticModel, FLAG_DOCUMENT_2 == 0)
dataLogisticModel<-subset(dataLogisticModel, FLAG_DOCUMENT_4 == 0)
dataLogisticModel<-subset(dataLogisticModel, FLAG_DOCUMENT_7 == 0)
dataLogisticModel<-subset(dataLogisticModel, FLAG_DOCUMENT_10 == 0)
dataLogisticModel<-subset(dataLogisticModel, FLAG_DOCUMENT_12 == 0)
dataLogisticModel<-subset(dataLogisticModel, FLAG_DOCUMENT_17 == 0)
dataLogisticModel<-subset(dataLogisticModel, FLAG_DOCUMENT_19 == 0)
dataLogisticModel<-subset(dataLogisticModel, FLAG_DOCUMENT_20 == 0)
dataLogisticModel<-subset(dataLogisticModel, FLAG_DOCUMENT_21 == 0)

# Drop Column

data<-subset(data, select = -FLAG_DOCUMENT_2)
data<-subset(data, select = -FLAG_DOCUMENT_4)
data<-subset(data, select = -FLAG_DOCUMENT_7)
data<-subset(data, select = -FLAG_DOCUMENT_10)
data<-subset(data, select = -FLAG_DOCUMENT_12)
data<-subset(data, select = -FLAG_DOCUMENT_17)
data<-subset(data, select = -FLAG_DOCUMENT_19)
data<-subset(data, select = -FLAG_DOCUMENT_20)
data<-subset(data, select = -FLAG_DOCUMENT_21)

dataLogisticModel<-subset(dataLogisticModel, select = -FLAG_DOCUMENT_2)
dataLogisticModel<-subset(dataLogisticModel, select = -FLAG_DOCUMENT_4)
dataLogisticModel<-subset(dataLogisticModel, select = -FLAG_DOCUMENT_7)
dataLogisticModel<-subset(dataLogisticModel, select = -FLAG_DOCUMENT_10)
dataLogisticModel<-subset(dataLogisticModel, select = -FLAG_DOCUMENT_12)
dataLogisticModel<-subset(dataLogisticModel, select = -FLAG_DOCUMENT_17)
dataLogisticModel<-subset(dataLogisticModel, select = -FLAG_DOCUMENT_19)
dataLogisticModel<-subset(dataLogisticModel, select = -FLAG_DOCUMENT_20)
dataLogisticModel<-subset(dataLogisticModel, select = -FLAG_DOCUMENT_21)
```

## Using credit card data

```{r creditcard}

#input
temp1<-creditcard_data
temp2<- dataLogisticModel#logistic
temp3<-data #tree 
#note
#month balance- length of record
#amt balance - how many money need to pay the bank in the latest month
#amt limit actual - the max credit bank arpoved
#status - the last application status
#

credit_merge<-aggregate(temp1[c("MONTHS_BALANCE")],by=temp1["SK_ID_CURR"],FUN = length)
credit_merge$MAX_Month<-aggregate(temp1[c("MONTHS_BALANCE")],by=temp1["SK_ID_CURR"],FUN = max)[["MONTHS_BALANCE"]]
colnames(credit_merge)<-c("SK_ID_CURR","CREDIT_CARD_RECORD_COUNT","MONTHS_BALANCE")
credit_merge<-left_join(credit_merge,creditcard_data[c("SK_ID_CURR","MONTHS_BALANCE","AMT_BALANCE","AMT_CREDIT_LIMIT_ACTUAL","NAME_CONTRACT_STATUS")], by=c("SK_ID_CURR","MONTHS_BALANCE"))
credit_merge<-credit_merge[,-which(names(credit_merge)=="MONTHS_BALANCE")]
credit_merge$NAME_CONTRACT_STATUS<-ifelse(credit_merge$NAME_CONTRACT_STATUS%in%c("Active","Completed"),credit_merge$NAME_CONTRACT_STATUS,"Others")


##remove duplicate credit record
templist1<-credit_merge$SK_ID_CURR
n_occur <- data.frame(table(templist1))
n_occur[n_occur$Freq > 1,]
diff<-templist1[templist1 %in% n_occur$templist1[n_occur$Freq > 1]]
removeRow<-c()
for(i in diff){
  temploc<-as.numeric(rownames(subset(credit_merge,credit_merge$SK_ID_CURR%in% i)))
if(credit_merge[temploc[1],][["NAME_CONTRACT_STATUS"]]!=credit_merge[temploc[2],][["NAME_CONTRACT_STATUS"]]){
  if(credit_merge[temploc[1],][["NAME_CONTRACT_STATUS"]]=="Active"){
    removeRow<-c(removeRow,temploc[2])
  }else{
    removeRow<-c(removeRow,temploc[1])
  }
}else{
  if(credit_merge[temploc[1],][["AMT_CREDIT_LIMIT_ACTUAL"]]>credit_merge[temploc[2],][["AMT_CREDIT_LIMIT_ACTUAL"]]){
    removeRow<-c(removeRow,temploc[2])
  }else{
    removeRow<-c(removeRow,temploc[1])
  }
}
}
removeRow<-unique(removeRow)
credit_merge<-credit_merge[-removeRow,]



temp2<-left_join(temp2,credit_merge, by="SK_ID_CURR") 
temp3<-left_join(temp3,credit_merge, by="SK_ID_CURR") 

clus <- makeCluster(detectCores())
clusterExport(clus,"qrtEncode")
clusterExport(clus,"ZeroEncode")

temp2$CREDIT_CARD_RECORD_COUNTE_FLAG <-  ifelse(is.na(temp2$CREDIT_CARD_RECORD_COUNT), 0, 1)#NA-0,else-1
temp2$CREDIT_CARD_RECORD_COUNT<-ifelse(is.na(temp2$CREDIT_CARD_RECORD_COUNT), 0, temp2$CREDIT_CARD_RECORD_COUNT)
temp3$CREDIT_CARD_RECORD_COUNT <-parLapply(clus,X=temp3$CREDIT_CARD_RECORD_COUNT,fun=qrtEncode,dat=quantile(temp3$CREDIT_CARD_RECORD_COUNT, prob = c(0.25,0.5,0.75),na.rm = T))
temp3$CREDIT_CARD_RECORD_COUNT<-unlist(temp3$CREDIT_CARD_RECORD_COUNT)

temp2$AMT_BALANCE_FLAG <-  ifelse(is.na(temp2$AMT_BALANCE), 0, 1)#NA-0,else-1
temp2$AMT_BALANCE<-ifelse(is.na(temp2$AMT_BALANCE), 0, temp2$AMT_BALANCE)
temp3$AMT_BALANCE <-parLapply(clus,X=temp3$AMT_BALANCE,fun=ZeroEncode,dat=quantile(temp3$AMT_BALANCE, prob = c(0.25,0.5,0.75),na.rm = T))
temp3$AMT_BALANCE<-unlist(temp3$AMT_BALANCE)

temp2$AMT_CREDIT_LIMIT_ACTUAL_FLAG <-  ifelse(is.na(temp2$AMT_CREDIT_LIMIT_ACTUAL), 0, 1)#NA-0,else-1
temp2$AMT_CREDIT_LIMIT_ACTUAL<-ifelse(is.na(temp2$AMT_CREDIT_LIMIT_ACTUAL), 0, temp2$AMT_CREDIT_LIMIT_ACTUAL)
temp3$AMT_CREDIT_LIMIT_ACTUAL <-parLapply(clus,X=temp3$AMT_CREDIT_LIMIT_ACTUAL,fun=qrtEncode,dat=quantile(temp3$AMT_CREDIT_LIMIT_ACTUAL, prob = c(0.25,0.5,0.75),na.rm = T))
temp3$AMT_CREDIT_LIMIT_ACTUAL<-unlist(temp3$AMT_CREDIT_LIMIT_ACTUAL)

#active status is cat data,fill NA
temp2$NAME_CONTRACT_STATUS <-  ifelse(is.na(temp2$NAME_CONTRACT_STATUS), "NA", temp2$NAME_CONTRACT_STATUS)
temp3$NAME_CONTRACT_STATUS <-  ifelse(is.na(temp3$NAME_CONTRACT_STATUS), "NA", temp3$NAME_CONTRACT_STATUS)

#output
dataLogisticModel<-temp2
data<-temp3
```


### Using previous application data

```{r prevApp}
#input
temp1<-previous_data
temp2<-dataLogisticModel #logistic
temp3<-data #tree 
#note
#month balance- length of record
#amt balance - how many money need to pay the bank in the latest month
#amt limit actual - the max credit bank arpoved
#status - the last application status
#
temp1<- subset(temp1,temp1$FLAG_LAST_APPL_PER_CONTRACT=="Y"&temp1$NFLAG_LAST_APPL_IN_DAY==1)

preapp_merge<-aggregate(temp1[c("NAME_CONTRACT_TYPE")],by=temp1["SK_ID_CURR"],FUN = length)
colnames(preapp_merge)<-c("SK_ID_CURR","PREV_RECORD_COUNT")

clus <- makeCluster(detectCores())
clusterExport(clus,"qrtEncode")
clusterExport(clus,"ZeroEncode")

#####Cash loans
temp<-subset(temp1,temp1$NAME_CONTRACT_TYPE=="Cash loans")
temp4<-aggregate(temp[c("NAME_CONTRACT_TYPE")],by=temp["SK_ID_CURR"],FUN = length)

temp5<-aggregate(temp[c("SK_ID_PREV")],by=temp[c("SK_ID_CURR","NAME_CONTRACT_STATUS")],FUN = length)
#approved
temp6<-subset(temp5,temp5$NAME_CONTRACT_STATUS=="Approved")
temp6<-temp6[,-which(names(temp6)=="NAME_CONTRACT_STATUS")]
colnames(temp6)<-c("SK_ID_CURR","APPROVED_COUNT")
temp4<-left_join(temp4,temp6,by="SK_ID_CURR" )
#refused
temp6<-subset(temp5,temp5$NAME_CONTRACT_STATUS=="Refused")
temp6<-temp6[,-which(names(temp6)=="NAME_CONTRACT_STATUS")]
colnames(temp6)<-c("SK_ID_CURR","REFUSED_COUNT")
temp4<-left_join(temp4,temp6,by="SK_ID_CURR" )
#unused
temp6<-subset(temp5,temp5$NAME_CONTRACT_STATUS=="Unused offer")
temp6<-temp6[,-which(names(temp6)=="NAME_CONTRACT_STATUS")]
colnames(temp6)<-c("SK_ID_CURR","UNUSED_COUNT")
temp4<-left_join(temp4,temp6,by="SK_ID_CURR" )

colnames(temp4)<-c("SK_ID_CURR","CASH_LOANS_COUNT","APPROVE_COUNT","REFUSED_COUNT","UNUSED_COUNT")
temp4$CASH_LOANS_COUNT<-ifelse(is.na(temp4$APPROVE_COUNT),0,temp4$APPROVE_COUNT)+ifelse(is.na(temp4$REFUSED_COUNT),0,temp4$REFUSED_COUNT)+ifelse(is.na(temp4$UNUSED_COUNT),0,temp4$UNUSED_COUNT)
temp4$APPROVE_COUNT<-ifelse(is.na(temp4$APPROVE_COUNT),0,temp4$APPROVE_COUNT)+ifelse(is.na(temp4$UNUSED_COUNT),0,temp4$UNUSED_COUNT)
temp4$APPROVE_COUNT<-ifelse(is.na(temp4$APPROVE_COUNT),0,temp4$APPROVE_COUNT)/temp4$CASH_LOANS_COUNT
temp4$APPROVE_COUNT<-ifelse(is.nan(temp4$APPROVE_COUNT),NA,temp4$APPROVE_COUNT)
colnames(temp4)<-c("SK_ID_CURR","CASH_LOANS_COUNT","CASH_LOANS_APPROVE_RATE")
temp4<-temp4[,1:3]
preapp_merge<-left_join(preapp_merge,temp4, by="SK_ID_CURR") 
preapp_merge$CASH_LOANS_COUNT<-ifelse(is.na(preapp_merge$CASH_LOANS_COUNT),0,preapp_merge$CASH_LOANS_COUNT)
####

####Consumer loans
temp<-subset(temp1,temp1$NAME_CONTRACT_TYPE=="Consumer loans")
temp4<-aggregate(temp[c("NAME_CONTRACT_TYPE")],by=temp["SK_ID_CURR"],FUN = length)

temp5<-aggregate(temp[c("SK_ID_PREV")],by=temp[c("SK_ID_CURR","NAME_CONTRACT_STATUS")],FUN = length)
#approved
temp6<-subset(temp5,temp5$NAME_CONTRACT_STATUS=="Approved")
temp6<-temp6[,-which(names(temp6)=="NAME_CONTRACT_STATUS")]
colnames(temp6)<-c("SK_ID_CURR","APPROVED_COUNT")
temp4<-left_join(temp4,temp6,by="SK_ID_CURR" )
#refused
temp6<-subset(temp5,temp5$NAME_CONTRACT_STATUS=="Refused")
temp6<-temp6[,-which(names(temp6)=="NAME_CONTRACT_STATUS")]
colnames(temp6)<-c("SK_ID_CURR","REFUSED_COUNT")
temp4<-left_join(temp4,temp6,by="SK_ID_CURR" )
#unused
temp6<-subset(temp5,temp5$NAME_CONTRACT_STATUS=="Unused offer")
temp6<-temp6[,-which(names(temp6)=="NAME_CONTRACT_STATUS")]
colnames(temp6)<-c("SK_ID_CURR","UNUSED_COUNT")
temp4<-left_join(temp4,temp6,by="SK_ID_CURR" )

colnames(temp4)<-c("SK_ID_CURR","COMSUMER_LOANS_COUNT","APPROVE_COUNT","REFUSED_COUNT","UNUSED_COUNT")
temp4$COMSUMER_LOANS_COUNT<-ifelse(is.na(temp4$APPROVE_COUNT),0,temp4$APPROVE_COUNT)+ifelse(is.na(temp4$REFUSED_COUNT),0,temp4$REFUSED_COUNT)+ifelse(is.na(temp4$UNUSED_COUNT),0,temp4$UNUSED_COUNT)
temp4$APPROVE_COUNT<-ifelse(is.na(temp4$APPROVE_COUNT),0,temp4$APPROVE_COUNT)+ifelse(is.na(temp4$UNUSED_COUNT),0,temp4$UNUSED_COUNT)
temp4$APPROVE_COUNT<-ifelse(is.na(temp4$APPROVE_COUNT),0,temp4$APPROVE_COUNT)/temp4$COMSUMER_LOANS_COUNT
temp4$APPROVE_COUNT<-ifelse(is.nan(temp4$APPROVE_COUNT),NA,temp4$APPROVE_COUNT)
colnames(temp4)<-c("SK_ID_CURR","COMSUMER_LOANS_COUNT","CONSUMER_LOANS_APPROVE_RATE")
temp4<-temp4[,1:3]
preapp_merge<-left_join(preapp_merge,temp4, by="SK_ID_CURR") 
preapp_merge$COMSUMER_LOANS_COUNT<-ifelse(is.na(preapp_merge$COMSUMER_LOANS_COUNT),0,preapp_merge$COMSUMER_LOANS_COUNT)

##Revolving loans
temp<-subset(temp1,temp1$NAME_CONTRACT_TYPE=="Revolving loans")
temp4<-aggregate(temp[c("NAME_CONTRACT_TYPE")],by=temp["SK_ID_CURR"],FUN = length)

temp5<-aggregate(temp[c("SK_ID_PREV")],by=temp[c("SK_ID_CURR","NAME_CONTRACT_STATUS")],FUN = length)
#approved
temp6<-subset(temp5,temp5$NAME_CONTRACT_STATUS=="Approved")
temp6<-temp6[,-which(names(temp6)=="NAME_CONTRACT_STATUS")]
colnames(temp6)<-c("SK_ID_CURR","APPROVED_COUNT")
temp4<-left_join(temp4,temp6,by="SK_ID_CURR" )
#refused
temp6<-subset(temp5,temp5$NAME_CONTRACT_STATUS=="Refused")
temp6<-temp6[,-which(names(temp6)=="NAME_CONTRACT_STATUS")]
colnames(temp6)<-c("SK_ID_CURR","REFUSED_COUNT")
temp4<-left_join(temp4,temp6,by="SK_ID_CURR" )
#unused
temp6<-subset(temp5,temp5$NAME_CONTRACT_STATUS=="Unused offer")
temp6<-temp6[,-which(names(temp6)=="NAME_CONTRACT_STATUS")]
colnames(temp6)<-c("SK_ID_CURR","UNUSED_COUNT")
temp4<-left_join(temp4,temp6,by="SK_ID_CURR" )

colnames(temp4)<-c("SK_ID_CURR","REVOLVING_LOANS_COUNT","APPROVE_COUNT","REFUSED_COUNT","UNUSED_COUNT")
temp4$REVOLVING_LOANS_COUNT<-ifelse(is.na(temp4$APPROVE_COUNT),0,temp4$APPROVE_COUNT)+ifelse(is.na(temp4$REFUSED_COUNT),0,temp4$REFUSED_COUNT)+ifelse(is.na(temp4$UNUSED_COUNT),0,temp4$UNUSED_COUNT)
temp4$APPROVE_COUNT<-ifelse(is.na(temp4$APPROVE_COUNT),0,temp4$APPROVE_COUNT)+ifelse(is.na(temp4$UNUSED_COUNT),0,temp4$UNUSED_COUNT)
temp4$APPROVE_COUNT<-ifelse(is.na(temp4$APPROVE_COUNT),0,temp4$APPROVE_COUNT)/temp4$REVOLVING_LOANS_COUNT
temp4$APPROVE_COUNT<-ifelse(is.nan(temp4$APPROVE_COUNT),NA,temp4$APPROVE_COUNT)
colnames(temp4)<-c("SK_ID_CURR","REVOLVING_LOANS_COUNT","REVOLVING_LOANS_APPROVE_RATE")
temp4<-temp4[,1:3]
preapp_merge<-left_join(preapp_merge,temp4, by="SK_ID_CURR") 
preapp_merge$REVOLVING_LOANS_COUNT<-ifelse(is.na(preapp_merge$REVOLVING_LOANS_COUNT),0,preapp_merge$REVOLVING_LOANS_COUNT)

temp4<-aggregate(temp1[c("CNT_PAYMENT")],by=temp1["SK_ID_CURR"],FUN = mean)
colnames(temp4)<-c("SK_ID_CURR","CNT_PAYMENT_AVG")
preapp_merge<-left_join(preapp_merge,temp4, by="SK_ID_CURR") 

temp2<-left_join(temp2,preapp_merge, by="SK_ID_CURR") #linear
temp3<-left_join(temp3,preapp_merge, by="SK_ID_CURR") ##tree

for (i in c("PREV_RECORD_COUNT", "CASH_LOANS_COUNT","CASH_LOANS_APPROVE_RATE","COMSUMER_LOANS_COUNT" ,"CONSUMER_LOANS_APPROVE_RATE","REVOLVING_LOANS_COUNT","REVOLVING_LOANS_APPROVE_RATE")){
  temp2[[i]] <-ifelse(is.na(temp2[[i]]), 0, 1)#have-1,NA-0,overwrite
temp3[[i]] <-ifelse(is.na(temp3[[i]]), 0, 1)#have-1,NA-0,overwrite
}

temp2$CNT_PAYMENT_AVG_FLAG <-  ifelse(is.na(temp2$CNT_PAYMENT_AVG), 0, 1)#NA-0,else-1
temp2$CNT_PAYMENT_AVG<-ifelse(is.na(temp2$CNT_PAYMENT_AVG), 0, temp2$CNT_PAYMENT_AVG)

temp3$CNT_PAYMENT_AVG<-parLapply(clus,X=temp3$CNT_PAYMENT_AVG,fun=qrtEncode,dat=quantile(temp3$CNT_PAYMENT_AVG, prob = c(0.25,0.5,0.75),na.rm = T))
temp3$CNT_PAYMENT_AVG<-unlist(temp3$CNT_PAYMENT_AVG)

dataLogisticModel<-temp2 #logistic
data<-temp3 #tree 
```

## 1.4 Encoding Categorical Variables

```{r}
#Dummification of categorical variables logistic model

WRTENABLE= F
dataLogisticModel$TARGET<-as.numeric(dataLogisticModel$TARGET)
dataDummyLogistic <- dummyVars("~.",data=dataLogisticModel, fullRank=F)
data.dummified.logistic <- as.data.frame(predict(dataDummyLogistic,dataLogisticModel))
data.dummified.logistic$TARGET <- as.factor(data.dummified.logistic$TARGET)
if(WRTENABLE){
  data.raw.dummy<-write.csv(data.dummified.logistic,file="data.dummified.logistic.csv") 
}

##Dummification of categorical variables tree model

data$TARGET<-as.numeric(data$TARGET)
dataDummy <- dummyVars("~.",data=data, fullRank=F)
data.dummified <- as.data.frame(predict(dataDummy,data))
data.dummified$TARGET <- as.factor(data.dummified$TARGET)

if(WRTENABLE){
  data.raw.dummy<-write.csv(data.dummified,file="data.dummified.csv")
}
#Fixing dummified variables' names
names(data.dummified.logistic)<-make.names(names(data.dummified.logistic),unique = TRUE)
names(data.dummified)<-make.names(names(data.dummified),unique = TRUE)
```

# PART II: Model

## 2.1 Logistic Regression

```{r}
outcomeName <- "TARGET"
predictorNames <- names(data.dummified.logistic)[names(data.dummified.logistic) != outcomeName]
predictorNames

set.seed(1234)  # setting seed to reproduce results of random sampling
split<-(.80)
trainingRowIndex <- sample(1:nrow(data.dummified.logistic),(split)*nrow(data.dummified.logistic))  # row indices for training data
trainingData <- data.dummified.logistic[trainingRowIndex, ]  # model training data
testData  <- data.dummified.logistic[-trainingRowIndex, ]   # test data


#Model
model <- as.formula(paste("TARGET~", paste(names(trainingData[-2]), 
                                           collapse="+")))
target.lm <- glm(model, data=trainingData, family = binomial(link = "logit"))  # build the model
# Review diagnostic measures
summary(target.lm)

# Step 3: Calculate prediction accuracy and error rates
response<- ifelse(predict(target.lm, testData, type = "response")>.5, 1, 0) 
class(response)
confusionMatrix(table(response,testData$TARGET))


##Balancing Data
train.both<-ovun.sample(model, data = trainingData, method = "both", N= 22792)$data
prop.table(table(train.both$TARGET))


targetBalanced.lm<- glm(model, data=train.both, family = binomial(link = "logit"))  # build the model with the balanced data

responseBalanced<- ifelse(predict(targetBalanced.lm, testData, type = "response")>.5,1,0)
responseBalanced
length(responseBalanced)
table(responseBalanced,testData$TARGET)
confusionMatrix(table(responseBalanced, testData$TARGET))


save(model,file = "LogisticModel.Rdata")

```

## 2.2 Random Forest with Boosting

```{r}
cl<-makeCluster(5)
registerDoParallel(cl)

# Selecting data to train and test
outcomeName <- "TARGET"
predictorNames <- names(data.dummified)[names(data.dummified) != outcomeName]
predictorNames

set.seed(1234)  # setting seed to reproduce results of random sampling
split<-(.80)
trainingRowIndex <- sample(1:nrow(data.dummified),(split)*nrow(data.dummified))  # row indices for training data
trainingDataGBM <- data.dummified[trainingRowIndex, ]  # model training data
testDataGBM  <- data.dummified[-trainingRowIndex, ]   # test data


gbm<-train(trainingDataGBM[,predictorNames],trainingDataGBM[,outcomeName],
                 method='gbm',
                trControl=trainControl())

# # summarizing the model

gbmImp<-varImp(gbm) #generates error.  run with line below
plot(gbmImp, top=20)

# measuring performance
gbm.predict<-predict(gbm,testDataGBM[,predictorNames],type="raw")
gbm.predict
confusionMatrix(table(gbm.predict,testDataGBM$TARGET))

# draw ROC curve and perform visual check for better accurancy/performacen


gbm.probs <- predict(gbm,testDataGBM[-2],type="prob")
gbm.plot<-plot(roc(testDataGBM$TARGET,gbm.probs[,2]))
legend("bottomright", legend=c("rf", "gbm","logistic unbalanced","logistic balanced"), col=c("blue", "black","purple","green"), lwd=2)

#Model tuning
fitControl.gbm <- trainControl(method = "cv",
                           number = 20,
                           sampling = "up")   # control parameters for training
                                              # see help(trainControl) for details

gbm.tuned<-train(trainingDataGBM [,predictorNames],trainingDataGBM[,outcomeName],   #model retraining
           method='gbm',
           trControl=fitControl.gbm)

# measuring performance
gbm.tuned.predict<-predict(gbm.tuned,testDataGBM[,predictorNames],type="raw")
confusionMatrix(table(gbm.tuned.predict,testDataGBM$TARGET))
gbm.tuned.probs <- predict(gbm.tuned,testDataGBM[,predictorNames],type="prob")
gbmImpTuned<-varImp(gbm.tuned) #generates error.  run with line below
plot(gbmImpTuned, top=20)

# gbm.tuned.plot<-lines(roc(testDataGBM$TARGET,gbm.tuned.probs[,2]), col="red")
# legend("bottomright", legend=c("rf", "gbm", "gbm.tuned"), col=c("blue", "black", "red"), lwd=2)

save(gbm,file = "gbmModel.Rdata")

stopImplicitCluster()
```

## 2.3 LGBM model setup,training& save

```{r}

temp1<-data

#over sample
for ( i in colnames(temp1)){
  if(!is.numeric(temp1[[i]])){
    temp1[[i]]<-as.factor(temp1[[i]])
  }
}
temp1 <- ROSE(TARGET~., data=temp1,N = 540000, seed=1)$data

##model


Target <- temp1$TARGET
temp1[,c('SK_ID_CURR','TARGET')] <- NULL

train <- temp1[1:length(Target),]

inTrain <- createDataPartition(Target, p=.8, list = F)

tr <- train[inTrain,]
va <- train[-inTrain,]
tr_ta <- Target[inTrain]
va_ta <- Target[-inTrain]

lgb.train = lgb.Dataset(data.matrix(tr), label = tr_ta)
lgb.valid = lgb.Dataset(data.matrix(va), label = va_ta)

lgb.params<- list(objective = "binary",
                  metric = "auc",
                  num_leaves = 32,
                  max_depth=8,
                  num_threads = detectCores(),
                  min_data_in_leaf = 10,
                  min_sum_hessian_in_leaf = 40,
                  feature_fraction = 0.95,
                  bagging_fraction = 0.87,
                  bagging_freq = 0,
                  lambda_l1 = 0.04, 
                  lambda_l2 = 0.073,
                  min_gain_to_split=0.02
                  )

lgb.model <- lgb.train(params = lgb.params,
                       data = lgb.train,
                       valids = list(val = lgb.valid),
                       learning_rate = 0.02,
                       nrounds = 3000,
                       early_stopping_rounds = 200,
                       eval_freq = 50
                       )

# Make prediction
lgb_pred <- predict(lgb.model, data = data.matrix(temp1), n = lgb.model$best_iter)
lgb_pred<-ifelse(lgb_pred>0.5,1,0)
confusionMatrix(table(lgb_pred, Target))
LGBImportance = lgb.importance(lgb.model, percentage = TRUE)
lgb.importance(lgb.model, percentage = TRUE) %>% head(20) %>% print()
varImportance <- data.frame(Variables = LGBImportance$Feature, 
                            Importance = LGBImportance$Gain)
# Create a rank variable based on importance
rankImportance <- varImportance %>%
  mutate(Rank = paste0('#',dense_rank(desc(Importance)))) %>%
  head(30)
rankImportancefull = rankImportance
ggplot(rankImportance, aes(x = reorder(Variables, Importance), 
                           y = Importance)) +
  geom_bar(stat='identity',colour="white", fill = "#F1C40F") +
  geom_text(aes(x = Variables, y = 0.1, label = Rank),
            hjust=0, vjust=.5, size = 4, colour = 'black',
            fontface = 'bold') +
  labs(x = 'Variables', title = 'Relative Variable Importance') +
  coord_flip() + 
  theme_bw()

##roc plot

gbm.probs <- predict(lgb.model, data = data.matrix(full))
gbm.plot<-plot(roc(Target,gbm.probs))


##save model

save(lgb.model,file = "lgbmModel.Rdata")
```

## 2.4 Support Vector Machine

### Applying k-Fold Cross Validation

```{r}
# Multi thread
cl<-makeCluster(5)
registerDoParallel(cl)

# Create the folds we specify the target feature
folds = createFolds(training_set$TARGET, k = 10)

svm = lapply(folds, function(x) { 
  # Separate the Training set into it's 10 pieces
  training_fold = training_set[-x, ] # training fold =  training set minus (-) it's sub test fold
  testing_fold = training_set[x, ] 
  
  # apply (train) the classifer on the training_fold
  classifier = svm(formula = TARGET ~ .,
                   data = training_fold,
                   type = 'C-classification',
                   kernel = 'radial')
  
  # calculate the predictions and cm and we equate the accuracy
  y_pred = predict(classifier, newdata = testing_fold[-1])
  cm = table(testing_fold[, 1], y_pred)
  accuracy = (cm[1,1] + cm[2,2]) / (cm[1,1] + cm[2,2] + cm[1,2] + cm[2,1])
  return(accuracy)
})

stopImplicitCluster()
```

### For CV we can see we have 10 folds/iterations each with slight variations of accuracy.

```{r}
knitr::include_graphics("svm.png")
```

### Calculate the mean of accuracy

```{r}
accuracy = mean(as.numeric(svm))
accuracy
```