Target Feature

The response feature is income which is given

The target feature has two classes and hence it is a binary classification problem. To reiterate, The goal is to predict whether a person subcribe a deposit.

Descriptive Features

The variable description is produced here from bank.name file:

• age: numeric
• workclass: ype of job (categorical: “admin.”,“unknown”,“unemployed”,“management”,“housemaid”,“entrepreneur”, “student”, “blue-collar”,“self-employed”,“retired”,“technician”,“services”)
• marital : marital status (categorical: “married”,“divorced”,“single”; note: “divorced” means divorced or widowed)
• education (categorical: “unknown”,“secondary”,“primary”,“tertiary”)
• default: has credit in default? (binary: “yes”,“no”)
• balance: average yearly balance, in euros (numeric)
• housing: has housing loan? (binary: “yes”,“no”)
• loan: has personal loan? (binary: “yes”,“no”)
• contact: contact communication type (categorical: “unknown”,“telephone”,“cellular”)
• sex: Female, Male.day: last contact day of the month (numeric)
• month: last contact month of year (categorical: “jan”, “feb”, “mar”, …, “nov”, “dec”)
• duration: last contact duration, in seconds (numeric)
• campaign: number of contacts performed during this campaign and for this client (numeric, includes last contact)
• pdays: number of days that passed by after the client was last contacted from a previous campaign (numeric, -1 means client was not previously contacted)
• previous: number of contacts performed before this campaign and for this client (numeric)
• poutcome: outcome of the previous marketing campaign (categorical: “unknown”,“other”,“failure”,“success”)

Preliminaries

In this project, we used the following R packages.

bank <- read.csv("~/Downloads/bank.csv", stringsAsFactors = FALSE,
                 header = TRUE, sep = ';')

Data Cleaning

str(bank)

## 'data.frame':    4521 obs. of  17 variables:
##  $ age      : int  30 33 35 30 59 35 36 39 41 43 ...
##  $ job      : chr  "unemployed" "services" "management" "management" ...
##  $ marital  : chr  "married" "married" "single" "married" ...
##  $ education: chr  "primary" "secondary" "tertiary" "tertiary" ...
##  $ default  : chr  "no" "no" "no" "no" ...
##  $ balance  : int  1787 4789 1350 1476 0 747 307 147 221 -88 ...
##  $ housing  : chr  "no" "yes" "yes" "yes" ...
##  $ loan     : chr  "no" "yes" "no" "yes" ...
##  $ contact  : chr  "cellular" "cellular" "cellular" "unknown" ...
##  $ day      : int  19 11 16 3 5 23 14 6 14 17 ...
##  $ month    : chr  "oct" "may" "apr" "jun" ...
##  $ duration : int  79 220 185 199 226 141 341 151 57 313 ...
##  $ campaign : int  1 1 1 4 1 2 1 2 2 1 ...
##  $ pdays    : int  -1 339 330 -1 -1 176 330 -1 -1 147 ...
##  $ previous : int  0 4 1 0 0 3 2 0 0 2 ...
##  $ poutcome : chr  "unknown" "failure" "failure" "unknown" ...
##  $ y        : chr  "no" "no" "no" "no" ...

summarizeColumns(bank) %>% knitr::kable( caption = 'Feature Summary before Data Preprocessing')

We removed the excessive white spaces for all character features.

bank[, sapply( bank, is.character )] <- sapply( bank[,sapply(bank, is.character )], trimws) 
## remove exessive white spaces
table(bank$y)

## 
##   no  yes 
## 4000  521

It seems to me that the origional data is pretty clean and has no missing variable. Now we are going to an interesting part: Visualisation.

Quick Visualization

• Box plot for age:

boxplot( data= bank, bank$age, col = "darkblue") 

• Distribution of age:

ggplot(bank, aes(x=age)) + 
  geom_histogram(aes(y=..density..), colour="grey", fill="lightblue", linetype="dashed")+
  geom_density(alpha=.2, fill="#FF6666")+ 
  geom_vline(aes(xintercept= mean(age)), color="blue", linetype="dashed", size=1)

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

• Box plot for duration:

boxplot( data= bank, bank$duration, col = "darkblue",boxwex = 0.75) 

• Histogram for duration:

ggplot(bank, aes(x=duration)) + 
  geom_histogram(aes(y=..density..), colour="grey", fill="lightblue", linetype="dashed")+
  geom_density(alpha=.2)+ 
  geom_vline(aes(xintercept= mean(duration)), color="blue",
             linetype="dashed", size=1)

## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

• Histogram for duration with deposit

ggplot(bank, aes(x=duration, fill=y)) + geom_density(alpha=.3)

• Explore the people who made a deposit and job category:

NROW(na.omit(bank))

## [1] 4521

bank %>%
  group_by(job) %>%
  summarise(
    count = sum(y == 'yes')) 

## # A tibble: 12 x 2
##    job           count
##    <chr>         <int>
##  1 admin.           58
##  2 blue-collar      69
##  3 entrepreneur     15
##  4 housemaid        14
##  5 management      131
##  6 retired          54
##  7 self-employed    20
##  8 services         38
##  9 student          19
## 10 technician       83
## 11 unemployed       13
## 12 unknown           7

From here, I would like to combine similar jobs into categories. In which: - admin. and management will be white-collar; - services and housemaid will be pink-collar; - retired and student, uneployed, unknown will be other;

bank$job <- as.character(bank$job)
bank$job[bank$job %in% c("admin.","management")] <- "white-collar"
bank$job[bank$job %in% c('services','housemaid')] <- "pink-collar"
bank$job[bank$job %in% c('retired', 'student', 'unemployed', 'unknown')] <- "other"
head(bank)

##   age          job marital education default balance housing loan  contact
## 1  30        other married   primary      no    1787      no   no cellular
## 2  33  pink-collar married secondary      no    4789     yes  yes cellular
## 3  35 white-collar  single  tertiary      no    1350     yes   no cellular
## 4  30 white-collar married  tertiary      no    1476     yes  yes  unknown
## 5  59  blue-collar married secondary      no       0     yes   no  unknown
## 6  35 white-collar  single  tertiary      no     747      no   no cellular
##   day month duration campaign pdays previous poutcome  y
## 1  19   oct       79        1    -1        0  unknown no
## 2  11   may      220        1   339        4  failure no
## 3  16   apr      185        1   330        1  failure no
## 4   3   jun      199        4    -1        0  unknown no
## 5   5   may      226        1    -1        0  unknown no
## 6  23   feb      141        2   176        3  failure no

bank$job <- factor(bank$job)
bank %>%
  group_by(job) %>%
  summarise(
    count = sum(y == 'yes')) 

## # A tibble: 7 x 2
##   job           count
##   <fct>         <int>
## 1 blue-collar      69
## 2 entrepreneur     15
## 3 other            93
## 4 pink-collar      52
## 5 self-employed    20
## 6 technician       83
## 7 white-collar    189

Data transformation

bank$poutcome <- as.character(bank$poutcome)
bank$poutcome[bank$poutcome %in% c("other")] <- "unknown"
head(bank$poutcome)

## [1] "unknown" "failure" "failure" "unknown" "unknown" "failure"

bank$default<-ifelse(bank$default =="yes", 1,0)
bank$housing<-ifelse(bank$housing =='yes', 1,0)
bank$loan<-ifelse(bank$loan=='yes', 1,0)
bank$y <- ifelse(bank$y == 'yes', 1, 0)
head(bank)

##   age          job marital education default balance housing loan  contact
## 1  30        other married   primary       0    1787       0    0 cellular
## 2  33  pink-collar married secondary       0    4789       1    1 cellular
## 3  35 white-collar  single  tertiary       0    1350       1    0 cellular
## 4  30 white-collar married  tertiary       0    1476       1    1  unknown
## 5  59  blue-collar married secondary       0       0       1    0  unknown
## 6  35 white-collar  single  tertiary       0     747       0    0 cellular
##   day month duration campaign pdays previous poutcome y
## 1  19   oct       79        1    -1        0  unknown 0
## 2  11   may      220        1   339        4  failure 0
## 3  16   apr      185        1   330        1  failure 0
## 4   3   jun      199        4    -1        0  unknown 0
## 5   5   may      226        1    -1        0  unknown 0
## 6  23   feb      141        2   176        3  failure 0

bank$day <- NULL
bank$month <- NULL
bank$contact <- NULL

# Create a copy of processed bank data
bank_origional <- bank

Data Visualisation in the whole population

bankcp<- bank # Create a copy of dummy data

corr <- cor(bank) # Create a matrix of correlation

heatmap(corr, Rowv = NA, Colv = NA)

smp_size <- floor(0.8*nrow(bank))
set.seed(123)
train_index <- sample(seq(nrow(bank)), size = smp_size)

train <- bank[train_index, ]
test <- bank[-train_index, ]