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 errors
library(correlationfunnel)
## Warning: package 'correlationfunnel' was built under R version 4.4.2
## ══ correlationfunnel Tip #2 ════════════════════════════════════════════════════
## Clean your NA's prior to using `binarize()`.
## Missing values and cleaning data are critical to getting great correlations. :)
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)
Data summary
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()