Comparing modelr and CARET

# Core ecosystem
library(tidyverse)
library(ISLR2)       # data set
library(caret)       # Unified interface for training and evaluation
library(DT)          # fancy tables
library(modelr)      # for model_matrix

# Tree-based model packages
library(rpart)       # Single decision trees
library(rpart.plot)  # Visualizing CART structures
library(randomForest)# Bagging & Random Forests
library(xgboost)     # Gradient boosted decision trees

# Imbalanced data resampling
library(themis)      # Tidymodels / recipe SMOTE methods
library(recipes)     # Preprocessing pipelines

Load Data

# Read training dataset and future prediction dataset
train_raw<-read_csv("C:/Users/email/Documents/UTSA/STA 6543 Pred Mod/fundraising.csv")
future_raw <- read_csv("C:/Users/email/Documents/UTSA/STA 6543 Pred Mod/future_fundraising.csv")

# Clean target factor levels to be valid R variable names
y_train <- factor(
  train_raw$target, 
  levels = c("No Donor", "Donor"),
  labels = c("No_Donor", "Donor") # <--- Fixed space here for nb
)

# Separate predictors
train_x_raw <- train_raw %>% select(-target)
future_x_raw <- future_raw

Preprocessing & Dummy Encoding via model_matrix

# A. Apply model_matrix to convert factor/categorical predictors into dummy variables
# We use ~ . - 1 to omit the intercept column from model_matrix
mm_formula <- formula(~ . - 1)

# Generate design matrix for training set
X_train_mm <- model_matrix(mm_formula, data = train_x_raw) %>% as.data.frame()

# Generate design matrix for future scoring set
X_future_mm <- model_matrix(mm_formula, data = future_x_raw) %>% as.data.frame()

# Align columns to ensure future set matches training set design matrix exactly
X_future_mm <- X_future_mm %>% select(all_of(colnames(X_train_mm)))

# B. Caret Preprocessing Pipeline: Zero-Variance Removal, Median Imputation, Centering & Scaling
preproc_plan <- preProcess(
  X_train_mm,
  method = c("nzv", "medianImpute", "center", "scale")
)

# Transform predictors using preproc_plan
X_train_proc <- predict(preproc_plan, X_train_mm)
X_future_proc <- predict(preproc_plan, X_future_mm)

# Combine processed predictors with target for Caret formula modeling
train_processed <- cbind(X_train_proc, target = y_train)

Train Control with Cross-Validation & Class Probabilities

set.seed(123)
ctrl <- trainControl(
  method = "cv",
  number = 10,
  classProbs = TRUE,
  summaryFunction = twoClassSummary,
  savePredictions = "final"
)

Model Training (Naive Bayes, Random Forest, XGBoost)

# A. Naive Bayes Model
set.seed(123)
fit_nb <- train(
  target ~ ., 
  data = train_processed,
  method = "nb",
  trControl = ctrl,
  metric = "ROC"
)

# B. Random Forest Model
set.seed(123)
fit_rf <- train(
  target ~ ., 
  data = train_processed,
  method = "rf",
  trControl = ctrl,
  metric = "ROC",
  tuneLength = 10
)

# C. XGBoost (Gradient Boosted Trees) Model
set.seed(123)
# Define an explicit tuning grid for gbm
gbm_grid <- expand.grid(
  interaction.depth = c(1, 3, 5),
  n.trees = (1:3) * 50,
  shrinkage = 0.1,
  n.minobsinnode = 10
)

set.seed(123)
fit_xgb <- train(
  target ~ ., 
  data = train_processed,
  method = "gbm",
  trControl = ctrl,
  metric = "ROC",
  tuneGrid = gbm_grid, # <--- Using an explicit grid avoids passing dots
  verbose = FALSE
)

Model Comparison

resamples_list <- resamples(list(
  NaiveBayes = fit_nb,
  RandomForest = fit_rf,
  XGBoost = fit_xgb
))

# Extract and average all CV metrics across folds automatically
model_metrics <- resamples_list$values %>%
  pivot_longer(-Resample, names_to = "Metric", values_to = "Value") %>%
  separate(Metric, into = c("Model", "Metric"), sep = "~") %>%
  group_by(Model, Metric) %>%
  summarize(Mean_Value = mean(Value, na.rm = TRUE), .groups = "drop") %>%
  pivot_wider(names_from = Metric, values_from = Mean_Value) %>%
  select(Model, ROC, Sens, Spec)

# Format into DT Datatable
datatable(
  model_metrics,
  colnames = c("Model Algorithm", "CV ROC AUC", "Sensitivity (Donor)", "Specificity"),
  options = list(dom = 't', ordering = TRUE),
  rownames = FALSE
) %>%
  formatRound(columns = c("ROC", "Sens", "Spec"), digits = 3)

NA

# raw resamples output
summary(resamples_list)

Call:
summary.resamples(object = resamples_list)

Models: NaiveBayes, RandomForest, XGBoost 
Number of resamples: 10 

ROC 
                  Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
NaiveBayes   0.5142667 0.5547333 0.5676444 0.5665455 0.5850737 0.6224000    0
RandomForest 0.5080222 0.5376667 0.5582408 0.5560535 0.5757176 0.6013778    0
XGBoost      0.5160222 0.5508722 0.5792444 0.5785444 0.5983469 0.6687111    0

Sens 
                  Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
NaiveBayes   0.3866667 0.4216667 0.4533333 0.4543267 0.4966667 0.5266667    0
RandomForest 0.4666667 0.5083333 0.5333333 0.5336115 0.5533333 0.6000000    0
XGBoost      0.4666667 0.5316667 0.5600000 0.5609051 0.5733333 0.6466667    0

Spec 
                  Min.   1st Qu.    Median      Mean   3rd Qu.      Max. NA's
NaiveBayes   0.5600000 0.6116667 0.6433333 0.6397852 0.6750559 0.7000000    0
RandomForest 0.5000000 0.5216667 0.5300000 0.5323758 0.5483333 0.5637584    0
XGBoost      0.4066667 0.5250000 0.5485235 0.5297047 0.5600000 0.5733333    0

# Plot it
bwplot(resamples_list, metric = "ROC")

Cut-Off & Profit Optimization Analysis

# Extract out-of-fold cross-validation probability predictions from winning model (XGBoost)
xgb_preds <- fit_xgb$pred |> filter(obs != "")

# Financial Inputs
cost_per_mail <- 0.68
avg_donation <- 13.00
net_donation <- avg_donation - cost_per_mail

# Profit evaluation across candidate probability cutoffs
thresholds <- seq(0.1, 0.9, by = 0.01)
profit_results <- map_df(thresholds, function(cutoff) {
  predicted_class <- ifelse(xgb_preds$Donor >= cutoff, "Donor", "No Donor")
  
  # Confusion Matrix components
  tp <- sum(predicted_class == "Donor" & xgb_preds$obs == "Donor")
  fp <- sum(predicted_class == "Donor" & xgb_preds$obs == "No Donor")
  
  # Total net profit = (True Donors * Net Donation) - (False Donors * Mailing Cost)
  total_profit <- (tp * net_donation) - (fp * cost_per_mail)
  
  data.frame(
    Cutoff = cutoff,
    Mailed_Count = tp + fp,
    True_Donors = tp,
    False_Donors = fp,
    Total_Profit = total_profit
  )
})

optimal_row <- profit_results %>% 
  filter(Total_Profit == max(Total_Profit)) %>% 
  filter(Cutoff == max(Cutoff)) #choose highest cutoff if profit ties exist
print(paste("Optimal Cutoff:", optimal_row$Cutoff))

[1] "Optimal Cutoff: 0.32"

print(paste("Max Profit:", round(optimal_row$Total_Profit, 2)))

[1] "Max Profit: 18467.68"

Score Future Fundraising Dataset & Write CSV Output

# Predict probabilities on future_fundraising.csv
future_probs <- predict(fit_xgb, newdata = X_future_proc, type = "prob")

# Apply optimal cutoff for decision recommendation
optimal_cutoff <- optimal_row$Cutoff[1]

future_results <- future_probs |>
  mutate(
    value = ifelse(future_probs$Donor >= optimal_cutoff, "Donor", "No Donor")
  ) |>
  select(value)
# Output predictions to CSV file using write_csv
write_csv(future_results, "future_fundraising_predictions.csv")
cat("Successfully exported predictions to future_fundraising_predictions.csv\n")

Successfully exported predictions to future_fundraising_predictions.csv