library(tidyverse)
## Warning: package 'ggplot2' was built under R version 4.5.2
## Warning: package 'dplyr' was built under R version 4.5.2
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.2
## ✔ ggplot2 4.0.1 ✔ tibble 3.3.0
## ✔ lubridate 1.9.4 ✔ tidyr 1.3.1
## ✔ purrr 1.1.0
## ── 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.5.3
## Loading required package: lattice
##
## Attaching package: 'caret'
##
## The following object is masked from 'package:purrr':
##
## lift
library(DT)
## Warning: package 'DT' was built under R version 4.5.3
set.seed(12345)
library(readr)
fund <- read_csv("school/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.
View(fund)
future_fund <- read_csv("school/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.
View(future_fund)
#response to a factor
fund <- fund %>%
mutate(
target = factor(
target,
levels = c("Donor", "No Donor"),
labels = c("Donor", "No_Donor")
)
)
table(fund$target)
##
## Donor No_Donor
## 1499 1501
prop.table(table(fund$target))
##
## Donor No_Donor
## 0.4996667 0.5003333
round(
prop.table(table(fund$target)) * 100,
2
)
##
## Donor No_Donor
## 49.97 50.03
#split the data to 80/20
set.seed(12345)
train_index <- createDataPartition(
fund$target,
p = 0.80,
list = FALSE
)
fund_train <- fund[train_index, ]
fund_validation <- fund[-train_index, ]
dim(fund_train)
## [1] 2401 21
dim(fund_validation)
## [1] 599 21
table(fund_train$target)
##
## Donor No_Donor
## 1200 1201
table(fund_validation$target)
##
## Donor No_Donor
## 299 300
round(
prop.table(table(fund_train$target)) * 100,
2
)
##
## Donor No_Donor
## 49.98 50.02
round(
prop.table(table(fund_validation$target)) * 100,
2
)
##
## Donor No_Donor
## 49.92 50.08
train_x <- fund_train %>%
select(-target)
train_y <- fund_train$target
validation_x <- fund_validation %>%
select(-target)
validation_y <- fund_validation$target
future_x <- future_fund
cv_control <- trainControl(
method = "cv",
number = 10,
classProbs = TRUE,
summaryFunction = twoClassSummary,
savePredictions = "final"
)
#look at data, check variables and check for any missing values
summary(fund)
## zipconvert2 zipconvert3 zipconvert4 zipconvert5
## Length:3000 Length:3000 Length:3000 Length:3000
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
##
## homeowner num_child income female
## Length:3000 Min. :1.000 Min. :1.000 Length:3000
## Class :character 1st Qu.:1.000 1st Qu.:3.000 Class :character
## Mode :character Median :1.000 Median :4.000 Mode :character
## Mean :1.069 Mean :3.899
## 3rd Qu.:1.000 3rd Qu.:5.000
## 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
## Donor :1499
## No_Donor:1501
##
##
##
##
glimpse(fund)
## 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 <fct> Donor, Donor, No_Donor, No_Donor, Donor, Donor, Do…
str(fund)
## tibble [3,000 × 21] (S3: tbl_df/tbl/data.frame)
## $ zipconvert2 : chr [1:3000] "Yes" "No" "No" "No" ...
## $ zipconvert3 : chr [1:3000] "No" "No" "No" "Yes" ...
## $ zipconvert4 : chr [1:3000] "No" "No" "No" "No" ...
## $ zipconvert5 : chr [1:3000] "No" "Yes" "Yes" "No" ...
## $ homeowner : chr [1:3000] "Yes" "No" "Yes" "Yes" ...
## $ num_child : num [1:3000] 1 2 1 1 1 1 1 1 1 1 ...
## $ income : num [1:3000] 1 5 3 4 4 4 4 4 4 1 ...
## $ female : chr [1:3000] "No" "Yes" "No" "No" ...
## $ wealth : num [1:3000] 7 8 4 8 8 8 5 8 8 5 ...
## $ home_value : num [1:3000] 698 828 1471 547 482 ...
## $ med_fam_inc : num [1:3000] 422 358 484 386 242 450 333 458 541 203 ...
## $ avg_fam_inc : num [1:3000] 463 376 546 432 275 498 388 533 575 271 ...
## $ pct_lt15k : num [1:3000] 4 13 4 7 28 5 16 8 11 39 ...
## $ num_prom : num [1:3000] 46 32 94 20 38 47 51 21 66 73 ...
## $ lifetime_gifts : num [1:3000] 94 30 177 23 73 139 63 26 108 161 ...
## $ largest_gift : num [1:3000] 12 10 10 11 10 20 15 16 12 6 ...
## $ last_gift : num [1:3000] 12 5 8 11 10 20 10 16 7 3 ...
## $ months_since_donate: num [1:3000] 34 29 30 30 31 37 37 30 31 32 ...
## $ time_lag : num [1:3000] 6 7 3 6 3 3 8 6 1 7 ...
## $ avg_gift : num [1:3000] 9.4 4.29 7.08 7.67 7.3 ...
## $ target : Factor w/ 2 levels "Donor","No_Donor": 1 1 2 2 1 1 1 2 1 1 ...
missing_summary <- sapply(fund, function(x) sum(is.na(x)))
missing_summary
## 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
## 0
table(fund$target)
##
## Donor No_Donor
## 1499 1501
prop.table(table(fund$target))
##
## Donor No_Donor
## 0.4996667 0.5003333
numeric_vars <- fund %>%
select(where(is.numeric))
ncol(numeric_vars)
## [1] 14
numeric_vars %>%
pivot_longer(
everything(),
names_to = "Variable",
values_to = "Value"
) %>%
ggplot(aes(Value)) +
geom_histogram(
bins = 30,
fill = "steelblue",
color = "white"
) +
facet_wrap(~Variable, scales = "free") +
theme_minimal()
fund %>%
pivot_longer(
cols = where(is.numeric),
names_to = "Variable",
values_to = "Value"
) %>%
ggplot(aes(target, Value, fill = target)) +
geom_boxplot(alpha = .8) +
facet_wrap(~Variable, scales = "free") +
theme_minimal() +
theme(
legend.position = "none"
)
cor_matrix <- cor(
numeric_vars,
use = "complete.obs"
)
round(cor_matrix, 2)
## num_child income wealth home_value med_fam_inc avg_fam_inc
## num_child 1.00 0.09 0.06 -0.01 0.05 0.05
## income 0.09 1.00 0.21 0.29 0.37 0.38
## wealth 0.06 0.21 1.00 0.26 0.38 0.39
## home_value -0.01 0.29 0.26 1.00 0.74 0.75
## med_fam_inc 0.05 0.37 0.38 0.74 1.00 0.97
## avg_fam_inc 0.05 0.38 0.39 0.75 0.97 1.00
## pct_lt15k -0.03 -0.28 -0.38 -0.40 -0.67 -0.68
## num_prom -0.09 -0.07 -0.41 -0.06 -0.05 -0.06
## lifetime_gifts -0.05 -0.02 -0.23 -0.02 -0.04 -0.04
## largest_gift -0.02 0.03 -0.03 0.06 0.05 0.04
## last_gift -0.01 0.11 0.05 0.16 0.14 0.13
## months_since_donate -0.01 0.08 0.03 0.02 0.03 0.03
## time_lag -0.01 0.00 -0.07 0.00 0.02 0.02
## avg_gift -0.02 0.12 0.09 0.17 0.14 0.13
## pct_lt15k num_prom lifetime_gifts largest_gift last_gift
## num_child -0.03 -0.09 -0.05 -0.02 -0.01
## income -0.28 -0.07 -0.02 0.03 0.11
## wealth -0.38 -0.41 -0.23 -0.03 0.05
## home_value -0.40 -0.06 -0.02 0.06 0.16
## med_fam_inc -0.67 -0.05 -0.04 0.05 0.14
## avg_fam_inc -0.68 -0.06 -0.04 0.04 0.13
## pct_lt15k 1.00 0.04 0.06 -0.01 -0.06
## num_prom 0.04 1.00 0.54 0.11 -0.06
## lifetime_gifts 0.06 0.54 1.00 0.51 0.20
## largest_gift -0.01 0.11 0.51 1.00 0.45
## last_gift -0.06 -0.06 0.20 0.45 1.00
## months_since_donate -0.01 -0.28 -0.14 0.02 0.19
## time_lag -0.02 0.12 0.04 0.04 0.08
## avg_gift -0.06 -0.15 0.18 0.47 0.87
## months_since_donate time_lag avg_gift
## num_child -0.01 -0.01 -0.02
## income 0.08 0.00 0.12
## wealth 0.03 -0.07 0.09
## home_value 0.02 0.00 0.17
## med_fam_inc 0.03 0.02 0.14
## avg_fam_inc 0.03 0.02 0.13
## pct_lt15k -0.01 -0.02 -0.06
## num_prom -0.28 0.12 -0.15
## lifetime_gifts -0.14 0.04 0.18
## largest_gift 0.02 0.04 0.47
## last_gift 0.19 0.08 0.87
## months_since_donate 1.00 0.02 0.19
## time_lag 0.02 1.00 0.07
## avg_gift 0.19 0.07 1.00
library(corrplot)
## Warning: package 'corrplot' was built under R version 4.5.2
## corrplot 0.95 loaded
corrplot(
cor_matrix,
method = "color",
tl.cex = .7,
number.cex = .6
)
fund %>%
group_by(target) %>%
summarise(
across(
where(is.numeric),
mean,
na.rm = TRUE
)
)
## Warning: There was 1 warning in `summarise()`.
## ℹ In argument: `across(where(is.numeric), mean, na.rm = TRUE)`.
## ℹ In group 1: `target = Donor`.
## Caused by warning:
## ! The `...` argument of `across()` is deprecated as of dplyr 1.1.0.
## Supply arguments directly to `.fns` through an anonymous function instead.
##
## # Previously
## across(a:b, mean, na.rm = TRUE)
##
## # Now
## across(a:b, \(x) mean(x, na.rm = TRUE))
## # A tibble: 2 × 15
## target num_child income wealth home_value med_fam_inc avg_fam_inc pct_lt15k
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 Donor 1.05 3.96 6.40 1164. 390. 433. 14.7
## 2 No_Donor 1.08 3.84 6.39 1123. 387. 432. 14.7
## # ℹ 7 more variables: num_prom <dbl>, lifetime_gifts <dbl>, largest_gift <dbl>,
## # last_gift <dbl>, months_since_donate <dbl>, time_lag <dbl>, avg_gift <dbl>
#Overall Distribution of the Predictors The first figure shows the distribution of every numerical predictor.
Several important patterns emerge immediately. Most numerical variables are positively (right) skewed, especially: avg_gift largest_gift last_gift lifetime_gifts home_value
This indicates that most individuals donate relatively small amounts while only a few donors contribute very large gifts. Likewise, neighborhood financial variables such as
home_value avg_fam_inc med_fam_inc
also display long right tails, suggesting substantial variability in socioeconomic status across households. Variables such as: income wealth
are ordinal rather than continuous and therefore naturally appear clustered into categories. The histogram of months_since_donate suggests that many donors have not contributed recently, while num_prom indicates a wide range in the number of promotional mailings previously received.