Needed Packages
library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.2.1 ✔ readr 2.2.0
## ✔ forcats 1.0.1 ✔ stringr 1.6.0
## ✔ ggplot2 4.0.3 ✔ tibble 3.3.1
## ✔ lubridate 1.9.5 ✔ tidyr 1.3.2
## ✔ purrr 1.2.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(caret)
## Warning: package 'caret' was built under R version 4.6.1
## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## lift
library(recipes)
## Warning: package 'recipes' was built under R version 4.6.1
##
## Attaching package: 'recipes'
##
## The following object is masked from 'package:stringr':
##
## fixed
##
## The following object is masked from 'package:stats':
##
## step
library(xgboost)
## Warning: package 'xgboost' was built under R version 4.6.1
library(ranger)
## Warning: package 'ranger' was built under R version 4.6.1
library(naivebayes)
## Warning: package 'naivebayes' was built under R version 4.6.1
## naivebayes 1.0.0 loaded
## For more information please visit:
## https://majkamichal.github.io/naivebayes/
library(pROC)
## Warning: package 'pROC' was built under R version 4.6.1
## Type 'citation("pROC")' for a citation.
##
## Attaching package: 'pROC'
##
## The following objects are masked from 'package:stats':
##
## cov, smooth, var
library(corrplot)
## Warning: package 'corrplot' was built under R version 4.6.1
## corrplot 0.95 loaded
library(gbm)
## Warning: package 'gbm' was built under R version 4.6.1
## Loaded gbm 2.3.1
## This version of gbm is no longer under development. Consider transitioning to gbm3, https://github.com/gbm-developers/gbm3
library(kernlab)
## Warning: package 'kernlab' was built under R version 4.6.1
##
## Attaching package: 'kernlab'
##
## The following object is masked from 'package:purrr':
##
## cross
##
## The following object is masked from 'package:ggplot2':
##
## alpha
Creation of alternative variables to help predict
library(readr)
fundraising <- read_csv("fundraising.csv")
## Rows: 3000 Columns: 21
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (7): zipconvert2, zipconvert3, zipconvert4, zipconvert5, homeowner, fem...
## dbl (14): num_child, income, wealth, home_value, med_fam_inc, avg_fam_inc, p...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
future_fundraising <- read_csv("future_fundraising.csv")
## Rows: 120 Columns: 20
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (6): zipconvert2, zipconvert3, zipconvert4, zipconvert5, homeowner, female
## dbl (14): num_child, income, wealth, home_value, med_fam_inc, avg_fam_inc, p...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
fundraising_alt <- fundraising
future_fundraising_alt <- future_fundraising
# Adjusting Target to Factor
fundraising_alt$target <- factor(
fundraising_alt$target,
levels = c("Donor", "No Donor"),
labels = c("Donor", "No_Donor")
)
# creating the zipconvert1
fundraising_alt <- fundraising_alt %>%
mutate(
zipconvert1 = if_else(
zipconvert2 == "No" &
zipconvert3 == "No" &
zipconvert4 == "No" &
zipconvert5 == "No",
"Yes",
"No"
)
)
future_fundraising_alt <- future_fundraising_alt %>%
mutate(
zipconvert1 = if_else(
zipconvert2 == "No" &
zipconvert3 == "No" &
zipconvert4 == "No" &
zipconvert5 == "No",
"Yes",
"No"
)
)
# Creating a unique zip variable
fundraising_alt <- fundraising_alt %>%
mutate(
zip_group = case_when(
zipconvert1 == "Yes" ~ "zip1",
zipconvert2 == "Yes" ~ "zip2",
zipconvert3 == "Yes" ~ "zip3",
zipconvert4 == "Yes" ~ "zip4",
zipconvert5 == "Yes" ~ "zip5",
TRUE ~ NA_character_
),
zip_group = factor(zip_group)
)
future_fundraising_alt <- future_fundraising_alt %>%
mutate(
zip_group = case_when(
zipconvert1 == "Yes" ~ "zip1",
zipconvert2 == "Yes" ~ "zip2",
zipconvert3 == "Yes" ~ "zip3",
zipconvert4 == "Yes" ~ "zip4",
zipconvert5 == "Yes" ~ "zip5",
TRUE ~ NA_character_
),
zip_group = factor(
zip_group,
levels = levels(fundraising_alt$zip_group)
)
)
# Creating the num_don variable which is a variable to
# address the amount of donations an individual made
fundraising_alt <- fundraising_alt %>%
mutate(
num_don = if_else(
avg_gift > 0,
lifetime_gifts / avg_gift,
0
)
)
future_fundraising_alt <- future_fundraising_alt %>%
mutate(
num_don = if_else(
avg_gift > 0,
lifetime_gifts / avg_gift,
0
)
)
# Creating the don_by_promo variable
# to account for those who donate a lot but also receive a lot of promos
fundraising_alt <- fundraising_alt %>%
mutate(
don_by_promo = if_else(
num_prom > 0,
num_don / num_prom,
0
)
)
future_fundraising_alt <- future_fundraising_alt %>%
mutate(
don_by_promo = if_else(
num_prom > 0,
num_don / num_prom,
0
)
)
# Setting up num_child to be able to be used as a dummy variable
# to try to account for the overwhelming of them to be 1
fundraising_alt <- fundraising_alt %>%
mutate(num_child = factor(num_child))
future_fundraising_alt <- future_fundraising_alt %>%
mutate(
num_child = factor(
num_child,
levels = levels(fundraising_alt$num_child)
)
)
# Creating a high-earner variable which is to
# highlight those who are above the median in income but
# live in areas with above median proverty
pct_lt15k_median <- median(
fundraising_alt$pct_lt15k,
na.rm = TRUE
)
pct_lt15k_median
## [1] 12
fundraising_alt <- fundraising_alt %>%
mutate(
high_earner = if_else(
income >= 5 & pct_lt15k > pct_lt15k_median,
"Yes",
"No"
),
high_earner = factor(
high_earner,
levels = c("No", "Yes")
)
)
future_fundraising_alt <- future_fundraising_alt %>%
mutate(
high_earner = if_else(
income >= 5 & pct_lt15k > pct_lt15k_median,
"Yes",
"No"
),
high_earner = factor(
high_earner,
levels = c("No", "Yes")
)
)
Models and Training
set.seed(12345)
cv_folds <- createMultiFolds(
fundraising_alt$target,
k = 5,
times = 2
)
ctrl <- trainControl(
method = "repeatedcv",
number = 5,
repeats = 2,
index = cv_folds,
classProbs = TRUE,
summaryFunction = twoClassSummary,
savePredictions = "final",
allowParallel = TRUE,
verboseIter = FALSE
)
fundraising_alt$target <- factor(
fundraising_alt$target,
levels = c("Donor", "No_Donor")
)
# this is to create the recipe I will be using for each of the models
# I wanted to account for the difference by zip and account for differences
# and correlations that might not be taken in account just running the model
fundraising_recipe <- recipe(
target ~ .,
data = fundraising_alt
) %>%
step_rm(
zipconvert1,
zipconvert2,
zipconvert3,
zipconvert4,
zipconvert5
) %>%
step_string2factor(
all_nominal_predictors()
) %>%
step_novel(
all_nominal_predictors()
) %>%
step_unknown(
all_nominal_predictors()
) %>%
step_dummy(
all_nominal_predictors()
) %>%
step_normalize(
last_gift,
months_since_donate
) %>%
step_mutate(
donation_recency_score =
last_gift - months_since_donate
) %>%
step_zv(
all_predictors()
)
# Time to train some models, first I'm going with is the randome forest model
rf_grid <- expand.grid(
mtry = c(4, 8, 12),
splitrule = "gini",
min.node.size = c(5, 15)
)
rf_fit <- train(
target ~ .,
data = fundraising_alt,
method = "ranger",
metric = "Accuracy",
trControl = ctrl,
tuneGrid = rf_grid,
num.trees = 500,
importance = "permutation"
)
## Warning in train.default(x, y, weights = w, ...): The metric "Accuracy" was not
## in the result set. ROC will be used instead.
rf_fit
## Random Forest
##
## 3000 samples
## 25 predictor
## 2 classes: 'Donor', 'No_Donor'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold, repeated 2 times)
## Summary of sample sizes: 2401, 2400, 2400, 2399, 2400, 2400, ...
## Resampling results across tuning parameters:
##
## mtry min.node.size ROC Sens Spec
## 4 5 0.5593125 0.5543445 0.5186910
## 4 15 0.5656558 0.5600212 0.5306833
## 8 5 0.5626473 0.5526767 0.5300100
## 8 15 0.5631776 0.5566823 0.5300111
## 12 5 0.5582993 0.5469989 0.5240233
## 12 15 0.5596418 0.5440000 0.5283477
##
## Tuning parameter 'splitrule' was held constant at a value of gini
## ROC was used to select the optimal model using the largest value.
## The final values used for the model were mtry = 4, splitrule = gini
## and min.node.size = 15.
plot(rf_fit)
rf_importance <- varImp(
rf_fit,
scale = TRUE
)
rf_importance
## ranger variable importance
##
## only 20 most important variables shown (out of 31)
##
## Overall
## months_since_donate 100.000
## largest_gift 99.618
## don_by_promo 96.400
## num_don 95.148
## med_fam_inc 63.240
## avg_gift 59.389
## last_gift 58.661
## avg_fam_inc 55.636
## lifetime_gifts 46.004
## num_prom 40.481
## home_value 39.213
## pct_lt15k 38.066
## income 31.438
## wealth 17.833
## high_earnerYes 13.296
## time_lag 13.146
## homeownerYes 11.946
## num_child3 10.905
## zip_groupzip3 7.021
## zipconvert1Yes 6.466
plot(
rf_importance,
top = 20
)
# Second Model Naive Bayes
nb_grid <- expand.grid(
laplace = c(0, 1),
usekernel = c(TRUE, FALSE),
adjust = c(0.5, 1)
)
nb_fit <- train(
fundraising_recipe,
data = fundraising_alt,
method = "naive_bayes",
metric = "ROC",
trControl = ctrl,
tuneGrid = nb_grid
)
nb_fit
## Naive Bayes
##
## 3000 samples
## 25 predictor
## 2 classes: 'Donor', 'No_Donor'
##
## Recipe steps: rm, string2factor, novel, unknown, dummy, normalize, mutate, zv
## Resampling: Cross-Validated (5 fold, repeated 2 times)
## Summary of sample sizes: 2401, 2400, 2400, 2399, 2400, 2400, ...
## Resampling results across tuning parameters:
##
## laplace usekernel adjust ROC Sens Spec
## 0 FALSE 0.5 0.5541571 0.9178662 0.1093112
## 0 FALSE 1.0 0.5541571 0.9178662 0.1093112
## 0 TRUE 0.5 0.5723121 0.1939197 0.8370244
## 0 TRUE 1.0 0.5801272 0.1669130 0.8600033
## 1 FALSE 0.5 0.5541571 0.9178662 0.1093112
## 1 FALSE 1.0 0.5541571 0.9178662 0.1093112
## 1 TRUE 0.5 0.5723121 0.1939197 0.8370244
## 1 TRUE 1.0 0.5801272 0.1669130 0.8600033
##
## ROC was used to select the optimal model using the largest value.
## The final values used for the model were laplace = 0, usekernel = TRUE
## and adjust = 1.
plot(nb_fit)
# Final Model Gradient Boost
# Had to to the gmb instead of xgboost to get it to work in caret
gbm_grid <- expand.grid(
n.trees = c(100, 250, 500),
interaction.depth = c(1, 2, 3, 5),
shrinkage = c(0.005, 0.01, 0.05),
n.minobsinnode = c(5, 10)
)
gbm_fit <- train(
fundraising_recipe,
data = fundraising_alt,
method = "gbm",
metric = "ROC",
trControl = ctrl,
tuneGrid = gbm_grid,
verbose = FALSE
)
## Warning: package 'plyr' was built under R version 4.6.1
## ------------------------------------------------------------------------------
## You have loaded plyr after dplyr - this is likely to cause problems.
## If you need functions from both plyr and dplyr, please load plyr first, then dplyr:
## library(plyr); library(dplyr)
## ------------------------------------------------------------------------------
##
## Attaching package: 'plyr'
## The following objects are masked from 'package:dplyr':
##
## arrange, count, desc, mutate, rename, summarise, summarize
## The following object is masked from 'package:purrr':
##
## compact
gbm_fit
## Stochastic Gradient Boosting
##
## 3000 samples
## 25 predictor
## 2 classes: 'Donor', 'No_Donor'
##
## Recipe steps: rm, string2factor, novel, unknown, dummy, normalize, mutate, zv
## Resampling: Cross-Validated (5 fold, repeated 2 times)
## Summary of sample sizes: 2401, 2400, 2400, 2399, 2400, 2400, ...
## Resampling results across tuning parameters:
##
## shrinkage interaction.depth n.minobsinnode n.trees ROC Sens
## 0.005 1 5 100 0.5822641 0.5646878
## 0.005 1 5 250 0.5851652 0.5663657
## 0.005 1 5 500 0.5872155 0.5566957
## 0.005 1 10 100 0.5805518 0.5583545
## 0.005 1 10 250 0.5838632 0.5570201
## 0.005 1 10 500 0.5868629 0.5570234
## 0.005 2 5 100 0.5818108 0.5630290
## 0.005 2 5 250 0.5844711 0.5586923
## 0.005 2 5 500 0.5860007 0.5453411
## 0.005 2 10 100 0.5837895 0.5596979
## 0.005 2 10 250 0.5853329 0.5536845
## 0.005 2 10 500 0.5857896 0.5483467
## 0.005 3 5 100 0.5814290 0.5520033
## 0.005 3 5 250 0.5836991 0.5493434
## 0.005 3 5 500 0.5845476 0.5430100
## 0.005 3 10 100 0.5816130 0.5566756
## 0.005 3 10 250 0.5831740 0.5573445
## 0.005 3 10 500 0.5829150 0.5463478
## 0.005 5 5 100 0.5821805 0.5516689
## 0.005 5 5 250 0.5833722 0.5450089
## 0.005 5 5 500 0.5819621 0.5410100
## 0.005 5 10 100 0.5810721 0.5506700
## 0.005 5 10 250 0.5820638 0.5466800
## 0.005 5 10 500 0.5822077 0.5436767
## 0.010 1 5 100 0.5841452 0.5640223
## 0.010 1 5 250 0.5864148 0.5596945
## 0.010 1 5 500 0.5870920 0.5436845
## 0.010 1 10 100 0.5835420 0.5687023
## 0.010 1 10 250 0.5871074 0.5613579
## 0.010 1 10 500 0.5872255 0.5466812
## 0.010 2 5 100 0.5824910 0.5570256
## 0.010 2 5 250 0.5833001 0.5423501
## 0.010 2 5 500 0.5820735 0.5390111
## 0.010 2 10 100 0.5842321 0.5540223
## 0.010 2 10 250 0.5842267 0.5513489
## 0.010 2 10 500 0.5831001 0.5406789
## 0.010 3 5 100 0.5826597 0.5450089
## 0.010 3 5 250 0.5839343 0.5406745
## 0.010 3 5 500 0.5814735 0.5383423
## 0.010 3 10 100 0.5817385 0.5503467
## 0.010 3 10 250 0.5820008 0.5410145
## 0.010 3 10 500 0.5804678 0.5390145
## 0.010 5 5 100 0.5808976 0.5530212
## 0.010 5 5 250 0.5797393 0.5460089
## 0.010 5 5 500 0.5769186 0.5466800
## 0.010 5 10 100 0.5802225 0.5476734
## 0.010 5 10 250 0.5823451 0.5460123
## 0.010 5 10 500 0.5775965 0.5430134
## 0.050 1 5 100 0.5880296 0.5466845
## 0.050 1 5 250 0.5802318 0.5313456
## 0.050 1 5 500 0.5730885 0.5306789
## 0.050 1 10 100 0.5864116 0.5476912
## 0.050 1 10 250 0.5821620 0.5353378
## 0.050 1 10 500 0.5748724 0.5306845
## 0.050 2 5 100 0.5817226 0.5380212
## 0.050 2 5 250 0.5759076 0.5316823
## 0.050 2 5 500 0.5663843 0.5356867
## 0.050 2 10 100 0.5819604 0.5413411
## 0.050 2 10 250 0.5733330 0.5316734
## 0.050 2 10 500 0.5633648 0.5370234
## 0.050 3 5 100 0.5795347 0.5383411
## 0.050 3 5 250 0.5708600 0.5413411
## 0.050 3 5 500 0.5585885 0.5340111
## 0.050 3 10 100 0.5779520 0.5426823
## 0.050 3 10 250 0.5666138 0.5416812
## 0.050 3 10 500 0.5555154 0.5380212
## 0.050 5 5 100 0.5708157 0.5376589
## 0.050 5 5 250 0.5595286 0.5363356
## 0.050 5 5 500 0.5496128 0.5316711
## 0.050 5 10 100 0.5744734 0.5393523
## 0.050 5 10 250 0.5643107 0.5370056
## 0.050 5 10 500 0.5533692 0.5340022
## Spec
## 0.5446633
## 0.5506512
## 0.5576456
## 0.5566434
## 0.5569801
## 0.5563101
## 0.5456523
## 0.5556489
## 0.5663101
## 0.5543178
## 0.5596456
## 0.5636401
## 0.5546567
## 0.5556489
## 0.5606512
## 0.5526567
## 0.5576445
## 0.5579801
## 0.5509900
## 0.5546534
## 0.5603178
## 0.5556567
## 0.5519845
## 0.5639779
## 0.5513289
## 0.5579790
## 0.5649801
## 0.5489967
## 0.5559756
## 0.5686423
## 0.5563189
## 0.5613145
## 0.5659767
## 0.5576523
## 0.5619823
## 0.5673112
## 0.5626401
## 0.5599956
## 0.5636467
## 0.5586434
## 0.5596523
## 0.5636489
## 0.5549856
## 0.5573245
## 0.5526600
## 0.5586545
## 0.5539911
## 0.5536656
## 0.5656379
## 0.5679701
## 0.5606534
## 0.5696235
## 0.5656268
## 0.5583112
## 0.5666246
## 0.5619635
## 0.5496467
## 0.5616390
## 0.5589856
## 0.5523145
## 0.5636445
## 0.5529911
## 0.5509856
## 0.5643234
## 0.5469967
## 0.5376667
## 0.5539900
## 0.5440011
## 0.5310000
## 0.5573234
## 0.5559823
## 0.5409978
##
## ROC was used to select the optimal model using the largest value.
## The final values used for the model were n.trees = 100, interaction.depth =
## 1, shrinkage = 0.05 and n.minobsinnode = 5.
plot(gbm_fit)
# So I started with just 3 but NaiveBayes did real bad, RF did the best
# on the real data submission while GBM did best according to CV.
# I wanted to test a couple more I thought might work on this data
# Regularized Logistic Regression
glmnet_grid <- expand.grid(
alpha = c(0, 0.5, 1),
lambda = seq(0.0001, 0.1, length = 15)
)
glmnet_fit <- train(
fundraising_recipe,
data = fundraising_alt,
method = "glmnet",
metric = "ROC",
trControl = ctrl,
tuneGrid = glmnet_grid
)
## Loading required namespace: glmnet
## Warning: package 'glmnet' was built under R version 4.6.1
## Loading required package: Matrix
##
## Attaching package: 'Matrix'
## The following objects are masked from 'package:tidyr':
##
## expand, pack, unpack
## Loaded glmnet 5.0
# Second new model will be SVM
svm_grid <- expand.grid(
sigma = c(0.001, 0.01),
C = c(0.25, 0.5, 1, 2)
)
svm_fit <- train(
fundraising_recipe,
data = fundraising_alt,
method = "svmRadial",
metric = "ROC",
trControl = ctrl,
tuneGrid = svm_grid
)
# Removing the fundraising_recipe
rf_fit_raw <- train(
target ~ .,
data = fundraising_alt,
method = "ranger",
metric = "ROC",
trControl = ctrl,
tuneGrid = rf_grid,
num.trees = 500,
importance = "permutation"
)
# I tested this and it came out to essentially be like the
# other random forest model so I didn't include later
# however I wanted to include that I did it so there
# won't be questions about if it was better this way
Model Comparison
model_resamples <- resamples(
list(
Random_Forest = rf_fit,
Naive_Bayes = nb_fit,
GBM = gbm_fit,
Logistic = glmnet_fit,
SVM = svm_fit
)
)
summary(model_resamples)
##
## Call:
## summary.resamples(object = model_resamples)
##
## Models: Random_Forest, Naive_Bayes, GBM, Logistic, SVM
## Number of resamples: 10
##
## ROC
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## Random_Forest 0.5216390 0.5631913 0.5742389 0.5656558 0.5804244 0.5834333 0
## Naive_Bayes 0.5236102 0.5736024 0.5807284 0.5801272 0.5918628 0.6261333 0
## GBM 0.5286268 0.5706942 0.5934250 0.5880296 0.6025681 0.6391056 0
## Logistic 0.5250055 0.5636133 0.5831079 0.5813754 0.6026917 0.6177000 0
## SVM 0.5315725 0.5694806 0.5918489 0.5846201 0.5987139 0.6157000 0
##
## Sens
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## Random_Forest 0.5317726 0.54333333 0.56500000 0.5600212 0.57583333 0.5866667
## Naive_Bayes 0.0100000 0.01666667 0.02166667 0.1669130 0.02918896 0.7966667
## GBM 0.5033333 0.52882107 0.54333333 0.5466845 0.56500000 0.6000000
## Logistic 0.5400000 0.57250000 0.58430881 0.5860624 0.59983835 0.6300000
## SVM 0.4800000 0.52797938 0.55833333 0.5476990 0.56333333 0.6033333
## NA's
## Random_Forest 0
## Naive_Bayes 0
## GBM 0
## Logistic 0
## SVM 0
##
## Spec
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## Random_Forest 0.4617940 0.4966667 0.5450000 0.5306833 0.5591667 0.5800000 0
## Naive_Bayes 0.3133333 0.9758333 0.9916667 0.8600033 0.9958472 1.0000000 0
## GBM 0.5315615 0.5441667 0.5483333 0.5656379 0.5937043 0.6300000 0
## Logistic 0.5049834 0.5133333 0.5341307 0.5396578 0.5591667 0.6166667 0
## SVM 0.5348837 0.5433333 0.5650000 0.5729756 0.5958333 0.6500000 0
bwplot(
model_resamples,
metric = "ROC"
)
model_differences <- diff(
model_resamples
)
summary(model_differences)
##
## Call:
## summary.diff.resamples(object = model_differences)
##
## p-value adjustment: bonferroni
## Upper diagonal: estimates of the difference
## Lower diagonal: p-value for H0: difference = 0
##
## ROC
## Random_Forest Naive_Bayes GBM Logistic SVM
## Random_Forest -0.014471 -0.022374 -0.015720 -0.018964
## Naive_Bayes 0.40715 -0.007902 -0.001248 -0.004493
## GBM 0.02441 0.98398 0.006654 0.003409
## Logistic 0.25139 1.00000 1.00000 -0.003245
## SVM 0.10247 1.00000 1.00000 1.00000
##
## Sens
## Random_Forest Naive_Bayes GBM Logistic SVM
## Random_Forest 0.393108 0.013337 -0.026041 0.012322
## Naive_Bayes 0.039474 -0.379771 -0.419149 -0.380786
## GBM 0.976903 0.045982 -0.039378 -0.001014
## Logistic 0.311629 0.023409 0.007466 0.038363
## SVM 1.000000 0.031751 1.000000 0.044060
##
## Spec
## Random_Forest Naive_Bayes GBM Logistic SVM
## Random_Forest -0.329320 -0.034955 -0.008975 -0.042292
## Naive_Bayes 0.045440 0.294365 0.320346 0.287028
## GBM 0.044065 0.067723 0.025980 -0.007338
## Logistic 1.000000 0.054037 0.204167 -0.033318
## SVM 0.005028 0.080486 1.000000 0.010416
comparison_table <- tibble(
Model = c(
"Random Forest",
"Naive Bayes",
"GBM",
"Regularized Logistic",
"SVM"
),
ROC = c(
max(rf_fit$results$ROC),
max(nb_fit$results$ROC),
max(gbm_fit$results$ROC),
max(glmnet_fit$results$ROC),
max(svm_fit$results$ROC)
),
Sensitivity = c(
rf_fit$results$Sens[
which.max(rf_fit$results$ROC)
],
nb_fit$results$Sens[
which.max(nb_fit$results$ROC)
],
gbm_fit$results$Sens[
which.max(gbm_fit$results$ROC)
],
glmnet_fit$results$Sens[
which.max(glmnet_fit$results$ROC)
],
svm_fit$results$Sens[
which.max(svm_fit$results$ROC)
]
),
Specificity = c(
rf_fit$results$Spec[
which.max(rf_fit$results$ROC)
],
nb_fit$results$Spec[
which.max(nb_fit$results$ROC)
],
gbm_fit$results$Spec[
which.max(gbm_fit$results$ROC)
],
glmnet_fit$results$Spec[
which.max(glmnet_fit$results$ROC)
],
svm_fit$results$Spec[
which.max(svm_fit$results$ROC)
]
)
) %>%
arrange(desc(ROC))
comparison_table
best_model <- rf_fit
future_predictions <- predict(
best_model,
newdata = future_fundraising_alt,
type = "raw"
)
table(future_predictions)
## future_predictions
## Donor No_Donor
## 61 59
submission <- tibble(
target = if_else(
future_predictions == "No_Donor",
"No Donor",
"Donor"
)
)
write_csv(
submission,
"fundraising_submission.csv"
)