Apply 5 2.0
Cam Paquette
2025-03-06
Import Data
library(tidyverse)## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.4 ✔ readr 2.1.5
## ✔ forcats 1.0.0 ✔ stringr 1.5.1
## ✔ ggplot2 3.5.1 ✔ tibble 3.2.1
## ✔ lubridate 1.9.3 ✔ tidyr 1.3.1
## ✔ purrr 1.0.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(correlationfunnel)## Warning: package 'correlationfunnel' was built under R version 4.4.2## ══ Using correlationfunnel? ════════════════════════════════════════════════════
## You might also be interested in applied data science training for business.
## </> Learn more at - www.business-science.io </>data <- readr::read_csv('https://raw.githubusercontent.com/rfordatascience/tidytuesday/main/data/2023/2023-08-15/spam.csv')## Rows: 4601 Columns: 7
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (1): yesno
## dbl (6): crl.tot, dollar, bang, money, n000, make
##
## ℹ 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.Explore data
skimr::skim(data)| Name | data |
| Number of rows | 4601 |
| Number of columns | 7 |
| _______________________ | |
| Column type frequency: | |
| character | 1 |
| numeric | 6 |
| ________________________ | |
| Group variables | None |
Variable type: character
| skim_variable | n_missing | complete_rate | min | max | empty | n_unique | whitespace |
|---|---|---|---|---|---|---|---|
| yesno | 0 | 1 | 1 | 1 | 0 | 2 | 0 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| crl.tot | 0 | 1 | 283.29 | 606.35 | 1 | 35 | 95 | 266.00 | 15841.00 | ▇▁▁▁▁ |
| dollar | 0 | 1 | 0.08 | 0.25 | 0 | 0 | 0 | 0.05 | 6.00 | ▇▁▁▁▁ |
| bang | 0 | 1 | 0.27 | 0.82 | 0 | 0 | 0 | 0.32 | 32.48 | ▇▁▁▁▁ |
| money | 0 | 1 | 0.09 | 0.44 | 0 | 0 | 0 | 0.00 | 12.50 | ▇▁▁▁▁ |
| n000 | 0 | 1 | 0.10 | 0.35 | 0 | 0 | 0 | 0.00 | 5.45 | ▇▁▁▁▁ |
| make | 0 | 1 | 0.10 | 0.31 | 0 | 0 | 0 | 0.00 | 4.54 | ▇▁▁▁▁ |
Comparing the occurrence of the dollar/money sign and how it relates to emails being spam
data %>%
filter(dollar > 0, money > 0) %>%
ggplot(aes(money, dollar, color = yesno)) +
geom_point(alpha = 0.3, size = 1.0)
data %>%
ggplot(aes(dollar, y = after_stat(density), fill = yesno)) +
geom_histogram(position = "identity", alpha = 1.0)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
data %>%
ggplot(aes(money, y = after_stat(density), fill = yesno)) +
geom_histogram(position = "identity", alpha = 1.0)## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
# Step 1: Binarize
data_binarized <- data %>%
select(-dollar) %>%
binarize()
data_binarized %>% glimpse()## Rows: 4,601
## Columns: 15
## $ `crl.tot__-Inf_35` <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0, …
## $ crl.tot__35_95 <dbl> 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ crl.tot__95_266 <dbl> 0, 0, 0, 1, 1, 0, 1, 0, 0, 0, 0, 1, 1, 0, 1, 1, 1, …
## $ crl.tot__266_Inf <dbl> 1, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, …
## $ `bang__-Inf_0.315` <dbl> 0, 0, 1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 0, 0, 0, …
## $ bang__0.315_Inf <dbl> 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 0, 1, 1, 1, …
## $ money__0 <dbl> 1, 0, 0, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 1, 1, 0, 1, …
## $ `money__-OTHER` <dbl> 0, 1, 1, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 1, 0, …
## $ n000__0 <dbl> 1, 0, 0, 1, 1, 1, 1, 1, 1, 0, 1, 1, 1, 1, 0, 1, 1, …
## $ `n000__-OTHER` <dbl> 0, 1, 1, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 1, 0, 0, …
## $ make__0 <dbl> 1, 0, 0, 1, 1, 1, 1, 1, 0, 0, 1, 1, 1, 1, 1, 1, 1, …
## $ make__0.1 <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ `make__-OTHER` <dbl> 0, 1, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 0, 0, 0, …
## $ yesno__n <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …
## $ yesno__y <dbl> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, …# Step 2: Correlation
data_correlation <- data_binarized %>%
correlate(yesno__y)
data_correlation## # A tibble: 15 × 3
## feature bin correlation
## <fct> <chr> <dbl>
## 1 yesno n -1
## 2 yesno y 1
## 3 bang -Inf_0.315 -0.490
## 4 bang 0.315_Inf 0.490
## 5 money -OTHER 0.475
## 6 money 0 -0.475
## 7 n000 0 -0.419
## 8 n000 -OTHER 0.419
## 9 crl.tot -Inf_35 -0.360
## 10 crl.tot 266_Inf 0.299
## 11 make 0 -0.239
## 12 make -OTHER 0.223
## 13 crl.tot 95_266 0.145
## 14 crl.tot 35_95 -0.0818
## 15 make 0.1 0.0803# Step 3: Plot
data_correlation %>%
correlationfunnel::plot_correlation_funnel()
Build a model
library(tidymodels)## Warning: package 'tidymodels' was built under R version 4.4.2## ── Attaching packages ────────────────────────────────────── tidymodels 1.2.0 ──## ✔ broom 1.0.6 ✔ rsample 1.2.1
## ✔ dials 1.3.0 ✔ tune 1.2.1
## ✔ infer 1.0.7 ✔ workflows 1.1.4
## ✔ modeldata 1.4.0 ✔ workflowsets 1.1.0
## ✔ parsnip 1.2.1 ✔ yardstick 1.3.2
## ✔ recipes 1.1.0## Warning: package 'dials' was built under R version 4.4.2## Warning: package 'infer' was built under R version 4.4.2## Warning: package 'modeldata' was built under R version 4.4.2## Warning: package 'parsnip' was built under R version 4.4.2## Warning: package 'tune' was built under R version 4.4.2## Warning: package 'workflows' was built under R version 4.4.2## Warning: package 'workflowsets' was built under R version 4.4.2## Warning: package 'yardstick' was built under R version 4.4.2## ── Conflicts ───────────────────────────────────────── tidymodels_conflicts() ──
## ✖ scales::discard() masks purrr::discard()
## ✖ dplyr::filter() masks stats::filter()
## ✖ recipes::fixed() masks stringr::fixed()
## ✖ dplyr::lag() masks stats::lag()
## ✖ yardstick::spec() masks readr::spec()
## ✖ recipes::step() masks stats::step()
## • Search for functions across packages at https://www.tidymodels.org/find/set.seed(123)
spam_split <- initial_split(data, strata =yesno)
spam_train <- training(spam_split)
spam_test <- testing(spam_split)
set.seed(278)
spam_folds <- vfold_cv(spam_train, strata = yesno)
spam_folds## # 10-fold cross-validation using stratification
## # A tibble: 10 × 2
## splits id
## <list> <chr>
## 1 <split [3104/346]> Fold01
## 2 <split [3105/345]> Fold02
## 3 <split [3105/345]> Fold03
## 4 <split [3105/345]> Fold04
## 5 <split [3105/345]> Fold05
## 6 <split [3105/345]> Fold06
## 7 <split [3105/345]> Fold07
## 8 <split [3105/345]> Fold08
## 9 <split [3105/345]> Fold09
## 10 <split [3106/344]> Fold10usemodels::use_ranger(yesno ~ ., data = spam_train)## ranger_recipe <-
## recipe(formula = yesno ~ ., data = spam_train)
##
## ranger_spec <-
## rand_forest(mtry = tune(), min_n = tune(), trees = 1000) %>%
## set_mode("classification") %>%
## set_engine("ranger")
##
## ranger_workflow <-
## workflow() %>%
## add_recipe(ranger_recipe) %>%
## add_model(ranger_spec)
##
## set.seed(86942)
## ranger_tune <-
## tune_grid(ranger_workflow, resamples = stop("add your rsample object"), grid = stop("add number of candidate points"))Specify Model
library(themis)## Warning: package 'themis' was built under R version 4.4.3ranger_recipe <-
recipe(formula = yesno ~ ., data = spam_train) %>%
step_unknown(all_nominal_predictors()) %>%
step_other(all_nominal_predictors(), threshold = 0.03)
ranger_spec <-
rand_forest(trees = 1000) %>%
set_mode("classification") %>%
set_engine("ranger")
ranger_workflow <-
workflow() %>%
add_recipe(ranger_recipe) %>%
add_model(ranger_spec)Tune Hyperparameters
doParallel::registerDoParallel()
set.seed(12345)
ranger_rs <- fit_resamples(ranger_workflow, resamples = spam_folds, control = control_resamples(save_pred = TRUE))