Mission475Solutions.Rmd

---
title: "Conditional Probability in R: Guided Project Solutions"
output: html_document
---

```{r, warning = FALSE, message = FALSE }
library(tidyverse)
set.seed(1)
options(dplyr.summarise.inform = FALSE)
```

# Introduction

This analysis is an application of what we've learned in Dataquest's Conditional Probability course. Using a dataset of pre-labeled SMS messages, we'll create a spam filter using the Naive Bayes algorithm.

```{r}
# Bring in the dataset
spam <- read_csv("spam.csv")
```

The `spam` dataset has `r nrow(spam)` rows and `r ncol(spam)` columns. Of these messages, `r mean(spam$label == "ham") * 100`% of them are not classified as spam, the rest are spam.

# Training, Cross-validation and Test Sets

```{r}
# Calculate some helper values to split the dataset
n <- nrow(spam)
n_training <- 0.8 * n
n_cv <- 0.1 * n
n_test <- 0.1 * n

# Create the random indices for training set
train_indices <- sample(1:n, size = n_training, replace = FALSE)

# Get indices not used by the training set
remaining_indices <- setdiff(1:n, train_indices)

# Remaining indices are already randomized, just allocate correctly
cv_indices <- remaining_indices[1:(length(remaining_indices)/2)]
test_indices <- remaining_indices[((length(remaining_indices)/2) + 1):length(remaining_indices)]

# Use the indices to create each of the datasets
spam_train <- spam[train_indices,]
spam_cv <- spam[cv_indices,]
spam_test <- spam[test_indices,]

# Sanity check: are the ratios of ham to spam relatively constant?
print(mean(spam_train$label == "ham"))
print(mean(spam_cv$label == "ham"))
print(mean(spam_test$label == "ham"))
```

The number of ham messages in each dataset is relatively close to each other in each dataset. This is just to make sure that no dataset is entirely just "ham", which ruins the point of spam detection.

# Data Cleaning

```{r}
# To lowercase, removal of punctuation, weird characters, digits
tidy_train <- spam_train %>% 
  mutate(
    # Take the messages and remove unwanted characters
    sms = str_to_lower(sms) %>% 
      str_squish %>% 
      str_replace_all("[[:punct:]]", "") %>% 
      str_replace_all("[\u0094\u0092\u0096\n\t]", "") %>% # Unicode characters
      str_replace_all("[[:digit:]]", "")
  )

# Creating the vocabulary
vocabulary <- NULL
messages <- tidy_train %>%  pull(sms)

# Iterate through the messages and add to the vocabulary
for (m in messages) {
  words <- str_split(m, " ")[[1]]
  vocabulary <- c(vocabulary, words)
}

# Remove duplicates from the vocabulary 
vocabulary <- vocabulary %>% unique()
```

# Calculating Constants and Parameters

```{r}
# Isolate the spam and ham messages
spam_messages <- tidy_train %>% 
  filter(label == "spam") %>% 
  pull(sms)

ham_messages <- tidy_train %>% 
  filter(label == "ham") %>% 
  pull(sms)

# Isolate the vocabulary in spam and ham messages
spam_vocab <- NULL
for (sm in spam_messages) {
  words <- str_split(sm, " ")[[1]]
  spam_vocab  <- c(spam_vocab, words)
}
spam_vocab

ham_vocab <- NULL
for (hm in ham_messages) {
  words <- str_split(hm, " ")[[1]]
  ham_vocab <- c(ham_vocab, words)
}
ham_vocab

# Calculate some important parameters from the vocab
n_spam <- spam_vocab %>% length()
n_ham <- ham_vocab %>% length()
n_vocabulary <- vocabulary %>% length()
```

# Calculating Probability Parameters

```{r}
# New vectorized approach to a calculating ham and spam probabilities

# Marginal probability of a training message being spam or ham
p_spam <- mean(tidy_train$label == "spam")
p_ham <- mean(tidy_train$label == "ham")

# Break up the spam and ham counting into their own tibbles
spam_counts <- tibble(
  word = spam_vocab
) %>% 
  mutate(
    # Calculate the number of times a word appears in spam
    spam_count = map_int(word, function(w) {
      
      # Count how many times each word appears in all spam messsages, then sum
      map_int(spam_messages, function(sm) {
        (str_split(sm, " ")[[1]] == w) %>% sum # for a single message
      }) %>% 
        sum # then summing over all messages
      
    })
  )

# There are many words in the ham vocabulary so this will take a while!
# Run this code and distract yourself while the counts are calculated
ham_counts <- tibble(
  word = ham_vocab
) %>% 
  mutate(
    # Calculate the number of times a word appears in ham
    ham_count = map_int(word, function(w) {
      
      # Count how many times each word appears in all ham messsages, then sum
      map_int(ham_messages, function(hm) {
        (str_split(hm, " ")[[1]] == w) %>% sum 
      }) %>% 
        sum
      
    })
  )

# Join these tibbles together
word_counts <- full_join(spam_counts, ham_counts, by = "word") %>% 
  mutate(
    # Fill in zeroes where there are missing values
    spam_count = ifelse(is.na(spam_count), 0, spam_count),
    ham_count = ifelse(is.na(ham_count), 0, ham_count)
  )
```


# Classifying New Messages

```{r}
# This is the updated function using the vectorized approach to calculating
# the spam and ham probabilities

# Create a function that makes it easy to classify a tibble of messages
# we add an alpha argument to make it easy to recalculate probabilities 
# based on this alpha (default to 1)
classify <- function(message, alpha = 1) {
  
  # Splitting and cleaning the new message
  # This is the same cleaning procedure used on the training messages
  clean_message <- str_to_lower(message) %>% 
    str_squish %>% 
      str_replace_all("[[:punct:]]", "") %>% 
      str_replace_all("[\u0094\u0092\u0096\n\t]", "") %>% # Unicode characters
      str_replace_all("[[:digit:]]", "")
  
  words <- str_split(clean_message, " ")[[1]]
  
  # There is a possibility that there will be words that don't appear
  # in the training vocabulary, so this must be accounted for
  
  # Find the words that aren't present in the training
  new_words <- setdiff(vocabulary, words)
  
  # Add them to the word_counts 
  new_word_probs <- tibble(
    word = new_words,
    spam_prob = 1,
    ham_prob = 1
  )

  # Filter down the probabilities to the words present 
  # use group by to multiply everything together
  present_probs <- word_counts %>% 
    filter(word %in% words) %>% 
    mutate(
      # Calculate the probabilities from the counts
      spam_prob = (spam_count + alpha) / (n_spam + alpha * n_vocabulary),
      ham_prob = (ham_count + alpha) / (n_ham + alpha * n_vocabulary)
    ) %>% 
    bind_rows(new_word_probs) %>% 
    pivot_longer(
      cols = c("spam_prob", "ham_prob"),
      names_to = "label",
      values_to = "prob"
    ) %>% 
    group_by(label) %>% 
    summarize(
      wi_prob = prod(prob) # prod is like sum, but with multiplication
    )
 
  # Calculate the conditional probabilities
  p_spam_given_message <- p_spam * (present_probs %>% filter(label == "spam_prob") %>% pull(wi_prob))
  p_ham_given_message <- p_ham * (present_probs %>% filter(label == "ham_prob") %>% pull(wi_prob))
  
  # Classify the message based on the probability
  ifelse(p_spam_given_message >= p_ham_given_message, "spam", "ham")
}

# Use the classify function to classify the messages in the training set
# This takes advantage of vectorization
final_train <- tidy_train %>% 
  mutate(
    prediction = map_chr(sms, function(m) { classify(m) })
  ) 
```

# Calculating Accuracy

```{r}
# Results of classification on training
confusion <- table(final_train$label, final_train$prediction)
accuracy <- (confusion[1,1] + confusion[2,2]) / nrow(final_train)
```


The Naive Bayes Classifier achieves an accuracy of about 89%. Pretty good! Let's see how well it works on messages that it has never seen before.

# Hyperparameter Tuning

```{r}
alpha_grid <- seq(0.05, 1, by = 0.05)
cv_accuracy <- NULL

for (alpha in alpha_grid) {
  
  # Recalculate probabilities based on new alpha
  cv_probs <- word_counts %>% 
    mutate(
      # Calculate the probabilities from the counts based on new alpha
      spam_prob = (spam_count + alpha / (n_spam + alpha * n_vocabulary)),
      ham_prob = (ham_count + alpha) / (n_ham + alpha * n_vocabulary)
    )
  
  # Predict the classification of each message in cross validation
  cv <- spam_cv %>% 
    mutate(
      prediction = map_chr(sms, function(m) { classify(m, alpha = alpha) })
    ) 
  
  # Assess the accuracy of the classifier on cross-validation set
  confusion <- table(cv$label, cv$prediction)
  acc <- (confusion[1,1] + confusion[2,2]) / nrow(cv)
  cv_accuracy <- c(cv_accuracy, acc)
}

# Check out what the best alpha value is
tibble(
  alpha = alpha_grid,
  accuracy = cv_accuracy
)
```

Judging from the cross-validation set, higher $\alpha$ values cause the accuracy to decrease. We'll go with $\alpha = 0.1$ since it produces the highest cross-validation prediction accuracy.

# Test Set Performance

```{r}
# Reestablishing the proper parameters
optimal_alpha <- 0.1

# Using optimal alpha with training parameters, perform final predictions
spam_test <- spam_test %>% 
  mutate(
    prediction = map_chr(sms, function(m) { classify(m, alpha = optimal_alpha)} )
    )
  
confusion <- table(spam_test$label, spam_test$prediction)
test_accuracy <- (confusion[1,1] + confusion[2,2]) / nrow(spam_test)
test_accuracy
```

We've achieved an accuracy of 93% in the test set. Not bad!