Mathur_Navodita_FinalProject_Bonus_Part-2,3.Rmd

---
title: "PPG Paint Colors: Final Project"
subtitle: "Bonus : Low Frequency Categories & Imbalanced Dataset"
author: "Navodita Mathur"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
```

## Overview

This RMarkdown shows how to predict probability of binary outcome in the final project data.   

## Load packages

```{r, load_packages}
library(tidyverse)
library(caret)
```

## Read data

The code chunk below reads in the final project data.  
```{r, read_final_data}
df <- readr::read_csv("paint_project_bonus_data.csv", col_names = TRUE)
```

The `readr::read_csv()` function displays the data types and column names associated with the data. However, a glimpse is shown below that reveals the number of rows and also shows some of the representative values for the columns.  

```{r, show_data_glimpse}
df %>% glimpse()
```

The data consist of continuous and categorical inputs. The `glimpse()` shown above reveals the data type for each variable which state to you whether the input is continuous or categorical. The RGB color model inputs, `R`, `G`, and `B` are continuous (dbl) inputs. The HSL color model inputs consist of 2 categorical inputs, `Lightness` and `Saturation`, and a continuous input, `Hue`. Two outputs are provided. The continuous output, `response`, and the Binary output, `outcome`. However, the data type of the Binary outcome is numeric because the Binary `outcome` is **encoded** as `outcome = 1` for the EVENT and `outcome = 0` for the NON-EVENT.  

# Binary classification task

The Binary output variable, `challenge_outcome`, is a numeric variable. `challenge_outcome = 1` denotes the **EVENT** while `challenge_outcome = 0` denotes the **NON-EVENT**. 

Let us have a look if it is a roughly balanced dataset.
```{r}
mean(df$challenge_outcome == 1)
```

No, its not a roughly balanced dataset. We use `recipes` package to handle the same through `step_upsample`

Let us now check for low frequency categories
```{r}
table(df$Lightness)
```

No, there are not any low frequency categories of Lightness.

```{r}
table(df$Saturation)
```

Yes, there are 3 low frequency categories of Saturation

```{r}
fct_count(fct_lump_n(df$Saturation, 7))
```

We use `recipes` package to handle the same through `step_other`

Check for near zero variance
```{r}
nearZeroVar(df, saveMetrics = TRUE)
```

```{r, make_data}
df_bonus_data <- df %>% 
  dplyr::select(-response) %>% 
  dplyr::select(-outcome) %>% 
  dplyr::mutate(challenge_outcome = ifelse(challenge_outcome == 1, 'event', 'non_event'),
         challenge_outcome = factor(challenge_outcome, levels = c('event', 'non_event')))

df_bonus_data %>% glimpse()
```

By converting `outcome` to a factor, the unique values of the variables are "always known":  

```{r, show_outcome_levels}
df_bonus_data %>% pull(challenge_outcome) %>% levels()
```

However, the value counts are the same as the original encoding.  
```{r, confirm_outcome_Counts}
df_bonus_data %>% dplyr::count(challenge_outcome)
```

Load essential libraries
```{r}
library(yardstick)
library(themis)
library(recipes)
library(Deducer)
```

## Model Training and Validation 
## Recipes

Let us create recipes with selected inputs and all inputs
Recipe steps include
1. Subsampling
2. Lumping low frequency categories
3. Account for near zero variance
4. Center
5. Scale
6. Dummy encoding

### Recipe-1
```{r}
recipe_1 <- recipe(challenge_outcome ~ G+Hue+Saturation,
                       data = df_bonus_data) %>% 
  step_upsample(challenge_outcome, over_ratio = 1) %>%
  step_other(Saturation, threshold = .1, other = "Other")%>%
  step_nzv(all_predictors())%>%
  step_center(all_numeric_predictors()) %>% 
  step_scale(all_numeric_predictors()) %>% 
  step_dummy(all_nominal_predictors())
```

### Recipe-2
```{r}
recipe_2 <- recipe(challenge_outcome ~ .,
                       data = df_bonus_data) %>% 
  step_upsample(challenge_outcome, over_ratio = 1) %>%
  step_other(Saturation, threshold = .1, other = "Other")%>%
  step_nzv(all_predictors()) %>%
  step_center(all_numeric_predictors()) %>% 
  step_scale(all_numeric_predictors()) %>% 
  step_dummy(all_nominal_predictors())
```

Train and validate the model using caret with recipes

Models Used
1. Selected Variables -GLM
2. All variables -GLM
3. Gradient Boosted Tree 
4. Random Forest
5. Generalized Additive Models

Performance Metrics
1. ROC
2. Accuracy

## Model Training and Validation Using ROC

Initializing metrics required.
```{r}
glm_ctrl_roc <- trainControl(method = "repeatedcv", number = 5, repeats = 5, summaryFunction=twoClassSummary,  classProbs = TRUE, savePredictions = TRUE)
glm_metric_roc <- "ROC"
```

### Training Model-1

```{r}
set.seed(1001)
fit_bonus_glm_1_roc <- train(recipe_1,
                  data = df_bonus_data ,
                  method = "glm",
                  metric = glm_metric_roc,
                  trControl = glm_ctrl_roc,
                  family="binomial")
fit_bonus_glm_1_roc
```

```{r}
fit_bonus_glm_1_roc$pred %>% 
  roc_curve(obs, event)%>%
  autoplot()
```

```{r}
fit_bonus_glm_1_roc$pred %>% 
  roc_curve(obs, event)%>%
  autoplot()
```

```{r}
confusionMatrix(fit_bonus_glm_1_roc)
```

```{r}
coefplot::coefplot(fit_bonus_glm_1_roc)
```

```{r}
plot(varImp(fit_bonus_glm_1_roc))
```

### Training Model-2

```{r}
set.seed(1001)
fit_bonus_glm_2_roc <- train(recipe_2,
                  data = df_bonus_data ,
                  method = "glm",
                  metric = glm_metric_roc,
                  trControl = glm_ctrl_roc,
                  family="binomial")
fit_bonus_glm_2_roc
```

```{r}
fit_bonus_glm_2_roc$pred %>% 
  roc_curve(obs, event)%>%
  autoplot()
```

```{r}
confusionMatrix(fit_bonus_glm_2_roc)
```

```{r}
coefplot::coefplot(fit_bonus_glm_2_roc)
```

```{r}
plot(varImp(fit_bonus_glm_2_roc))
```

### Training Model-3 (Gradient Boosting)

```{r}
set.seed(1001)
fit_bonus_glm_3_roc <- train(recipe_2,
                  data = df_bonus_data ,
                  method = "xgbTree",
                  metric = glm_metric_roc,
                  trControl = glm_ctrl_roc,
                  family="binomial",
                  verbosity = 0)
fit_bonus_glm_3_roc
```

```{r}
fit_bonus_glm_3_roc$pred %>% 
  roc_curve(obs, event)%>%
  autoplot()
```

```{r}
confusionMatrix(fit_bonus_glm_3_roc)
```

```{r}
plot(varImp(fit_bonus_glm_3_roc))
```

### Training Model-4 (Random Forest)

```{r}
set.seed(1001)
fit_bonus_glm_4_roc <- train(recipe_2,
                  data = df_bonus_data ,
                  method = "svmRadial",
                  metric = glm_metric_roc,
                  trControl = glm_ctrl_roc,
                  family="binomial")
fit_bonus_glm_4_roc
```

```{r}
fit_bonus_glm_4_roc$pred%>%
  roc_curve(obs, event)%>%
  autoplot()
```

```{r}
confusionMatrix(fit_bonus_glm_4_roc)
```

### Training Model-5 (Generalized linear model)

```{r}
set.seed(1001)
fit_bonus_glm_5_roc <- train(recipe_2,
                  data = df_bonus_data ,
                  method = "gam",
                  metric = glm_metric_roc,
                  trControl = glm_ctrl_roc,
                  family="binomial")
```

```{r}
fit_bonus_glm_5_roc$pred%>%
  roc_curve(obs, event)%>%
  autoplot()
```

```{r}
confusionMatrix(fit_bonus_glm_5_roc)
```

## Performance Comparison

```{r}
glm_results_roc <- resamples(list(fit_bonus_glm_1 = fit_bonus_glm_1_roc,
                             fit_bonus_glm_2 = fit_bonus_glm_2_roc,
                             fit_bonus_glm_3 = fit_bonus_glm_3_roc,
                             fit_bonus_glm_4 = fit_bonus_glm_4_roc,
                             fit_bonus_glm_5 = fit_bonus_glm_5_roc))
```

```{r}
summary(glm_results_roc)
```

```{r}
dotplot(glm_results_roc)
```

## Model Training and Validation Using Accuracy

```{r}
glm_ctrl_acc <- trainControl(method = "repeatedcv", number = 5, repeats = 5, savePredictions = TRUE)
glm_metric_acc <- "Accuracy"
```

### Training Model-1

```{r}
set.seed(1001)
fit_bonus_glm_1_acc <- train(recipe_1,
                  data = df_bonus_data ,
                  method = "glm",
                  metric = glm_metric_acc,
                  trControl = glm_ctrl_acc,
                  family="binomial")
fit_bonus_glm_1_acc
```

```{r}
confusionMatrix(fit_bonus_glm_1_acc)
```

```{r}
coefplot::coefplot(fit_bonus_glm_1_acc)
```

```{r}
plot(varImp(fit_bonus_glm_1_acc))
```

### Training Model-2

```{r}
set.seed(1001)
fit_bonus_glm_2_acc <- train(recipe_2,
                  data = df_bonus_data ,
                  method = "glm",
                  metric = glm_metric_acc,
                  trControl = glm_ctrl_acc,
                  family="binomial")
fit_bonus_glm_2_acc
```

```{r}
confusionMatrix(fit_bonus_glm_2_acc)
```

```{r}
coefplot::coefplot(fit_bonus_glm_2_acc)
```

```{r}
plot(varImp(fit_bonus_glm_2_acc))
```

### Training Model-3 (Gradient Boosted Tree)

```{r}
set.seed(1001)
fit_bonus_glm_3_acc <- train(recipe_2,
                  data = df_bonus_data ,
                  method = "xgbTree",
                  metric = glm_metric_acc,
                  trControl = glm_ctrl_acc,
                  family="binomial",
                  verbosity = 0)
fit_bonus_glm_3_acc
```

```{r}
confusionMatrix(fit_bonus_glm_3_acc)
```

```{r}
plot(varImp(fit_bonus_glm_3_acc))
```

### Training Model-4 (SVM)

```{r}
set.seed(1001)
fit_bonus_glm_4_acc <- train(recipe_2,
                  data = df_bonus_data ,
                  method = "svmRadial",
                  metric = glm_metric_acc,
                  trControl = glm_ctrl_acc,
                  family="binomial")
fit_bonus_glm_4_acc
```

```{r}
confusionMatrix(fit_bonus_glm_4_acc)
```

### Training Model-5 (Generalized linear model)

```{r}
set.seed(1001)
fit_bonus_glm_5_acc <- train(recipe_2,
                  data = df_bonus_data ,
                  method = "gam",
                  metric = glm_metric_acc,
                  trControl = glm_ctrl_acc,
                  family="binomial")
```

```{r}
confusionMatrix(fit_bonus_glm_5_acc)
```

## Performance Comparison

```{r}
glm_results_acc <- resamples(list(fit_bonus_glm_1 = fit_bonus_glm_1_acc,
                             fit_bonus_glm_2 = fit_bonus_glm_2_acc,
                             fit_bonus_glm_3 = fit_bonus_glm_3_acc,
                             fit_bonus_glm_4 = fit_bonus_glm_4_acc,
                             fit_bonus_glm_5 = fit_bonus_glm_5_acc))
```

```{r}
summary(glm_results_acc)
```

```{r}
dotplot(glm_results_acc)
```

The top model is gradient boosted tree

# Prediction

### Save the model with best performance

Save the model by piping the `fit_glm_xgb_roc` object into `readr::write_rds()`.
```{r}
fit_bonus_glm_3_roc %>% readr::write_rds("glm_bonus_model.rds")
```

```{r}
fit_bonus_glm_3_roc$pred
```

```{r}
df_pred <- cbind(df_bonus_data,fit_bonus_glm_3_roc$pred %>% 
  dplyr::group_by(rowIndex) %>% 
  dplyr::summarise(pred = mean(event))%>%
  dplyr::mutate(event_prob = pred)%>%
  dplyr::mutate(pred = ifelse(event_prob>0.5, "event", "non_event"),pred = factor(pred, levels = c('event', 'non_event'))))
```

```{r}
df_pred
```

```{r}
library(pROC)
```

```{r}
roc(df_pred$challenge_outcome ~ df_pred$event_prob, plot = TRUE, print.auc = TRUE)
```

```{r}
confusionMatrix(factor(df_pred$pred),factor(df_pred$challenge_outcome))
```

### Save the predictions of best model (XGB)

```{r}
write.csv(df_pred,file='glm_bonus_predict.csv')
```