# Mark Nelson, Assignment3
# load libraries
library(C50)
## Warning: package 'C50' was built under R version 4.4.3
library(gmodels)
## Warning: package 'gmodels' was built under R version 4.4.3
# load data and setup
bank <- read.csv("bank-additional-full.csv", sep = ";", stringsAsFactors = TRUE)
# drop $duration, prevent data leakage
bank$duration <- NULL
# Create training and test split (90/10)
set.seed(12345)
train_sample <- sample(41188, 37069)
bank_train <- bank[train_sample, ]
bank_test <- bank[-train_sample, ]
# vector to track successful identifications for evaluation/plotting
results_tracking <- c()
# Experiment1: baseline C5.0 model
# Hypothesis: a default model favors overall accuracy over the minority class
#
m1_baseline <- C5.0(bank_train[-20], bank_train$y)
p1_baseline <- predict(m1_baseline, bank_test)
CrossTable(bank_test$y, p1_baseline, prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE, dnn = c('Actual', 'Predicted'))
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 4119
##
##
## | Predicted
## Actual | 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 |
## -------------|-----------|-----------|-----------|
##
##
# record true positives ('yes' is the second level)
results_tracking["1. Baseline"] <- sum(bank_test$y == "yes" & p1_baseline == "yes")
# plot a subset of the baseline tree to see the initial decision rules
plot(m1_baseline, subtree = 2, main = "Exp 1: Baseline C5.0 Decision Tree")
# Experiment2: cost matrix
# Hypothesis: 4x penalty on false negatives will capture more subscriptions
# Change: costs = error_cost_4x
#
matrix_dim <- list(c("no", "yes"), c("no", "yes"))
names(matrix_dim) <- c("predicted", "actual")
error_cost_4x <- matrix(c(0, 1, 4, 0), nrow = 2, dimnames = matrix_dim)
m2_cost <- C5.0(bank_train[-20], bank_train$y, costs = error_cost_4x)
p2_cost <- predict(m2_cost, bank_test)
CrossTable(bank_test$y, p2_cost, prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE, dnn = c('Actual', 'Predicted'))
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 4119
##
##
## | Predicted
## Actual | 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 |
## -------------|-----------|-----------|-----------|
##
##
results_tracking["2. Cost (4x)"] <- sum(bank_test$y == "yes" & p2_cost == "yes")
# Experiment3: winnowing
# Hypothesis: winnowing will simplify the tree by dropping noisy features
# Change: C5.0Control(winnow = TRUE)
#
m3_winnow <- C5.0(bank_train[-20], bank_train$y, costs = error_cost_4x, control = C5.0Control(winnow = TRUE))
p3_winnow <- predict(m3_winnow, bank_test)
CrossTable(bank_test$y, p3_winnow, prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE, dnn = c('Actual', 'Predicted'))
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 4119
##
##
## | Predicted
## Actual | no | yes | Row Total |
## -------------|-----------|-----------|-----------|
## no | 3298 | 369 | 3667 |
## | 0.801 | 0.090 | |
## -------------|-----------|-----------|-----------|
## yes | 187 | 265 | 452 |
## | 0.045 | 0.064 | |
## -------------|-----------|-----------|-----------|
## Column Total | 3485 | 634 | 4119 |
## -------------|-----------|-----------|-----------|
##
##
results_tracking["3. Winnowing"] <- sum(bank_test$y == "yes" & p3_winnow == "yes")
# Experiment4: boosting
# Hypothesis: a 10-trial boosted ensemble will improve accuracy
# Change: removed winnowing, added trials = 10
#
m4_boost <- C5.0(bank_train[-20], bank_train$y, trials = 10)
p4_boost <- predict(m4_boost, bank_test)
CrossTable(bank_test$y, p4_boost, prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE, dnn = c('Actual', 'Predicted'))
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 4119
##
##
## | Predicted
## Actual | no | yes | Row Total |
## -------------|-----------|-----------|-----------|
## no | 3554 | 113 | 3667 |
## | 0.863 | 0.027 | |
## -------------|-----------|-----------|-----------|
## yes | 314 | 138 | 452 |
## | 0.076 | 0.034 | |
## -------------|-----------|-----------|-----------|
## Column Total | 3868 | 251 | 4119 |
## -------------|-----------|-----------|-----------|
##
##
results_tracking["4. Boosting"] <- sum(bank_test$y == "yes" & p4_boost == "yes")
# Experiment5: restricting tree depth
# Hypothesis: forcing higher minimum case limit prevents boosted model overfitting
# Change: C5.0Control(minCases = 15)
#
m5_mincases <- C5.0(bank_train[-20], bank_train$y, trials = 10, control = C5.0Control(minCases = 15))
p5_mincases <- predict(m5_mincases, bank_test)
CrossTable(bank_test$y, p5_mincases, prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE, dnn = c('Actual', 'Predicted'))
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 4119
##
##
## | Predicted
## Actual | no | yes | Row Total |
## -------------|-----------|-----------|-----------|
## no | 3591 | 76 | 3667 |
## | 0.872 | 0.018 | |
## -------------|-----------|-----------|-----------|
## yes | 345 | 107 | 452 |
## | 0.084 | 0.026 | |
## -------------|-----------|-----------|-----------|
## Column Total | 3936 | 183 | 4119 |
## -------------|-----------|-----------|-----------|
##
##
results_tracking["5. Min Cases (15)"] <- sum(bank_test$y == "yes" & p5_mincases == "yes")
# Experiment6: boosting + heavy cost penalty
# Hypothesis: boosting combined with 8x cost penalty will obtain highest subscription detection
# Change: added cost matrix (8x penalty), boosting
#
error_cost_8x <- matrix(c(0, 1, 8, 0), nrow = 2, dimnames = matrix_dim)
m6_synthesis <- C5.0(bank_train[-20], bank_train$y, trials = 10, costs = error_cost_8x)
p6_synthesis <- predict(m6_synthesis, bank_test)
CrossTable(bank_test$y, p6_synthesis, prop.chisq = FALSE, prop.c = FALSE, prop.r = FALSE, dnn = c('Actual', 'Predicted'))
##
##
## Cell Contents
## |-------------------------|
## | N |
## | N / Table Total |
## |-------------------------|
##
##
## Total Observations in Table: 4119
##
##
## | Predicted
## Actual | no | yes | Row Total |
## -------------|-----------|-----------|-----------|
## no | 3586 | 81 | 3667 |
## | 0.871 | 0.020 | |
## -------------|-----------|-----------|-----------|
## yes | 340 | 112 | 452 |
## | 0.083 | 0.027 | |
## -------------|-----------|-----------|-----------|
## Column Total | 3926 | 193 | 4119 |
## -------------|-----------|-----------|-----------|
##
##
results_tracking["6. Boost + Cost (8x)"] <- sum(bank_test$y == "yes" & p6_synthesis == "yes")
# Evaluation
# create bar chart comparing successful subscriptions identified across 6 experiments
#
barplot(results_tracking,
main = "Model Tuning: True Positives (Subscribers Identified)",
ylab = "Number of Correctly Predicted Subscriptions",
col = c("gray", "lightblue", "lightblue", "lightgreen", "lightgreen", "darkblue"),
las = 2, # Make x-axis labels vertical for readability
ylim = c(0, max(results_tracking) + 50))
# add numbers
text(x = barplot(results_tracking, plot = FALSE),
y = results_tracking + 15,
labels = results_tracking,
cex = 0.9,
font = 2)
