Logistic Regression - with SMOTE (Kaggle fraud data)
Nao Mimoto – Class Web Page
1. Load data
SMOTE + Logistic Regression on the Kaggle “Credit Card Fraud Detection” dataset (anonymized European cardholder transactions, Sep 2013, ULB Machine Learning Group). 284,807 transactions, 492 frauds (0.173%) one of the most extreme real-world class imbalances in a public dataset. Kaggle page
rm(list=ls()) # clear the memory
library(tidyverse)
library(caret)
library(smotefamily)
library(pROC)
library(PRROC)
DF <- read_csv("creditcard.csv")
DF## # A tibble: 284,807 × 30
## V1 V2 V3 V4 V5 V6 V7 V8 V9 V10
## <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 -1.36 -0.0728 2.54 1.38 -0.338 0.462 0.240 0.0987 0.364 0.0908
## 2 1.19 0.266 0.166 0.448 0.0600 -0.0824 -0.0788 0.0851 -0.255 -0.167
## 3 -1.36 -1.34 1.77 0.380 -0.503 1.80 0.791 0.248 -1.51 0.208
## 4 -0.966 -0.185 1.79 -0.863 -0.0103 1.25 0.238 0.377 -1.39 -0.0550
## 5 -1.16 0.878 1.55 0.403 -0.407 0.0959 0.593 -0.271 0.818 0.753
## 6 -0.426 0.961 1.14 -0.168 0.421 -0.0297 0.476 0.260 -0.569 -0.371
## 7 1.23 0.141 0.0454 1.20 0.192 0.273 -0.00516 0.0812 0.465 -0.0993
## 8 -0.644 1.42 1.07 -0.492 0.949 0.428 1.12 -3.81 0.615 1.25
## 9 -0.894 0.286 -0.113 -0.272 2.67 3.72 0.370 0.851 -0.392 -0.410
## 10 -0.338 1.12 1.04 -0.222 0.499 -0.247 0.652 0.0695 -0.737 -0.367
## # ℹ 284,797 more rows
## # ℹ 20 more variables: V11 <dbl>, V12 <dbl>, V13 <dbl>, V14 <dbl>, V15 <dbl>,
## # V16 <dbl>, V17 <dbl>, V18 <dbl>, V19 <dbl>, V20 <dbl>, V21 <dbl>,
## # V22 <dbl>, V23 <dbl>, V24 <dbl>, V25 <dbl>, V26 <dbl>, V27 <dbl>,
## # V28 <dbl>, Amount <dbl>, Class <dbl>## [1] "V1" "V2" "V3" "V4" "V5" "V6" "V7" "V8"
## [9] "V9" "V10" "V11" "V12" "V13" "V14" "V15" "V16"
## [17] "V17" "V18" "V19" "V20" "V21" "V22" "V23" "V24"
## [25] "V25" "V26" "V27" "V28" "Amount" "Class"## Rows: 284,807
## Columns: 30
## $ V1 <dbl> -1.3598071, 1.1918571, -1.3583541, -0.9662717, -1.1582331, -0.4…
## $ V2 <dbl> -0.07278117, 0.26615071, -1.34016307, -0.18522601, 0.87773675, …
## $ V3 <dbl> 2.53634674, 0.16648011, 1.77320934, 1.79299334, 1.54871785, 1.1…
## $ V4 <dbl> 1.37815522, 0.44815408, 0.37977959, -0.86329128, 0.40303393, -0…
## $ V5 <dbl> -0.33832077, 0.06001765, -0.50319813, -0.01030888, -0.40719338,…
## $ V6 <dbl> 0.46238778, -0.08236081, 1.80049938, 1.24720317, 0.09592146, -0…
## $ V7 <dbl> 0.239598554, -0.078802983, 0.791460956, 0.237608940, 0.59294074…
## $ V8 <dbl> 0.098697901, 0.085101655, 0.247675787, 0.377435875, -0.27053267…
## $ V9 <dbl> 0.3637870, -0.2554251, -1.5146543, -1.3870241, 0.8177393, -0.56…
## $ V10 <dbl> 0.09079417, -0.16697441, 0.20764287, -0.05495192, 0.75307443, -…
## $ V11 <dbl> -0.55159953, 1.61272666, 0.62450146, -0.22648726, -0.82284288, …
## $ V12 <dbl> -0.61780086, 1.06523531, 0.06608369, 0.17822823, 0.53819555, 0.…
## $ V13 <dbl> -0.99138985, 0.48909502, 0.71729273, 0.50775687, 1.34585159, -0…
## $ V14 <dbl> -0.31116935, -0.14377230, -0.16594592, -0.28792375, -1.11966983…
## $ V15 <dbl> 1.468176972, 0.635558093, 2.345864949, -0.631418118, 0.17512113…
## $ V16 <dbl> -0.47040053, 0.46391704, -2.89008319, -1.05964725, -0.45144918,…
## $ V17 <dbl> 0.207971242, -0.114804663, 1.109969379, -0.684092786, -0.237033…
## $ V18 <dbl> 0.02579058, -0.18336127, -0.12135931, 1.96577500, -0.03819479, …
## $ V19 <dbl> 0.40399296, -0.14578304, -2.26185710, -1.23262197, 0.80348692, …
## $ V20 <dbl> 0.25141210, -0.06908314, 0.52497973, -0.20803778, 0.40854236, 0…
## $ V21 <dbl> -0.018306778, -0.225775248, 0.247998153, -0.108300452, -0.00943…
## $ V22 <dbl> 0.277837576, -0.638671953, 0.771679402, 0.005273597, 0.79827849…
## $ V23 <dbl> -0.110473910, 0.101288021, 0.909412262, -0.190320519, -0.137458…
## $ V24 <dbl> 0.06692807, -0.33984648, -0.68928096, -1.17557533, 0.14126698, …
## $ V25 <dbl> 0.12853936, 0.16717040, -0.32764183, 0.64737603, -0.20600959, -…
## $ V26 <dbl> -0.18911484, 0.12589453, -0.13909657, -0.22192884, 0.50229222, …
## $ V27 <dbl> 0.133558377, -0.008983099, -0.055352794, 0.062722849, 0.2194222…
## $ V28 <dbl> -0.021053053, 0.014724169, -0.059751841, 0.061457629, 0.2151531…
## $ Amount <dbl> 149.62, 2.69, 378.66, 123.50, 69.99, 3.67, 4.99, 40.80, 93.20, …
## $ Class <dbl> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, …## Class
## 0 1
## 284315 492DF2 = DF %>% rename(resp=Class) %>% relocate(resp)
DF3 = DF2 %>% mutate(resp=ifelse(resp==1, "Yes", "No")) %>%
mutate_at("resp", as_factor)
DF3## # A tibble: 284,807 × 30
## resp V1 V2 V3 V4 V5 V6 V7 V8 V9
## <fct> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 No -1.36 -0.0728 2.54 1.38 -0.338 0.462 0.240 0.0987 0.364
## 2 No 1.19 0.266 0.166 0.448 0.0600 -0.0824 -0.0788 0.0851 -0.255
## 3 No -1.36 -1.34 1.77 0.380 -0.503 1.80 0.791 0.248 -1.51
## 4 No -0.966 -0.185 1.79 -0.863 -0.0103 1.25 0.238 0.377 -1.39
## 5 No -1.16 0.878 1.55 0.403 -0.407 0.0959 0.593 -0.271 0.818
## 6 No -0.426 0.961 1.14 -0.168 0.421 -0.0297 0.476 0.260 -0.569
## 7 No 1.23 0.141 0.0454 1.20 0.192 0.273 -0.00516 0.0812 0.465
## 8 No -0.644 1.42 1.07 -0.492 0.949 0.428 1.12 -3.81 0.615
## 9 No -0.894 0.286 -0.113 -0.272 2.67 3.72 0.370 0.851 -0.392
## 10 No -0.338 1.12 1.04 -0.222 0.499 -0.247 0.652 0.0695 -0.737
## # ℹ 284,797 more rows
## # ℹ 20 more variables: V10 <dbl>, V11 <dbl>, V12 <dbl>, V13 <dbl>, V14 <dbl>,
## # V15 <dbl>, V16 <dbl>, V17 <dbl>, V18 <dbl>, V19 <dbl>, V20 <dbl>,
## # V21 <dbl>, V22 <dbl>, V23 <dbl>, V24 <dbl>, V25 <dbl>, V26 <dbl>,
## # V27 <dbl>, V28 <dbl>, Amount <dbl>## [1] 284807 30## Class counts:##
## No Yes
## 284315 492## Fraud rate: 0.1727%2. Data Separation
DF00 = DF3
# Load the file from my website
source("https://nmimoto.github.io/R/ML-00.txt") # load CreateCV()
# Use this function to create CV dataset
# CreateCV(DF3, numFolds=3, seed=453)
CreateCV(DF3, numFolds=3, seed=163)##
## number of folds: 3
## number of obs: 284807
## training data: 71201 x 3 = 213603
## size of test data: 71204
##
## Global variables created:
## Train.set Train.resp
## Test.set Test.resp
## CV.train[[k]] CV.train.resp[[k]]
## CV.valid[[k]] CV.valid.resp[[k]] # how claude wanted to do it originally:
#set.seed(42)
#set.seed(123)
#set.seed(59)
#Train.set_idx <- createDataPartition(DF00$resp, p=0.7, list=FALSE)
#Train.set <- DF00[Train.set_idx, ]
#Test.set <- DF00[-Train.set_idx, ]
#Test.resp = Test.set$resp
print(table(Train.set$resp))##
## No Yes
## 213242 361##
## No Yes
## 71073 1313. Baseline: logistic regression directly on the imbalanced data
##
## Call:
## glm(formula = resp ~ ., family = binomial, data = Train.set)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -8.6790227 0.1696829 -51.148 < 2e-16 ***
## V1 0.0525918 0.0495487 1.061 0.288501
## V2 -0.0203378 0.0657319 -0.309 0.757013
## V3 0.0502334 0.0541816 0.927 0.353859
## V4 0.6576288 0.0781997 8.410 < 2e-16 ***
## V5 0.0542151 0.0758249 0.715 0.474607
## V6 -0.1169386 0.0910741 -1.284 0.199144
## V7 -0.0715494 0.0770800 -0.928 0.353279
## V8 -0.1916125 0.0352284 -5.439 5.35e-08 ***
## V9 -0.3792383 0.1199975 -3.160 0.001576 **
## V10 -0.7882800 0.1094337 -7.203 5.88e-13 ***
## V11 0.0085789 0.0898074 0.096 0.923897
## V12 0.0274348 0.0994019 0.276 0.782549
## V13 -0.3248000 0.0955344 -3.400 0.000674 ***
## V14 -0.5558650 0.0719566 -7.725 1.12e-14 ***
## V15 -0.1018098 0.0979690 -1.039 0.298710
## V16 -0.2057378 0.1333675 -1.543 0.122918
## V17 0.0178166 0.0788136 0.226 0.821155
## V18 -0.0435501 0.1386225 -0.314 0.753397
## V19 0.1116589 0.1084242 1.030 0.303088
## V20 -0.4131150 0.1018396 -4.057 4.98e-05 ***
## V21 0.3539726 0.0633399 5.588 2.29e-08 ***
## V22 0.4908048 0.1447002 3.392 0.000694 ***
## V23 -0.0275001 0.0655843 -0.419 0.674990
## V24 0.2863809 0.1806744 1.585 0.112951
## V25 -0.1189064 0.1494840 -0.795 0.426354
## V26 -0.0286097 0.2160716 -0.132 0.894661
## V27 -0.7479407 0.1539367 -4.859 1.18e-06 ***
## V28 -0.3121670 0.1049421 -2.975 0.002933 **
## Amount 0.0006494 0.0004800 1.353 0.176073
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 5329.9 on 213602 degrees of freedom
## Residual deviance: 1629.9 on 213573 degrees of freedom
## AIC: 1689.9
##
## Number of Fisher Scoring iterations: 11Fit00 = Fit03
#- Extract fitted response (training)
Train.prob =predict(Fit00, type ="response")
#- Predict in Test Set
Test.prob = predict(Fit00, newdata=Test.set, type="response")
###----------
### a. Output ROC curve and AUC for all threshold
library(pROC)
auc.test = auc(factor(as.matrix(Test.resp)), Test.prob, levels=c("No", "Yes"))
auc.test## Area under the curve: 0.9726 ###----------
### b. Output result for given threshold value
threshold = .5 # pick a threshold
#- Check the training set accuracy
library(caret)
Train.pred = ifelse(Train.prob > threshold, "Yes", "No") # Turn the fitted values to Up/Down using threshold of .5
Test.pred = ifelse(Test.prob > threshold, "Yes", "No")
CM.train <- confusionMatrix(factor(Train.pred), factor(as.matrix(Train.resp)), positive="Yes")
CM.test <- confusionMatrix(factor(Test.pred), factor(as.matrix(Test.resp)), positive="Yes")
CM.train # Training set result## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 213214 134
## Yes 28 227
##
## Accuracy : 0.9992
## 95% CI : (0.9991, 0.9994)
## No Information Rate : 0.9983
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.7366
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.628809
## Specificity : 0.999869
## Pos Pred Value : 0.890196
## Neg Pred Value : 0.999372
## Prevalence : 0.001690
## Detection Rate : 0.001063
## Detection Prevalence : 0.001194
## Balanced Accuracy : 0.814339
##
## 'Positive' Class : Yes
## ## Reference
## Prediction No Yes
## No 213214 134
## Yes 28 227## [1] 0.6288089## [1] 0.9998687## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 71060 47
## Yes 13 84
##
## Accuracy : 0.9992
## 95% CI : (0.9989, 0.9994)
## No Information Rate : 0.9982
## P-Value [Acc > NIR] : 2.945e-12
##
## Kappa : 0.7364
##
## Mcnemar's Test P-Value : 2.042e-05
##
## Sensitivity : 0.641221
## Specificity : 0.999817
## Pos Pred Value : 0.865979
## Neg Pred Value : 0.999339
## Prevalence : 0.001840
## Detection Rate : 0.001180
## Detection Prevalence : 0.001362
## Balanced Accuracy : 0.820519
##
## 'Positive' Class : Yes
## ## Reference
## Prediction No Yes
## No 71060 47
## Yes 13 84 # Test set result
# Reference
# Prediction No Yes
# No 1437 62 [Specificity][ ] = TrueNeg / sum of col
# Yes 0 1 [ ][Sensitivity] = TruePos / sum of col
colSums(CM.test$table) / sum(colSums(CM.test$table)) # % of Actual Yes/No## No Yes
## 0.998160216 0.001839784## No Yes
## 0.998637717 0.0013622834. Apply SMOTE to the TRAINING data only
The function SMOTE() controls oversampling via dup_size (synthetic copies per real minority sample).
num_minority <- sum(Train.set$resp=="Yes")
target_minority <- nrow(Train.set)/10
dup_size <- round(target_minority / num_minority)
dup_size## [1] 59# Get names of columns except "resp".
feature_cols <- setdiff(names(DF00), "resp")
# Do the SMOTE
smote_out <- SMOTE(
X = Train.set[, feature_cols],
target = Train.set$resp,
K = 5,
dup_size = dup_size
)
Train.smote <- smote_out$data
names(Train.smote)[names(Train.smote) == "class"] <- "resp"
Train.smote$resp <- factor(Train.smote$resp, levels = levels(Train.set$resp))
Train.smote.resp = Train.smote$resp
cat("\nResampled Train.set class counts:\n")##
## Resampled Train.set class counts:##
## No Yes
## 213242 21660##----------
## Visualize SMOTE
DFo = Train.set %>% filter(resp=="Yes")
DFs = Train.smote %>% filter(resp=="Yes")
layout(matrix(1:2, 1, 2))
plot(DFo$V9, DFo$V8, col="red", pch=19)
plot(DFo$V9, DFo$V8, col="red", pch=19)
lines(DFs$V9, DFs$V8, type="p")
layout(matrix(1:2, 1, 2))
plot(DFo$V5, DFo$V4, col="red", pch=19)
plot(DFo$V5, DFo$V4, col="red", pch=19)
lines(DFs$V5, DFs$V4, type="p")
5. SMOTE: logistic regression fit on the balanced data
## Warning: glm.fit: algorithm did not converge## Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred##
## Call:
## glm(formula = resp ~ ., family = binomial, data = Train.smote)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -5.8613911 0.0494546 -118.521 < 2e-16 ***
## V1 0.2331789 0.0189448 12.308 < 2e-16 ***
## V2 0.0073753 0.0375836 0.196 0.844425
## V3 0.1765088 0.0188715 9.353 < 2e-16 ***
## V4 0.8642517 0.0201156 42.964 < 2e-16 ***
## V5 0.1452284 0.0285786 5.082 3.74e-07 ***
## V6 -0.2481628 0.0270139 -9.186 < 2e-16 ***
## V7 -0.0386111 0.0351486 -1.099 0.271982
## V8 -0.4328766 0.0154847 -27.955 < 2e-16 ***
## V9 -0.3310352 0.0285884 -11.579 < 2e-16 ***
## V10 -0.7065223 0.0325443 -21.710 < 2e-16 ***
## V11 0.4482009 0.0214042 20.940 < 2e-16 ***
## V12 -0.8072174 0.0235593 -34.263 < 2e-16 ***
## V13 -0.3876522 0.0204155 -18.988 < 2e-16 ***
## V14 -0.9154924 0.0220814 -41.460 < 2e-16 ***
## V15 -0.0712709 0.0226570 -3.146 0.001657 **
## V16 -0.4583111 0.0324762 -14.112 < 2e-16 ***
## V17 -0.3323750 0.0257894 -12.888 < 2e-16 ***
## V18 -0.2308805 0.0327461 -7.051 1.78e-12 ***
## V19 -0.0526124 0.0264167 -1.992 0.046411 *
## V20 -0.1893819 0.0430720 -4.397 1.10e-05 ***
## V21 0.2246499 0.0193657 11.600 < 2e-16 ***
## V22 0.2577343 0.0349721 7.370 1.71e-13 ***
## V23 0.0499394 0.0340397 1.467 0.142351
## V24 0.3316215 0.0447733 7.407 1.30e-13 ***
## V25 0.0177368 0.0410626 0.432 0.665782
## V26 -0.2083427 0.0545662 -3.818 0.000134 ***
## V27 0.1121484 0.0666991 1.681 0.092683 .
## V28 0.1041267 0.0484621 2.149 0.031664 *
## Amount 0.0010279 0.0003482 2.952 0.003154 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 144520 on 234901 degrees of freedom
## Residual deviance: 21164 on 234872 degrees of freedom
## AIC: 21224
##
## Number of Fisher Scoring iterations: 25Fit00 = Fit_SMOTE
#- Extract fitted response (training)
Train.prob =predict(Fit00, type ="response")
#- Predict in Test Set
Test.prob = predict(Fit00, newdata=Test.set, type="response")
###----------
### a. Output ROC curve and AUC for all threshold
library(pROC)
auc.test.smote = auc(factor(as.matrix(Test.resp)), Test.prob, levels=c("No", "Yes"))
auc.test.smote## Area under the curve: 0.9801 ###----------
### b. Output result for given threshold value
threshold = .5 # pick a threshold
#- Check the training set accuracy
library(caret)
Train.pred = ifelse(Train.prob > threshold, "Yes", "No") # Turn the fitted values to Up/Down using threshold of .5
Test.pred = ifelse(Test.prob > threshold, "Yes", "No")
CM.train <- confusionMatrix(factor(Train.pred), factor(as.matrix(Train.smote.resp)), positive="Yes")
CM.test <- confusionMatrix(factor(Test.pred), factor(as.matrix(Test.resp)), positive="Yes")
CM.train # Training set result## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 212894 2266
## Yes 348 19394
##
## Accuracy : 0.9889
## 95% CI : (0.9884, 0.9893)
## No Information Rate : 0.9078
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.9308
##
## Mcnemar's Test P-Value : < 2.2e-16
##
## Sensitivity : 0.89538
## Specificity : 0.99837
## Pos Pred Value : 0.98237
## Neg Pred Value : 0.98947
## Prevalence : 0.09221
## Detection Rate : 0.08256
## Detection Prevalence : 0.08404
## Balanced Accuracy : 0.94688
##
## 'Positive' Class : Yes
## ## Reference
## Prediction No Yes
## No 212894 2266
## Yes 348 19394## [1] 0.8953832## [1] 0.9983681## Confusion Matrix and Statistics
##
## Reference
## Prediction No Yes
## No 70938 20
## Yes 135 111
##
## Accuracy : 0.9978
## 95% CI : (0.9975, 0.9982)
## No Information Rate : 0.9982
## P-Value [Acc > NIR] : 0.9819
##
## Kappa : 0.5879
##
## Mcnemar's Test P-Value : <2e-16
##
## Sensitivity : 0.847328
## Specificity : 0.998101
## Pos Pred Value : 0.451220
## Neg Pred Value : 0.999718
## Prevalence : 0.001840
## Detection Rate : 0.001559
## Detection Prevalence : 0.003455
## Balanced Accuracy : 0.922714
##
## 'Positive' Class : Yes
## ## Reference
## Prediction No Yes
## No 70938 20
## Yes 135 111 # Test set result
# Reference
# Prediction No Yes
# No 1437 62 [Specificity][ ] = TrueNeg / sum of col
# Yes 0 1 [ ][Sensitivity] = TruePos / sum of col
colSums(CM.test$table) / sum(colSums(CM.test$table)) # % of Actual Yes/No## No Yes
## 0.998160216 0.001839784## No Yes
## 0.996545138 0.003454862## Area under the curve: 0.9726## Area under the curve: 0.9801CODE ONLY
##----------------------------------------
## 1. Load data
rm(list=ls()) # clear the memory
library(tidyverse)
library(caret)
library(smotefamily)
library(pROC)
library(PRROC)
DF <- read_csv("creditcard.csv")
DF
# See column names of the DF
names(DF)
# See class of all columns
glimpse(DF)
# Class is the response variable (coded 0 = legit, 1 = fraud)
DF %>% select(Class) %>% table
DF2 = DF %>% rename(resp=Class) %>% relocate(resp)
DF3 = DF2 %>% mutate(resp=ifelse(resp==1, "Yes", "No")) %>%
mutate_at("resp", as_factor)
DF3
dim(DF3)
cat("Class counts:\n"); print(table(DF3$resp))
cat(sprintf("Fraud rate: %.4f%%\n", 100 * mean(DF3$resp == "Yes")))
##----------------------------------------
## 2. Data Separation
DF00 = DF3
# Load the file from my website
source("https://nmimoto.github.io/R/ML-00.txt") # load CreateCV()
# Use this function to create CV dataset
CreateCV(DF3, numFolds=3, seed=163)
# CreateCV(DF3, numFolds=3, seed=453)
# how claude wanted to do it originally:
#set.seed(42)
#set.seed(123)
#set.seed(59)
#Train.set_idx <- createDataPartition(DF00$resp, p=0.7, list=FALSE)
#Train.set <- DF00[Train.set_idx, ]
#Test.set <- DF00[-Train.set_idx, ]
#Test.resp = Test.set$resp
print(table(Train.set$resp))
print(table(Test.set$resp))
##----------------------------------------
## 3. Baseline: logistic regression directly on the imbalanced data
Fit03 <- glm(resp ~., family=binomial, data=Train.set)
summary(Fit03)
Fit00 = Fit03
#- Extract fitted response (training)
Train.prob =predict(Fit00, type ="response")
#- Predict in Test Set
Test.prob = predict(Fit00, newdata=Test.set, type="response")
###----------
### a. Output ROC curve and AUC for all threshold
library(pROC)
auc.test = auc(factor(as.matrix(Test.resp)), Test.prob, levels=c("No", "Yes"))
auc.test
###----------
### b. Output result for given threshold value
threshold = .5 # pick a threshold
#- Check the training set accuracy
library(caret)
Train.pred = ifelse(Train.prob > threshold, "Yes", "No") # Turn the fitted values to Up/Down using threshold of .5
Test.pred = ifelse(Test.prob > threshold, "Yes", "No")
CM.train <- confusionMatrix(factor(Train.pred), factor(as.matrix(Train.resp)), positive="Yes")
CM.test <- confusionMatrix(factor(Test.pred), factor(as.matrix(Test.resp)), positive="Yes")
CM.train # Training set result
CM.train$table # output just the table
CM.train[["byClass"]][["Sensitivity"]]
CM.train[["byClass"]][["Specificity"]]
CM.test # Testing set
CM.test$table # output just the table
# Test set result
# Reference
# Prediction No Yes
# No 1437 62 [Specificity][ ] = TrueNeg / sum of col
# Yes 0 1 [ ][Sensitivity] = TruePos / sum of col
colSums(CM.test$table) / sum(colSums(CM.test$table)) # % of Actual Yes/No
rowSums(CM.test$table) / sum(rowSums(CM.test$table)) # % of predicted Yes/No
##----------------------------------------
## 4. Apply SMOTE to the TRAINING data only
num_minority <- sum(Train.set$resp=="Yes")
target_minority <- nrow(Train.set)/10
dup_size <- round(target_minority / num_minority)
dup_size
# Get names of columns except "resp".
feature_cols <- setdiff(names(DF00), "resp")
# Do the SMOTE
smote_out <- SMOTE(
X = Train.set[, feature_cols],
target = Train.set$resp,
K = 5,
dup_size = dup_size
)
Train.smote <- smote_out$data
names(Train.smote)[names(Train.smote) == "class"] <- "resp"
Train.smote$resp <- factor(Train.smote$resp, levels = levels(Train.set$resp))
Train.smote.resp = Train.smote$resp
cat("\nResampled Train.set class counts:\n")
print(table(Train.smote$resp))
##----------
## Visualize SMOTE
DFo = Train.set %>% filter(resp=="Yes")
DFs = Train.smote %>% filter(resp=="Yes")
layout(matrix(1:2, 1, 2))
plot(DFo$V9, DFo$V8, col="red", pch=19)
plot(DFo$V9, DFo$V8, col="red", pch=19)
lines(DFs$V9, DFs$V8, type="p")
layout(matrix(1:2, 1, 2))
plot(DFo$V5, DFo$V4, col="red", pch=19)
plot(DFo$V5, DFo$V4, col="red", pch=19)
lines(DFs$V5, DFs$V4, type="p")
##----------------------------------------
## 5. SMOTE: logistic regression fit on the balanced data
Fit_SMOTE <- glm(resp ~., family=binomial, data=Train.smote)
summary(Fit_SMOTE)
Fit00 = Fit_SMOTE
#- Extract fitted response (training)
Train.prob =predict(Fit00, type ="response")
#- Predict in Test Set
Test.prob = predict(Fit00, newdata=Test.set, type="response")
###----------
### a. Output ROC curve and AUC for all threshold
library(pROC)
auc.test.smote = auc(factor(as.matrix(Test.resp)), Test.prob, levels=c("No", "Yes"))
auc.test.smote
###----------
### b. Output result for given threshold value
threshold = .5 # pick a threshold
#- Check the training set accuracy
library(caret)
Train.pred = ifelse(Train.prob > threshold, "Yes", "No") # Turn the fitted values to Up/Down using threshold of .5
Test.pred = ifelse(Test.prob > threshold, "Yes", "No")
CM.train <- confusionMatrix(factor(Train.pred), factor(as.matrix(Train.smote.resp)), positive="Yes")
CM.test <- confusionMatrix(factor(Test.pred), factor(as.matrix(Test.resp)), positive="Yes")
CM.train # Training set result
CM.train$table # output just the table
CM.train[["byClass"]][["Sensitivity"]]
CM.train[["byClass"]][["Specificity"]]
CM.test # Testing set
CM.test$table # output just the table
# Test set result
# Reference
# Prediction No Yes
# No 1437 62 [Specificity][ ] = TrueNeg / sum of col
# Yes 0 1 [ ][Sensitivity] = TruePos / sum of col
colSums(CM.test$table) / sum(colSums(CM.test$table)) # % of Actual Yes/No
rowSums(CM.test$table) / sum(rowSums(CM.test$table)) # % of predicted Yes/No
auc.test
auc.test.smote