Final project
Julius Cervantes
2026-08-06
library(tidyverse)## Warning: package 'tidyverse' was built under R version 4.6.1## Warning: package 'ggplot2' was built under R version 4.6.1## Warning: package 'tibble' was built under R version 4.6.1## Warning: package 'tidyr' was built under R version 4.6.1## Warning: package 'readr' was built under R version 4.6.1## Warning: package 'purrr' was built under R version 4.6.1## Warning: package 'dplyr' was built under R version 4.6.1## Warning: package 'stringr' was built under R version 4.6.1## Warning: package 'forcats' was built under R version 4.6.1## Warning: package 'lubridate' was built under R version 4.6.1## ── 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 errorslibrary(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':
##
## liftlibrary(randomForest)## Warning: package 'randomForest' was built under R version 4.6.1## randomForest 4.7-1.2
## Type rfNews() to see new features/changes/bug fixes.
##
## Attaching package: 'randomForest'
##
## The following object is masked from 'package:dplyr':
##
## combine
##
## The following object is masked from 'package:ggplot2':
##
## marginlibrary(rpart)
library(rpart.plot)## Warning: package 'rpart.plot' was built under R version 4.6.1library(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, varlibrary(corrplot)## Warning: package 'corrplot' was built under R version 4.6.1## corrplot 0.95 loadedlibrary(modelr)## Warning: package 'modelr' was built under R version 4.6.1fundraising <- read_csv("C:/Users/juliu/Downloads/VS-Code/RStudio/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("C:/Users/juliu/Downloads/VS-Code/RStudio/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.dim(fundraising)## [1] 3000 21glimpse(fundraising)## Rows: 3,000
## Columns: 21
## $ zipconvert2 <chr> "Yes", "No", "No", "No", "No", "No", "No", "Yes", …
## $ zipconvert3 <chr> "No", "No", "No", "Yes", "Yes", "No", "No", "No", …
## $ zipconvert4 <chr> "No", "No", "No", "No", "No", "No", "Yes", "No", "…
## $ zipconvert5 <chr> "No", "Yes", "Yes", "No", "No", "Yes", "No", "No",…
## $ homeowner <chr> "Yes", "No", "Yes", "Yes", "Yes", "Yes", "Yes", "Y…
## $ num_child <dbl> 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1,…
## $ income <dbl> 1, 5, 3, 4, 4, 4, 4, 4, 4, 1, 4, 5, 2, 3, 4, 4, 2,…
## $ female <chr> "No", "Yes", "No", "No", "Yes", "Yes", "No", "Yes"…
## $ wealth <dbl> 7, 8, 4, 8, 8, 8, 5, 8, 8, 5, 5, 8, 8, 5, 6, 9, 7,…
## $ home_value <dbl> 698, 828, 1471, 547, 482, 857, 505, 1438, 1316, 42…
## $ med_fam_inc <dbl> 422, 358, 484, 386, 242, 450, 333, 458, 541, 203, …
## $ avg_fam_inc <dbl> 463, 376, 546, 432, 275, 498, 388, 533, 575, 271, …
## $ pct_lt15k <dbl> 4, 13, 4, 7, 28, 5, 16, 8, 11, 39, 6, 8, 5, 3, 13,…
## $ num_prom <dbl> 46, 32, 94, 20, 38, 47, 51, 21, 66, 73, 59, 25, 27…
## $ lifetime_gifts <dbl> 94, 30, 177, 23, 73, 139, 63, 26, 108, 161, 84, 40…
## $ largest_gift <dbl> 12, 10, 10, 11, 10, 20, 15, 16, 12, 6, 5, 10, 20, …
## $ last_gift <dbl> 12, 5, 8, 11, 10, 20, 10, 16, 7, 3, 3, 10, 20, 7, …
## $ months_since_donate <dbl> 34, 29, 30, 30, 31, 37, 37, 30, 31, 32, 30, 32, 37…
## $ time_lag <dbl> 6, 7, 3, 6, 3, 3, 8, 6, 1, 7, 12, 2, 7, 1, 10, 3, …
## $ avg_gift <dbl> 9.400000, 4.285714, 7.080000, 7.666667, 7.300000, …
## $ target <chr> "Donor", "Donor", "No Donor", "No Donor", "Donor",…summary(fundraising)## zipconvert2 zipconvert3 zipconvert4 zipconvert5
## Length :3000 Length :3000 Length :3000 Length :3000
## N.unique : 2 N.unique : 2 N.unique : 2 N.unique : 2
## N.blank : 0 N.blank : 0 N.blank : 0 N.blank : 0
## Min.nchar: 2 Min.nchar: 2 Min.nchar: 2 Min.nchar: 2
## Max.nchar: 3 Max.nchar: 3 Max.nchar: 3 Max.nchar: 3
##
## homeowner num_child income female
## Length :3000 Min. :1.000 Min. :1.000 Length :3000
## N.unique : 2 1st Qu.:1.000 1st Qu.:3.000 N.unique : 2
## N.blank : 0 Median :1.000 Median :4.000 N.blank : 0
## Min.nchar: 2 Mean :1.069 Mean :3.899 Min.nchar: 2
## Max.nchar: 3 3rd Qu.:1.000 3rd Qu.:5.000 Max.nchar: 3
## Max. :5.000 Max. :7.000
## wealth home_value med_fam_inc avg_fam_inc
## Min. :0.000 Min. : 0.0 Min. : 0.0 Min. : 0.0
## 1st Qu.:5.000 1st Qu.: 554.8 1st Qu.: 278.0 1st Qu.: 318.0
## Median :8.000 Median : 816.5 Median : 355.0 Median : 396.0
## Mean :6.396 Mean :1143.3 Mean : 388.4 Mean : 432.3
## 3rd Qu.:8.000 3rd Qu.:1341.2 3rd Qu.: 465.0 3rd Qu.: 516.0
## Max. :9.000 Max. :5945.0 Max. :1500.0 Max. :1331.0
## pct_lt15k num_prom lifetime_gifts largest_gift
## Min. : 0.00 Min. : 11.00 Min. : 15.0 Min. : 5.00
## 1st Qu.: 5.00 1st Qu.: 29.00 1st Qu.: 45.0 1st Qu.: 10.00
## Median :12.00 Median : 48.00 Median : 81.0 Median : 15.00
## Mean :14.71 Mean : 49.14 Mean : 110.7 Mean : 16.65
## 3rd Qu.:21.00 3rd Qu.: 65.00 3rd Qu.: 135.0 3rd Qu.: 20.00
## Max. :90.00 Max. :157.00 Max. :5674.9 Max. :1000.00
## last_gift months_since_donate time_lag avg_gift
## Min. : 0.00 Min. :17.00 Min. : 0.000 Min. : 2.139
## 1st Qu.: 7.00 1st Qu.:29.00 1st Qu.: 3.000 1st Qu.: 6.333
## Median : 10.00 Median :31.00 Median : 5.000 Median : 9.000
## Mean : 13.48 Mean :31.13 Mean : 6.876 Mean : 10.669
## 3rd Qu.: 16.00 3rd Qu.:34.00 3rd Qu.: 9.000 3rd Qu.: 12.800
## Max. :219.00 Max. :37.00 Max. :77.000 Max. :122.167
## target
## Length :3000
## N.unique : 2
## N.blank : 0
## Min.nchar: 5
## Max.nchar: 8
## #no missing values
colSums(is.na(fundraising))## zipconvert2 zipconvert3 zipconvert4 zipconvert5
## 0 0 0 0
## homeowner num_child income female
## 0 0 0 0
## wealth home_value med_fam_inc avg_fam_inc
## 0 0 0 0
## pct_lt15k num_prom lifetime_gifts largest_gift
## 0 0 0 0
## last_gift months_since_donate time_lag avg_gift
## 0 0 0 0
## target
## 0table(fundraising$target)##
## Donor No Donor
## 1499 1501prop.table(table(fundraising$target))##
## Donor No Donor
## 0.4996667 0.5003333numeric <- fundraising %>%
select(where(is.numeric))
cor_matrix <- cor(numeric)
corrplot(cor_matrix, method="color", type="upper", tl.cex=.7)
lifetime_gifts, largest_gift, last_gift, and avg_gift seem moderately
correlated.
ggplot(fundraising, aes(target, avg_gift)) + geom_boxplot()
ggplot(fundraising, aes(target, last_gift)) + geom_boxplot()
ggplot(fundraising, aes(target, months_since_donate)) + geom_boxplot()
previous donation behavior is associated with future donor status.
Individuals with larger average gifts and larger recent gifts are more
likely to donate again. Donors generally have fewer months since their
last donation, making these variables strong candidate predictors.
fundraising <- fundraising %>%
mutate(across(where(is.character), as.factor))
future_fundraising <- future_fundraising %>%
mutate(across(where(is.character), as.factor))
fundraising$target <- factor(
fundraising$target,
levels = c("No Donor", "Donor")
)Logistic Regression
set.seed(123)
train_index <- createDataPartition(fundraising$target, p=.80, list=FALSE)
train <- fundraising[train_index, ]
valid <- fundraising[-train_index, ]glm_fit <- glm(target ~ ., data = train, family = binomial)
glm_prob <- predict(glm_fit, newdata = valid, type = "response")
glm_pred <- ifelse(glm_prob > 0.5, "Donor", "No Donor")
glm_pred <- factor(glm_pred, levels = levels(valid$target))
glm_cm <- confusionMatrix(glm_pred, valid$target)
glm_cm## Confusion Matrix and Statistics
##
## Reference
## Prediction No Donor Donor
## No Donor 170 125
## Donor 130 174
##
## Accuracy : 0.5743
## 95% CI : (0.5336, 0.6143)
## No Information Rate : 0.5008
## P-Value [Acc > NIR] : 0.0001849
##
## Kappa : 0.1486
##
## Mcnemar's Test P-Value : 0.8022087
##
## Sensitivity : 0.5667
## Specificity : 0.5819
## Pos Pred Value : 0.5763
## Neg Pred Value : 0.5724
## Prevalence : 0.5008
## Detection Rate : 0.2838
## Detection Prevalence : 0.4925
## Balanced Accuracy : 0.5743
##
## 'Positive' Class : No Donor
## glm_roc <- roc(response = valid$target, predictor = glm_prob, levels = c("No Donor", "Donor"))## Setting direction: controls < casesauc(glm_roc)## Area under the curve: 0.6156Decisison tree
tree_fit <-rpart(target ~ .,data = train, method = "class")
rpart.plot(tree_fit)
tree_pred <-predict(tree_fit, newdata = valid, type = "class")
tree_cm <- confusionMatrix(tree_pred, valid$target)
tree_cm## Confusion Matrix and Statistics
##
## Reference
## Prediction No Donor Donor
## No Donor 163 149
## Donor 137 150
##
## Accuracy : 0.5225
## 95% CI : (0.4817, 0.5632)
## No Information Rate : 0.5008
## P-Value [Acc > NIR] : 0.1535
##
## Kappa : 0.045
##
## Mcnemar's Test P-Value : 0.5154
##
## Sensitivity : 0.5433
## Specificity : 0.5017
## Pos Pred Value : 0.5224
## Neg Pred Value : 0.5226
## Prevalence : 0.5008
## Detection Rate : 0.2721
## Detection Prevalence : 0.5209
## Balanced Accuracy : 0.5225
##
## 'Positive' Class : No Donor
## tree_prob <- predict(tree_fit, newdata = valid, type = "prob")
tree_roc <- roc(valid$target, tree_prob[, "Donor"], levels = c("No Donor", "Donor"))## Setting direction: controls < casesauc(tree_roc)## Area under the curve: 0.5225Random Forest
set.seed(123)
rf_fit <- randomForest(target ~ ., data = train, importance = TRUE)rf_pred <- predict(rf_fit, newdata = valid)
rf_cm <- confusionMatrix(rf_pred, valid$target)
rf_cm## Confusion Matrix and Statistics
##
## Reference
## Prediction No Donor Donor
## No Donor 156 137
## Donor 144 162
##
## Accuracy : 0.5309
## 95% CI : (0.49, 0.5714)
## No Information Rate : 0.5008
## P-Value [Acc > NIR] : 0.07632
##
## Kappa : 0.0618
##
## Mcnemar's Test P-Value : 0.72040
##
## Sensitivity : 0.5200
## Specificity : 0.5418
## Pos Pred Value : 0.5324
## Neg Pred Value : 0.5294
## Prevalence : 0.5008
## Detection Rate : 0.2604
## Detection Prevalence : 0.4891
## Balanced Accuracy : 0.5309
##
## 'Positive' Class : No Donor
## varImpPlot(rf_fit)
rf_prob <- predict(rf_fit, newdata = valid, type = "prob")
rf_roc <- roc(valid$target, rf_prob[, "Donor"], levels = c("No Donor", "Donor"))## Setting direction: controls < casesauc(rf_roc)## Area under the curve: 0.5478results <- tibble( Model = c(
"Logistic Regression",
"Decision Tree",
"Random Forest"),
Accuracy = c(
glm_cm$overall["Accuracy"],
tree_cm$overall["Accuracy"],
rf_cm$overall["Accuracy"]
),
ROC = c(
as.numeric(auc(glm_roc)),
as.numeric(auc(tree_roc)),
as.numeric(auc(rf_roc))
)
)
results## # A tibble: 3 × 3
## Model Accuracy ROC
## <chr> <dbl> <dbl>
## 1 Logistic Regression 0.574 0.616
## 2 Decision Tree 0.523 0.523
## 3 Random Forest 0.531 0.548Logistic Regression has the highest accuracy at 57.42%
best_model <- glm_fit
future_prediction <- predict(best_model, newdata = future_fundraising, type = "response")
future_prediction <- ifelse( future_prediction > 0.5, "Donor", "No Donor")
submission <- data.frame(value = future_prediction)
write_csv(submission, "future_fundraising_predictions.csv")