Direct-Mail Fundraising
Laween Khaild
2024-05-10
Business Problem
A national veterans’ organization seeks to develop a predictive model to improve the cost-effectiveness of their direct marketing campaign. With a database of over 13 million donors, they are among the largest direct-mail fundraisers in the U.S. Recent records show a 5.1% response rate and an average donation of $13.00. Each mailing costs $0.68. Using this data, we sample the dataset to develop a classification model that identifies potential donors to maximize net profit. Weighted sampling ensures equal representation of donors and non-donors.
Business Objective and Goals
The objective is to find the best classification model to maximize net profit by predicting likely donors in the direct-mail campaign, thus enhancing cost-effectiveness.
Data Source
The fundraising file contains 3,000 records, with approximately 50% donors and 50% non-donors.
This balanced sampling is crucial for producing repeatable results. If the training data had only 10% donors (random sample), it would be challenging to create an accurate predictive model due to the scarcity of donor data.
Fundraising_data: 3,000 observations and 20 predictor variables (6 factor and 14 numerical) and 1 response variable (Factor)
zip convert 1: 00000–19999 zip convert 2: 20000–39999 zip convert 3: 40000–59999 zip convert 4: 60000–79999 zip convert 5: 80000–99999 homeowner: Yes = homeowner, No = not a homeowner num_child: Number of children income Household income female: No = male, Yes = female wealth: Wealth rating uses median family income and population statistics from each area to index relative wealth within each state. The segments are denoted 0 to 9, with 9 being the highest-wealth group and zero the lowest. Each rating has a different meaning within each state home_value: Average home value in potential donor’s neighborhood in hundreds of dollars med_fam_inc Median family income in potential donor’s neighborhood in hundreds of dollars avg_fam_inc: Average family income in potential donor’s neighborhood in hundreds pct_lt15k: Percent earning less than $15K in potential donor’s neighborhood num_prom: Lifetime number of promotions received to date lifetime_gifts Dollar amount of lifetime gifts to date largest_gift: Dollar amount of largest gift to date last_gift Dollar amount of most recent gift months_since_donate: Number of months from last donation to July 2018 time_lag Number of months between first and second gift avg_gift: Average dollar amount of gifts to date target Outcome variable: binary indicator for response Yes = donor, No = non-donor Future_fundraising: 120 observations and 20 predictor variables, no response variable, since it is unknown.
library(corrplot)## corrplot 0.92 loadedlibrary(ggplot2)## Warning: package 'ggplot2' was built under R version 4.3.2library(GGally)## Warning: package 'GGally' was built under R version 4.3.2## Registered S3 method overwritten by 'GGally':
## method from
## +.gg ggplot2library(car)## Loading required package: carDatalibrary(caret)## Loading required package: latticelibrary(glmnet)## Loading required package: Matrix## Loaded glmnet 4.1-8library(readr)
library(randomForest)## randomForest 4.7-1.1## Type rfNews() to see new features/changes/bug fixes.##
## Attaching package: 'randomForest'## The following object is masked from 'package:ggplot2':
##
## marginlibrary(class)
library(e1071)
library(rpart)
library(rpart.plot)## Warning: package 'rpart.plot' was built under R version 4.3.2library(reshape2)fundraising_data <- read.csv("/Users/paymankhalid/Desktop/fundraising.csv")
future_fundraising_data <- read.csv("/Users/paymankhalid/Desktop/future_fundraising.csv")head(fundraising_data)## zipconvert2 zipconvert3 zipconvert4 zipconvert5 homeowner num_child income
## 1 Yes No No No Yes 1 1
## 2 No No No Yes No 2 5
## 3 No No No Yes Yes 1 3
## 4 No Yes No No Yes 1 4
## 5 No Yes No No Yes 1 4
## 6 No No No Yes Yes 1 4
## female wealth home_value med_fam_inc avg_fam_inc pct_lt15k num_prom
## 1 No 7 698 422 463 4 46
## 2 Yes 8 828 358 376 13 32
## 3 No 4 1471 484 546 4 94
## 4 No 8 547 386 432 7 20
## 5 Yes 8 482 242 275 28 38
## 6 Yes 8 857 450 498 5 47
## lifetime_gifts largest_gift last_gift months_since_donate time_lag avg_gift
## 1 94 12 12 34 6 9.400000
## 2 30 10 5 29 7 4.285714
## 3 177 10 8 30 3 7.080000
## 4 23 11 11 30 6 7.666667
## 5 73 10 10 31 3 7.300000
## 6 139 20 20 37 3 10.692308
## target
## 1 Donor
## 2 Donor
## 3 No Donor
## 4 No Donor
## 5 Donor
## 6 Donorhead(future_fundraising_data)## zipconvert2 zipconvert3 zipconvert4 zipconvert5 homeowner num_child income
## 1 No Yes No No Yes 1 5
## 2 Yes No No No Yes 1 1
## 3 No No No Yes Yes 1 4
## 4 No No Yes No Yes 1 4
## 5 No Yes No No Yes 1 2
## 6 Yes No No No Yes 1 4
## female wealth home_value med_fam_inc avg_fam_inc pct_lt15k num_prom
## 1 Yes 9 1399 637 703 1 74
## 2 No 7 1355 411 497 9 77
## 3 Yes 1 835 310 364 22 70
## 4 No 8 1019 389 473 15 21
## 5 Yes 7 992 524 563 6 63
## 6 Yes 8 834 371 408 10 35
## lifetime_gifts largest_gift last_gift months_since_donate time_lag avg_gift
## 1 102 6 5 29 3 4.857143
## 2 249 15 7 35 3 9.576923
## 3 126 6 6 34 8 4.344828
## 4 26 16 16 37 5 13.000000
## 5 100 20 3 21 6 7.692308
## 6 92 37 37 37 5 23.000000fundraising_data$target <- as.factor(ifelse(fundraising_data$target == "Donor", 1, 0))
str(fundraising_data)## 'data.frame': 3000 obs. of 21 variables:
## $ zipconvert2 : chr "Yes" "No" "No" "No" ...
## $ zipconvert3 : chr "No" "No" "No" "Yes" ...
## $ zipconvert4 : chr "No" "No" "No" "No" ...
## $ zipconvert5 : chr "No" "Yes" "Yes" "No" ...
## $ homeowner : chr "Yes" "No" "Yes" "Yes" ...
## $ num_child : int 1 2 1 1 1 1 1 1 1 1 ...
## $ income : int 1 5 3 4 4 4 4 4 4 1 ...
## $ female : chr "No" "Yes" "No" "No" ...
## $ wealth : int 7 8 4 8 8 8 5 8 8 5 ...
## $ home_value : int 698 828 1471 547 482 857 505 1438 1316 428 ...
## $ med_fam_inc : int 422 358 484 386 242 450 333 458 541 203 ...
## $ avg_fam_inc : int 463 376 546 432 275 498 388 533 575 271 ...
## $ pct_lt15k : int 4 13 4 7 28 5 16 8 11 39 ...
## $ num_prom : int 46 32 94 20 38 47 51 21 66 73 ...
## $ lifetime_gifts : num 94 30 177 23 73 139 63 26 108 161 ...
## $ largest_gift : num 12 10 10 11 10 20 15 16 12 6 ...
## $ last_gift : num 12 5 8 11 10 20 10 16 7 3 ...
## $ months_since_donate: int 34 29 30 30 31 37 37 30 31 32 ...
## $ time_lag : int 6 7 3 6 3 3 8 6 1 7 ...
## $ avg_gift : num 9.4 4.29 7.08 7.67 7.3 ...
## $ target : Factor w/ 2 levels "0","1": 2 2 1 1 2 2 2 1 2 2 ...str(future_fundraising_data)## 'data.frame': 120 obs. of 20 variables:
## $ zipconvert2 : chr "No" "Yes" "No" "No" ...
## $ zipconvert3 : chr "Yes" "No" "No" "No" ...
## $ zipconvert4 : chr "No" "No" "No" "Yes" ...
## $ zipconvert5 : chr "No" "No" "Yes" "No" ...
## $ homeowner : chr "Yes" "Yes" "Yes" "Yes" ...
## $ num_child : int 1 1 1 1 1 1 1 1 1 1 ...
## $ income : int 5 1 4 4 2 4 2 3 4 2 ...
## $ female : chr "Yes" "No" "Yes" "No" ...
## $ wealth : int 9 7 1 8 7 8 1 8 3 5 ...
## $ home_value : int 1399 1355 835 1019 992 834 639 457 349 698 ...
## $ med_fam_inc : int 637 411 310 389 524 371 209 253 302 335 ...
## $ avg_fam_inc : int 703 497 364 473 563 408 259 285 324 348 ...
## $ pct_lt15k : int 1 9 22 15 6 10 36 25 19 14 ...
## $ num_prom : int 74 77 70 21 63 35 72 68 55 59 ...
## $ lifetime_gifts : num 102 249 126 26 100 92 146 98 66 276 ...
## $ largest_gift : num 6 15 6 16 20 37 12 5 7 15 ...
## $ last_gift : num 5 7 6 16 3 37 11 3 5 13 ...
## $ months_since_donate: int 29 35 34 37 21 37 36 32 30 33 ...
## $ time_lag : int 3 3 8 5 6 5 5 9 9 10 ...
## $ avg_gift : num 4.86 9.58 4.34 13 7.69 ...Checking for any missing values(NA)
I see that I don’t have any NA
na_summary_fundraising <- sapply(fundraising_data, function(x) sum(is.na(x)))
print("Missing values in fundraising_data:")## [1] "Missing values in fundraising_data:"print(na_summary_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
## 0na_summary_future_fundraising <- sapply(future_fundraising_data, function(x) sum(is.na(x)))
print("Missing values in future_fundraising_data:")## [1] "Missing values in future_fundraising_data:"print(na_summary_future_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 0Checking for balanced data
I checked the target variable in both datasets and I calculated the proportions. According to my results, I can see the datset is balanced with apporximately 50% donors and 50% non-donors.
target_distribution <- table(fundraising_data$target)
print("Distribution of the target variable in fundraising_data:")## [1] "Distribution of the target variable in fundraising_data:"print(target_distribution)##
## 0 1
## 1501 1499target_proportions <- prop.table(target_distribution)
print("Proportion of the target variable in fundraising_data:")## [1] "Proportion of the target variable in fundraising_data:"print(target_proportions)##
## 0 1
## 0.5003333 0.4996667Correlation Plot
I did a correlation analysis on the numerical variables to visualize it. I can see a strong coeelations between med_fam_inc and avg_fam_inc. Also between lifetime_gifts, largest_gift, last_gift, and avg_gift show strong positive correlations among themselves.
numeric_columns <- sapply(fundraising_data, is.numeric)
numeric_data <- fundraising_data[, numeric_columns]
correlation_matrix <- cor(numeric_data, use = "complete.obs")
corrplot(correlation_matrix, method = "color", tl.cex = 0.8)
Plots
I plotted the Comparison of Donors and Non-Donors by Gender, and I saw the Females are more likely to be donors compared to males.
fundraising_data$gender <- ifelse(fundraising_data$female == "Yes", "Female", "Male")
gender_plot <- ggplot(fundraising_data, aes(x = target, fill = gender)) +
geom_bar(position = "dodge") +
geom_text(stat = 'count', aes(label = ..count..), position = position_dodge(width = 0.9), vjust = -0.3, size = 4) +
scale_fill_manual(values = c("Female" = "#FF9999", "Male" = "skyblue")) +
labs(title = "Comparison of Donors and Non-Donors by Gender",
x = "Target",
y = "Count",
fill = "Gender") +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5), # Center align the title
axis.title.x = element_text(size = 14),
axis.title.y = element_text(size = 14),
legend.title = element_text(size = 12),
legend.text = element_text(size = 10))
# Display the plot
print(gender_plot)## Warning: The dot-dot notation (`..count..`) was deprecated in ggplot2 3.4.0.
## ℹ Please use `after_stat(count)` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
Colinearity and significance
According to my results, I can see the significant predictors are:
- num_child: Number of children (p-value = 0.01544)
- income: Household income (p-value = 0.00738)
- months_since_donate: Number of months since the last donation (p-value < 0.001)
These predictors are statistically significant at the 5% level, indicating they have a meaningful impact on the probability of being a donor.
logreg_model = glm(formula = target ~ ., data = fundraising_data, family = binomial)
summary(logreg_model)##
## Call:
## glm(formula = target ~ ., family = binomial, data = fundraising_data)
##
## Coefficients: (1 not defined because of singularities)
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.184e+01 2.670e+02 -0.044 0.96464
## zipconvert2Yes 1.365e+01 2.670e+02 0.051 0.95924
## zipconvert3Yes 1.361e+01 2.670e+02 0.051 0.95934
## zipconvert4Yes 1.365e+01 2.670e+02 0.051 0.95922
## zipconvert5Yes 1.365e+01 2.670e+02 0.051 0.95922
## homeownerYes 4.957e-02 9.412e-02 0.527 0.59847
## num_child -2.752e-01 1.137e-01 -2.422 0.01544 *
## income 6.952e-02 2.595e-02 2.679 0.00738 **
## femaleYes 5.995e-02 7.673e-02 0.781 0.43463
## wealth 1.907e-02 1.800e-02 1.059 0.28940
## home_value 1.074e-04 7.141e-05 1.503 0.13272
## med_fam_inc 1.200e-03 9.303e-04 1.289 0.19725
## avg_fam_inc -1.756e-03 1.010e-03 -1.738 0.08226 .
## pct_lt15k 9.519e-04 4.440e-03 0.214 0.83024
## num_prom 3.682e-03 2.317e-03 1.589 0.11204
## lifetime_gifts -1.599e-04 3.721e-04 -0.430 0.66743
## largest_gift 1.773e-03 3.091e-03 0.574 0.56629
## last_gift -9.923e-03 7.562e-03 -1.312 0.18945
## months_since_donate -5.922e-02 1.003e-02 -5.906 3.51e-09 ***
## time_lag 6.174e-03 6.789e-03 0.909 0.36311
## avg_gift -7.539e-03 1.106e-02 -0.682 0.49526
## genderMale NA NA NA NA
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 4158.9 on 2999 degrees of freedom
## Residual deviance: 4062.0 on 2979 degrees of freedom
## AIC: 4104
##
## Number of Fisher Scoring iterations: 12Lasso Regression model
My Lasso regression results show which predicotrs have been slected and they are:
homeownerYes: 0.005473944 num_child: -0.1658818 income: 0.04248429 femaleYes: 0.001159419 home_value: 0.00001069157 num_prom: 0.001636589 last_gift: -0.006974952 months_since_donate: -0.05303778 avg_gift: -0.002990472
x <- model.matrix(target ~ ., fundraising_data)[,-1] # Exclude intercept
y <- as.numeric(as.character(fundraising_data$target))
lasso_model <- cv.glmnet(x, y, family = "binomial", alpha = 1)
best_lambda <- lasso_model$lambda.min
print(paste("Best lambda value:", best_lambda))## [1] "Best lambda value: 0.00864132429815332"lasso_coefficients <- coef(lasso_model, s = best_lambda)
print(lasso_coefficients)## 22 x 1 sparse Matrix of class "dgCMatrix"
## s1
## (Intercept) 1.690502e+00
## zipconvert2Yes .
## zipconvert3Yes .
## zipconvert4Yes .
## zipconvert5Yes .
## homeownerYes 5.473944e-03
## num_child -1.658818e-01
## income 4.248429e-02
## femaleYes 1.159419e-03
## wealth .
## home_value 1.069157e-05
## med_fam_inc .
## avg_fam_inc .
## pct_lt15k .
## num_prom 1.636589e-03
## lifetime_gifts .
## largest_gift .
## last_gift -6.974952e-03
## months_since_donate -5.303778e-02
## time_lag .
## avg_gift -2.990472e-03
## genderMale .Methodology
Step 1: Partitioning. You might think about how to estimate the out of sample error. Either partition the dataset into 80% training and 20% validation or use cross validation (set the seed to 12345).
fundraising_data <- read_csv("/Users/paymankhalid/Desktop/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.fundraising_data$target <- as.factor(ifelse(fundraising_data$target == "Donor", 1, 0))
set.seed(12345)
# Partition the data into 80% training and 20% validation
trainIndex <- createDataPartition(fundraising_data$target, p = .8, list = FALSE)
train_set <- fundraising_data[trainIndex, ]
validation_set <- fundraising_data[-trainIndex, ]
head(train_set)## # A tibble: 6 × 21
## zipconvert2 zipconvert3 zipconvert4 zipconvert5 homeowner num_child income
## <chr> <chr> <chr> <chr> <chr> <dbl> <dbl>
## 1 Yes No No No Yes 1 1
## 2 No No No Yes No 2 5
## 3 No No No Yes Yes 1 3
## 4 No Yes No No Yes 1 4
## 5 No Yes No No Yes 1 4
## 6 No No Yes No Yes 1 4
## # ℹ 14 more variables: female <chr>, wealth <dbl>, home_value <dbl>,
## # med_fam_inc <dbl>, avg_fam_inc <dbl>, pct_lt15k <dbl>, num_prom <dbl>,
## # lifetime_gifts <dbl>, largest_gift <dbl>, last_gift <dbl>,
## # months_since_donate <dbl>, time_lag <dbl>, avg_gift <dbl>, target <fct>head(validation_set)## # A tibble: 6 × 21
## zipconvert2 zipconvert3 zipconvert4 zipconvert5 homeowner num_child income
## <chr> <chr> <chr> <chr> <chr> <dbl> <dbl>
## 1 No No No Yes Yes 1 4
## 2 Yes No No No Yes 1 4
## 3 No No No Yes No 1 6
## 4 No No No Yes Yes 1 5
## 5 No No Yes No No 1 5
## 6 No No Yes No No 1 4
## # ℹ 14 more variables: female <chr>, wealth <dbl>, home_value <dbl>,
## # med_fam_inc <dbl>, avg_fam_inc <dbl>, pct_lt15k <dbl>, num_prom <dbl>,
## # lifetime_gifts <dbl>, largest_gift <dbl>, last_gift <dbl>,
## # months_since_donate <dbl>, time_lag <dbl>, avg_gift <dbl>, target <fct>Models
Step 2: Model Building. Follow the following steps to build, evaluate, and choose a model.
Logistic Regression
I did a logistic regression then stepwise AIC Selection. According to my model and using the AIC method my accuracy was 57.93%.
full_model <- glm(target ~ ., data = train_set, family = binomial)
summary(full_model)##
## Call:
## glm(formula = target ~ ., family = binomial, data = train_set)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.208e+01 2.675e+02 -0.045 0.9640
## zipconvert2Yes 1.359e+01 2.675e+02 0.051 0.9595
## zipconvert3Yes 1.355e+01 2.675e+02 0.051 0.9596
## zipconvert4Yes 1.360e+01 2.675e+02 0.051 0.9594
## zipconvert5Yes 1.361e+01 2.675e+02 0.051 0.9594
## homeownerYes 6.957e-02 1.044e-01 0.666 0.5051
## num_child -3.218e-01 1.271e-01 -2.532 0.0114 *
## income 6.023e-02 2.878e-02 2.093 0.0364 *
## femaleYes 4.470e-02 8.554e-02 0.523 0.6013
## wealth 3.197e-02 2.009e-02 1.591 0.1116
## home_value 7.260e-05 7.935e-05 0.915 0.3603
## med_fam_inc 2.192e-04 1.091e-03 0.201 0.8408
## avg_fam_inc -6.316e-04 1.164e-03 -0.543 0.5874
## pct_lt15k 2.335e-03 5.049e-03 0.463 0.6437
## num_prom 4.037e-03 2.661e-03 1.517 0.1293
## lifetime_gifts -2.349e-04 5.324e-04 -0.441 0.6591
## largest_gift 9.819e-04 7.788e-03 0.126 0.8997
## last_gift -8.162e-03 9.101e-03 -0.897 0.3698
## months_since_donate -5.325e-02 1.104e-02 -4.825 1.4e-06 ***
## time_lag 5.613e-03 7.433e-03 0.755 0.4501
## avg_gift -6.257e-03 1.270e-02 -0.493 0.6223
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 3328.5 on 2400 degrees of freedom
## Residual deviance: 3260.4 on 2380 degrees of freedom
## AIC: 3302.4
##
## Number of Fisher Scoring iterations: 12Stepwise AIC Selection
stepwise_model <- step(full_model, direction = "both")## Start: AIC=3302.37
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## homeowner + num_child + income + female + wealth + home_value +
## med_fam_inc + avg_fam_inc + pct_lt15k + num_prom + lifetime_gifts +
## largest_gift + last_gift + months_since_donate + time_lag +
## avg_gift
##
## Df Deviance AIC
## - largest_gift 1 3260.4 3300.4
## - med_fam_inc 1 3260.4 3300.4
## - lifetime_gifts 1 3260.6 3300.6
## - pct_lt15k 1 3260.6 3300.6
## - avg_gift 1 3260.6 3300.6
## - female 1 3260.6 3300.6
## - avg_fam_inc 1 3260.7 3300.7
## - homeowner 1 3260.8 3300.8
## - time_lag 1 3260.9 3300.9
## - last_gift 1 3261.2 3301.2
## - home_value 1 3261.2 3301.2
## <none> 3260.4 3302.4
## - num_prom 1 3262.7 3302.7
## - wealth 1 3262.9 3302.9
## - income 1 3264.8 3304.8
## - zipconvert3 1 3265.8 3305.8
## - zipconvert2 1 3265.9 3305.9
## - zipconvert4 1 3266.0 3306.0
## - zipconvert5 1 3266.0 3306.0
## - num_child 1 3267.2 3307.2
## - months_since_donate 1 3284.2 3324.2
##
## Step: AIC=3300.39
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## homeowner + num_child + income + female + wealth + home_value +
## med_fam_inc + avg_fam_inc + pct_lt15k + num_prom + lifetime_gifts +
## last_gift + months_since_donate + time_lag + avg_gift
##
## Df Deviance AIC
## - med_fam_inc 1 3260.4 3298.4
## - pct_lt15k 1 3260.6 3298.6
## - avg_gift 1 3260.6 3298.6
## - female 1 3260.7 3298.7
## - lifetime_gifts 1 3260.7 3298.7
## - avg_fam_inc 1 3260.7 3298.7
## - homeowner 1 3260.8 3298.8
## - time_lag 1 3261.0 3299.0
## - home_value 1 3261.2 3299.2
## - last_gift 1 3261.3 3299.3
## <none> 3260.4 3300.4
## - num_prom 1 3262.8 3300.8
## - wealth 1 3262.9 3300.9
## + largest_gift 1 3260.4 3302.4
## - income 1 3264.8 3302.8
## - zipconvert3 1 3265.8 3303.8
## - zipconvert2 1 3266.0 3304.0
## - zipconvert4 1 3266.0 3304.0
## - zipconvert5 1 3266.1 3304.1
## - num_child 1 3267.2 3305.2
## - months_since_donate 1 3284.2 3322.2
##
## Step: AIC=3298.43
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## homeowner + num_child + income + female + wealth + home_value +
## avg_fam_inc + pct_lt15k + num_prom + lifetime_gifts + last_gift +
## months_since_donate + time_lag + avg_gift
##
## Df Deviance AIC
## - pct_lt15k 1 3260.6 3296.6
## - avg_gift 1 3260.7 3296.7
## - female 1 3260.7 3296.7
## - lifetime_gifts 1 3260.7 3296.7
## - homeowner 1 3260.9 3296.9
## - time_lag 1 3261.0 3297.0
## - avg_fam_inc 1 3261.1 3297.1
## - home_value 1 3261.3 3297.3
## - last_gift 1 3261.3 3297.3
## <none> 3260.4 3298.4
## - num_prom 1 3262.9 3298.9
## - wealth 1 3263.0 3299.0
## + med_fam_inc 1 3260.4 3300.4
## + largest_gift 1 3260.4 3300.4
## - income 1 3264.8 3300.8
## - zipconvert3 1 3265.8 3301.8
## - zipconvert2 1 3266.0 3302.0
## - zipconvert4 1 3266.0 3302.0
## - zipconvert5 1 3266.1 3302.1
## - num_child 1 3267.2 3303.2
## - months_since_donate 1 3284.3 3320.3
##
## Step: AIC=3296.64
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## homeowner + num_child + income + female + wealth + home_value +
## avg_fam_inc + num_prom + lifetime_gifts + last_gift + months_since_donate +
## time_lag + avg_gift
##
## Df Deviance AIC
## - avg_gift 1 3260.9 3294.9
## - lifetime_gifts 1 3260.9 3294.9
## - female 1 3260.9 3294.9
## - homeowner 1 3261.1 3295.1
## - time_lag 1 3261.2 3295.2
## - last_gift 1 3261.5 3295.5
## - home_value 1 3261.8 3295.8
## - avg_fam_inc 1 3262.4 3296.4
## <none> 3260.6 3296.6
## - num_prom 1 3263.0 3297.0
## - wealth 1 3263.0 3297.0
## + pct_lt15k 1 3260.4 3298.4
## + med_fam_inc 1 3260.6 3298.6
## + largest_gift 1 3260.6 3298.6
## - income 1 3265.0 3299.0
## - zipconvert3 1 3266.1 3300.1
## - zipconvert2 1 3266.3 3300.3
## - zipconvert4 1 3266.3 3300.3
## - zipconvert5 1 3266.4 3300.4
## - num_child 1 3267.4 3301.4
## - months_since_donate 1 3284.5 3318.5
##
## Step: AIC=3294.87
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## homeowner + num_child + income + female + wealth + home_value +
## avg_fam_inc + num_prom + lifetime_gifts + last_gift + months_since_donate +
## time_lag
##
## Df Deviance AIC
## - female 1 3261.2 3293.2
## - lifetime_gifts 1 3261.2 3293.2
## - homeowner 1 3261.3 3293.3
## - time_lag 1 3261.4 3293.4
## - home_value 1 3262.0 3294.0
## - avg_fam_inc 1 3262.6 3294.6
## <none> 3260.9 3294.9
## - wealth 1 3263.2 3295.2
## - num_prom 1 3263.7 3295.7
## + avg_gift 1 3260.6 3296.6
## + pct_lt15k 1 3260.7 3296.7
## + med_fam_inc 1 3260.8 3296.8
## + largest_gift 1 3260.9 3296.9
## - income 1 3265.1 3297.1
## - zipconvert3 1 3266.3 3298.3
## - zipconvert2 1 3266.5 3298.5
## - zipconvert4 1 3266.5 3298.5
## - zipconvert5 1 3266.6 3298.6
## - last_gift 1 3267.4 3299.4
## - num_child 1 3267.5 3299.5
## - months_since_donate 1 3284.7 3316.7
##
## Step: AIC=3293.21
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## homeowner + num_child + income + wealth + home_value + avg_fam_inc +
## num_prom + lifetime_gifts + last_gift + months_since_donate +
## time_lag
##
## Df Deviance AIC
## - lifetime_gifts 1 3261.5 3291.5
## - homeowner 1 3261.7 3291.7
## - time_lag 1 3261.7 3291.7
## - home_value 1 3262.3 3292.3
## - avg_fam_inc 1 3262.9 3292.9
## <none> 3261.2 3293.2
## - wealth 1 3263.6 3293.6
## - num_prom 1 3264.0 3294.0
## + female 1 3260.9 3294.9
## + avg_gift 1 3260.9 3294.9
## + pct_lt15k 1 3261.0 3295.0
## + med_fam_inc 1 3261.2 3295.2
## + largest_gift 1 3261.2 3295.2
## - income 1 3265.4 3295.4
## - zipconvert3 1 3266.7 3296.7
## - zipconvert2 1 3266.9 3296.9
## - zipconvert4 1 3267.0 3297.0
## - zipconvert5 1 3267.0 3297.0
## - last_gift 1 3267.9 3297.9
## - num_child 1 3268.0 3298.0
## - months_since_donate 1 3285.1 3315.1
##
## Step: AIC=3291.55
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## homeowner + num_child + income + wealth + home_value + avg_fam_inc +
## num_prom + last_gift + months_since_donate + time_lag
##
## Df Deviance AIC
## - homeowner 1 3262.0 3290.0
## - time_lag 1 3262.1 3290.1
## - home_value 1 3262.6 3290.6
## - avg_fam_inc 1 3263.2 3291.2
## <none> 3261.5 3291.5
## - wealth 1 3263.9 3291.9
## - num_prom 1 3264.1 3292.1
## + avg_gift 1 3261.2 3293.2
## + lifetime_gifts 1 3261.2 3293.2
## + female 1 3261.2 3293.2
## + pct_lt15k 1 3261.3 3293.3
## + largest_gift 1 3261.3 3293.3
## + med_fam_inc 1 3261.5 3293.5
## - income 1 3265.7 3293.7
## - zipconvert3 1 3267.1 3295.1
## - zipconvert2 1 3267.3 3295.3
## - zipconvert4 1 3267.3 3295.3
## - zipconvert5 1 3267.3 3295.3
## - num_child 1 3268.3 3296.3
## - last_gift 1 3270.0 3298.0
## - months_since_donate 1 3285.3 3313.3
##
## Step: AIC=3290.01
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## num_child + income + wealth + home_value + avg_fam_inc +
## num_prom + last_gift + months_since_donate + time_lag
##
## Df Deviance AIC
## - time_lag 1 3262.6 3288.6
## - home_value 1 3263.1 3289.1
## - avg_fam_inc 1 3263.7 3289.7
## <none> 3262.0 3290.0
## - wealth 1 3264.3 3290.3
## - num_prom 1 3264.7 3290.7
## + homeowner 1 3261.5 3291.5
## + avg_gift 1 3261.6 3291.6
## + lifetime_gifts 1 3261.7 3291.7
## + female 1 3261.7 3291.7
## + largest_gift 1 3261.8 3291.8
## + pct_lt15k 1 3261.8 3291.8
## + med_fam_inc 1 3262.0 3292.0
## - income 1 3267.4 3293.4
## - zipconvert3 1 3267.6 3293.6
## - zipconvert2 1 3267.8 3293.8
## - zipconvert4 1 3267.8 3293.8
## - zipconvert5 1 3267.9 3293.9
## - num_child 1 3268.7 3294.7
## - last_gift 1 3270.6 3296.6
## - months_since_donate 1 3285.6 3311.6
##
## Step: AIC=3288.6
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## num_child + income + wealth + home_value + avg_fam_inc +
## num_prom + last_gift + months_since_donate
##
## Df Deviance AIC
## - home_value 1 3263.7 3287.7
## - avg_fam_inc 1 3264.2 3288.2
## <none> 3262.6 3288.6
## - wealth 1 3264.8 3288.8
## - num_prom 1 3265.5 3289.5
## + time_lag 1 3262.0 3290.0
## + homeowner 1 3262.1 3290.1
## + lifetime_gifts 1 3262.2 3290.2
## + avg_gift 1 3262.3 3290.3
## + female 1 3262.3 3290.3
## + largest_gift 1 3262.4 3290.4
## + pct_lt15k 1 3262.4 3290.4
## + med_fam_inc 1 3262.6 3290.6
## - income 1 3267.9 3291.9
## - zipconvert3 1 3268.1 3292.1
## - zipconvert2 1 3268.3 3292.3
## - zipconvert4 1 3268.3 3292.3
## - zipconvert5 1 3268.4 3292.4
## - num_child 1 3269.3 3293.3
## - last_gift 1 3270.9 3294.9
## - months_since_donate 1 3286.0 3310.0
##
## Step: AIC=3287.65
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## num_child + income + wealth + avg_fam_inc + num_prom + last_gift +
## months_since_donate
##
## Df Deviance AIC
## - avg_fam_inc 1 3264.2 3286.2
## <none> 3263.7 3287.7
## - wealth 1 3265.7 3287.7
## - num_prom 1 3266.4 3288.4
## + home_value 1 3262.6 3288.6
## + time_lag 1 3263.1 3289.1
## + homeowner 1 3263.1 3289.1
## + pct_lt15k 1 3263.2 3289.2
## + lifetime_gifts 1 3263.3 3289.3
## + female 1 3263.3 3289.3
## + avg_gift 1 3263.4 3289.4
## + largest_gift 1 3263.4 3289.4
## + med_fam_inc 1 3263.6 3289.6
## - zipconvert3 1 3268.9 3290.9
## - income 1 3269.0 3291.0
## - zipconvert4 1 3269.1 3291.1
## - zipconvert2 1 3269.1 3291.1
## - zipconvert5 1 3269.3 3291.3
## - num_child 1 3270.7 3292.7
## - last_gift 1 3271.6 3293.6
## - months_since_donate 1 3287.2 3309.2
##
## Step: AIC=3286.21
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## num_child + income + wealth + num_prom + last_gift + months_since_donate
##
## Df Deviance AIC
## - wealth 1 3265.8 3285.8
## <none> 3264.2 3286.2
## - num_prom 1 3266.7 3286.7
## + pct_lt15k 1 3263.3 3287.3
## + avg_fam_inc 1 3263.7 3287.7
## + time_lag 1 3263.7 3287.7
## + homeowner 1 3263.7 3287.7
## + med_fam_inc 1 3263.8 3287.8
## + lifetime_gifts 1 3263.9 3287.9
## + female 1 3263.9 3287.9
## + avg_gift 1 3263.9 3287.9
## + largest_gift 1 3264.0 3288.0
## + home_value 1 3264.2 3288.2
## - income 1 3269.0 3289.0
## - zipconvert3 1 3269.5 3289.5
## - zipconvert4 1 3269.7 3289.7
## - zipconvert2 1 3269.8 3289.8
## - zipconvert5 1 3269.9 3289.9
## - num_child 1 3271.4 3291.4
## - last_gift 1 3272.5 3292.5
## - months_since_donate 1 3287.8 3307.8
##
## Step: AIC=3285.81
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## num_child + income + num_prom + last_gift + months_since_donate
##
## Df Deviance AIC
## - num_prom 1 3267.2 3285.2
## <none> 3265.8 3285.8
## + wealth 1 3264.2 3286.2
## + homeowner 1 3265.3 3287.3
## + time_lag 1 3265.4 3287.4
## + lifetime_gifts 1 3265.5 3287.5
## + female 1 3265.5 3287.5
## + avg_gift 1 3265.5 3287.5
## + home_value 1 3265.6 3287.6
## + pct_lt15k 1 3265.6 3287.6
## + largest_gift 1 3265.6 3287.6
## + avg_fam_inc 1 3265.7 3287.7
## + med_fam_inc 1 3265.8 3287.8
## - zipconvert3 1 3271.3 3289.3
## - zipconvert4 1 3271.5 3289.5
## - zipconvert2 1 3271.5 3289.5
## - zipconvert5 1 3271.7 3289.7
## - income 1 3272.0 3290.0
## - num_child 1 3272.9 3290.9
## - last_gift 1 3273.9 3291.9
## - months_since_donate 1 3290.9 3308.9
##
## Step: AIC=3285.17
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## num_child + income + last_gift + months_since_donate
##
## Df Deviance AIC
## <none> 3267.2 3285.2
## + num_prom 1 3265.8 3285.8
## + time_lag 1 3266.5 3286.5
## + avg_gift 1 3266.6 3286.6
## + homeowner 1 3266.6 3286.6
## + wealth 1 3266.7 3286.7
## + female 1 3266.9 3286.9
## + pct_lt15k 1 3267.0 3287.0
## + home_value 1 3267.0 3287.0
## + avg_fam_inc 1 3267.1 3287.1
## + largest_gift 1 3267.1 3287.1
## + med_fam_inc 1 3267.1 3287.1
## + lifetime_gifts 1 3267.2 3287.2
## - zipconvert3 1 3272.7 3288.7
## - zipconvert4 1 3273.0 3289.0
## - zipconvert2 1 3273.0 3289.0
## - income 1 3273.1 3289.1
## - zipconvert5 1 3273.2 3289.2
## - num_child 1 3274.9 3290.9
## - last_gift 1 3275.3 3291.3
## - months_since_donate 1 3297.6 3313.6summary(stepwise_model)##
## Call:
## glm(formula = target ~ zipconvert2 + zipconvert3 + zipconvert4 +
## zipconvert5 + num_child + income + last_gift + months_since_donate,
## family = binomial, data = train_set)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -11.577819 266.937790 -0.043 0.96540
## zipconvert2Yes 13.644397 266.937600 0.051 0.95923
## zipconvert3Yes 13.580571 266.937601 0.051 0.95942
## zipconvert4Yes 13.638093 266.937599 0.051 0.95925
## zipconvert5Yes 13.678754 266.937593 0.051 0.95913
## num_child -0.338467 0.125896 -2.688 0.00718 **
## income 0.062232 0.025630 2.428 0.01518 *
## last_gift -0.011469 0.004201 -2.730 0.00634 **
## months_since_donate -0.057469 0.010585 -5.429 5.66e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 3328.5 on 2400 degrees of freedom
## Residual deviance: 3267.2 on 2392 degrees of freedom
## AIC: 3285.2
##
## Number of Fisher Scoring iterations: 12Evaluate the Stepwise Model on Validation Data
stepwise_predictions <- predict(stepwise_model, newdata = validation_set, type = "response")
stepwise_pred_class <- ifelse(stepwise_predictions > 0.5, "Donor", "No Donor")
stepwise_pred_class <- factor(stepwise_pred_class, levels = c("No Donor", "Donor"))
validation_set$target <- factor(validation_set$target, levels = c(0, 1), labels = c("No Donor", "Donor"))
conf_matrix <- confusionMatrix(stepwise_pred_class, validation_set$target)
print(conf_matrix)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Donor Donor
## No Donor 153 105
## Donor 147 194
##
## Accuracy : 0.5793
## 95% CI : (0.5386, 0.6192)
## No Information Rate : 0.5008
## P-Value [Acc > NIR] : 7.023e-05
##
## Kappa : 0.1588
##
## Mcnemar's Test P-Value : 0.009801
##
## Sensitivity : 0.5100
## Specificity : 0.6488
## Pos Pred Value : 0.5930
## Neg Pred Value : 0.5689
## Prevalence : 0.5008
## Detection Rate : 0.2554
## Detection Prevalence : 0.4307
## Balanced Accuracy : 0.5794
##
## 'Positive' Class : No Donor
## summary(stepwise_model)##
## Call:
## glm(formula = target ~ zipconvert2 + zipconvert3 + zipconvert4 +
## zipconvert5 + num_child + income + last_gift + months_since_donate,
## family = binomial, data = train_set)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -11.577819 266.937790 -0.043 0.96540
## zipconvert2Yes 13.644397 266.937600 0.051 0.95923
## zipconvert3Yes 13.580571 266.937601 0.051 0.95942
## zipconvert4Yes 13.638093 266.937599 0.051 0.95925
## zipconvert5Yes 13.678754 266.937593 0.051 0.95913
## num_child -0.338467 0.125896 -2.688 0.00718 **
## income 0.062232 0.025630 2.428 0.01518 *
## last_gift -0.011469 0.004201 -2.730 0.00634 **
## months_since_donate -0.057469 0.010585 -5.429 5.66e-08 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 3328.5 on 2400 degrees of freedom
## Residual deviance: 3267.2 on 2392 degrees of freedom
## AIC: 3285.2
##
## Number of Fisher Scoring iterations: 12Random Forest
According to my results, I got an accuracy rate of 54.42% which is a little lower than the logistic regression.
fundraising_data <- read_csv("/Users/paymankhalid/Desktop/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.fundraising_data$target <- factor(ifelse(fundraising_data$target == "Donor", 1, 0), levels = c(0, 1), labels = c("No Donor", "Donor"))
set.seed(12345)
trainIndex <- createDataPartition(fundraising_data$target, p = .8, list = FALSE)
train_set <- fundraising_data[trainIndex, ]
validation_set <- fundraising_data[-trainIndex, ]
train_set$target <- factor(train_set$target, levels = c("No Donor", "Donor"))
validation_set$target <- factor(validation_set$target, levels = c("No Donor", "Donor"))Train the Random Forest with zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 + num_child + income + last_gift + months_since_donate variables
set.seed(12345)
rf_model <- randomForest(target ~ zipconvert2 + zipconvert3 + zipconvert4 +
zipconvert5 + num_child + income + last_gift + months_since_donate,
data = train_set, importance = TRUE)
print(rf_model)##
## Call:
## randomForest(formula = target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 + num_child + income + last_gift + months_since_donate, data = train_set, importance = TRUE)
## Type of random forest: classification
## Number of trees: 500
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 49.94%
## Confusion matrix:
## No Donor Donor class.error
## No Donor 581 620 0.5162365
## Donor 579 621 0.4825000varImpPlot(rf_model)
Predict and Evaluate the Random Forest Model on Validation Data
rf_predictions <- predict(rf_model, newdata = validation_set)
rf_predictions <- factor(rf_predictions, levels = c("No Donor", "Donor"))
conf_matrix_rf <- confusionMatrix(rf_predictions, validation_set$target)
print(conf_matrix_rf)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Donor Donor
## No Donor 156 129
## Donor 144 170
##
## Accuracy : 0.5442
## 95% CI : (0.5034, 0.5847)
## No Information Rate : 0.5008
## P-Value [Acc > NIR] : 0.01854
##
## Kappa : 0.0886
##
## Mcnemar's Test P-Value : 0.39682
##
## Sensitivity : 0.5200
## Specificity : 0.5686
## Pos Pred Value : 0.5474
## Neg Pred Value : 0.5414
## Prevalence : 0.5008
## Detection Rate : 0.2604
## Detection Prevalence : 0.4758
## Balanced Accuracy : 0.5443
##
## 'Positive' Class : No Donor
## Naive Bayes
According to my results, my Naive Bayes accuracy was 54.09%
set.seed(12345)
trainIndex <- createDataPartition(fundraising_data$target, p = .8, list = FALSE)
train_set <- fundraising_data[trainIndex, ]
validation_set <- fundraising_data[-trainIndex, ]
train_set$target <- factor(train_set$target, levels = c("No Donor", "Donor"))
validation_set$target <- factor(validation_set$target, levels = c("No Donor", "Donor"))
train_data <- train_set[, c("zipconvert2", "zipconvert3", "zipconvert4", "zipconvert5", "num_child", "income", "last_gift", "months_since_donate")]
train_labels <- train_set$target
validation_data <- validation_set[, c("zipconvert2", "zipconvert3", "zipconvert4", "zipconvert5", "num_child", "income", "last_gift", "months_since_donate")]
validation_labels <- validation_set$targetTrain Naive Bayes
nb_model <- naiveBayes(train_data, train_labels)
print(nb_model)##
## Naive Bayes Classifier for Discrete Predictors
##
## Call:
## naiveBayes.default(x = train_data, y = train_labels)
##
## A-priori probabilities:
## train_labels
## No Donor Donor
## 0.5002082 0.4997918
##
## Conditional probabilities:
## zipconvert2
## train_labels No Yes
## No Donor 0.7885096 0.2114904
## Donor 0.7908333 0.2091667
##
## zipconvert3
## train_labels No Yes
## No Donor 0.8068276 0.1931724
## Donor 0.8183333 0.1816667
##
## zipconvert4
## train_labels No Yes
## No Donor 0.7835137 0.2164863
## Donor 0.7875000 0.2125000
##
## zipconvert5
## train_labels No Yes
## No Donor 0.6244796 0.3755204
## Donor 0.6033333 0.3966667
##
## num_child
## train_labels [,1] [,2]
## No Donor 1.089092 0.4015253
## Donor 1.052500 0.2912292
##
## income
## train_labels [,1] [,2]
## No Donor 3.858451 1.646698
## Donor 3.964167 1.647264
##
## last_gift
## train_labels [,1] [,2]
## No Donor 14.34471 10.65906
## Donor 12.82667 10.99458
##
## months_since_donate
## train_labels [,1] [,2]
## No Donor 31.62864 3.855988
## Donor 30.64250 4.289136Predict and Evaluate the Naive Bayes Model on Validation Data
nb_predictions <- predict(nb_model, validation_data)
conf_matrix_nb <- confusionMatrix(nb_predictions, validation_labels)
print(conf_matrix_nb)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Donor Donor
## No Donor 60 35
## Donor 240 264
##
## Accuracy : 0.5409
## 95% CI : (0.5, 0.5814)
## No Information Rate : 0.5008
## P-Value [Acc > NIR] : 0.02736
##
## Kappa : 0.0828
##
## Mcnemar's Test P-Value : < 2e-16
##
## Sensitivity : 0.2000
## Specificity : 0.8829
## Pos Pred Value : 0.6316
## Neg Pred Value : 0.5238
## Prevalence : 0.5008
## Detection Rate : 0.1002
## Detection Prevalence : 0.1586
## Balanced Accuracy : 0.5415
##
## 'Positive' Class : No Donor
## Decision Tree
According to my decision tree, I got a result of 55.59 accuracy.
set.seed(12345)
trainIndex <- createDataPartition(fundraising_data$target, p = .8, list = FALSE)
train_set <- fundraising_data[trainIndex, ]
validation_set <- fundraising_data[-trainIndex, ]
train_set$target <- factor(train_set$target, levels = c("No Donor", "Donor"))
validation_set$target <- factor(validation_set$target, levels = c("No Donor", "Donor"))
train_data <- train_set[, c("zipconvert2", "zipconvert3", "zipconvert4", "zipconvert5", "num_child", "income", "last_gift", "months_since_donate")]
train_labels <- train_set$target
validation_data <- validation_set[, c("zipconvert2", "zipconvert3", "zipconvert4", "zipconvert5", "num_child", "income", "last_gift", "months_since_donate")]
validation_labels <- validation_set$targetTrain Decision Tree
dt_model <- rpart(target ~ zipconvert2 + zipconvert3 + zipconvert4 +
zipconvert5 + num_child + income + last_gift + months_since_donate,
data = train_set, method = "class")
rpart.plot(dt_model)
## Predict and Evaluate the Decision Tree Model on Validation Data
dt_predictions <- predict(dt_model, newdata = validation_set, type = "class")
conf_matrix_dt <- confusionMatrix(dt_predictions, validation_labels)
print(conf_matrix_dt)## Confusion Matrix and Statistics
##
## Reference
## Prediction No Donor Donor
## No Donor 107 73
## Donor 193 226
##
## Accuracy : 0.5559
## 95% CI : (0.5151, 0.5962)
## No Information Rate : 0.5008
## P-Value [Acc > NIR] : 0.003928
##
## Kappa : 0.1124
##
## Mcnemar's Test P-Value : 2.957e-13
##
## Sensitivity : 0.3567
## Specificity : 0.7559
## Pos Pred Value : 0.5944
## Neg Pred Value : 0.5394
## Prevalence : 0.5008
## Detection Rate : 0.1786
## Detection Prevalence : 0.3005
## Balanced Accuracy : 0.5563
##
## 'Positive' Class : No Donor
## Model Comparison
# Consolidate accuracy metrics into a data frame
accuracy_comparison <- data.frame(
Model = c("Logistic Regression", "Random Forest", "Naive Bayes", "Decision Tree"),
Accuracy = c(0.5793, 0.5442, 0.5409, 0.5559)
)
print(accuracy_comparison)## Model Accuracy
## 1 Logistic Regression 0.5793
## 2 Random Forest 0.5442
## 3 Naive Bayes 0.5409
## 4 Decision Tree 0.5559ggplot(accuracy_comparison, aes(x = Model, y = Accuracy, fill = Model)) +
geom_bar(stat = "identity", position = "dodge") +
geom_text(aes(label = round(Accuracy, 4)), vjust = 1.5, color = "white", size = 4) +
labs(title = "Model Accuracy Comparison", y = "Accuracy") +
theme_minimal() +
theme(axis.text.x = element_text(angle = 45, hjust = 1))
## Results, Conclusion, and Recommendation For my model, I used Decision
Tree, Logistic Regression, Naive Bayes, and Random Forest and according
to my reults, my logistic regression was the best. My accuracy score was
57.93, my other modles were really close with 55.59% for Decision Tree,
54.09% for Naive Bayes(which was the worst), and 55.42 for Random
Forest. I used stepwise AIC selection most helpful variables were
zipconvert2, zipconvert3, zipconvert4, zipconvert5, num_child, income,
last_gift, and months_since_donate. And the ones that were significant
were months_since_donate, last_gift, income, num_child and num_prom. For
the next mail campaign,
I recommend targeting individuals based on their recent donation history, the amount of their most recent gift, household income, number of children, and the lifetime number of promotions received.
Testing the future fundraising
Step 3: Testing. The file FutureFundraising.csv contains the attributes for future mailing candidates.
train_set$target <- factor(train_set$target, levels = c("No Donor", "Donor"))
full_model <- glm(target ~ zipconvert2 + zipconvert3 + zipconvert4 +
zipconvert5 + num_child + income + last_gift + months_since_donate, data = train_set, family = binomial)
stepwise_model <- step(full_model, direction = "both")## Start: AIC=3285.17
## target ~ zipconvert2 + zipconvert3 + zipconvert4 + zipconvert5 +
## num_child + income + last_gift + months_since_donate
##
## Df Deviance AIC
## <none> 3267.2 3285.2
## - zipconvert3 1 3272.7 3288.7
## - zipconvert4 1 3273.0 3289.0
## - zipconvert2 1 3273.0 3289.0
## - income 1 3273.1 3289.1
## - zipconvert5 1 3273.2 3289.2
## - num_child 1 3274.9 3290.9
## - last_gift 1 3275.3 3291.3
## - months_since_donate 1 3297.6 3313.6future_predictions <- predict(stepwise_model, newdata = future_fundraising_data, type = "response")
future_pred_class <- ifelse(future_predictions > 0.5, "Donor", "No Donor")submission <- data.frame(value = future_pred_class)
str(submission)## 'data.frame': 120 obs. of 1 variable:
## $ value: chr "Donor" "No Donor" "No Donor" "No Donor" ...head(submission)## value
## 1 Donor
## 2 No Donor
## 3 No Donor
## 4 No Donor
## 5 Donor
## 6 No Donorwrite_csv(submission, "future_predictions.csv")