DATASET OVERVIEW AND QUALITY ASSESSMENT
# Read the CSV file; using sep=";" based on the dataset documentation
bank <- read.csv("bank-additional-full.csv", sep = ";", stringsAsFactors = TRUE)
# Examine the structure and variables to understand data types
str(bank)
## 'data.frame': 41188 obs. of 21 variables:
## $ age : int 56 57 37 40 56 45 59 41 24 25 ...
## $ job : Factor w/ 12 levels "admin.","blue-collar",..: 4 8 8 1 8 8 1 2 10 8 ...
## $ marital : Factor w/ 4 levels "divorced","married",..: 2 2 2 2 2 2 2 2 3 3 ...
## $ education : Factor w/ 8 levels "basic.4y","basic.6y",..: 1 4 4 2 4 3 6 8 6 4 ...
## $ default : Factor w/ 3 levels "no","unknown",..: 1 2 1 1 1 2 1 2 1 1 ...
## $ housing : Factor w/ 3 levels "no","unknown",..: 1 1 3 1 1 1 1 1 3 3 ...
## $ loan : Factor w/ 3 levels "no","unknown",..: 1 1 1 1 3 1 1 1 1 1 ...
## $ contact : Factor w/ 2 levels "cellular","telephone": 2 2 2 2 2 2 2 2 2 2 ...
## $ month : Factor w/ 10 levels "apr","aug","dec",..: 7 7 7 7 7 7 7 7 7 7 ...
## $ day_of_week : Factor w/ 5 levels "fri","mon","thu",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ duration : int 261 149 226 151 307 198 139 217 380 50 ...
## $ campaign : int 1 1 1 1 1 1 1 1 1 1 ...
## $ pdays : int 999 999 999 999 999 999 999 999 999 999 ...
## $ previous : int 0 0 0 0 0 0 0 0 0 0 ...
## $ poutcome : Factor w/ 3 levels "failure","nonexistent",..: 2 2 2 2 2 2 2 2 2 2 ...
## $ emp.var.rate : num 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 1.1 ...
## $ cons.price.idx: num 94 94 94 94 94 ...
## $ cons.conf.idx : num -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 -36.4 ...
## $ euribor3m : num 4.86 4.86 4.86 4.86 4.86 ...
## $ nr.employed : num 5191 5191 5191 5191 5191 ...
## $ y : Factor w/ 2 levels "no","yes": 1 1 1 1 1 1 1 1 1 1 ...
# Display summary statistics to evaluate central tendency, spread, and missing values
summary(bank)
## age job marital
## Min. :17.00 admin. :10422 divorced: 4612
## 1st Qu.:32.00 blue-collar: 9254 married :24928
## Median :38.00 technician : 6743 single :11568
## Mean :40.02 services : 3969 unknown : 80
## 3rd Qu.:47.00 management : 2924
## Max. :98.00 retired : 1720
## (Other) : 6156
## education default housing loan
## university.degree :12168 no :32588 no :18622 no :33950
## high.school : 9515 unknown: 8597 unknown: 990 unknown: 990
## basic.9y : 6045 yes : 3 yes :21576 yes : 6248
## professional.course: 5243
## basic.4y : 4176
## basic.6y : 2292
## (Other) : 1749
## contact month day_of_week duration
## cellular :26144 may :13769 fri:7827 Min. : 0.0
## telephone:15044 jul : 7174 mon:8514 1st Qu.: 102.0
## aug : 6178 thu:8623 Median : 180.0
## jun : 5318 tue:8090 Mean : 258.3
## nov : 4101 wed:8134 3rd Qu.: 319.0
## apr : 2632 Max. :4918.0
## (Other): 2016
## campaign pdays previous poutcome
## Min. : 1.000 Min. : 0.0 Min. :0.000 failure : 4252
## 1st Qu.: 1.000 1st Qu.:999.0 1st Qu.:0.000 nonexistent:35563
## Median : 2.000 Median :999.0 Median :0.000 success : 1373
## Mean : 2.568 Mean :962.5 Mean :0.173
## 3rd Qu.: 3.000 3rd Qu.:999.0 3rd Qu.:0.000
## Max. :56.000 Max. :999.0 Max. :7.000
##
## emp.var.rate cons.price.idx cons.conf.idx euribor3m
## Min. :-3.40000 Min. :92.20 Min. :-50.8 Min. :0.634
## 1st Qu.:-1.80000 1st Qu.:93.08 1st Qu.:-42.7 1st Qu.:1.344
## Median : 1.10000 Median :93.75 Median :-41.8 Median :4.857
## Mean : 0.08189 Mean :93.58 Mean :-40.5 Mean :3.621
## 3rd Qu.: 1.40000 3rd Qu.:93.99 3rd Qu.:-36.4 3rd Qu.:4.961
## Max. : 1.40000 Max. :94.77 Max. :-26.9 Max. :5.045
##
## nr.employed y
## Min. :4964 no :36548
## 1st Qu.:5099 yes: 4640
## Median :5191
## Mean :5167
## 3rd Qu.:5228
## Max. :5228
##
# Check the distribution of the target variable 'y' to confirm class imbalance
prop.table(table(bank$y))
##
## no yes
## 0.8873458 0.1126542
EXPLORATORY DATA ANALYSIS (EDA)
# Identify missing/unknown values in categorical features
table(bank$job, useNA = "ifany")
##
## admin. blue-collar entrepreneur housemaid management
## 10422 9254 1456 1060 2924
## retired self-employed services student technician
## 1720 1421 3969 875 6743
## unemployed unknown
## 1014 330
table(bank$default, useNA = "ifany")
##
## no unknown yes
## 32588 8597 3
# Visualize the distribution of a categorical variable
barplot(table(bank$education),
main = "Distribution of Education Levels",
col = "coral",
las = 2,
cex.names = 0.7)
# Visualize the distribution of client age
hist(bank$age, main = "Histogram of Client Age", xlab = "Age", col = "lightblue")
# Visualize outliers in campaign contacts using a boxplot
boxplot(bank$campaign, main = "Boxplot of Campaign Contacts", ylab = "Number of Contacts", col = "lightgreen")
# Scatterplot to investigate the relationship between age and campaign contacts
plot(bank$age, bank$campaign,
main = "Scatterplot of Age vs. Campaign Contacts",
xlab = "Client Age",
ylab = "Number of Contacts During Campaign",
col = ifelse(bank$y == "yes", "blue", "darkgray"),
pch = 16,
cex = 0.8)
legend("topright", legend = c("Subscribed (Yes)", "Did Not Subscribe (No)"),
col = c("blue", "darkgray"), pch = 16)
# Visual Correlation Matrix to identify macroeconomic multicollinearity
library(psych)
# Take a random sample to drastically reduce rendering time
set.seed(123)
bank_sample <- bank[sample(nrow(bank), 1000), ]
# Generate the plot directly in the RStudio pane using the sampled data
pairs.panels(bank_sample[, c("emp.var.rate", "cons.price.idx", "cons.conf.idx", "euribor3m", "nr.employed")],
main = "Visual Correlation Matrix of Macroeconomic Indicators",
method = "pearson",
hist.col = "lightblue",
density = TRUE,
ellipses = TRUE)
FEATURE ENGINEERING AND SELECTION
# Address Data Leakage: Drop the 'duration' column
# Call duration is unknown before the call and perfectly predicts outcome if 0
bank$duration <- NULL
# Set a random seed to ensure reproducibility of the random split
set.seed(12345)
# Create a random sample vector for a 90/10 training/test split
train_sample <- sample(41188, 37069)
# Split the data frame into training and testing sets
bank_train <- bank[train_sample, ]
bank_test <- bank[-train_sample, ]
MODEL TRAINING / IMBALANCES
# Load the C50 package for decision tree classification
library(C50)
# Train a baseline C5.0 decision tree
# Exclude the target variable (column 20) from the training features
bank_model <- C5.0(bank_train[-20], bank_train$y)
# View basic tree footprint and feature importance (replacing the massive summary output)
print(bank_model)
##
## Call:
## C5.0.default(x = bank_train[-20], y = bank_train$y)
##
## Classification Tree
## Number of samples: 37069
## Number of predictors: 19
##
## Tree size: 63
##
## Non-standard options: attempt to group attributes
C5imp(bank_model)
## Overall
## poutcome 100.00
## nr.employed 100.00
## month 90.13
## contact 9.30
## pdays 7.82
## emp.var.rate 7.61
## day_of_week 3.53
## campaign 1.93
## education 1.50
## default 1.45
## housing 1.07
## job 0.92
## loan 0.24
## previous 0.21
## marital 0.19
## cons.price.idx 0.07
## euribor3m 0.07
## cons.conf.idx 0.04
## age 0.02
# Plot a focused subtree (Node 2) to visualize the highest-propensity splits clearly
plot(bank_model, subtree = 2)
# Make predictions on the unseen test dataset
bank_pred <- predict(bank_model, bank_test)
# Load the gmodels package to evaluate performance
library(gmodels)
CrossTable(bank_test$y, bank_pred,
prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE,
dnn = c('Actual Subscription', 'Predicted Subscription'))
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 4119
##
##
## | Predicted Subscription
## Actual Subscription | no | yes | Row Total |
## --------------------|-----------|-----------|-----------|
## no | 3602 | 65 | 3667 |
## | 0.874 | 0.016 | |
## --------------------|-----------|-----------|-----------|
## yes | 342 | 110 | 452 |
## | 0.083 | 0.027 | |
## --------------------|-----------|-----------|-----------|
## Column Total | 3944 | 175 | 4119 |
## --------------------|-----------|-----------|-----------|
##
##
OPTIMIZING FOR BUSINESS GOALS (COST SENSITIVE LEARNING)
# Address the severe class imbalance using a cost matrix
# Goal: Prioritize high-propensity contacts by penalizing false negatives
matrix_dimensions <- list(c("no", "yes"), c("no", "yes"))
names(matrix_dimensions) <- c("predicted", "actual")
# Assign a 4x penalty to false negatives (predicting 'no' when actual is 'yes')
error_cost <- matrix(c(0, 1, 4, 0), nrow = 2, dimnames = matrix_dimensions)
# Train a cost-sensitive C5.0 decision tree to maximize the 25% conversion target
bank_cost_model <- C5.0(bank_train[-20], bank_train$y, costs = error_cost)
# Evaluate the cost-sensitive model predictions
bank_cost_pred <- predict(bank_cost_model, bank_test)
CrossTable(bank_test$y, bank_cost_pred,
prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE,
dnn = c('Actual Subscription', 'Predicted Subscription'))
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 4119
##
##
## | Predicted Subscription
## Actual Subscription | no | yes | Row Total |
## --------------------|-----------|-----------|-----------|
## no | 3343 | 324 | 3667 |
## | 0.812 | 0.079 | |
## --------------------|-----------|-----------|-----------|
## yes | 206 | 246 | 452 |
## | 0.050 | 0.060 | |
## --------------------|-----------|-----------|-----------|
## Column Total | 3549 | 570 | 4119 |
## --------------------|-----------|-----------|-----------|
##
##