Final Project, Part 2
library(readr)
library(tidyverse)
library(caret)
library(gt) #https://github.com/rstudio/gt https://gt.rstudio.com/
library(yardstick)
library(gridExtra)
library(skimr) #https://cran.r-project.org/web/packages/skimr/vignettes/skimr.html
library(MLeval)
library(doParallel)
library(e1071)
library(tictoc)
library(GGally)
library(mlbench)
library(hrbrthemes)
# knitr::knit_exit()Discussion
1. A discussion of the best performing algorithm(s) in the cross-validation and hold-out data
- which algorithms appear to be reasonable/good choices for use according to cross-validation?
I based my selection of “reasonable/good” by setting a high threshold for Recall (~.90) and then observing which models obtain the best F1 score. A higher F1 score suggests that we are paying less of a cost in terms of Precision.
Random Forest, KNN and SVM Radial – all with down-sampled data - are the best candidates according to cross-validation. All have Recall above 0.9 and obtain F1 scores over 0.9. Notably, the SVM took much longer to run.
Given the extreme imbalance in the data, I wanted to explore the impact of weighting data versus downsampling data. Therefore, in addition to the assigned models, I chose to compete Support Vector Machines (SVM) Linear with weighted and then with downsampled data. Also, I competed SVM Radial with weighted and then with downsampled data. Interestingly, with SVM Linear, the choice of weighted or downsampled did not lead to differing results. With SVM Radial, weighted data produced better results. This does not speak to which models performed best overall.
I failed to implement a cost benefit analysis. So, my short hand for deciding on a threshold was to evaluate the trade off between Recall and Precision. Recall gives us a measure of the correctly identified Blue Tarps from all the actual Blue Tarps. It is important when the cost of False Negatives is high (potentially lost lives). Source here Obviously the trade off was a loss in Precision, which gives us a measure of the correctly identified Blue Tarps from all the predicted positive cases. Precision is useful when the costs of False Positives is high (wasted money on fruitless flights)–the lesser of the two costs.
I “tuned” or selected a confusion matrix threshold value that produced a Recall of approximately 0.9. However, when observing the PR curve, we see this tradeoff (see plot below). Specifically, from right to left, as we lower the recall, we can see at what point we obtain (or not) gains in terms of Precision. So, the potential for dramatic gains or losses in these metrics also influenced my choice on a case by case basis. This frequently required dramatically different threshold values.
Additionally, in determining the best model, I also looked at the variance in predictions across folds of cross-validation. If there was wide vs narrow variance, it might provide some indication of the stability of the model. For instance, with Random Forest we see increasing performance (as measured by PR-AUC) as we allow the size of the lowest node to increase. This is possibly guarding against overfitting. We also see that when we use one feature at each split, we getting vastly better performance. This stands to reason. Potentially, a blue pixel is good at predicting blue tarps.
- It’s worth noting that, from the scatter plot matrix, the data appears to be easily separable, which is confirmed by the generally strong results in these models. KNN applies a linear decision boundary, which can help to avoid overfitting. Random Forests can manage linear and nonlinear boundaries. So, potentially linear decision boundaries are better suited to this data. Surprisingly, SVM Radial, a very complex model, fit well on the training data, but I set the threshold exceedingly high.
- which algorithms actually ended up performing well in the hold-out data?
- The models above maintained their winning position based on F1 scores. KNN obtained the best results in terms of F1 score. Suprisingly, SVM Radial faired well. Random Forest came third. All suffered greatly terms of precision.
2. A discussion or analysis justifying why your findings above are compatible or reconcilable
- Do the answers in both of the above questions agree? (I.e., are they compatible?) If not, do you have any reasons why they might not agree? (I.e., can they be reconciled somehow?)
Largely, but with some surprises, the results were as expected.
3. A recommendation and rationale regarding which algorithm to use for detection of blue tarps
The nature of the data likely determines which model(s) are best. In this case, we appear to have data that is easily linearly-separable but extremely imbalanced. Based on this report, my recommendation is to first downsample the data in order to mitigate agaisnt problems associated with imbalanced data.
I recommend KNN with a large k (100 or higher) and a threshold above 90 such that we are obtaining Recall scores around 0.90.
That said, a methodical approach to how we might treat the data (raw, weighted or down-sampled), the number of cross-folds, how explore tuning parameters, what adjustments we make to the confusion matrix threshold - all impact the performance of any given model. (Of course, a couple of these models did not have tuning parameters.)
For instance, some of my decisions were:
Treating the data: I chose to downsample the data. While there are theoretical grounds for this with imbalanced data, my choice was also based on dramatically reduced running time of the algorithms. That said, because caret facilitate easy implementation of downsampling and weighting with SVMs, I chose to compete these approaches with SVM Linear and SVM Radial. With SVM Linear, weighting the data improved performance compared with downsampling. With SVM Radial downsampling and weighting obtained the same results. Admittedly, I have yet to figure what this suggests.
Number of folds: For most models, I implemented 10 cross validation. This likely results in more stable predictions. A few (namely the SVMs), are computationally expensive. So, I chose to reduce the number of folds. Notably, the SVMs still took a long time (SVM Radial took ~900 sec). This obviously may have negatively impacted my ability to compare weighted versus downsampling the data.
Tuning parameters: I will discuss just a few of them here in general terms:
Of course, it decreases run time if you simply run default tune grids, but that’s just no fun.
For KNN, I initially ran cv over range for k from 1 to 100. I set the
tuneGrid = data.frame(k = seq(1, 100, 4)))in order to find the best value for k. Notably, the AUC is still climbing, suggesting that a higher grid search is warranted.For Random Forest, I settled on mtry = seq(1, 3, 1), splitrule = ‘gini’, and min.node.size = seq(1, 5, 1)). Of course, the maximum for mtry (number of features used for training at each node split) is the number of features in the data. So, this choice was limited. Additionally, using gini (class purity) as the splitting rule is standard for classification problems. Last, min.node.size (minimum number of observations in a terminal node). I clearly ran over a grid from 1 to 5. In retrospect, this may not have been large enough. I’m concerned that allowing for such a small number of observations in each terminal node might have led the model to overfit the training data. However, the tradeoff here is increasing computational time.
SVM Radial Weighted: For this model, I set the parameter tune grid to sigma = c(0.001, 0.01, 0.1, 1), cost=seq(0.1, 4, 1), and weight= 1:2). The first two parameters are moving along the bias-variance spectrum.
In some sense, the gamma parameter answers the question: do the support vectors have wide-spread influence? When we transform the data by gamma, we are moving into a higher dimension to make the data linearly separable. Gamma controls this transformation. As gamma get larger, bias is increasing and variance is decreasing. The values I chose for sigma (the inverse of gamma) are quasi-exponential to ensure a large degree of difference. Reference
Cost is the parameter for the soft margin cost function, or the cost of missclasification. It controls the total amount of data we allow on the “wrong side” of the margin. The more data on the wrong side, the higher the bias and the more stable the model. A large C gives us a narrow margin, thereby reducing the number of support vectors and increasing variance. So, we are trading error penalty for stability as we move the decision boundary out and allow for more support vectors. Setting my grid to check values from 0.1 to 4 appeared to capture the best model. Importantly, this model was not among the best models. Given the models that performed best, it appears that linear decision boundaries are better suited. SVM Radial was likely too flexible to stabilize.
4. A discussion of the relevance of the metrics calculated in the tables to this application context
F1 Score: The F1 score, which combines precision and recall into one metric by calculating the harmonic mean, gives a better measure of the incorrectly classified cases than the Accuracy Metric. I already discussed precision and recall above.
It’s worth mentioning that the F1 score is considered suitable for imbalanced data. “F1-score metric is(trying) to find an equal balance between precision and recall, which is extremely useful in most scenarios when we are working with imbalanced datasets”. That said, I mitigated against this by implementing downsampling (aka undersampling). Under-sampling randomly selects "a subset of samples from the class with more instances to match the number of samples coming from each class…The main disadvantage of under-sampling is that we lose potentially relevant information from the left-out samples. For me, one advantage is that this dramatically decreases computation time. Additionally, this is easy to implement in caret. Sources here and here(https://shiring.github.io/machine_learning/2017/04/02/unbalanced) and here
PR Curve and AUC: Complementary to the F1 score, the AUC for the precision-recall (PR) curve also serves as an aggregate metric by which we can compare the models (I assume as long as the class imbalance is the same). Precision-recall curves plot the precision (or PPV) against the precision (or TPR). As such, as we move along the curve from left to right, we see drops at given percentages of false positive predictions. Reference here
Note, however, that the the area under the PR curve does not have a probabilistic interpretation like ROC. Now, caret does have the ‘prSummary’ function that uses area under the PR curve to select the best model.
Similar to the above discussion about the F1 score, “PR curves, because they use precision, instead of specificity (like ROC) can pick up false positives in the predicted positive fraction.” As such, they are particularly helpful with class imbalance is such that the negative outcome exceeds the positive outcome.
- Sidenote: I obtained slightly different results when I calculated these metrics with yardstick, mlbench, and caret.
Metrics Tables
Metrics Table - Train
# table stored on the end of the markdown
read_csv("outSampleResults.csv") %>% dplyr::select(-X1) %>% gt() %>%
tab_header(
title = "Summary Table/Model Results from Training Data")| Summary Table/Model Results from Training Data | ||||||
|---|---|---|---|---|---|---|
| Method | KNN (k = 97) | LDA | QDA | LogisticRegression | RandomForest | SVM Rad (DownSampled) |
| Accuracy | 0.996 | 0.978 | 0.99 | 0.991 | 0.996 | 0.996 |
| AUC-ROC | 0.999 | 0.996 | 0.788 | 1 | 0.977 | 1 |
| ROC | See Below | See Below | See Below | See Below | See Below | See Below |
| Threshold-Selected | 0.95 | 0.3 | 0.1 | 0.95 | 0.93 | 0.06 |
| AUC-PR | 0.984 | 0.891 | 0.966 | 0.972 | 0.989 | 1 |
| Sensitivity | 0.907 | 0.91 | 0.901 | 0.916 | 0.902 | 0.919 |
| Specificity | 0.999 | 0.98 | 0.993 | 0.993 | 0.999 | 0.998 |
| FDR (1-Precision) | 0.043 | 0.395 | 0.201 | 0.186 | 0.036 | 0.056 |
| Precision (also PPV) | 0.957 | 0.605 | 0.799 | 0.814 | 0.964 | 0.944 |
| F1 Score | 0.931 | 0.315 | 0.847 | 0.814 | 0.932 | 0.931 |
| Approx. Run Time | ~18 sec | ~1.7 sec | ~1.9 sec | ~2 sec | ~69 sec | ~900 sec |
Metrics Table - Test
# table stored on the end of the markdown
read_csv("test_results.csv") %>% dplyr::select(-X1) %>% gt() %>%
tab_header(
title = "Summary Table/Model Results from FHO set")| Summary Table/Model Results from FHO set | ||||||
|---|---|---|---|---|---|---|
| Method | KNN (k = 97) | LDA | QDA | LogisticRegression | RandomForest | SVM Rad (DownSampled) |
| Accuracy | 0.994 | 0.969 | 0.975 | 0.98 | 0.993 | 0.996 |
| AUC-ROC | 0.953 | 0.996 | 0.788 | 1 | 0.977 | 0.992 |
| ROC | See Below | See Below | See Below | See Below | See Below | See Below |
| Threshold-Selected | 0.95 | 0.3 | 0.1 | 0.95 | 0.93 | 0.06 |
| AUC-PR | 0.638 | 0.801 | 0.495 | 1 | 0.515 | 0.713 |
| Sensitivity | 0.734 | 0.99 | 0.621 | 0.999 | 0.299 | 0.714 |
| Specificity | 0.995 | 0.969 | 0.978 | 0.979 | 0.998 | 0.996 |
| FDR (1-Precision) | 0.461 | 0.813 | 0.829 | 0.739 | 0.435 | 0.446 |
| Precision (also PPV) | 0.539 | 0.187 | 0.171 | 0.261 | 0.565 | 0.996 |
| F1 Score | 0.621 | 0.315 | 0.268 | 0.414 | 0.391 | 0.624 |
PR Curves - FHO data
For the sake of space/brevity, plots below are from the FHO set only.
Plots obtained from the train models are in the analysis.
ROC Curves - FHO Data
For the sake of space/brevity, plots below are from the FHO set only.
Plots obtained from the train model are in the analysis.
Confusion Matrices - FHO
For the sake of space/brevity, matrices below are from the FHO set only.
Matrices obtained from the train model are in the analysis.
Load and Clean Data
df_train <- read_csv("df_train.csv") %>%
dplyr::select(Class, Red, Green, Blue) %>%
mutate(Class = factor(Class))
df_test <- read_csv('df_test.csv') %>%
dplyr::select(Class, Red, Green, Blue) %>%
mutate(Class = factor(Class))
# df_train <- sample_n(df_train, 4000)
# df_test <- sample_n(df_test, 4000)Take a look at the TRAINING data:
| Name | df_train |
| Number of rows | 63241 |
| Number of columns | 4 |
| _______________________ | |
| Column type frequency: | |
| factor | 1 |
| numeric | 3 |
| ________________________ | |
| Group variables | None |
Variable type: factor
| skim_variable | n_missing | complete_rate | ordered | n_unique | top_counts |
|---|---|---|---|---|---|
| Class | 0 | 1 | FALSE | 2 | NoB: 61219, Blu: 2022 |
Variable type: numeric
| skim_variable | n_missing | complete_rate | mean | sd | p0 | p25 | p50 | p75 | p100 | hist |
|---|---|---|---|---|---|---|---|---|---|---|
| Red | 0 | 1 | 162.98 | 78.88 | 48 | 80 | 163 | 255 | 255 | ▆▂▂▂▇ |
| Green | 0 | 1 | 153.66 | 72.64 | 48 | 78 | 148 | 226 | 255 | ▇▃▂▃▇ |
| Blue | 0 | 1 | 125.14 | 61.39 | 44 | 63 | 123 | 181 | 255 | ▇▂▃▆▁ |
KNN
Define and Train the Model
Here, I use 10-fold cross-validation with the values centered and scaled as well as downsampled the data. I set the tuneGrid = data.frame(k = seq(1, 100, 4))) in order to find the best value for k. Notably, the AUC is still climbing, suggesting that a higher grid search is warrented.
#Define and implement the train model
#http://rstudio-pubs-static.s3.amazonaws.com/521300_d4eea870fd224bc5bfe0cc1f1bc7b468.html
# build the method
train_control <- trainControl(method = "cv",
number = 10,
summaryFunction = prSummary,
classProbs = T,
sampling = "down",
savePredictions = TRUE,
allowParallel = TRUE)
#train the data
tictoc::tic()
set.seed(1)
knn_fit <- train(Class ~ ., data = df_train,
method = "knn",
preProc = c("center", "scale"),
trControl = train_control,
metric="AUC",
tuneGrid = data.frame(k = seq(1, 100, 4)))
tictoc::toc()
#> 81.8 sec elapsedTrain Model Performance
Confusion Matrix at Default Threshold (50%)
# predict on the train set to obtain confusion matrix
pred_knn_train_prob = predict(knn_fit, newdata = df_train, type = "prob")
knn_pred_train_raw <- predict(knn_fit, newdata = df_train, type="raw")
df_scored <- cbind(df_train, knn_pred_train_raw, pred_knn_train_prob)
conf_data <- df_train %>%
bind_cols(pred_knn_train_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > 0.5, "BlueTarp", "NoBlueTarp")))
confusionMatrix(conf_data$predicted, conf_data$Class, mode = "everything")
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 2020 1224
#> NoBlueTarp 2 59995
#>
#> Accuracy : 0.9806
#> 95% CI : (0.9795, 0.9817)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.7576
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.99901
#> Specificity : 0.98001
#> Pos Pred Value : 0.62269
#> Neg Pred Value : 0.99997
#> Precision : 0.62269
#> Recall : 0.99901
#> F1 : 0.76719
#> Prevalence : 0.03197
#> Detection Rate : 0.03194
#> Detection Prevalence : 0.05130
#> Balanced Accuracy : 0.98951
#>
#> 'Positive' Class : BlueTarp
#> Best Model/Tuning Parameters
#https://gt.rstudio.com/reference/cols_align.html
knn_fit$bestTune %>% gt() %>%
tab_header(title = "Best 'k' by CV:") %>%
cols_align(align = "center")| Best 'k' by CV: |
|---|
| k |
| 97 |
Training Variance (across folds)
knn_fit$resample %>%
ggplot() +
geom_point(aes(x=Resample, y = AUC, size = Recall, col=Resample)) +
labs(title = "KNN: PR-AUC by CV Fold",
x = "") +
theme(legend.position = "none") +
theme_bw()
Train Set PR/ROC
# AUCs
knnFitTrn.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
knnFitTrn.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)# data for curves
knn_pr_curve_train <- knn_fit$pred %>%
group_by(Resample) %>%
pr_curve(obs, BlueTarp)
knn_roc_curve_train <- knn_fit$pred %>%
group_by(Resample) %>%
roc_curve(obs, BlueTarp)
# Plot the curves
knnFit.pr_curve_oos <- autoplot(knn_pr_curve_train) +
labs(title = "KNN PR - Train",
caption = paste0("AUC: ", round(knnFitTrn.pr_auc$.estimate,3))) +
theme_minimal()
knnFit.roc_curve_oos <- autoplot(knn_roc_curve_train) +
labs(title = "KNN ROC - Train",
caption = paste0("AUC: ", round(knnFitTrn.roc_auc$.estimate,3))) +
theme_minimal()
grid.arrange(knnFit.pr_curve_oos, knnFit.roc_curve_oos, nrow=1)
CM and Threshold Selection
#create cutpoint
print("Threshold = 95%")
#> [1] "Threshold = 95%"
cut_point_knn <- .95
conf_data <- df_train %>%
bind_cols(pred_knn_train_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_knn, "BlueTarp", "NoBlueTarp")))
cm_knn_train <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = "everything")
cm_knn_train
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 1834 82
#> NoBlueTarp 188 61137
#>
#> Accuracy : 0.9957
#> 95% CI : (0.9952, 0.9962)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.9292
#>
#> Mcnemar's Test P-Value : 1.658e-10
#>
#> Sensitivity : 0.90702
#> Specificity : 0.99866
#> Pos Pred Value : 0.95720
#> Neg Pred Value : 0.99693
#> Precision : 0.95720
#> Recall : 0.90702
#> F1 : 0.93144
#> Prevalence : 0.03197
#> Detection Rate : 0.02900
#> Detection Prevalence : 0.03030
#> Balanced Accuracy : 0.95284
#>
#> 'Positive' Class : BlueTarp
#> Test (FHO) Performance
Predicting on the final hold-Out and evaluating at the specified threshold.
#https://rpubs.com/jkylearmstrong/knn_w_caret
#library(yardstick)
knn_pred_prob <- predict(knn_fit, newdata = df_test, type="prob")
knn_pred_raw <- predict(knn_fit, newdata = df_test, type="raw")
df_scored <- cbind(df_test, knn_pred_raw, knn_pred_prob)
# confusionMatrix(knn_pred_raw, df_test$Class)conf_data <- df_test %>%
bind_cols(knn_pred_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_knn, "BlueTarp", "NoBlueTarp")))
cm_knn_test <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = "everything")
cm_knn_test
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 10632 9111
#> NoBlueTarp 3848 1980586
#>
#> Accuracy : 0.9935
#> 95% CI : (0.9934, 0.9936)
#> No Information Rate : 0.9928
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.6182
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.734254
#> Specificity : 0.995421
#> Pos Pred Value : 0.538520
#> Neg Pred Value : 0.998061
#> Precision : 0.538520
#> Recall : 0.734254
#> F1 : 0.621337
#> Prevalence : 0.007225
#> Detection Rate : 0.005305
#> Detection Prevalence : 0.009851
#> Balanced Accuracy : 0.864838
#>
#> 'Positive' Class : BlueTarp
#>
knnFit.conf_mat <- conf_data %>%
conf_mat(truth=Class, predicted)
knnConfMat <- autoplot(knnFit.conf_mat, type = "heatmap") +
labs(title = "KNN Hold-Out Test Performance",
subtitle = paste0("Threshold: ", cut_point_knn))Prediction AUCs, Precision/Recall and ROC Curves
# https://onezero.blog/modelling-binary-logistic-regression-using-r-research-oriented-modelling-and-interpretation/
# https://yardstick.tidymodels.org/reference/f_meas.html
# act_pred <- data.frame(obs = df_test$Class, pred = knn_pred_raw)
# knn_prec <- precision(act_pred, obs, pred)
# knn_rec <- recall(act_pred, obs, pred)
# knn_F1_score <- f_meas(act_pred, obs, pred) #called f_measure
# bind_rows(knn_prec, knn_rec, knn_F1_score) %>% gt() %>%
# tab_header(title = "PR Metrics:") %>%
# cols_align(align = "center")
knnFit.roc_auc_test <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://yardstick.tidymodels.org/reference/pr_auc.html
knnFit.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
bind_rows(knnFit.pr_auc, knnFit.roc_auc_test) %>% gt() %>%
tab_header(title = "AUC's:") %>%
cols_align(align = "center")| AUC's: | ||
|---|---|---|
| .metric | .estimator | .estimate |
| pr_auc | binary | 0.6378963 |
| roc_auc | binary | 0.9529393 |
# https://yardstick.tidymodels.org/reference/pr_curve.html
# pr_curve(knn_pred_prob, df_test$Class, BlueTarp) %>%
# ggplot(aes(x = recall, y = precision)) +
# geom_path() +
# coord_equal() +
# theme_bw()
knn_pr_curve <- autoplot(pr_curve(knn_pred_prob, df_test$Class, BlueTarp)) +
labs(title = "KNN PR - FHO",
caption = paste0("AUC: ", round(knnFit.pr_auc$.estimate,3)))
knnFit.roc_curve <- df_scored %>%
roc_curve(truth=Class, BlueTarp) %>%
autoplot() +
labs(title = "KNN ROC - FHO",
caption = paste0("AUC: ", round(knnFit.roc_auc_test$.estimate,3)))
grid.arrange(knn_pr_curve,knnFit.roc_curve, nrow=1)
LDA
Define and Train the Model
As stated above, to make an “apples to apples” comparison, I will used 10-fold cross validation - this time with LDA.
#https://setscholars.net/wp-content/uploads/2019/04/How-to-utilise-caret-LDA-in-R.html
# setup cross validation and control parameters
control <- trainControl(method="cv",
number = 10,
summaryFunction = prSummary,
classProbs = TRUE,
savePredictions = TRUE,
sampling = "down",
search = "grid",
allowParallel = TRUE)
tictoc::tic()
# Training process
# Fit / train a Linear Regression model to dataset
lda_fit <- caret::train(Class~.,
data=df_train,
method="lda",
metric="AUC",
trControl=control,
tuneLength = 10)
tictoc::toc()
#> 1.86 sec elapsedTrain Model Performance
Confusion Matrix at Default Threshold (50%)
pred_lda_train_prob = predict(lda_fit, newdata = df_train, type = "prob")
pred_lda_train_raw = predict(lda_fit, newdata = df_train, type = "raw")
df_scored <- cbind(df_train, pred_lda_train_raw, pred_lda_train_prob)
conf_data <- df_train %>%
bind_cols(pred_lda_train_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > 0.5, "BlueTarp", "NoBlueTarp")))
confusionMatrix(conf_data$predicted, conf_data$Class, mode = 'everything')
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 1774 834
#> NoBlueTarp 248 60385
#>
#> Accuracy : 0.9829
#> 95% CI : (0.9818, 0.9839)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.7576
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.87735
#> Specificity : 0.98638
#> Pos Pred Value : 0.68021
#> Neg Pred Value : 0.99591
#> Precision : 0.68021
#> Recall : 0.87735
#> F1 : 0.76631
#> Prevalence : 0.03197
#> Detection Rate : 0.02805
#> Detection Prevalence : 0.04124
#> Balanced Accuracy : 0.93186
#>
#> 'Positive' Class : BlueTarp
#> Best Model/Tuning Parameters
lda_fit2 <- MASS::lda(Class ~ ., data = df_train)
print("Distribution of the linear discriminants")
#> [1] "Distribution of the linear discriminants"
plot(lda_fit2)
Train Set PR/ROC
ldaFitTrn.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
ldaFitTrn.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
lda_pr_curve_train <- lda_fit$pred %>%
group_by(Resample) %>%
pr_curve(obs, BlueTarp)
lda_roc_curve_train <- lda_fit$pred %>%
group_by(Resample) %>%
roc_curve(obs, BlueTarp)
ldaFit.pr_curve_oos <- autoplot(lda_pr_curve_train) +
labs(title = "LDA PR - Train",
caption = paste0("AUC: ", round(ldaFitTrn.pr_auc$.estimate,3))) +
theme_minimal()
ldaFit.roc_curve_oos <- autoplot(lda_roc_curve_train) +
labs(title = "LDA ROC - Train",
caption = paste0("AUC: ", round(ldaFitTrn.roc_auc$.estimate,3))) +
theme_minimal()
grid.arrange(ldaFit.pr_curve_oos, ldaFit.roc_curve_oos, nrow=1)
Training Variance (across folds)
lda_fit$resample %>%
ggplot() +
geom_point(aes(x=Resample, y = AUC, size = Recall, col=Resample)) +
labs(title = "LDA: AUC by CV Fold",
x = "",
y = "AUC") +
theme_minimal()
CM and Threshold Selection
accuracy <- NULL
for (i in 1:20) {
cut_point <- i/20
conf_data <- df_train %>%
bind_cols(pred_lda_train_prob) %>%
mutate(guess = as.factor(if_else(BlueTarp > cut_point, "BlueTarp", "NoBlueTarp")))
cm <- confusionMatrix(conf_data$guess, conf_data$Class, mode = 'everything')
accuracy_new <- tibble(
cut_point = i/20,
accuracy = cm$overall["Accuracy"])
accuracy <- bind_rows(
accuracy_new,
accuracy)
}
accuracy %>%
filter(accuracy == max(accuracy)) %>%
rename(Maximized = accuracy) %>% gt() | cut_point | Maximized |
|---|---|
| 0.9 | 0.9857213 |
print("Threshold = 13%")
#> [1] "Threshold = 13%"
cut_point_lda <- .3
conf_data <- df_train %>%
bind_cols(pred_lda_train_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_lda, "BlueTarp", "NoBlueTarp")))
cm_lda_train <- caret::confusionMatrix(conf_data$predicted, conf_data$Class, mode = 'everything')
cm_lda_train
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 1841 1202
#> NoBlueTarp 181 60017
#>
#> Accuracy : 0.9781
#> 95% CI : (0.977, 0.9793)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.716
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.91048
#> Specificity : 0.98037
#> Pos Pred Value : 0.60500
#> Neg Pred Value : 0.99699
#> Precision : 0.60500
#> Recall : 0.91048
#> F1 : 0.72695
#> Prevalence : 0.03197
#> Detection Rate : 0.02911
#> Detection Prevalence : 0.04812
#> Balanced Accuracy : 0.94543
#>
#> 'Positive' Class : BlueTarp
#> Test (FHO) Performance
lda_pred_prob <- predict(lda_fit, newdata = df_test, type="prob")
lda_pred_raw <- predict(lda_fit, newdata = df_test, type="raw")
df_scored <- cbind(df_test, lda_pred_raw, lda_pred_prob )Predicting on the final hold-Out and evaluating at the specified threshold.
conf_data <- df_test %>%
bind_cols(lda_pred_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_lda, "BlueTarp", "NoBlueTarp")))
cm_lda_test <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = "everything")
cm_lda_test
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 14342 62201
#> NoBlueTarp 138 1927496
#>
#> Accuracy : 0.9689
#> 95% CI : (0.9687, 0.9691)
#> No Information Rate : 0.9928
#> P-Value [Acc > NIR] : 1
#>
#> Kappa : 0.3067
#>
#> Mcnemar's Test P-Value : <2e-16
#>
#> Sensitivity : 0.990470
#> Specificity : 0.968738
#> Pos Pred Value : 0.187372
#> Neg Pred Value : 0.999928
#> Precision : 0.187372
#> Recall : 0.990470
#> F1 : 0.315129
#> Prevalence : 0.007225
#> Detection Rate : 0.007156
#> Detection Prevalence : 0.038192
#> Balanced Accuracy : 0.979604
#>
#> 'Positive' Class : BlueTarp
#> ldaFit.conf_mat <- conf_data %>%
conf_mat(truth=Class, predicted)
ldaConfMat <- autoplot(ldaFit.conf_mat, type = "heatmap") +
labs(title = "LDA",
subtitle = paste0("Threshold: ", cut_point_lda))Prediction AUCs, Precision/Recall and ROC Curves
lda_Fit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://onezero.blog/modelling-binary-logistic-regression-using-r-research-oriented-modelling-and-interpretation/
# https://yardstick.tidymodels.org/reference/f_meas.html
# act_pred <- data.frame(obs = df_test$Class, pred = lda_pred_raw)
# lda_prec <- precision(act_pred, obs, pred)
# lda_rec <- recall(act_pred, obs, pred)
# lda_F1_score <- f_meas(act_pred, obs, pred) #called f_measure
# bind_rows(lda_prec, lda_rec, lda_F1_score) %>% gt() %>%
# tab_header(title = "PR Metrics:") %>%
# cols_align(align = "center")
ldaFit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://yardstick.tidymodels.org/reference/pr_auc.html
ldaFit.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
bind_rows(ldaFit.pr_auc, ldaFit.roc_auc) %>% gt() %>%
tab_header(title = "AUC's:") %>%
cols_align(align = "center")| AUC's: | ||
|---|---|---|
| .metric | .estimator | .estimate |
| pr_auc | binary | 0.8010409 |
| roc_auc | binary | 0.9956315 |
# https://yardstick.tidymodels.org/reference/pr_curve.html
# pr_curve(lda_pred_prob, df_test$Class, BlueTarp) %>%
# ggplot(aes(x = recall, y = precision)) +
# geom_path() +
# coord_equal() +
# theme_bw()
lda_pr_curve <- autoplot(pr_curve(lda_pred_prob, df_test$Class, BlueTarp)) +
labs(title = "LDA PR - FHO",
caption = paste0("AUC : ", round(ldaFit.pr_auc$.estimate,3)))
ldaFit.roc_curve <- df_scored %>%
roc_curve(truth=Class, BlueTarp) %>%
autoplot() +
labs(title = "LDA ROC - FHO",
caption = paste0("AUC: ", round(ldaFit.roc_auc$.estimate,3)))
grid.arrange(lda_pr_curve, ldaFit.roc_curve, nrow=1)
QDA
Define and Train the Model
As above, I use 10-fold cross-validation - to keep the apples to apples comparison of models - with QDA.
tictoc::tic()
# setup cross validation and control parameters
control <- trainControl(method="cv",
number = 10,
summaryFunction = prSummary,
classProbs = TRUE,
savePredictions = TRUE,
search = "grid",
allowParallel = TRUE)
# Training process
# Fit / train a Linear Regression model to dataset
qda_fit <- caret::train(Class~.,
data=df_train,
method="qda",
metric="AUC",
trControl=control,
tuneLength = 10)
tictoc::toc()
#> 2.43 sec elapsed
#https://setscholars.net/wp-content/uploads/2019/04/How-to-utilise-caret-qda-in-R.htmlTrain Model Performance
Confusion Matrix at Default Threshold (50%)
pred_qda_train_prob = predict(qda_fit, newdata = df_train, type = "prob")
pred_qda_train_raw = predict(qda_fit, newdata = df_train, type = "raw")
df_scored <- cbind(df_train, pred_qda_train_raw, pred_qda_train_prob)
conf_data <- df_train %>%
bind_cols(pred_qda_train_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > 0.5, "BlueTarp", "NoBlueTarp")))
confusionMatrix(df_scored$pred_qda_train_raw, df_scored$Class, mode = 'everything')
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 1699 18
#> NoBlueTarp 323 61201
#>
#> Accuracy : 0.9946
#> 95% CI : (0.994, 0.9952)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.906
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.84026
#> Specificity : 0.99971
#> Pos Pred Value : 0.98952
#> Neg Pred Value : 0.99475
#> Precision : 0.98952
#> Recall : 0.84026
#> F1 : 0.90880
#> Prevalence : 0.03197
#> Detection Rate : 0.02687
#> Detection Prevalence : 0.02715
#> Balanced Accuracy : 0.91998
#>
#> 'Positive' Class : BlueTarp
#> Train Set PR/ROC
qdaFitTrn.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
qdaFitTrn.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
qda_pr_curve_train <- qda_fit$pred %>%
group_by(Resample) %>%
pr_curve(obs, BlueTarp)
qda_roc_curve_train <- qda_fit$pred %>%
group_by(Resample) %>%
roc_curve(obs, BlueTarp)
qdaFit.pr_curve_oos <- autoplot(qda_pr_curve_train) +
labs(title = "QDA PR - Train",
caption = paste0("AUC: ", round(qdaFitTrn.pr_auc$.estimate,3))) +
theme_minimal()
qdaFit.roc_curve_oos <- autoplot(qda_roc_curve_train) +
labs(title = "QDA ROC - Train",
caption = paste0("AUC: ", round(qdaFitTrn.roc_auc$.estimate,3))) +
theme_minimal()
grid.arrange(qdaFit.pr_curve_oos, qdaFit.roc_curve_oos, nrow=1)
Training Variance (across folds)
qda_fit$resample %>%
ggplot() +
geom_point(aes(x=Resample, y = AUC, size = Recall, col=Resample)) +
labs(title = "QDA: PR AUC by CV Fold",
x = "") +
theme(legend.position = "none") +
theme_bw()
CM and Threshold Selection
print("Threshold = 3%")
#> [1] "Threshold = 3%"
cut_point_qda <- .1
conf_data <- df_train %>%
bind_cols(pred_qda_train_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_qda, "BlueTarp", "NoBlueTarp")))
cm_qda_train <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = 'everything')
cm_qda_train
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 1822 459
#> NoBlueTarp 200 60760
#>
#> Accuracy : 0.9896
#> 95% CI : (0.9888, 0.9904)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.8415
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.90109
#> Specificity : 0.99250
#> Pos Pred Value : 0.79877
#> Neg Pred Value : 0.99672
#> Precision : 0.79877
#> Recall : 0.90109
#> F1 : 0.84685
#> Prevalence : 0.03197
#> Detection Rate : 0.02881
#> Detection Prevalence : 0.03607
#> Balanced Accuracy : 0.94680
#>
#> 'Positive' Class : BlueTarp
#> Test (FHO) Performance
Predicting on the final hold-Out and evaluating at the specified threshold.
#https://rpubs.com/jkylearmstrong/qda_w_caret
qda_pred_prob <- predict(qda_fit, newdata = df_test, type="prob")
qda_pred_raw <- predict(qda_fit, newdata = df_test, type="raw")
df_scored <- cbind(df_test, qda_pred_raw, qda_pred_prob)conf_data <- df_test %>%
bind_cols(qda_pred_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_qda, "BlueTarp", "NoBlueTarp")))
cm_qda_test <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = 'everything')
cm_qda_test
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 8991 43716
#> NoBlueTarp 5489 1945981
#>
#> Accuracy : 0.9754
#> 95% CI : (0.9752, 0.9757)
#> No Information Rate : 0.9928
#> P-Value [Acc > NIR] : 1
#>
#> Kappa : 0.2592
#>
#> Mcnemar's Test P-Value : <2e-16
#>
#> Sensitivity : 0.620925
#> Specificity : 0.978029
#> Pos Pred Value : 0.170585
#> Neg Pred Value : 0.997187
#> Precision : 0.170585
#> Recall : 0.620925
#> F1 : 0.267641
#> Prevalence : 0.007225
#> Detection Rate : 0.004486
#> Detection Prevalence : 0.026299
#> Balanced Accuracy : 0.799477
#>
#> 'Positive' Class : BlueTarp
#>
qdaFit.conf_mat <- conf_data %>%
conf_mat(truth=Class, predicted)
qdaConfMat <- autoplot(qdaFit.conf_mat, type = "heatmap") +
labs(title = "QDA",
subtitle = paste0("Threshold: ", cut_point_qda))Prediction AUCs, Precision/Recall and ROC Curves
qdaFit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://onezero.blog/modelling-binary-logistic-regression-using-r-research-oriented-modelling-and-interpretation/
# https://yardstick.tidymodels.org/reference/f_meas.html
# act_pred <- data.frame(obs = df_test$Class, pred = lda_pred_raw)
# qda_prec <- precision(act_pred, obs, pred)
# qda_rec <- recall(act_pred, obs, pred)
# qda_F1_score <- f_meas(act_pred, obs, pred) #called f_measure
# bind_rows(qda_prec, qda_rec, qda_F1_score) %>% gt() %>%
# tab_header(title = "PR Metrics:") %>%
# cols_align(align = "center")
qdaFit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://yardstick.tidymodels.org/reference/pr_auc.html
qdaFit.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
bind_rows(qdaFit.pr_auc, qdaFit.roc_auc) %>% gt() %>%
tab_header(title = "AUC's:") %>%
cols_align(align = "center")| AUC's: | ||
|---|---|---|
| .metric | .estimator | .estimate |
| pr_auc | binary | 0.4950731 |
| roc_auc | binary | 0.7877103 |
qda_pr_curve <- autoplot(pr_curve(qda_pred_prob, df_test$Class, BlueTarp)) +
labs(title = "QDA PR - FHO",
caption = paste0("AUC : ", round(qdaFit.pr_auc$.estimate,3)))
qdaFit.roc_curve <- df_scored %>%
roc_curve(truth=Class, BlueTarp) %>%
autoplot() +
labs(title = "QDA ROC - FHO",
caption = paste0("AUC : ", round(qdaFit.roc_auc$.estimate,3)))
grid.arrange(qda_pr_curve, qdaFit.roc_curve, nrow=1)
Logistic Regression
Define and Train the Model
Here, I run logistic regression. I’m using 10-fold CV for comparing all models.
tictoc::tic()
#Define and implement the train model
set.seed(1)
train_control <- trainControl(method = "cv",
number = 10,
classProbs = T,
summaryFunction = prSummary,
sampling = "down",
savePredictions = TRUE,
allowParallel = TRUE)
log_fit <- train(Class ~ ., data = df_train,
method = "glm",
#preProc = c("center", "scale"),
trControl = train_control,
metric = "AUC")
tictoc::toc()
#> 2.19 sec elapsedTrain Model Performance
Confusion Matrix at Default Threshold (50%)
pred_log_train_prob <- predict(log_fit, newdata = df_train, type = "prob")
pred_log_train_raw <- predict(log_fit, newdata = df_train, type = "raw")
df_scored <- cbind(df_train, pred_log_train_raw, pred_log_train_prob)
# https://topepo.github.io/caret/measuring-performance.html
confusionMatrix(df_scored$pred_log_train_raw, df_scored$Class, mode = "everything")
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 1982 754
#> NoBlueTarp 40 60465
#>
#> Accuracy : 0.9874
#> 95% CI : (0.9865, 0.9883)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.8268
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.98022
#> Specificity : 0.98768
#> Pos Pred Value : 0.72442
#> Neg Pred Value : 0.99934
#> Precision : 0.72442
#> Recall : 0.98022
#> F1 : 0.83312
#> Prevalence : 0.03197
#> Detection Rate : 0.03134
#> Detection Prevalence : 0.04326
#> Balanced Accuracy : 0.98395
#>
#> 'Positive' Class : BlueTarp
#> Train Set PR/ROC
logFitTrn.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
logFitTrn.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
log_pr_curve_train <- log_fit$pred %>%
group_by(Resample) %>%
pr_curve(obs, BlueTarp)
log_roc_curve_train <- log_fit$pred %>%
group_by(Resample) %>%
roc_curve(obs, BlueTarp)
logFit.pr_curve_oos <- autoplot(log_pr_curve_train) +
labs(title = "LOG PR - Train",
caption = paste0("AUC: ", round(logFitTrn.pr_auc$.estimate,3))) +
theme_minimal()
logFit.roc_curve_oos <- autoplot(log_roc_curve_train) +
labs(title = "LOG ROC - Train",
caption = paste0("AUC: ", round(logFitTrn.roc_auc$.estimate,3))) +
theme_minimal()
grid.arrange(logFit.pr_curve_oos, logFit.roc_curve_oos, nrow=1)
Training Variance (across folds)
log_fit$resample %>%
ggplot() +
geom_point(aes(x=Resample, y = AUC, size = Recall, col=Resample)) +
labs(title = "LR: PR AUC by CV Fold",
x = "") +
theme(legend.position = "none") +
theme_bw()
CM and Threshold Selection
print("Threshold = 95%")
#> [1] "Threshold = 95%"
cut_point_log <- .95
conf_data <- df_train %>%
bind_cols(pred_log_train_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_log, "BlueTarp", "NoBlueTarp")))
cm_log_train <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = 'everything')
cm_log_train
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 1852 422
#> NoBlueTarp 170 60797
#>
#> Accuracy : 0.9906
#> 95% CI : (0.9899, 0.9914)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.8574
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.91592
#> Specificity : 0.99311
#> Pos Pred Value : 0.81442
#> Neg Pred Value : 0.99721
#> Precision : 0.81442
#> Recall : 0.91592
#> F1 : 0.86220
#> Prevalence : 0.03197
#> Detection Rate : 0.02928
#> Detection Prevalence : 0.03596
#> Balanced Accuracy : 0.95452
#>
#> 'Positive' Class : BlueTarp
#> Test (FHO) Performance
log_pred_prob <- log_fit %>% predict(df_test, type="prob")
log_pred_raw <- log_fit %>% predict(df_test, type="raw")
df_scored <- cbind(df_test, log_pred_raw, log_pred_prob)Predicting on the final hold-Out and evaluating at the specified threshold.
conf_data <- df_test %>%
bind_cols(log_pred_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_log, "BlueTarp", "NoBlueTarp")))
cm_log_test <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = "everything")
cm_log_test
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 14471 40922
#> NoBlueTarp 9 1948775
#>
#> Accuracy : 0.9796
#> 95% CI : (0.9794, 0.9798)
#> No Information Rate : 0.9928
#> P-Value [Acc > NIR] : 1
#>
#> Kappa : 0.4074
#>
#> Mcnemar's Test P-Value : <2e-16
#>
#> Sensitivity : 0.999378
#> Specificity : 0.979433
#> Pos Pred Value : 0.261242
#> Neg Pred Value : 0.999995
#> Precision : 0.261242
#> Recall : 0.999378
#> F1 : 0.414209
#> Prevalence : 0.007225
#> Detection Rate : 0.007220
#> Detection Prevalence : 0.027639
#> Balanced Accuracy : 0.989406
#>
#> 'Positive' Class : BlueTarp
#> logFit.conf_mat <- conf_data %>%
conf_mat(truth=Class, predicted)
logConfMat <- autoplot(logFit.conf_mat, type = "heatmap") +
labs(title = "Log Regression",
subtitle = paste0("Threshold: ", cut_point_log))Prediction AUCs, Precision/Recall and ROC Curves
logFit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://onezero.blog/modelling-binary-logistic-regression-using-r-research-oriented-modelling-and-interpretation/
# https://yardstick.tidymodels.org/reference/f_meas.html
# act_pred <- data.frame(obs = df_test$Class, pred = log_pred_raw)
# log_prec <- precision(act_pred, obs, pred)
# log_rec <- recall(act_pred, obs, pred)
# log_F1_score <- f_meas(act_pred, obs, pred) #called f_measure
# bind_rows(log_prec, log_rec, log_F1_score) %>% gt() %>%
# tab_header(title = "PR Metrics:") %>%
# cols_align(align = "center")
logFit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://yardstick.tidymodels.org/reference/pr_auc.html
logFit.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
bind_rows(logFit.pr_auc, logFit.roc_auc) %>% gt() %>%
tab_header(title = "AUC's:") %>%
cols_align(align = "center")| AUC's: | ||
|---|---|---|
| .metric | .estimator | .estimate |
| pr_auc | binary | 0.9809980 |
| roc_auc | binary | 0.9998006 |
log_pr_curve <- autoplot(pr_curve(log_pred_prob, df_test$Class, BlueTarp)) +
labs(title = "Logistic Regression PR-FHO",
caption = paste0("AUC: ", round(logFit.pr_auc$.estimate,3)))
logFit.roc_curve <- df_scored %>%
roc_curve(truth=Class, BlueTarp) %>%
autoplot() +
labs(title = "Logistic Regression ROC-FHO",
caption = paste0("AUC: ", round(logFit.roc_auc$.estimate,3)))
grid.arrange(log_pr_curve, logFit.roc_curve, nrow=1)
Random Forest
Define and Train the Model
# code reference - tidylab
trcontl <- caret::trainControl(method="cv", number = 10,
savePredictions=TRUE,
returnResamp='all',
classProbs = TRUE,
sampling = "down",
summaryFunction = prSummary,
allowParallel = TRUE)
# The maximum for mtry is the number of features in the data
# Could simply use tuneLength, which is by default mtry = 3
# https://stackoverflow.com/questions/60458676/random-forest-how-mtry-is-larger-than-total-number-of-independent-variable
# I will build my own tuning grid anyway.
rf_grid = expand.grid(mtry = seq(1, 3, 1),
splitrule = 'gini',
min.node.size = seq(1, 40, 4))
tictoc::tic()
set.seed(1)
rf_fit <- train(Class~., data = df_train,
preProcess = c("center","scale"),
method = 'ranger',
trControl = trcontl,
importance = 'impurity',
metric = "AUC",
verbose = FALSE,
tuneGrid = rf_grid)
tictoc::toc()
#> 134.37 sec elapsedResults from training data
pred_rf_train_prob <- predict(rf_fit, newdata = df_train, type = "prob")
pred_rf_train_raw <- predict(rf_fit, newdata = df_train, type = "raw")
df_scored <- cbind(df_train, pred_rf_train_raw, pred_rf_train_prob)
confusionMatrix(df_scored$pred_rf_train_raw, df_scored$Class, mode = 'everything')
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 2021 682
#> NoBlueTarp 1 60537
#>
#> Accuracy : 0.9892
#> 95% CI : (0.9884, 0.99)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.85
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.99951
#> Specificity : 0.98886
#> Pos Pred Value : 0.74769
#> Neg Pred Value : 0.99998
#> Precision : 0.74769
#> Recall : 0.99951
#> F1 : 0.85545
#> Prevalence : 0.03197
#> Detection Rate : 0.03196
#> Detection Prevalence : 0.04274
#> Balanced Accuracy : 0.99418
#>
#> 'Positive' Class : BlueTarp
#> Best Model/Tuning Parameters
| Best Model by CV: | ||
|---|---|---|
| mtry | splitrule | min.node.size |
| 1 | gini | 37 |
Train Set PR/ROC
rfFitTrn.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
rfFitTrn.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
rf_pr_curve_train <- rf_fit$pred %>%
group_by(Resample) %>%
pr_curve(obs, BlueTarp)
rf_roc_curve_train <- rf_fit$pred %>%
group_by(Resample) %>%
roc_curve(obs, BlueTarp)
rfFit.pr_curve_oos <- autoplot(rf_pr_curve_train) +
labs(title = "RF PR - Train",
caption = paste0("AUC: ", round(rfFitTrn.pr_auc$.estimate,3))) +
theme_minimal()
rfFit.roc_curve_oos <- autoplot(rf_roc_curve_train) +
labs(title = "RF ROC - Train",
caption = paste0("AUC: ", round(rfFitTrn.roc_auc$.estimate,3))) +
theme_minimal()
grid.arrange(rfFit.pr_curve_oos, rfFit.roc_curve_oos, nrow=1)
Training Variance (across folds)
rfVariance <- rf_fit$resample %>%
ggplot() +
#geom_line(aes(x=min.node.size, y=AUC, col=Resample)) +
geom_point(aes(x=min.node.size, y=AUC, col=Resample, size=Recall)) +
xlab('Minimum Node Size') +
labs(title = "AUC on Min Node Size by mtry (Colored by CV Fold)",
subtitle = "NB: Jitter added to uncover overlapping points",
y = "AUC") +
facet_wrap(~mtry, scales = "free_y") +
theme_bw() +
theme(legend.title = element_blank()) # this line of code from: https://www.datanovia.com/en/blog/ggplot-legend-title-position-and-labels/
ggsave(file="rfVariance.png", device = "png", rfVariance)
rfVariance
rf_fit$resample %>%
ggplot() + geom_jitter(aes(x=min.node.size, y=F, col=Resample)) +
xlab('Minimum Node Size') +
labs(title = "F Score on Min Node Size by mtry (Colored by CV Fold)",
subtitle = "NB: Jitter added to uncover overlapping points",
y = "F Score") +
facet_wrap(~mtry, scales = "free_y") +
theme_bw() +
theme(legend.title = element_blank()) 
CM and Threshold Selection
print("Threshold = 93%")
#> [1] "Threshold = 93%"
cut_point_rf <- .93
conf_data <- df_train %>%
bind_cols(pred_rf_train_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_rf, "BlueTarp", "NoBlueTarp")))
cm_rf_train <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = 'everything')
cm_rf_train
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 1824 68
#> NoBlueTarp 198 61151
#>
#> Accuracy : 0.9958
#> 95% CI : (0.9953, 0.9963)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.9299
#>
#> Mcnemar's Test P-Value : 2.584e-15
#>
#> Sensitivity : 0.90208
#> Specificity : 0.99889
#> Pos Pred Value : 0.96406
#> Neg Pred Value : 0.99677
#> Precision : 0.96406
#> Recall : 0.90208
#> F1 : 0.93204
#> Prevalence : 0.03197
#> Detection Rate : 0.02884
#> Detection Prevalence : 0.02992
#> Balanced Accuracy : 0.95048
#>
#> 'Positive' Class : BlueTarp
#> ** Prediction**
rf_pred_prob <- rf_fit %>% predict(df_test, type = "prob")
#> Aggregating predictions.. Progress: 75%. Estimated remaining time: 10 seconds.
rf_pred_raw <- rf_fit %>% predict(df_test, type = "raw")
#> Aggregating predictions.. Progress: 75%. Estimated remaining time: 10 seconds.
df_scored <- cbind(df_test, rf_pred_raw, rf_pred_prob)CM at Selected Threshold
Confusion Matrix at Specified Threshold
conf_data <- df_test %>%
bind_cols(rf_pred_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_rf, "BlueTarp", "NoBlueTarp")))
cm_rf_test <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = "everything")
cm_rf_test
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 4324 3327
#> NoBlueTarp 10156 1986370
#>
#> Accuracy : 0.9933
#> 95% CI : (0.9932, 0.9934)
#> No Information Rate : 0.9928
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.3877
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.298619
#> Specificity : 0.998328
#> Pos Pred Value : 0.565155
#> Neg Pred Value : 0.994913
#> Precision : 0.565155
#> Recall : 0.298619
#> F1 : 0.390764
#> Prevalence : 0.007225
#> Detection Rate : 0.002157
#> Detection Prevalence : 0.003818
#> Balanced Accuracy : 0.648473
#>
#> 'Positive' Class : BlueTarp
#>
rfFit.conf_mat <- conf_data %>%
conf_mat(truth=Class, predicted)
rfConfMat <- autoplot(rfFit.conf_mat, type = "heatmap") +
labs(title = "Random Forest",
subtitle = paste0("Threshold: ", cut_point_rf))
rfConfMat
rfFit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://onezero.blog/modelling-binary-logistic-regression-using-r-research-oriented-modelling-and-interpretation/
# https://yardstick.tidymodels.org/reference/f_meas.html
# act_pred <- data.frame(obs = df_test$Class, pred = rf_pred_raw)
# rf_prec <- precision(act_pred, obs, pred)
# rf_rec <- recall(act_pred, obs, pred)
# rf_F1_score <- f_meas(act_pred, obs, pred) #called f_measure
# bind_rows(rf_prec, rf_rec, rf_F1_score) %>% gt() %>%
# tab_header(title = "PR Metrics:") %>%
# cols_align(align = "center")
rfFit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://yardstick.tidymodels.org/reference/pr_auc.html
rfFit.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
bind_rows(rfFit.pr_auc, rfFit.roc_auc) %>% gt() %>%
tab_header(title = "AUC's:") %>%
cols_align(align = "center")| AUC's: | ||
|---|---|---|
| .metric | .estimator | .estimate |
| pr_auc | binary | 0.5154013 |
| roc_auc | binary | 0.9768357 |
rf_pr_curve <- autoplot(pr_curve(rf_pred_prob, df_test$Class, BlueTarp)) +
labs(title = "Random Forest PR - FHO",
caption = paste0("AUC: ", round(rfFit.pr_auc$.estimate)))
rfFit.roc_curve <- df_scored %>%
roc_curve(truth=Class, BlueTarp) %>%
autoplot() +
labs(title = "Random Forest ROC - FHO",
caption = paste0("AUC: ", round(rfFit.roc_auc$.estimate,3)))
grid.arrange(rf_pr_curve, rfFit.roc_curve, nrow=1)
SVM Linear: Downsampled vs Wieghted
Search available models: https://topepo.github.io/caret/available-models.html svmLinearWeights2 svmLinear = kernlab and svmLinear2 = e1071 svmPoly for classification, no weighted option
Define and Train the Models
SVM Linear Downsampled
# https://github.com/topepo/caret/blob/master/RegressionTests/Code/svmLinearWeights2.R
trcontl <- caret::trainControl("cv", number = 10,
savePredictions=TRUE,
returnResamp='all',
sampling = "down",
classProbs = TRUE,
allowParallel = TRUE,
summaryFunction = prSummary
)
tictoc::tic()
set.seed(1)
svm_lin <- caret::train(Class~., data=df_train, method='svmLinear2',
preProcess = c("center","scale"),
tuneLength = 4,
metric="AUC",
prob.model=TRUE,
trControl=trcontl)
tictoc::toc()
#> 8.11 sec elapsedTrain Model Performance
Confusion Matrix at Default Threshold (50%)
pred_svmLS_train_prob = predict(svm_lin, newdata = df_train, type = "prob")
pred_svmLS_train_raw = predict(svm_lin, newdata = df_train, type = "raw")
df_scored <- cbind(df_train, pred_svmLS_train_raw, pred_svmLS_train_prob)
confusionMatrix(conf_data$predicted, conf_data$Class, mode = 'everything')
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 4324 3327
#> NoBlueTarp 10156 1986370
#>
#> Accuracy : 0.9933
#> 95% CI : (0.9932, 0.9934)
#> No Information Rate : 0.9928
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.3877
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.298619
#> Specificity : 0.998328
#> Pos Pred Value : 0.565155
#> Neg Pred Value : 0.994913
#> Precision : 0.565155
#> Recall : 0.298619
#> F1 : 0.390764
#> Prevalence : 0.007225
#> Detection Rate : 0.002157
#> Detection Prevalence : 0.003818
#> Balanced Accuracy : 0.648473
#>
#> 'Positive' Class : BlueTarp
#> svmFitLS.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
svmFitLS.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
svmLS_pr_curve_train <- svm_lin$pred %>%
group_by(Resample) %>%
pr_curve(obs, BlueTarp)
svmLS_roc_curve_train <- svm_lin$pred %>%
group_by(Resample) %>%
roc_curve(obs, BlueTarp)
svmFitLS.pr_curve_oos <- autoplot(svmLS_pr_curve_train) +
labs(title = "SVM Lin Samp. PR",
caption = paste0("AUC: ", round(svmFitLS.pr_auc$.estimate,3))) +
theme_minimal()
svmFitLS.roc_curve_oos <- autoplot(svmLS_roc_curve_train) +
labs(title = "SVM Lin Samp. ROC",
caption = paste0("AUC: ", round(svmFitLS.roc_auc$.estimate,3))) +
theme_minimal()SVM Linear Weighted
# https://github.com/topepo/caret/blob/master/RegressionTests/Code/svmLinearWeights2.R
trcontl <- caret::trainControl("cv", number = 4,
savePredictions=TRUE,
returnResamp='all',
classProbs = TRUE,
allowParallel = TRUE,
summaryFunction = prSummary
)
tictoc::tic()
set.seed(1)
svm_lin_Weighted <- caret::train(Class~., data=df_train, method='svmLinearWeights',
preProcess = c("center","scale"),
tuneLength = 4,
metric="AUC",
prob.model=TRUE,
trControl=trcontl)
tictoc::toc()
#> 138.72 sec elapsedTrain Model Performance
Confusion Matrix at Default Threshold (50%)
pred_svmL_train_prob = predict(svm_lin_Weighted, newdata = df_train, type = "prob")
pred_svmL_train_raw = predict(svm_lin_Weighted, newdata = df_train, type = "raw")
df_scored <- cbind(df_train, pred_svmL_train_raw, pred_svmL_train_prob)
confusionMatrix(conf_data$predicted, conf_data$Class, mode = 'everything')
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 4324 3327
#> NoBlueTarp 10156 1986370
#>
#> Accuracy : 0.9933
#> 95% CI : (0.9932, 0.9934)
#> No Information Rate : 0.9928
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.3877
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.298619
#> Specificity : 0.998328
#> Pos Pred Value : 0.565155
#> Neg Pred Value : 0.994913
#> Precision : 0.565155
#> Recall : 0.298619
#> F1 : 0.390764
#> Prevalence : 0.007225
#> Detection Rate : 0.002157
#> Detection Prevalence : 0.003818
#> Balanced Accuracy : 0.648473
#>
#> 'Positive' Class : BlueTarp
#> svmFitLW.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
svmFitLW.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
svmLW_pr_curve_train <- svm_lin_Weighted$pred %>%
group_by(Resample) %>%
pr_curve(obs, BlueTarp)
svmLW_roc_curve_train <- svm_lin_Weighted$pred %>%
group_by(Resample) %>%
roc_curve(obs, BlueTarp)
svmFitLW.pr_curve_oos <- autoplot(svmLW_pr_curve_train) +
labs(title = "SVM Lin Wtd. PR",
caption = paste0("AUC: ", round(svmFitLW.pr_auc$.estimate,3))) +
theme_minimal()
svmFitLW.roc_curve_oos <- autoplot(svmLW_roc_curve_train) +
labs(title = "SVM Lin Wtd. ROC",
caption = paste0("AUC: ", round(svmFitLW.roc_auc$.estimate,3))) +
theme_minimal()Best Model/Tuning Parameters
| Best Tune SVM Linear |
|---|
| cost |
| 2 |
| Best Tune SVM Linear Weighted | |
|---|---|
| cost | weight |
| 2 | 4 |
SVM Linear Downsampled
SVM Linear Weighted
Train Set PR/ROC
grid.arrange(svmFitLS.pr_curve_oos, svmFitLS.roc_curve_oos, svmFitLW.pr_curve_oos, svmFitLW.roc_curve_oos, nrow=2)
svmPlots <- arrangeGrob(svmFitLS.pr_curve_oos, svmFitLW.pr_curve_oos, nrow = 1)
ggsave(file="svmPlots.png", device = "png", svmPlots)Training Variance (across folds)
# https://www.datanovia.com/en/blog/how-to-remove-legend-from-a-ggplot/
p1 <- svm_lin$resample %>%
ggplot() +
geom_boxplot(aes(x=AUC, fill="red"), show.legend = FALSE) +
labs(title = "SVM Downsampled",
y = "") +
theme(axis.ticks.y=element_blank()) +
coord_flip() +
theme_minimal()
p2 <- svm_lin_Weighted$resample %>%
ggplot() +
geom_boxplot(aes(x=AUC, fill="red"), show.legend = FALSE) +
labs(title = "SVM Weighted",
y = "",
x="") +
theme(axis.ticks.y=element_blank()) +
coord_flip() +
theme_minimal()
grid.arrange(p1, p2, nrow=1)
ps <- svm_lin$resample %>%
ggplot() +
geom_jitter(aes(x=cost, y = AUC, col=Resample, size=Recall)) +
#geom_line(aes(x=cost, y = Accuracy, col=Resample)) +
labs(title = "SVM Lin D.Samp.: AUC by CV Fold",
subtitle = "Jitter added to uncover overlapping points.",
x = "Cost") +
theme(legend.position = "none") +
theme_minimal()
pw <- svm_lin_Weighted$resample %>%
ggplot() +
geom_jitter(aes(x=cost, y = AUC, col=Resample, size=Recall)) +
#geom_line(aes(x=cost, y = Accuracy, col=Resample)) +
labs(title = "SVM Lin Wtd: AUC by CV Fold",
subtitle = "Jitter added to uncover overlapping points.",
x = "Cost",
y="") +
theme(legend.position = "none") +
theme_minimal()
grid.arrange(ps, pw, nrow=1)
CM and Threshold Selection
#create cutpoint at 10%
print("Threshold = 6%")
#> [1] "Threshold = 6%"
cut_point_svm <- .06
conf_data <- df_train %>%
bind_cols(pred_svmL_train_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_svm, "BlueTarp", "NoBlueTarp")))
cm_svm_lin_train <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = 'everything')
cm_svm_lin_train
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 1962 753
#> NoBlueTarp 60 60466
#>
#> Accuracy : 0.9871
#> 95% CI : (0.9862, 0.988)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.8218
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.97033
#> Specificity : 0.98770
#> Pos Pred Value : 0.72265
#> Neg Pred Value : 0.99901
#> Precision : 0.72265
#> Recall : 0.97033
#> F1 : 0.82837
#> Prevalence : 0.03197
#> Detection Rate : 0.03102
#> Detection Prevalence : 0.04293
#> Balanced Accuracy : 0.97901
#>
#> 'Positive' Class : BlueTarp
#> Prediction
Going on to prediction with the Weighted model
svm_pred_prob <- svm_lin_Weighted %>% predict(df_test, type="prob")
svm_pred_raw <- svm_lin_Weighted %>% predict(df_test, type="raw")
df_scored <- cbind(df_test, svm_pred_raw, svm_pred_prob)CM at specified Threshold
conf_data <- df_test %>%
bind_cols(svm_pred_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_svm, "BlueTarp", "NoBlueTarp")))
cm_svm_lin_test <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = "everything")
cm_svm_lin_test
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 14479 189069
#> NoBlueTarp 1 1800628
#>
#> Accuracy : 0.9057
#> 95% CI : (0.9053, 0.9061)
#> No Information Rate : 0.9928
#> P-Value [Acc > NIR] : 1
#>
#> Kappa : 0.121
#>
#> Mcnemar's Test P-Value : <2e-16
#>
#> Sensitivity : 0.999931
#> Specificity : 0.904976
#> Pos Pred Value : 0.071133
#> Neg Pred Value : 0.999999
#> Precision : 0.071133
#> Recall : 0.999931
#> F1 : 0.132818
#> Prevalence : 0.007225
#> Detection Rate : 0.007224
#> Detection Prevalence : 0.101562
#> Balanced Accuracy : 0.952453
#>
#> 'Positive' Class : BlueTarp
#> Prediction AUC, Precision/Recall and ROC Curves
svm_lin.conf_mat <- conf_data %>%
conf_mat(truth=Class, predicted)
svm_linConfMat <- autoplot(svm_lin.conf_mat, type = "heatmap") +
labs(title = "SVM Linear",
subtitle = paste0("Threshold: ", cut_point_svm))svm_lin_Fit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://onezero.blog/modelling-binary-logistic-regression-using-r-research-oriented-modelling-and-interpretation/
# https://yardstick.tidymodels.org/reference/f_meas.html
# act_pred <- data.frame(obs = df_test$Class, pred = svm_pred_raw)
# svm_prec <- precision(act_pred, obs, pred)
# svm_rec <- recall(act_pred, obs, pred)
# svm_F1_score <- f_meas(act_pred, obs, pred) #called f_measure
# bind_rows(svm_prec, svm_rec, svm_F1_score) %>% gt() %>%
# tab_header(title = "PR Metrics:") %>%
# cols_align(align = "center")
svmFit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://yardstick.tidymodels.org/reference/pr_auc.html
svmFit.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
bind_rows(svmFit.pr_auc, svmFit.roc_auc) %>% gt() %>%
tab_header(title = "AUC's:") %>%
cols_align(align = "center")| AUC's: | ||
|---|---|---|
| .metric | .estimator | .estimate |
| pr_auc | binary | 0.9785967 |
| roc_auc | binary | 0.9995406 |
svm_lin_pr_curve <- autoplot(pr_curve(svm_pred_prob, df_test$Class, BlueTarp)) +
labs(title = "SVM Linear PR - FHO",
caption = paste0("AUC : ", round(svmFit.pr_auc$.estimate,3)))
svm_lin_Fit.roc_curve <- df_scored %>%
roc_curve(truth=Class, BlueTarp) %>%
autoplot() +
labs(title = "SVM Linear ROC - FHO",
caption = paste0("AUC : ", round(logFit.roc_auc$.estimate,3)))
grid.arrange(svm_lin_pr_curve,svm_lin_Fit.roc_curve, nrow=1)
SVM Radial: Downsampled vs Wieghted
Define and Train the Model
grid_radial <- expand.grid(sigma = c(.001, .1, 1), #seq(0.1, 1, 0.1), # c(.001,.005,.009) 1 maybe is huge, typical 0.01
C=seq(0.1, 5, 1)) # while 5 is maybe small
trcontl <- caret::trainControl("cv", number=8,
savePredictions=TRUE,
returnResamp='all',
sampling = "down",
classProbs = FALSE,
allowParallel = TRUE,
#summaryFunction = twoClassSummary
)
tictoc::tic()
set.seed(1)
svm_Radial <- train(Class ~., data = df_train,
method = "svmRadial",
preProcess = c("center", "scale"),
tuneGrid = grid_radial,
prob.model=TRUE,
#metric="ROC",
#tuneLength = 4,
trControl=trcontl)
tictoc::toc()
#> 75.9 sec elapsedpred_svmR_train_prob = predict(svm_Radial, newdata = df_train, type = "prob")
pred_svmR_train_raw = predict(svm_Radial, newdata = df_train, type = "raw")
df_scored <- cbind(df_train, pred_svmR_train_raw, pred_svmR_train_prob)
confusionMatrix(conf_data$predicted, conf_data$Class, mode = 'everything')
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 14479 189069
#> NoBlueTarp 1 1800628
#>
#> Accuracy : 0.9057
#> 95% CI : (0.9053, 0.9061)
#> No Information Rate : 0.9928
#> P-Value [Acc > NIR] : 1
#>
#> Kappa : 0.121
#>
#> Mcnemar's Test P-Value : <2e-16
#>
#> Sensitivity : 0.999931
#> Specificity : 0.904976
#> Pos Pred Value : 0.071133
#> Neg Pred Value : 0.999999
#> Precision : 0.071133
#> Recall : 0.999931
#> F1 : 0.132818
#> Prevalence : 0.007225
#> Detection Rate : 0.007224
#> Detection Prevalence : 0.101562
#> Balanced Accuracy : 0.952453
#>
#> 'Positive' Class : BlueTarp
#> Best Model/Tuning Parameters
# http://www.sthda.com/english/articles/36-classification-methods-essentials/144-svm-model-support-vector-machine-essentials/
# https://dataaspirant.com/support-vector-machine-classifier-implementation-r-caret-package/
svm_Radial$bestTune %>% gt() %>%
tab_header(title = "Best Tune SVM Raidal Downsampled")| Best Tune SVM Raidal Downsampled | |
|---|---|
| sigma | C |
| 1 | 4.1 |
Train Set PR
svm_Rad_Fit.roc_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
svm_Rad_Fit.roc_curve_oos <- df_scored %>%
pr_curve(truth=Class, BlueTarp) %>%
autoplot() +
labs(title = "SVM Radial PR - Train",
caption = paste0("AUC: ", round(svm_Rad_Fit.roc_auc$.estimate,3)))
svm_Rad_Fit.roc_curve_oos
# http://www.sthda.com/english/articles/36-classification-methods-essentials/144-svm-model-support-vector-machine-essentials/
# https://dataaspirant.com/support-vector-machine-classifier-implementation-r-caret-package/
# https://topepo.github.io/caret/train-models-by-tag.html for svmRaidalWeights
# Tuning parameters:
# sigma (Sigma)
# C (Cost)
# Weight (Weight)
# Required packages: kernlab
# https://github.com/topepo/caret/blob/master/RegressionTests/Code/svmRadialWeights.R
# svmRadialWeight is the same as svmRadial but also considered class weights and is for 2-class problems only.
grid_radialWeights <- expand.grid(sigma = c(0.001, 0.01, 0.1, 1), # c(.001,.005,.009) seq(0.1, 1, 0.1)
C=seq(0.1, 4, 1),
Weight= 1:2)
trcontl <- caret::trainControl("cv", number=4,
savePredictions=TRUE,
returnResamp='all',
classProbs = FALSE,
allowParallel = TRUE,
#summaryFunction = twoClassSummary
)
tictoc::tic()
set.seed(1)
svm_RadialWeights <- train(Class ~., data = df_train,
method = "svmRadialWeights",
preProcess = c("center", "scale"),
tuneGrid = grid_radialWeights,
prob.model=TRUE,
metric="AUC",
#tuneLength = 4,
trControl=trcontl)
tictoc::toc()
#> 880.35 sec elapsedTrain Model Performance
Confusion Matrix at Default Threshold (50%)
pred_svmRW_train_prob = predict(svm_RadialWeights, newdata = df_train, type = "prob")
pred_svmRW_train_raw = predict(svm_RadialWeights, newdata = df_train, type = "raw")
df_scored <- cbind(df_train, pred_svmRW_train_raw, pred_svmRW_train_prob)
confusionMatrix(conf_data$predicted, conf_data$Class, mode = 'everything')
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 14479 189069
#> NoBlueTarp 1 1800628
#>
#> Accuracy : 0.9057
#> 95% CI : (0.9053, 0.9061)
#> No Information Rate : 0.9928
#> P-Value [Acc > NIR] : 1
#>
#> Kappa : 0.121
#>
#> Mcnemar's Test P-Value : <2e-16
#>
#> Sensitivity : 0.999931
#> Specificity : 0.904976
#> Pos Pred Value : 0.071133
#> Neg Pred Value : 0.999999
#> Precision : 0.071133
#> Recall : 0.999931
#> F1 : 0.132818
#> Prevalence : 0.007225
#> Detection Rate : 0.007224
#> Detection Prevalence : 0.101562
#> Balanced Accuracy : 0.952453
#>
#> 'Positive' Class : BlueTarp
#> Train Set ROC
I was not able implement the PR curve for this model.
svm_Rad_Fit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
svm_RadW_Fit.roc_curve_oos <- df_scored %>%
roc_curve(truth=Class, BlueTarp) %>%
autoplot() +
labs(title = "SVM Radial Wtd ROC - Train",
caption = paste0("AUC: ", round(svm_Rad_Fit.roc_auc$.estimate,3)))
svm_RadW_Fit.roc_curve_oos
Best Model/Tuning Parameters
# http://www.sthda.com/english/articles/36-classification-methods-essentials/144-svm-model-support-vector-machine-essentials/
# https://dataaspirant.com/support-vector-machine-classifier-implementation-r-caret-package/
svm_RadialWeights$bestTune %>% gt() %>%
tab_header(title = "Best Tune SVM Radial Weighted")| Best Tune SVM Radial Weighted | ||
|---|---|---|
| sigma | C | Weight |
| 1 | 3.1 | 1 |
Training Variance (across folds)
svm_Radial$resample %>%
ggplot() +
geom_jitter(aes(x=sigma, y = Accuracy, col=Resample)) +
labs(title = "SVM Radial: Accuracy on sigma colored by CV Fold",
x = "") +
theme(legend.position = "none") +
theme_bw()
p3 <- svm_Radial$resample %>%
ggplot() +
geom_boxplot(aes(x=C, y = Accuracy, fill="red")) +
labs(title = "SVM Radial Down Sampled",
x = "") +
theme(legend.position = "none") +
theme_minimal()
p4 <- svm_RadialWeights$resample %>%
ggplot() +
geom_boxplot(aes(x=Weight, y = Accuracy, fill="red")) +
labs(title = "SVM Radial Weighted",
x = "") +
theme(legend.position = "none") +
theme_minimal()
grid.arrange(p3, p4, nrow=1)
CM and Threshold Selection
Going on to prediction with the SVM Radial and Downsampled data. First, threshold selection:
print("Threshold = 98%")
#> [1] "Threshold = 98%"
cut_point_svmRad <- .98
conf_data <- df_train %>%
bind_cols(pred_svmR_train_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_svmRad, "BlueTarp", "NoBlueTarp")))
cm_svm_Rad <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = "everything")
cm_svm_Rad
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 1858 110
#> NoBlueTarp 164 61109
#>
#> Accuracy : 0.9957
#> 95% CI : (0.9951, 0.9962)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.9291
#>
#> Mcnemar's Test P-Value : 0.001365
#>
#> Sensitivity : 0.91889
#> Specificity : 0.99820
#> Pos Pred Value : 0.94411
#> Neg Pred Value : 0.99732
#> Precision : 0.94411
#> Recall : 0.91889
#> F1 : 0.93133
#> Prevalence : 0.03197
#> Detection Rate : 0.02938
#> Detection Prevalence : 0.03112
#> Balanced Accuracy : 0.95855
#>
#> 'Positive' Class : BlueTarp
#> Test (FHO) Performance
Predicting on the final hold-Out and evaluating at the specified threshold.
svm_Radial_pred_raw <- svm_Radial %>% predict(df_test, type = "raw")
svm_Radial_pred_prob <- svm_Radial %>% predict(df_test, type = "prob")
df_scored <- cbind(df_test, svm_Radial_pred_raw, svm_Radial_pred_prob)conf_data <- df_test %>%
bind_cols(svm_Radial_pred_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_svmRad, "BlueTarp", "NoBlueTarp")))
cm_svm_Rad_test <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = "everything")svmRadialFit.conf_mat <- conf_data %>%
conf_mat(truth=Class, predicted)
SVM_RConfMat <- autoplot(svmRadialFit.conf_mat, type = "heatmap") +
labs(title = "SVM Radial",
subtitle = paste0("Threshold: ", cut_point_svmRad))Prediction AUCs, Precision/Recall and ROC Curves
Area under the curve is:
# https://onezero.blog/modelling-binary-logistic-regression-using-r-research-oriented-modelling-and-interpretation/
# https://yardstick.tidymodels.org/reference/f_meas.html
# act_pred <- data.frame(obs = df_test$Class, pred = svm_Radial_pred_raw)
# svmRad_prec <- precision(act_pred, obs, pred)
# svmRad_rec <- recall(act_pred, obs, pred)
# svmRad_F1_score <- f_meas(act_pred, obs, pred) #called f_measure
# bind_rows(svmRad_prec, svmRad_rec, svmRad_F1_score) %>% gt() %>%
# tab_header(title = "PR Metrics:") %>%
# cols_align(align = "center")
svmRadFit_trn.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://yardstick.tidymodels.org/reference/pr_auc.html
svmRadFit_trn.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
bind_rows(svmRadFit_trn.pr_auc, svmRadFit_trn.roc_auc) %>% gt() %>%
tab_header(title = "AUC's:") %>%
cols_align(align = "center")| AUC's: | ||
|---|---|---|
| .metric | .estimator | .estimate |
| pr_auc | binary | 0.7133574 |
| roc_auc | binary | 0.9917188 |
svmRad_pr_curve <- autoplot(pr_curve(svm_Radial_pred_prob, df_test$Class, BlueTarp)) +
labs(title = "SVM Radial PR - FHO",
caption = paste0("AUC : ", round(svmRadFit_trn.pr_auc$.estimate,3)))
svmRad.roc_curve <- df_scored %>%
roc_curve(truth=Class, BlueTarp) %>%
autoplot() +
labs(title = "SVM Radial ROC - FHO",
caption = paste0("AUC : ", round(svmRadFit_trn.roc_auc$.estimate,3)))
grid.arrange(svmRad_pr_curve, svmRad.roc_curve, nrow=1)
SVM Poly
Define and Train the Model
grid_poly <- expand.grid(scale = 0.01, degree = seq(1, 3, 1),
C=seq(0, 20, 4))
#https://github.com/topepo/caret/blob/master/RegressionTests/Code/svmLinear2.R
trcontl <- caret::trainControl("cv", number=8,
savePredictions=TRUE,
returnResamp='all',
classProbs = TRUE,
sampling = "down",
allowParallel = TRUE,
summaryFunction=prSummary
)
tictoc::tic()
set.seed(1)
svm_Poly <- train(Class ~., data = df_train,
method = "svmPoly",
tuneGrid = grid_poly,
prob.model=TRUE,
trControl = trcontl,
preProcess = c("center","scale"),
metric = "AUC",
tuneLength = 2
)
tictoc::toc()
#> 60.31 sec elapsedTrain Model Performance
Confusion Matrix at Default Threshold (50%)
pred_svmP_train_prob = predict(svm_Poly, newdata = df_train, type = "prob")
pred_svmP_train_raw = predict(svm_Poly, newdata = df_train, type = "raw")
df_scored <- cbind(df_train, pred_svmP_train_raw, pred_svmP_train_prob)
conf_data <- df_train %>%
bind_cols(pred_svmP_train_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > 0.5, "BlueTarp", "NoBlueTarp")))
confusionMatrix(conf_data$predicted, conf_data$Class, mode = 'everything')
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 2012 1346
#> NoBlueTarp 10 59873
#>
#> Accuracy : 0.9786
#> 95% CI : (0.9774, 0.9797)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.7375
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.99505
#> Specificity : 0.97801
#> Pos Pred Value : 0.59917
#> Neg Pred Value : 0.99983
#> Precision : 0.59917
#> Recall : 0.99505
#> F1 : 0.74796
#> Prevalence : 0.03197
#> Detection Rate : 0.03181
#> Detection Prevalence : 0.05310
#> Balanced Accuracy : 0.98653
#>
#> 'Positive' Class : BlueTarp
#> Best Model/Tuning Parameters
| degree | scale | C |
|---|---|---|
| 2 | 0.01 | 4 |
Train Set ROC
svm_poly_Fit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
svm_poly_Fit.roc_curve_oos <- df_scored %>%
roc_curve(truth=Class, BlueTarp) %>%
autoplot() +
labs(title = "SVM Poly ROC - Train",
caption = paste0("AUC: ", round(svm_poly_Fit.roc_auc$.estimate,3)))
svm_poly_Fit.roc_curve_oos
Training Variance (across folds)
svm_Poly$resample %>%
ggplot() +
geom_boxplot(aes(x=AUC, fill=Resample)) +
labs(title = "SVM Poly: AUC by CV Fold",
x = "AUC Score") +
coord_flip() +
theme_bw()
CM and Threshold Selection
print("Threshold = 83%")
#> [1] "Threshold = 83%"
cut_point_svm_poly <- .83
conf_data <- df_train %>%
bind_cols(pred_svmP_train_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_svm_poly, "BlueTarp", "NoBlueTarp")))
cm_svm_poly <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = 'everything')
cm_svm_poly
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 1959 600
#> NoBlueTarp 63 60619
#>
#> Accuracy : 0.9895
#> 95% CI : (0.9887, 0.9903)
#> No Information Rate : 0.968
#> P-Value [Acc > NIR] : < 2.2e-16
#>
#> Kappa : 0.8499
#>
#> Mcnemar's Test P-Value : < 2.2e-16
#>
#> Sensitivity : 0.96884
#> Specificity : 0.99020
#> Pos Pred Value : 0.76553
#> Neg Pred Value : 0.99896
#> Precision : 0.76553
#> Recall : 0.96884
#> F1 : 0.85527
#> Prevalence : 0.03197
#> Detection Rate : 0.03098
#> Detection Prevalence : 0.04046
#> Balanced Accuracy : 0.97952
#>
#> 'Positive' Class : BlueTarp
#> Predicting on the FHO/Test Set
Predicting on the final hold-Out and evaluating at the specified threshold.
# Make predictions on the test data
svmPoly_pred_raw <- svm_Poly %>% predict(df_test, type = 'raw')
svmPoly_pred_prob <- svm_Poly %>% predict(df_test, type = 'prob')
df_scored <- cbind(df_test, svmPoly_pred_raw, svmPoly_pred_prob)
#confusionMatrix(svmPoly_pred_raw, df_test$Class)
# caret::confusionMatrix(data=predict(svm_Poly,
# newdata=df_test),
# reference=df_test$Class, positive='BlueTarp')conf_data <- df_test %>%
bind_cols(svmPoly_pred_prob) %>%
mutate(predicted = as.factor(if_else(BlueTarp > cut_point_svm_poly, "BlueTarp", "NoBlueTarp")))
svm_poly_eval <- conf_data %>% dplyr::select(BlueTarp, NoBlueTarp, Class)
cm_svm_poly_test <- confusionMatrix(conf_data$predicted, conf_data$Class, mode = "everything")
cm_svm_poly_test
#> Confusion Matrix and Statistics
#>
#> Reference
#> Prediction BlueTarp NoBlueTarp
#> BlueTarp 14463 45733
#> NoBlueTarp 17 1943964
#>
#> Accuracy : 0.9772
#> 95% CI : (0.977, 0.9774)
#> No Information Rate : 0.9928
#> P-Value [Acc > NIR] : 1
#>
#> Kappa : 0.3801
#>
#> Mcnemar's Test P-Value : <2e-16
#>
#> Sensitivity : 0.998826
#> Specificity : 0.977015
#> Pos Pred Value : 0.240265
#> Neg Pred Value : 0.999991
#> Precision : 0.240265
#> Recall : 0.998826
#> F1 : 0.387353
#> Prevalence : 0.007225
#> Detection Rate : 0.007216
#> Detection Prevalence : 0.030035
#> Balanced Accuracy : 0.987921
#>
#> 'Positive' Class : BlueTarp
#>
svm_Poly.conf_mat <- conf_data %>%
conf_mat(truth=Class, predicted)
svm_PolyConfMat <- autoplot(svm_Poly.conf_mat, type = "heatmap") +
labs(title = "SVM Poly",
subtitle = paste0("Threshold: ", cut_point_svm_poly))# https://stackoverflow.com/questions/62827779/roc-curve-for-the-testing-set-using-caret-package
# https://cran.r-project.org/web/packages/MLeval/vignettes/introduction.pdf
# https://intobioinformatics.wordpress.com/2019/12/05/how-to-make-a-precision-recall-curve-in-r/
# https://stackoverflow.com/questions/10566473/names-attribute-must-be-the-same-length-as-the-vector
# testPoly <- evalm(svm_poly)
# tmp <- tibble(svmPoly_pred_prob, df_test$Class)
# names(tmp)=c("B", "NB", "Class")
# test1 <- evalm(tmp, plots = 'r')Prediction AUCs, Precision/Recall and ROC Curves
svmPolyFit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://onezero.blog/modelling-binary-logistic-regression-using-r-research-oriented-modelling-and-interpretation/
# https://yardstick.tidymodels.org/reference/f_meas.html
# act_pred <- data.frame(obs = df_test$Class, pred = svmPoly_pred_raw)
# svmPoly_prec <- precision(act_pred, obs, pred)
# svmPoly_rec <- recall(act_pred, obs, pred)
# svmPoly_F1_score <- f_meas(act_pred, obs, pred) #called f_measure
# bind_rows(svmPoly_prec, svmPoly_rec, svmPoly_F1_score) %>% gt() %>%
# tab_header(title = "PR Metrics:") %>%
# cols_align(align = "center")
svmPolyFit.roc_auc <- df_scored %>%
roc_auc(truth=Class, BlueTarp)
# https://yardstick.tidymodels.org/reference/pr_auc.html
svmPolyFit.pr_auc <- df_scored %>%
pr_auc(truth=Class, BlueTarp)
bind_rows(svmPolyFit.pr_auc, svmPolyFit.roc_auc) %>% gt() %>%
tab_header(title = "AUC's:") %>%
cols_align(align = "center")| AUC's: | ||
|---|---|---|
| .metric | .estimator | .estimate |
| pr_auc | binary | 0.9694752 |
| roc_auc | binary | 0.9996056 |
svmPoly_pr_curve <- autoplot(pr_curve(svmPoly_pred_prob, df_test$Class, BlueTarp)) +
labs(title = "SVM Poly PR - FHO",
caption = paste0("AUC : ", round(svmPolyFit.pr_auc$.estimate,3)))
svmPoly_roc_curve <- df_scored %>%
roc_curve(truth=Class, BlueTarp) %>%
autoplot() +
labs(title = "SVM Poly ROC - FHO",
caption = paste0("AUC : ", round(svmPolyFit.roc_auc$.estimate,3)))
grid.arrange(svmPoly_pr_curve, svmPoly_roc_curve, nrow=1)
Compiling/Saving Results
conf_matrices1 <- arrangeGrob(knnConfMat, ldaConfMat, qdaConfMat, logConfMat, nrow=2)
ggsave(file="confusionMatrices1.png", device = "png", conf_matrices1)
conf_matrices2 <- arrangeGrob(rfConfMat, svm_linConfMat, SVM_RConfMat, svm_PolyConfMat, nrow = 2)
ggsave(file="confusionMatrices2.png", device = "png", conf_matrices2) pr_plots1 <- arrangeGrob(knn_pr_curve, lda_pr_curve, qda_pr_curve, log_pr_curve, nrow=2)
ggsave(file="prCurves1.png", device = "png", pr_plots1)
pr_plots2 <- arrangeGrob(rf_pr_curve, svm_lin_pr_curve, svmRad_pr_curve, svmPoly_pr_curve, nrow = 2)
ggsave(file="prCurves2.png", device = "png", pr_plots2) roc_plots1 <- arrangeGrob(knnFit.roc_curve, ldaFit.roc_curve, qdaFit.roc_curve, logFit.roc_curve, nrow=2)
ggsave(file="rocCurves1.png", device = "png", roc_plots1)
roc_plots2 <- arrangeGrob(rfFit.roc_curve, svm_lin_Fit.roc_curve, svmRad.roc_curve, svmPoly_pr_curve, nrow = 2)
ggsave(file="rocCurves2.png", device = "png", roc_plots2)outSampleResults <- data.frame(
Method = c('Accuracy', 'AUC-ROC', 'ROC', 'Threshold-Selected', 'AUC-PR', 'Sensitivity', 'Specificity', 'FDR (1-Precision)', 'Precision (also PPV)', 'F1 Score' ,'Approx. Run Time'),
KNN = c(round(cm_knn_train$overall[1],3), round(knnFitTrn.roc_auc$.estimate,3), "See Below", cut_point_knn, round(knnFitTrn.pr_auc$.estimate,3), round(cm_knn_train$byClass[1],3), round(cm_knn_train$byClass[2],3), round(1-cm_knn_train$byClass[3],3), round(cm_knn_train$byClass[3],3), round(cm_knn_train$byClass[7],3), '~18 sec'),
LDA = c(round(cm_lda_train$overall[1],3), round(ldaFit.roc_auc$.estimate,3), "See Below", cut_point_lda, round(ldaFitTrn.pr_auc$.estimate,3), round(cm_lda_train$byClass[1],3), round(cm_lda_train$byClass[2],3), round(1-cm_lda_train$byClass[3],3), round(cm_lda_train$byClass[3],3), round(cm_lda_test$byClass[7],3), '~1.7 sec'),
QDA = c(round(cm_qda_train$overall[1],3), round(qdaFit.roc_auc$.estimate,3), "See Below", cut_point_qda, round(qdaFitTrn.pr_auc$.estimate,3), round(cm_qda_train$byClass[1],3), round(cm_qda_train$byClass[2],3), round(1-cm_qda_train$byClass[3],3), round(cm_qda_train$byClass[3],3), round(cm_qda_train$byClass[7],3), '~1.9 sec'),
LogisticRegression = c(round(cm_log_train$overall[1],3), round(logFit.roc_auc$.estimate,3), "See Below", cut_point_log, round(logFitTrn.pr_auc$.estimate,3), round(cm_log_train$byClass[1],3), round(cm_log_train$byClass[2],3), round(1-cm_log_train$byClass[3],3), round(cm_log_train$byClass[3],3), round(cm_log_train$byClass[3],3), '~2 sec'),
RandomForest = c(round(cm_rf_train$overall[1],3), round(rfFit.roc_auc$.estimate,3), "See Below", cut_point_rf, round(rfFitTrn.pr_auc$.estimate,3), round(cm_rf_train$byClass[1],3), round(cm_rf_train$byClass[2],3), round(1-cm_rf_train$byClass[3],3), round(cm_rf_train$byClass[3],3), round(cm_rf_train$byClass[7],3), '~69 sec'),
SVMRadDownSampled = c(round(cm_svm_Rad$overall[1],3), round(svm_Rad_Fit.roc_auc$.estimate,3), "See Below", cut_point_svm, round(svm_Rad_Fit.roc_auc$.estimate,3), round(cm_svm_Rad$byClass[1],3), round(cm_svm_Rad$byClass[2],3), round(1-cm_svm_Rad$byClass[3],3), round(cm_svm_Rad$byClass[3],3), round(cm_svm_Rad$byClass[7],3), '~900 sec'))
outSampleResults <- outSampleResults %>%
dplyr::rename('KNN (k = 97)' = KNN,
'SVM Rad (DownSampled)'= SVMRadDownSampled)
#outSampleResults %>% gt()
write.csv(outSampleResults, "outSampleResults.csv")test_results <- data.frame(
Method = c('Accuracy', 'AUC-ROC', 'ROC', 'Threshold-Selected', 'AUC-PR', 'Sensitivity', 'Specificity', 'FDR (1-Precision)', 'Precision (also PPV)', 'F1 Score'),
KNN = c(round(cm_knn_test$overall[1],3), round(knnFit.roc_auc_test$.estimate,3), "See Below", cut_point_knn, round(knnFit.pr_auc$.estimate,3), round(cm_knn_test$byClass[1],3), round(cm_knn_test$byClass[2],3), round(1-cm_knn_test$byClass[3],3), round(cm_knn_test$byClass[3],3), round(cm_knn_test$byClass[7],3)),
LDA = c(round(cm_lda_test$overall[1],3), round(ldaFit.roc_auc$.estimate,3), "See Below", cut_point_lda, round(ldaFit.pr_auc$.estimate,3), round(cm_lda_test$byClass[1],3), round(cm_lda_test$byClass[2],3), round(1-cm_lda_test$byClass[3],3), round(cm_lda_test$byClass[3],3), round(cm_lda_test$byClass[7],3)),
QDA = c(round(cm_qda_test$overall[1],3), round(qdaFit.roc_auc$.estimate,3), "See Below", cut_point_qda, round(qdaFit.pr_auc$.estimate, 3), round(cm_qda_test$byClass[1],3), round(cm_qda_test$byClass[2],3), round(1-cm_qda_test$byClass[3],3), round(cm_qda_test$byClass[3],3), round(cm_qda_test$byClass[7],3)),
LogisticRegression = c(round(cm_log_test$overall[1],3), round(logFit.roc_auc$.estimate,3), "See Below", cut_point_log, round(logFit.roc_auc$.estimate,3), round(cm_log_test$byClass[1],3), round(cm_log_test$byClass[2],3), round(1-cm_log_test$byClass[3],3), round(cm_log_test$byClass[3],3), round(cm_log_test$byClass[7],3)),
RandomForest = c(round(cm_rf_test$overall[1],3), round(rfFit.roc_auc$.estimate,3), "See Below", cut_point_rf, round(rfFit.pr_auc$.estimate,3), round(cm_rf_test$byClass[1],3), round(cm_rf_test$byClass[2],3), round(1-cm_rf_test$byClass[3],3), round(cm_rf_test$byClass[3],3), round(cm_rf_test$byClass[7],3)),
SVMRadDownSampled = c(round(cm_svm_Rad$overall[1],3), round(svmRadFit_trn.roc_auc$.estimate,3), "See Below", cut_point_svm, round(svmRadFit_trn.pr_auc$.estimate,3), round(cm_svm_Rad_test$byClass[1],3), round(cm_svm_Rad_test$byClass[2],3), round(1-cm_svm_Rad_test$byClass[3],3), round(cm_svm_Rad_test$byClass[2],3), round(cm_svm_Rad_test$byClass[7],3)))
test_results <- test_results %>%
dplyr::rename('KNN (k = 97)' = KNN,
'SVM Rad (DownSampled)'= SVMRadDownSampled)
#test_results %>% gt()
write.csv(test_results, "test_results.csv")