Prospective GD Phenotype

message=FALSE
echo=FALSE
warnings=FALSE
error=FALSE
suppressWarnings({
  
  options(scipen = 9999, digits=3, max.print=999999, show.signif.stars=TRUE)
  
  data<-read_sav("C:/Users/vasil/Desktop/User-Avatar-Bond Gaming Disorder Paper AI/ARCUN1SF.sav")
  
  
  data1<-data[c("Age_W1", "Yearsofplay_W1","Averagetime_weekday_W1","Averagetime_weekend_W1", "Avatar_no_W1","PresenceQ1_W1", "PresenceQ2_W1", "PresenceQ3_W1", "PresenceQ4_W1", "PresenceQ5_W1", "PresenceQ6_W1", "PresenceQ7_W1", "PresenceQ8_W1", "PresenceQ9_W1", "PresenceQ10_W1","PresenceQ11_W1", "PresenceQ12_W1", "PresenceQ13_W1", "PresenceQ14_W1","FlowQ1_W1", "FlowQ2_W1", "FlowQ3_W1", "FlowQ4_W1", "FlowQ5_W1", "UABQ1_W1", "UABQ2_W1", "UABQ3_W1", "UABQ4_W1", "UABQ5_W1", "UABQ6_W1", "UABQ7_W1", "UABQ8_W1", "UABQ9_W1", "UABQ10_W1","UABQ11_W1", "UABQ12_W1", "PEQ_Q1_W1", "PEQ_Q2_W1", "PEQ_Q3_W1", "PEQ_Q4_W1", "PEQ_Q5_W1", "PEQ_Q6_W1","GD_Q1_W2", "GD_Q2_W2", "GD_Q3_W2", "GD_Q4_W2", "IGD9_Q1_W2", "IGD9_Q2_W2", "IGD9_Q3_W2","IGD9_Q4_W2","IGD9_Q5_W2", "IGD9_Q6_W2","IGD9_Q7_W2", "IGD9_Q8_W2", "IGD9_Q9_W2", "DASS_Q1_W2", "DASS_Q2_W2","DASS_Q3_W2",
"DASS_Q4_W2", "DASS_Q5_W2", "DASS_Q6_W2" ,"DASS_Q7_W2", "DASS_Q8_W2","DASS_Q9_W2","DASS_Q10_W2","DASS_Q11_W2","DASS_Q12_W2","DASS_Q13_W2","DASS_Q14_W2","DASS_Q15_W2","DASS_Q16_W2","DASS_Q17_W2","DASS_Q18_W2","DASS_Q19_W2","DASS_Q20_W2","DASS_Q21_W2","PEQ_Q1_W2","PEQ_Q2_W2","PEQ_Q3_W2","PEQ_Q4_W2","PEQ_Q5_W2","PEQ_Q6_W2")]
  
DataN<-data1%>%mutate(GD_Q1_W2=case_when(GD_Q1_W2>2~1,
                                      GD_Q1_W2<3~0,
                                      TRUE~NA_real_),
                       GD_Q2_W2=case_when(GD_Q2_W2>2~1,
                                      GD_Q2_W2<3~0,
                                      TRUE~NA_real_),
                       GD_Q3_W2=case_when(GD_Q3_W2>2~1,
                                      GD_Q3_W2<3~0,
                                      TRUE~NA_real_),
                       GD_Q4_W2=case_when(GD_Q4_W2>2~1,
                                      GD_Q4_W2<3~0,
                                      TRUE~NA_real_),
                       IGD9_Q1_W2=case_when(IGD9_Q1_W2>2~1,
                                      IGD9_Q1_W2<3~0,
                                      TRUE~NA_real_),
                       IGD9_Q2_W2=case_when(IGD9_Q2_W2>2~1,
                                      IGD9_Q2_W2<3~0,
                                      TRUE~NA_real_),
                       IGD9_Q3_W2=case_when(IGD9_Q3_W2>2~1,
                                      IGD9_Q3_W2<3~0,
                                      TRUE~NA_real_),
                       IGD9_Q4_W2=case_when(IGD9_Q4_W2>2~1,
                                      IGD9_Q4_W2<3~0,
                                      TRUE~NA_real_),
                       IGD9_Q5_W2=case_when(IGD9_Q5_W2>2~1,
                                      IGD9_Q5_W2<3~0,
                                      TRUE~NA_real_),
                       IGD9_Q6_W2=case_when(IGD9_Q6_W2>2~1,
                                      IGD9_Q6_W2<3~0,
                                      TRUE~NA_real_),
                       IGD9_Q7_W2=case_when(IGD9_Q7_W2>2~1,
                                      IGD9_Q7_W2<3~0,
                                      TRUE~NA_real_),
                       IGD9_Q8_W2=case_when(IGD9_Q8_W2>2~1,
                                      IGD9_Q8_W2<3~0,
                                      TRUE~NA_real_),
                       IGD9_Q9_W2=case_when(IGD9_Q9_W2>2~1,
                                      IGD9_Q9_W2<3~0,
                                      TRUE~NA_real_))
DataM<-DataN%>%mutate(GDTTotal=GD_Q1_W2+GD_Q2_W2+GD_Q3_W2+GD_Q4_W2)%>%mutate(IGDTTotal=IGD9_Q1_W2+IGD9_Q9_W2+IGD9_Q3_W2+IGD9_Q4_W2+IGD9_Q5_W2+IGD9_Q6_W2+IGD9_Q7_W2+IGD9_Q8_W2+IGD9_Q9_W2)%>%mutate(PQTotal=PresenceQ1_W1+PresenceQ2_W1+PresenceQ3_W1+PresenceQ4_W1+PresenceQ5_W1+PresenceQ6_W1+PresenceQ7_W1+PresenceQ8_W1+PresenceQ9_W1+PresenceQ10_W1+PresenceQ11_W1+PresenceQ12_W1+PresenceQ13_W1+PresenceQ14_W1)%>%mutate(FTotal=FlowQ1_W1+FlowQ2_W1+FlowQ3_W1+FlowQ4_W1+FlowQ5_W1)%>%mutate(IDTotal=UABQ1_W1+UABQ2_W1+UABQ3_W1+UABQ4_W1)%>%mutate(IMTotal=UABQ5_W1+UABQ6_W1+UABQ7_W1+UABQ8_W1+UABQ9_W1)%>%mutate(COMPTotal=UABQ10_W1+UABQ11_W1+UABQ12_W1)%>%mutate(PETotal1=PEQ_Q1_W1+PEQ_Q2_W1+PEQ_Q3_W1+PEQ_Q4_W1+PEQ_Q5_W1+PEQ_Q6_W1)%>%mutate(PETotal2=PEQ_Q1_W2+PEQ_Q2_W2+PEQ_Q3_W2+PEQ_Q4_W2+PEQ_Q5_W2+PEQ_Q6_W2)%>%mutate(PETotal2=PEQ_Q1_W2+PEQ_Q2_W2+PEQ_Q3_W2+PEQ_Q4_W2+PEQ_Q5_W2+PEQ_Q6_W2)%>%mutate(DEPTot=DASS_Q3_W2+DASS_Q5_W2+DASS_Q10_W2+DASS_Q13_W2+DASS_Q16_W2+DASS_Q17_W2+DASS_Q21_W2)%>%mutate(AnxTot=DASS_Q2_W2+DASS_Q4_W2+DASS_Q7_W2+DASS_Q9_W2+DASS_Q15_W2+DASS_Q19_W2+DASS_Q20_W2)%>%mutate(StressTot=DASS_Q1_W2+DASS_Q6_W2+DASS_Q8_W2+DASS_Q11_W2+DASS_Q12_W2+DASS_Q14_W2+DASS_Q18_W2)
})

suppressWarnings({
  
  options(scipen = 9999, digits=3, max.print=999999, show.signif.stars=TRUE)
DataMD<-DataM%>%mutate(DEPTot = case_when(DEPTot>20~1,
                              DEPTot<21~0,
                                      TRUE~NA_real_))%>%mutate(AnxTot = case_when(AnxTot>20~1,
                              AnxTot<21~0,
                                      TRUE~NA_real_))%>%mutate(StressTot = case_when(StressTot>20~1,
                              StressTot<21~0,
                                    TRUE~NA_real_))

DATAAIGDD<-DataM[c("Age_W1", "Yearsofplay_W1", "Averagetime_weekday_W1", "Averagetime_weekend_W1", "IMTotal", "IDTotal", "COMPTotal", "PETotal1", "PQTotal", "FTotal")]
DATAAIGDD <- scale(DATAAIGDD[,1:10],center=TRUE,scale=TRUE)
DATAGDTTotal<-DataM[c("GDTTotal")]
DATAAIGD<- cbind(DATAAIGDD,DATAGDTTotal)
 

DATAAIIGD<-DataM[c("Age_W1", "Yearsofplay_W1", "Averagetime_weekday_W1","Averagetime_weekend_W1", "IDTotal", "IMTotal", "COMPTotal", "PETotal1", "PQTotal", "FTotal","IGDTTotal")]

GDTD<-na.omit(DATAAIGD)
IGDD<-na.omit(DATAAIIGD)


GDTD<-GDTD%>% 
  mutate(GDTTotal = case_when(GDTTotal>2~1,
                              GDTTotal<3~0,
                                      TRUE~NA_real_))

GDTD<-GDTD%>% 
  mutate(GDTTotal = factor(GDTTotal, levels = c("1","0")))
GDTD<-GDTD %>% 
  mutate(GDTTotal = case_when(GDTTotal == 1 ~ "Yes",
                             GDTTotal == 0 ~ "No"))
GDTD$GDTTotal=as_factor(GDTD$GDTTotal)


IGDD<-IGDD%>%mutate(IGDTTotal=case_when(IGDTTotal>3~1,
                                      IGDTTotal<4~0,
                                      TRUE~NA_real_))
IGDD<-IGDD %>% 
  mutate(IGDTTotal = factor(IGDTTotal, levels = c("1","0")))

IGDD<-IGDD %>% 
  mutate(IGDTTotal = case_when(IGDTTotal == 1 ~ "Yes",
                             IGDTTotal == 0 ~ "No"))

  GDTDiag<-GDTD%>%setNames(c("AGE","Gameyears","TimeWD","TimeWENDD" ,"IMTotal", "IDTotal", "COMPTotal", "PETotal", "PQTotal", "FTotal","GDDiag")) 
  
  GDTDiagg<-GDTDiag[c("AGE","Gameyears","IMTotal", "IDTotal","COMPTotal","GDDiag")]
  
  
  IGDDiag<-IGDD%>%setNames(c("AGE", "Gameyears", "TimeWD","TimeWENDD","IDTotal", "IMTotal","COMPTotal", "PETotal", "PQTotal", "FTotal","IGDDiag"))
  
  WHOT<-table(GDTDiagg$GDDiag)
  APAT<-table(IGDDiag$IGDDiag)
  
}) 

WHOT

## 
##  No Yes 
## 232  58

APAT<-rev(APAT)

ComparisonWHOandAPA<-rbind(APAT,WHOT)
  kable(ComparisonWHOandAPA)

	Yes	No
APAT	59	231
WHOT	232	58

  ChiSqu<-chisq.test(ComparisonWHOandAPA)
  Cram<-cramer_v(ComparisonWHOandAPA)
  
  ChiSqu

## 
##  Pearson's Chi-squared test with Yates' continuity correction
## 
## data:  ComparisonWHOandAPA
## X-squared = 204, df = 1, p-value <0.0000000000000002

  Cram

## [1] 0.593

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
GDTDiag <- SMOTE(GDDiag ~ ., GDTDiagg, perc.over = 400, perc.under = 125)

table(GDTDiag$GDDiag)

## 
##  No Yes 
## 290 290

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
GDTDiag$GDDiag=as_factor(GDTDiag$GDDiag)
suppressWarnings({
  
  suppressMessages({
prior_dist <- rstanarm::student_t(df = 7, location = 0, scale = 2.5)
set.seed(123)
data_split <- initial_split(GDTDiag, prop = 4/5, strata = GDDiag, breaks = 4, pool = 0.1)
# Create data frames for the two sets:
train_data_GD <- training(data_split)
test_data_GD  <- testing(data_split)
#Crossvalidation split
set.seed(123)
folds <- vfold_cv(train_data_GD, v = 10)
TRGDTab<-table(train_data_GD$GDDiag)
TESTGDTab<-table(test_data_GD$GDDiag)
})
})
summary(train_data_GD)

##       AGE           Gameyears        IMTotal          IDTotal      
##  Min.   :-1.625   Min.   :-1.25   Min.   :-1.726   Min.   :-1.318  
##  1st Qu.:-0.591   1st Qu.:-0.82   1st Qu.:-0.562   1st Qu.:-0.900  
##  Median : 0.068   Median :-0.59   Median : 0.011   Median :-0.224  
##  Mean   : 0.099   Mean   :-0.18   Mean   : 0.046   Mean   :-0.200  
##  3rd Qu.: 0.727   3rd Qu.: 0.08   3rd Qu.: 0.603   3rd Qu.: 0.427  
##  Max.   : 2.984   Max.   : 5.43   Max.   : 2.677   Max.   : 1.923  
##    COMPTotal      GDDiag   
##  Min.   :-1.935   No :232  
##  1st Qu.:-0.610   Yes:232  
##  Median : 0.053            
##  Mean   : 0.017            
##  3rd Qu.: 0.716            
##  Max.   : 2.042

summary(test_data_GD)

##       AGE           Gameyears        IMTotal          IDTotal      
##  Min.   :-1.625   Min.   :-1.03   Min.   :-1.726   Min.   :-1.318  
##  1st Qu.:-0.567   1st Qu.:-0.81   1st Qu.:-0.462   1st Qu.:-1.070  
##  Median :-0.026   Median :-0.36   Median :-0.096   Median :-0.437  
##  Mean   : 0.018   Mean   : 0.00   Mean   : 0.018   Mean   :-0.352  
##  3rd Qu.: 0.540   3rd Qu.: 0.43   3rd Qu.: 0.603   3rd Qu.: 0.178  
##  Max.   : 2.796   Max.   : 3.65   Max.   : 2.700   Max.   : 1.674  
##    COMPTotal      GDDiag  
##  Min.   :-1.935   No :58  
##  1st Qu.:-0.610   Yes:58  
##  Median : 0.053           
##  Mean   : 0.017           
##  3rd Qu.: 0.892           
##  Max.   : 2.042

ComparisonTrainingandTesting<-rbind(TRGDTab, TESTGDTab)
  kable(ComparisonTrainingandTesting)

	No	Yes
TRGDTab	232	232
TESTGDTab	58	58

  ComparisonTrainingandTesting

##            No Yes
## TRGDTab   232 232
## TESTGDTab  58  58

  TTChiSqu<-chisq.test(ComparisonTrainingandTesting)
  TTCram<-cramer_v(ComparisonTrainingandTesting)
  
  TTChiSqu

## 
##  Pearson's Chi-squared test
## 
## data:  ComparisonTrainingandTesting
## X-squared = 0, df = 1, p-value = 1

  TTCram

## [1] 0

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 9999, digits=3, max.print=9999999, show.signif.stars=TRUE)
set.seed(123)

GD_rec <- recipe(GDDiag~ ., data = train_data_GD)%>% step_smote(GDDiag, over_ratio = 0.50)%>%step_zv(all_predictors())%>%step_nzv(all_predictors())%>%step_corr(all_predictors())%>%prep


train_data_GD_b<-bake(GD_rec, new_data = train_data_GD)
test_data_GD_b<-bake(GD_rec, new_data = test_data_GD)
Whole_data_GD_b<-bake(GD_rec, new_data=GDTDiag)
 describe(train_data_GD_b)

##           vars   n  mean   sd median trimmed  mad   min  max range  skew
## AGE          1 464  0.10 0.93   0.07    0.06 0.98 -1.62 2.98  4.61  0.45
## Gameyears    2 464 -0.18 1.06  -0.59   -0.40 0.66 -1.25 5.43  6.69  2.12
## IMTotal      3 464  0.05 0.93   0.01    0.04 0.88 -1.73 2.68  4.40  0.12
## IDTotal      4 464 -0.20 0.84  -0.22   -0.25 0.97 -1.32 1.92  3.24  0.33
## COMPTotal    5 464  0.02 0.99   0.05    0.05 0.98 -1.94 2.04  3.98 -0.29
## GDDiag*      6 464  1.50 0.50   1.50    1.50 0.74  1.00 2.00  1.00  0.00
##           kurtosis   se
## AGE          -0.03 0.04
## Gameyears     4.99 0.05
## IMTotal      -0.35 0.04
## IDTotal      -0.84 0.04
## COMPTotal    -0.61 0.05
## GDDiag*      -2.00 0.02

 describe(test_data_GD_b)

##           vars   n  mean   sd median trimmed  mad   min  max range  skew
## AGE          1 116  0.02 0.77  -0.03    0.00 0.81 -1.62 2.80  4.42  0.49
## Gameyears    2 116  0.00 1.09  -0.36   -0.18 0.75 -1.03 3.65  4.68  1.47
## IMTotal      3 116  0.02 0.90  -0.10    0.02 0.69 -1.73 2.70  4.43  0.19
## IDTotal      4 116 -0.35 0.81  -0.44   -0.44 0.94 -1.32 1.67  2.99  0.65
## COMPTotal    5 116  0.02 1.07   0.05    0.05 1.18 -1.94 2.04  3.98 -0.17
## GDDiag*      6 116  1.50 0.50   1.50    1.50 0.74  1.00 2.00  1.00  0.00
##           kurtosis   se
## AGE           0.69 0.07
## Gameyears     1.85 0.10
## IMTotal       0.01 0.08
## IDTotal      -0.37 0.08
## COMPTotal    -0.78 0.10
## GDDiag*      -2.02 0.05

 describe(Whole_data_GD_b)

##           vars   n  mean   sd median trimmed  mad   min  max range  skew
## AGE          1 580  0.08 0.90   0.07    0.04 0.98 -1.62 2.98  4.61  0.48
## Gameyears    2 580 -0.14 1.07  -0.58   -0.36 0.66 -1.25 5.43  6.69  1.98
## IMTotal      3 580  0.04 0.93  -0.04    0.03 0.89 -1.73 2.70  4.43  0.13
## IDTotal      4 580 -0.23 0.84  -0.32   -0.29 1.08 -1.32 1.92  3.24  0.39
## COMPTotal    5 580  0.02 1.00   0.05    0.05 0.98 -1.94 2.04  3.98 -0.26
## GDDiag*      6 580  1.50 0.50   1.50    1.50 0.74  1.00 2.00  1.00  0.00
##           kurtosis   se
## AGE           0.11 0.04
## Gameyears     4.24 0.04
## IMTotal      -0.28 0.04
## IDTotal      -0.77 0.03
## COMPTotal    -0.63 0.04
## GDDiag*      -2.00 0.02

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 9999, digits=3, max.print=9999999, show.signif.stars=TRUE)
set.seed(123)
train_boot <- bootstraps(train_data_GD, strata = GDDiag)

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 9999, digits=3, max.print=9999999, show.signif.stars=TRUE)
set.seed(123)
## token model
twt_null <- null_model()%>%
  set_engine("parsnip")%>%
  set_mode("classification")
## model specification LASSO
lasso_spec <- multinom_reg(penalty = 0.1, mixture = 1)%>%
  set_mode("classification")%>%
  set_engine("glmnet")
# model specification Naive Bayes
nb_spec <- naive_Bayes()%>%
  set_mode("classification")%>%
  set_engine("naivebayes")
# model spec random forest
ranger_spec<-rand_forest()%>% 
  set_engine("ranger", importance = "impurity")%>% 
  set_mode("classification")
##model spec log_regression
logreg_spec <- logistic_reg()%>% 
  set_engine("glm")%>% 
  set_mode("classification")
##model spec Kernel
svm_spec <- svm_rbf(mode = "classification", 
                    engine = "kernlab",
            cost = 1, rbf_sigma = 0.01)

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
set.seed(123)
#Null
Null_workflow <- workflow() %>% 
  add_recipe(GD_rec) %>% 
  add_model(twt_null)
#Lasso 
lasso_workflow <- workflow()%>% 
  add_recipe(GD_rec)%>% 
  add_model(lasso_spec)
#Naive Bayes 
NB_workflow <- workflow()%>% 
  add_recipe(GD_rec) %>% 
  add_model(nb_spec)
#Random Forests 
RF_workflow <- workflow()%>% 
  add_recipe(GD_rec) %>% 
  add_model(ranger_spec)
#Log_GLM_Workflow
LOGGLM_workflow <- workflow()%>% 
  add_recipe(GD_rec) %>% 
  add_model(logreg_spec)
#Kernel
Kernel_workflow<-workflow()%>% 
  add_recipe(GD_rec)%>% 
  add_model(svm_spec)

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 9999, digits=3, max.print=9999999, show.signif.stars=TRUE)
Null_fit<-Null_workflow%>%fit(train_data_GD_b)
Null_fit  

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: null_model()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## Null Regression Model
## Predicted Value: No

Lasso_fit<-lasso_workflow%>%fit(train_data_GD_b)
Lasso_fit

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: multinom_reg()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## 
## Call:  glmnet::glmnet(x = maybe_matrix(x), y = y, family = "multinomial",      alpha = ~1) 
## 
##    Df  %Dev Lambda
## 1   0  0.00 0.2070
## 2   1  2.11 0.1890
## 3   1  3.87 0.1720
## 4   1  5.35 0.1570
## 5   1  6.59 0.1430
## 6   1  7.65 0.1300
## 7   2  8.88 0.1190
## 8   2 10.14 0.1080
## 9   2 11.22 0.0984
## 10  2 12.14 0.0897
## 11  2 12.92 0.0817
## 12  2 13.59 0.0745
## 13  2 14.17 0.0679
## 14  2 14.66 0.0618
## 15  2 15.07 0.0563
## 16  2 15.43 0.0513
## 17  2 15.73 0.0468
## 18  2 15.99 0.0426
## 19  2 16.21 0.0388
## 20  3 16.42 0.0354
## 21  3 16.61 0.0322
## 22  3 16.78 0.0294
## 23  3 16.91 0.0268
## 24  3 17.03 0.0244
## 25  3 17.13 0.0222
## 26  3 17.21 0.0202
## 27  3 17.29 0.0184
## 28  4 17.35 0.0168
## 29  4 17.42 0.0153
## 30  4 17.48 0.0140
## 31  4 17.53 0.0127
## 32  4 17.58 0.0116
## 33  4 17.61 0.0106
## 34  4 17.64 0.0096
## 35  4 17.66 0.0088
## 36  4 17.69 0.0080
## 37  4 17.70 0.0073
## 38  4 17.72 0.0066
## 39  4 17.73 0.0060
## 40  4 17.74 0.0055
## 41  4 17.75 0.0050
## 42  4 17.75 0.0046
## 43  4 17.76 0.0042
## 44  4 17.77 0.0038
## 45  4 17.77 0.0035
## 46  4 17.77 0.0032
## 
## ...
## and 7 more lines.

RF_fit<-RF_workflow%>%fit(train_data_GD_b)
RF_fit

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: rand_forest()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## Ranger result
## 
## Call:
##  ranger::ranger(x = maybe_data_frame(x), y = y, importance = ~"impurity",      num.threads = 1, verbose = FALSE, seed = sample.int(10^5,          1), probability = TRUE) 
## 
## Type:                             Probability estimation 
## Number of trees:                  500 
## Sample size:                      464 
## Number of independent variables:  5 
## Mtry:                             2 
## Target node size:                 10 
## Variable importance mode:         impurity 
## Splitrule:                        gini 
## OOB prediction error (Brier s.):  0.0796

LogReg_fit<-LOGGLM_workflow%>%fit(train_data_GD_b)
LogReg_fit

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: logistic_reg()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## 
## Call:  stats::glm(formula = ..y ~ ., family = stats::binomial, data = data)
## 
## Coefficients:
## (Intercept)          AGE    Gameyears      IMTotal      IDTotal    COMPTotal  
##      0.0113      -0.5937      -0.1017       0.9680       0.1845      -0.0137  
## 
## Degrees of Freedom: 463 Total (i.e. Null);  458 Residual
## Null Deviance:       643 
## Residual Deviance: 529   AIC: 541

Kernel_fit<-Kernel_workflow%>%fit(train_data_GD_b)
Kernel_fit

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: svm_rbf()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## Support Vector Machine object of class "ksvm" 
## 
## SV type: C-svc  (classification) 
##  parameter : cost C = 1 
## 
## Gaussian Radial Basis kernel function. 
##  Hyperparameter : sigma =  0.01 
## 
## Number of Support Vectors : 353 
## 
## Objective Function Value : -326 
## Training error : 0.258621 
## Probability model included.

NB_fit<-NB_workflow%>%fit(train_data_GD_b)
NB_fit

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: naive_Bayes()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## 
## ================================== Naive Bayes ================================== 
##  
##  Call: 
## naive_bayes.default(x = maybe_data_frame(x), y = y, usekernel = TRUE)
## 
## --------------------------------------------------------------------------------- 
##  
## Laplace smoothing: 0
## 
## --------------------------------------------------------------------------------- 
##  
##  A priori probabilities: 
## 
##  No Yes 
## 0.5 0.5 
## 
## --------------------------------------------------------------------------------- 
##  
##  Tables: 
## 
## --------------------------------------------------------------------------------- 
##  ::: AGE::No (KDE)
## --------------------------------------------------------------------------------- 
## 
## Call:
##  density.default(x = x, na.rm = TRUE)
## 
## Data: x (232 obs.);  Bandwidth 'bw' = 0.2978
## 
##        x               y        
##  Min.   :-2.52   Min.   :0.000  
##  1st Qu.:-0.92   1st Qu.:0.034  
##  Median : 0.68   Median :0.113  
##  Mean   : 0.68   Mean   :0.156  
##  3rd Qu.: 2.28   3rd Qu.:0.302  
##  Max.   : 3.88   Max.   :0.389  
## 
## --------------------------------------------------------------------------------- 
##  ::: AGE::Yes (KDE)
## --------------------------------------------------------------------------------- 
## 
## Call:
##  density.default(x = x, na.rm = TRUE)
## 
## Data: x (232 obs.);  Bandwidth 'bw' = 0.2392
## 
##        x                y        
##  Min.   :-2.342   Min.   :0.000  
##  1st Qu.:-1.043   1st Qu.:0.026  
## 
## ...
## and 143 more lines.

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Null_Model_Untuned
results_NF <- test_data_GD_b%>%select(GDDiag)%>% 
  bind_cols(Null_fit%>% 
              predict(new_data = test_data_GD_b))%>% 
  bind_cols(Null_fit%>% 
              predict(new_data = test_data_GD_b, type = "prob"))
kable(results_NF)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
No	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5
Yes	No	0.5	0.5

describe(results_NF)

##              vars   n mean  sd median trimmed  mad min max range skew kurtosis
## GDDiag*         1 116  1.5 0.5    1.5     1.5 0.74 1.0 2.0     1    0    -2.02
## .pred_class*    2 116  1.0 0.0    1.0     1.0 0.00 1.0 1.0     0  NaN      NaN
## .pred_No        3 116  0.5 0.0    0.5     0.5 0.00 0.5 0.5     0  NaN      NaN
## .pred_Yes       4 116  0.5 0.0    0.5     0.5 0.00 0.5 0.5     0  NaN      NaN
##                se
## GDDiag*      0.05
## .pred_class* 0.00
## .pred_No     0.00
## .pred_Yes    0.00

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Collect precision metrics concurrently
ev_met1<-metric_set(ppv, f_meas)

results_NF %>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction No Yes
##        No  58  58
##        Yes  0   0

#Visualise Results
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_NF%>% 
  conf_mat(GDDiag,.pred_class) %>% 
  autoplot()

ev_met1_NF<-ev_met1(results_NF,truth = GDDiag, estimate = .pred_class)
Acc_NF<-yardstick::accuracy(results_NF, GDDiag,.pred_class)
Rec_NF<-yardstick::recall(results_NF, GDDiag, .pred_class)
#Plot Roc_Curve
curve_NF <- results_NF %>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot

## Warning: Returning more (or less) than 1 row per `summarise()` group was deprecated in
## dplyr 1.1.0.
## i Please use `reframe()` instead.
## i When switching from `summarise()` to `reframe()`, remember that `reframe()`
##   always returns an ungrouped data frame and adjust accordingly.
## i The deprecated feature was likely used in the yardstick package.
##   Please report the issue at <https://github.com/tidymodels/yardstick/issues>.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

curve_NF

auc_NF <- results_NF %>% 
  roc_auc(GDDiag, .pred_Yes)
NFMET<-list(auc_NF,ev_met1_NF, Rec_NF, Acc_NF)
kable(NFMET)

.metric .estimator .estimate roc_auc binary 0.5

.metric .estimator .estimate ppv binary 0.500 f_meas binary 0.667

.metric .estimator .estimate recall binary 1

.metric .estimator .estimate accuracy binary 0.5

results_RF <- test_data_GD_b %>% select(GDDiag)%>% 
  bind_cols(RF_fit %>% 
              predict(new_data = test_data_GD_b))%>% 
  bind_cols(RF_fit%>% 
             predict(new_data = test_data_GD_b, type = "prob"))
kable(results_RF)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	No	0.690	0.310
No	No	0.874	0.126
No	No	0.505	0.495
No	Yes	0.437	0.563
No	Yes	0.383	0.617
No	No	0.970	0.030
No	Yes	0.496	0.504
No	No	0.683	0.317
No	No	0.566	0.434
No	No	0.513	0.487
No	No	0.983	0.017
No	No	0.777	0.223
No	No	0.712	0.288
No	No	0.732	0.268
No	No	0.893	0.107
No	No	0.811	0.189
No	No	0.998	0.002
No	No	0.909	0.091
No	No	0.548	0.452
No	No	0.993	0.007
No	No	0.976	0.024
No	No	0.933	0.067
No	No	0.786	0.214
No	Yes	0.489	0.511
No	No	0.926	0.074
No	No	0.788	0.212
No	No	0.635	0.365
No	No	0.979	0.021
No	Yes	0.250	0.750
No	No	0.857	0.143
No	No	0.513	0.487
No	No	0.699	0.301
No	No	0.877	0.123
No	No	0.992	0.008
No	No	0.946	0.054
No	No	0.811	0.189
No	No	0.928	0.072
No	No	0.831	0.169
No	No	0.986	0.014
No	Yes	0.408	0.592
No	No	0.801	0.199
No	No	0.973	0.027
No	No	0.831	0.169
No	No	0.998	0.002
No	No	0.992	0.008
No	No	0.518	0.482
No	No	0.550	0.450
No	No	0.817	0.183
No	No	0.995	0.005
No	No	0.783	0.217
No	No	0.815	0.185
No	No	0.897	0.103
No	No	0.874	0.126
No	No	0.613	0.387
No	No	0.967	0.033
No	No	0.718	0.282
No	No	0.730	0.270
No	No	0.549	0.451
Yes	Yes	0.404	0.596
Yes	No	0.702	0.298
Yes	Yes	0.370	0.630
Yes	No	0.693	0.307
Yes	No	0.808	0.192
Yes	Yes	0.447	0.553
Yes	No	0.598	0.402
Yes	Yes	0.476	0.524
Yes	Yes	0.219	0.781
Yes	No	0.556	0.444
Yes	Yes	0.402	0.598
Yes	Yes	0.204	0.796
Yes	Yes	0.176	0.824
Yes	Yes	0.121	0.879
Yes	Yes	0.152	0.848
Yes	Yes	0.196	0.804
Yes	Yes	0.081	0.919
Yes	Yes	0.415	0.585
Yes	Yes	0.188	0.812
Yes	Yes	0.102	0.898
Yes	Yes	0.134	0.866
Yes	Yes	0.109	0.891
Yes	Yes	0.140	0.860
Yes	Yes	0.083	0.917
Yes	Yes	0.102	0.898
Yes	Yes	0.030	0.970
Yes	Yes	0.121	0.879
Yes	Yes	0.416	0.584
Yes	Yes	0.338	0.662
Yes	No	0.682	0.318
Yes	Yes	0.333	0.667
Yes	Yes	0.125	0.875
Yes	Yes	0.413	0.587
Yes	Yes	0.371	0.629
Yes	Yes	0.111	0.889
Yes	Yes	0.064	0.936
Yes	Yes	0.168	0.832
Yes	Yes	0.149	0.851
Yes	Yes	0.172	0.828
Yes	Yes	0.069	0.931
Yes	Yes	0.200	0.800
Yes	Yes	0.169	0.831
Yes	Yes	0.144	0.856
Yes	Yes	0.105	0.895
Yes	Yes	0.419	0.581
Yes	Yes	0.298	0.702
Yes	Yes	0.211	0.789
Yes	Yes	0.039	0.961
Yes	Yes	0.028	0.972
Yes	Yes	0.124	0.876
Yes	Yes	0.112	0.888
Yes	Yes	0.182	0.818
Yes	Yes	0.113	0.887
Yes	Yes	0.108	0.892
Yes	Yes	0.067	0.933
Yes	Yes	0.179	0.821
Yes	Yes	0.156	0.844
Yes	Yes	0.064	0.936

describe(results_RF)

##              vars   n mean   sd median trimmed  mad  min  max range  skew
## GDDiag*         1 116 1.50 0.50    1.5     1.5 0.74 1.00 2.00  1.00  0.00
## .pred_class*    2 116 1.50 0.50    1.5     1.5 0.74 1.00 2.00  1.00  0.00
## .pred_No        3 116 0.51 0.33    0.5     0.5 0.47 0.03 1.00  0.97  0.07
## .pred_Yes       4 116 0.49 0.33    0.5     0.5 0.47 0.00 0.97  0.97 -0.07
##              kurtosis   se
## GDDiag*         -2.02 0.05
## .pred_class*    -2.02 0.05
## .pred_No        -1.49 0.03
## .pred_Yes       -1.49 0.03

results_RF%>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction No Yes
##        No  52   6
##        Yes  6  52

#Visualise Results
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_RF%>% 
  conf_mat(GDDiag,.pred_class) %>% 
  autoplot()

ev_met1_RF<-ev_met1(results_RF,truth = GDDiag, estimate = .pred_class)
Rec_RF<-yardstick::recall(results_RF, GDDiag, .pred_class)
ACC_RF<-yardstick::accuracy(results_RF, GDDiag, .pred_class)
#Plot Roc_Curve
curve_RF <- results_RF %>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_RF

auc_RF <- results_RF %>% 
  roc_auc(GDDiag, .pred_No)
RFMET<-list(auc_RF,ev_met1_RF, Rec_RF, ACC_RF)
kable(RFMET)

.metric .estimator .estimate roc_auc binary 0.959

.metric .estimator .estimate ppv binary 0.897 f_meas binary 0.897

.metric .estimator .estimate recall binary 0.897

.metric .estimator .estimate accuracy binary 0.897

RFMETCurVe<-list(RFMET, curve_RF)
RFMETCurVe

## [[1]]
## [[1]][[1]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.959
## 
## [[1]][[2]]
## # A tibble: 2 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 ppv     binary         0.897
## 2 f_meas  binary         0.897
## 
## [[1]][[3]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 recall  binary         0.897
## 
## [[1]][[4]]
## # A tibble: 1 x 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy binary         0.897
## 
## 
## [[2]]

Extracting Important Predictors

RF_fit_Test<-RF_workflow%>%fit(test_data_GD_b)
RF_fit_Test

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: rand_forest()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## Ranger result
## 
## Call:
##  ranger::ranger(x = maybe_data_frame(x), y = y, importance = ~"impurity",      num.threads = 1, verbose = FALSE, seed = sample.int(10^5,          1), probability = TRUE) 
## 
## Type:                             Probability estimation 
## Number of trees:                  500 
## Sample size:                      116 
## Number of independent variables:  5 
## Mtry:                             2 
## Target node size:                 10 
## Variable importance mode:         impurity 
## Splitrule:                        gini 
## OOB prediction error (Brier s.):  0.186

RF_fit_Test %>% 
  extract_fit_parsnip() %>% 
 #Make VIP plot
 vip()

results_RFW <- Whole_data_GD_b %>% select(GDDiag)%>% 
  bind_cols(RF_fit %>% 
              predict(new_data = Whole_data_GD_b))%>% 
  bind_cols(RF_fit%>% 
             predict(new_data = Whole_data_GD_b, type = "prob"))
kable(results_RFW)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	No	0.874	0.126
No	No	0.690	0.310
No	No	0.874	0.126
No	No	0.967	0.033
No	No	0.921	0.079
No	No	0.970	0.030
No	No	0.991	0.009
No	No	0.704	0.296
No	No	0.879	0.121
No	No	0.988	0.012
No	No	0.987	0.013
No	No	0.505	0.495
No	No	0.991	0.009
No	No	0.998	0.002
No	Yes	0.437	0.563
No	No	0.979	0.021
No	No	0.996	0.004
No	Yes	0.383	0.617
No	No	0.970	0.030
No	No	0.944	0.056
No	No	0.946	0.054
No	No	0.738	0.262
No	No	0.904	0.096
No	No	0.737	0.263
No	No	0.667	0.333
No	No	0.893	0.107
No	No	0.948	0.052
No	Yes	0.496	0.504
No	No	0.896	0.104
No	No	0.690	0.310
No	No	0.722	0.278
No	No	0.777	0.223
No	No	0.996	0.004
No	No	0.814	0.186
No	No	0.817	0.183
No	No	0.783	0.217
No	No	0.879	0.121
No	No	0.815	0.185
No	No	0.909	0.091
No	No	0.888	0.112
No	No	0.605	0.395
No	No	0.926	0.074
No	No	0.746	0.254
No	No	0.683	0.317
No	No	0.566	0.434
No	No	0.849	0.151
No	No	0.513	0.487
No	No	0.880	0.120
No	No	0.983	0.017
No	No	0.877	0.123
No	No	0.995	0.005
No	No	0.939	0.061
No	No	0.909	0.091
No	No	0.998	0.002
No	No	0.967	0.033
No	No	0.777	0.223
No	No	0.717	0.283
No	No	0.996	0.004
No	No	0.901	0.099
No	No	0.950	0.050
No	No	0.844	0.156
No	No	0.712	0.288
No	No	0.740	0.260
No	No	0.877	0.123
No	No	0.732	0.268
No	No	0.988	0.012
No	No	0.999	0.001
No	No	0.893	0.107
No	No	0.907	0.093
No	No	0.976	0.024
No	No	0.811	0.189
No	No	0.683	0.317
No	No	0.977	0.023
No	No	0.985	0.015
No	No	0.909	0.091
No	No	0.871	0.129
No	No	0.898	0.102
No	No	0.717	0.283
No	No	0.907	0.093
No	No	0.998	0.002
No	No	0.972	0.028
No	No	0.972	0.028
No	No	0.985	0.015
No	No	0.683	0.317
No	No	0.604	0.396
No	No	0.980	0.020
No	No	0.958	0.042
No	No	0.985	0.015
No	No	0.678	0.322
No	No	0.780	0.220
No	No	0.986	0.014
No	No	0.909	0.091
No	No	0.996	0.004
No	No	0.898	0.102
No	No	0.548	0.452
No	No	0.954	0.046
No	No	0.920	0.080
No	No	0.737	0.263
No	No	0.993	0.007
No	No	0.973	0.027
No	No	0.976	0.024
No	No	0.730	0.270
No	No	0.933	0.067
No	No	0.901	0.099
No	No	0.513	0.487
No	No	0.936	0.064
No	No	0.921	0.079
No	No	0.874	0.126
No	No	0.780	0.220
No	No	0.688	0.312
No	No	0.993	0.007
No	No	0.999	0.001
No	No	0.989	0.011
No	No	0.998	0.002
No	No	0.786	0.214
No	No	0.996	0.004
No	No	0.848	0.152
No	No	0.814	0.186
No	No	0.759	0.241
No	Yes	0.489	0.511
No	No	0.783	0.217
No	No	0.998	0.002
No	No	0.926	0.074
No	No	0.788	0.212
No	No	0.980	0.020
No	No	0.635	0.365
No	No	0.935	0.065
No	No	0.919	0.081
No	No	0.993	0.007
No	No	0.979	0.021
No	Yes	0.250	0.750
No	No	0.725	0.275
No	No	0.983	0.017
No	No	0.950	0.050
No	No	0.995	0.005
No	No	0.548	0.452
No	No	0.998	0.002
No	No	0.999	0.001
No	No	0.977	0.023
No	No	0.613	0.387
No	No	0.831	0.169
No	No	0.811	0.189
No	No	0.986	0.014
No	No	0.703	0.297
No	No	0.995	0.005
No	No	0.857	0.143
No	No	0.996	0.004
No	No	0.817	0.183
No	No	0.970	0.030
No	No	0.513	0.487
No	No	0.855	0.145
No	No	0.579	0.421
No	No	0.844	0.156
No	No	0.950	0.050
No	No	0.877	0.123
No	No	0.987	0.013
No	No	0.814	0.186
No	No	0.985	0.015
No	No	0.690	0.310
No	No	0.893	0.107
No	No	0.943	0.057
No	No	0.995	0.005
No	No	0.758	0.242
No	No	0.699	0.301
No	No	0.692	0.308
No	No	0.958	0.042
No	No	0.970	0.030
No	No	0.994	0.006
No	No	0.990	0.010
No	No	0.989	0.011
No	No	0.985	0.015
No	No	0.877	0.123
No	No	0.992	0.008
No	No	0.896	0.104
No	No	0.936	0.064
No	No	0.946	0.054
No	No	0.907	0.093
No	No	0.986	0.014
No	No	0.980	0.020
No	No	0.577	0.423
No	No	0.811	0.189
No	No	0.996	0.004
No	No	0.928	0.072
No	No	0.852	0.148
No	No	0.928	0.072
No	No	0.948	0.052
No	No	0.658	0.342
No	No	0.746	0.254
No	No	0.922	0.078
No	No	0.831	0.169
No	No	0.835	0.165
No	No	0.900	0.100
No	No	0.901	0.099
No	No	0.977	0.023
No	No	0.676	0.324
No	No	0.647	0.353
No	No	0.954	0.046
No	Yes	0.485	0.515
No	No	0.759	0.241
No	No	0.950	0.050
No	No	0.717	0.283
No	No	0.986	0.014
No	No	0.998	0.002
No	No	0.882	0.118
No	Yes	0.408	0.592
No	No	0.801	0.199
No	No	0.907	0.093
No	No	0.990	0.010
No	No	0.836	0.164
No	No	0.893	0.107
No	No	0.848	0.152
No	No	0.987	0.013
No	No	0.998	0.002
No	No	0.718	0.282
No	No	0.758	0.242
No	No	0.746	0.254
No	No	0.763	0.237
No	No	0.904	0.096
No	No	0.777	0.223
No	No	0.758	0.242
No	No	0.777	0.223
No	No	0.943	0.057
No	No	0.996	0.004
No	No	0.985	0.015
No	No	0.973	0.027
No	No	0.831	0.169
No	No	0.926	0.074
No	No	0.998	0.002
No	No	0.849	0.151
No	No	0.855	0.145
No	No	0.958	0.042
No	No	0.900	0.100
No	No	0.985	0.015
No	No	0.987	0.013
No	No	0.963	0.037
No	No	0.729	0.271
No	No	0.967	0.033
No	No	0.676	0.324
No	No	0.992	0.008
No	No	0.992	0.008
No	No	0.992	0.008
No	No	0.518	0.482
No	No	0.683	0.317
No	No	0.505	0.495
No	No	0.550	0.450
No	No	0.901	0.099
No	No	0.879	0.121
No	No	0.729	0.271
No	No	0.936	0.064
No	No	0.986	0.014
No	No	0.817	0.183
No	No	0.995	0.005
No	No	0.811	0.189
No	No	0.685	0.315
No	No	0.783	0.217
No	No	0.901	0.099
No	No	0.815	0.185
No	No	0.934	0.066
No	No	0.758	0.242
No	No	0.683	0.317
No	No	0.897	0.103
No	No	0.814	0.186
No	No	0.973	0.027
No	No	0.977	0.023
No	No	0.957	0.043
No	No	0.967	0.033
No	No	0.786	0.214
No	No	0.874	0.126
No	No	0.613	0.387
No	No	0.815	0.185
No	No	0.967	0.033
No	No	0.718	0.282
No	No	0.879	0.121
No	No	0.984	0.016
No	No	0.712	0.288
No	No	0.790	0.210
No	No	0.995	0.005
No	No	0.972	0.028
No	No	0.730	0.270
No	No	0.998	0.002
No	No	0.852	0.148
No	No	0.897	0.103
No	No	0.920	0.080
No	No	0.690	0.310
No	No	0.948	0.052
No	No	0.549	0.451
No	No	0.786	0.214
No	No	0.988	0.012
No	No	0.931	0.069
No	No	0.970	0.030
Yes	Yes	0.404	0.596
Yes	Yes	0.166	0.834
Yes	Yes	0.194	0.806
Yes	Yes	0.312	0.688
Yes	Yes	0.245	0.755
Yes	Yes	0.380	0.620
Yes	No	0.702	0.298
Yes	Yes	0.340	0.660
Yes	Yes	0.207	0.793
Yes	Yes	0.266	0.734
Yes	Yes	0.150	0.850
Yes	Yes	0.364	0.636
Yes	Yes	0.370	0.630
Yes	No	0.693	0.307
Yes	No	0.808	0.192
Yes	Yes	0.225	0.775
Yes	Yes	0.447	0.553
Yes	Yes	0.271	0.729
Yes	Yes	0.249	0.751
Yes	Yes	0.359	0.641
Yes	Yes	0.230	0.770
Yes	Yes	0.104	0.896
Yes	No	0.598	0.402
Yes	No	0.583	0.417
Yes	Yes	0.380	0.620
Yes	Yes	0.273	0.727
Yes	Yes	0.476	0.524
Yes	Yes	0.228	0.772
Yes	Yes	0.201	0.799
Yes	Yes	0.031	0.969
Yes	Yes	0.281	0.719
Yes	No	0.536	0.464
Yes	Yes	0.167	0.833
Yes	Yes	0.441	0.559
Yes	Yes	0.171	0.829
Yes	Yes	0.257	0.743
Yes	Yes	0.240	0.760
Yes	Yes	0.310	0.690
Yes	Yes	0.188	0.812
Yes	Yes	0.246	0.754
Yes	Yes	0.298	0.702
Yes	Yes	0.219	0.781
Yes	Yes	0.475	0.525
Yes	No	0.556	0.444
Yes	Yes	0.445	0.555
Yes	Yes	0.254	0.746
Yes	Yes	0.102	0.898
Yes	Yes	0.063	0.937
Yes	Yes	0.215	0.785
Yes	Yes	0.173	0.827
Yes	Yes	0.215	0.785
Yes	Yes	0.177	0.823
Yes	Yes	0.153	0.847
Yes	Yes	0.159	0.841
Yes	Yes	0.195	0.805
Yes	Yes	0.402	0.598
Yes	Yes	0.272	0.728
Yes	Yes	0.204	0.796
Yes	Yes	0.247	0.753
Yes	Yes	0.214	0.786
Yes	Yes	0.155	0.845
Yes	Yes	0.017	0.983
Yes	Yes	0.291	0.709
Yes	Yes	0.155	0.845
Yes	Yes	0.105	0.895
Yes	Yes	0.145	0.855
Yes	Yes	0.119	0.881
Yes	Yes	0.176	0.824
Yes	Yes	0.121	0.879
Yes	Yes	0.079	0.921
Yes	Yes	0.068	0.932
Yes	Yes	0.068	0.932
Yes	Yes	0.151	0.849
Yes	Yes	0.242	0.758
Yes	Yes	0.168	0.832
Yes	Yes	0.080	0.920
Yes	Yes	0.146	0.854
Yes	Yes	0.167	0.833
Yes	Yes	0.099	0.901
Yes	Yes	0.052	0.948
Yes	Yes	0.050	0.950
Yes	Yes	0.053	0.947
Yes	Yes	0.025	0.975
Yes	Yes	0.177	0.823
Yes	Yes	0.031	0.969
Yes	Yes	0.152	0.848
Yes	Yes	0.196	0.804
Yes	Yes	0.080	0.920
Yes	Yes	0.081	0.919
Yes	Yes	0.415	0.585
Yes	Yes	0.072	0.928
Yes	Yes	0.132	0.868
Yes	Yes	0.167	0.833
Yes	Yes	0.116	0.884
Yes	Yes	0.135	0.865
Yes	Yes	0.053	0.947
Yes	Yes	0.073	0.927
Yes	Yes	0.083	0.917
Yes	Yes	0.188	0.812
Yes	Yes	0.134	0.866
Yes	Yes	0.102	0.898
Yes	Yes	0.028	0.972
Yes	Yes	0.291	0.709
Yes	Yes	0.272	0.728
Yes	Yes	0.182	0.818
Yes	Yes	0.143	0.857
Yes	Yes	0.088	0.912
Yes	Yes	0.089	0.911
Yes	Yes	0.134	0.866
Yes	Yes	0.019	0.981
Yes	Yes	0.077	0.923
Yes	Yes	0.228	0.772
Yes	Yes	0.102	0.898
Yes	Yes	0.264	0.736
Yes	Yes	0.067	0.933
Yes	Yes	0.159	0.841
Yes	Yes	0.246	0.754
Yes	Yes	0.186	0.814
Yes	Yes	0.061	0.939
Yes	Yes	0.090	0.910
Yes	Yes	0.212	0.788
Yes	Yes	0.122	0.878
Yes	Yes	0.264	0.736
Yes	Yes	0.109	0.891
Yes	Yes	0.049	0.951
Yes	Yes	0.140	0.860
Yes	Yes	0.083	0.917
Yes	Yes	0.087	0.913
Yes	Yes	0.102	0.898
Yes	Yes	0.187	0.813
Yes	Yes	0.105	0.895
Yes	Yes	0.066	0.934
Yes	Yes	0.030	0.970
Yes	Yes	0.037	0.963
Yes	Yes	0.102	0.898
Yes	Yes	0.012	0.988
Yes	Yes	0.065	0.935
Yes	Yes	0.121	0.879
Yes	Yes	0.123	0.877
Yes	Yes	0.080	0.920
Yes	Yes	0.041	0.959
Yes	Yes	0.154	0.846
Yes	Yes	0.062	0.938
Yes	Yes	0.140	0.860
Yes	Yes	0.016	0.984
Yes	Yes	0.048	0.952
Yes	Yes	0.164	0.836
Yes	Yes	0.196	0.804
Yes	Yes	0.175	0.825
Yes	Yes	0.416	0.584
Yes	Yes	0.338	0.662
Yes	No	0.682	0.318
Yes	Yes	0.084	0.916
Yes	Yes	0.333	0.667
Yes	Yes	0.060	0.940
Yes	Yes	0.062	0.938
Yes	Yes	0.125	0.875
Yes	Yes	0.100	0.900
Yes	Yes	0.081	0.919
Yes	Yes	0.070	0.930
Yes	Yes	0.077	0.923
Yes	Yes	0.096	0.904
Yes	Yes	0.190	0.810
Yes	Yes	0.161	0.839
Yes	Yes	0.034	0.966
Yes	Yes	0.167	0.833
Yes	Yes	0.049	0.951
Yes	Yes	0.117	0.883
Yes	Yes	0.035	0.965
Yes	Yes	0.064	0.936
Yes	Yes	0.413	0.587
Yes	Yes	0.173	0.827
Yes	Yes	0.371	0.629
Yes	Yes	0.207	0.793
Yes	Yes	0.036	0.964
Yes	Yes	0.012	0.988
Yes	Yes	0.011	0.989
Yes	Yes	0.021	0.979
Yes	Yes	0.067	0.933
Yes	Yes	0.016	0.984
Yes	Yes	0.084	0.916
Yes	Yes	0.111	0.889
Yes	Yes	0.064	0.936
Yes	Yes	0.062	0.938
Yes	Yes	0.168	0.832
Yes	Yes	0.331	0.669
Yes	Yes	0.143	0.857
Yes	Yes	0.149	0.851
Yes	Yes	0.081	0.919
Yes	Yes	0.172	0.828
Yes	Yes	0.207	0.793
Yes	Yes	0.038	0.962
Yes	Yes	0.071	0.929
Yes	Yes	0.197	0.803
Yes	Yes	0.069	0.931
Yes	Yes	0.147	0.853
Yes	Yes	0.200	0.800
Yes	Yes	0.103	0.897
Yes	Yes	0.039	0.961
Yes	Yes	0.045	0.955
Yes	Yes	0.035	0.965
Yes	Yes	0.055	0.945
Yes	Yes	0.151	0.849
Yes	Yes	0.049	0.951
Yes	Yes	0.146	0.854
Yes	Yes	0.111	0.889
Yes	Yes	0.169	0.831
Yes	Yes	0.290	0.710
Yes	Yes	0.295	0.705
Yes	Yes	0.114	0.886
Yes	Yes	0.144	0.856
Yes	Yes	0.017	0.983
Yes	Yes	0.080	0.920
Yes	Yes	0.020	0.980
Yes	Yes	0.052	0.948
Yes	Yes	0.113	0.887
Yes	Yes	0.072	0.928
Yes	Yes	0.048	0.952
Yes	Yes	0.105	0.895
Yes	Yes	0.095	0.905
Yes	Yes	0.081	0.919
Yes	Yes	0.082	0.918
Yes	Yes	0.076	0.924
Yes	Yes	0.043	0.957
Yes	Yes	0.083	0.917
Yes	Yes	0.090	0.910
Yes	Yes	0.098	0.902
Yes	Yes	0.032	0.968
Yes	Yes	0.038	0.962
Yes	Yes	0.132	0.868
Yes	Yes	0.135	0.865
Yes	Yes	0.162	0.838
Yes	Yes	0.165	0.835
Yes	Yes	0.134	0.866
Yes	Yes	0.188	0.812
Yes	Yes	0.419	0.581
Yes	Yes	0.210	0.790
Yes	Yes	0.180	0.820
Yes	Yes	0.298	0.702
Yes	Yes	0.211	0.789
Yes	Yes	0.125	0.875
Yes	Yes	0.075	0.925
Yes	Yes	0.039	0.961
Yes	Yes	0.020	0.980
Yes	Yes	0.022	0.978
Yes	Yes	0.039	0.961
Yes	Yes	0.018	0.982
Yes	Yes	0.108	0.892
Yes	Yes	0.028	0.972
Yes	Yes	0.048	0.952
Yes	Yes	0.124	0.876
Yes	Yes	0.036	0.964
Yes	Yes	0.095	0.905
Yes	Yes	0.059	0.941
Yes	Yes	0.112	0.888
Yes	Yes	0.073	0.927
Yes	Yes	0.114	0.886
Yes	Yes	0.120	0.880
Yes	Yes	0.120	0.880
Yes	Yes	0.182	0.818
Yes	Yes	0.131	0.869
Yes	Yes	0.089	0.911
Yes	Yes	0.161	0.839
Yes	Yes	0.113	0.887
Yes	Yes	0.113	0.887
Yes	Yes	0.108	0.892
Yes	Yes	0.049	0.951
Yes	Yes	0.041	0.959
Yes	Yes	0.026	0.974
Yes	Yes	0.030	0.970
Yes	Yes	0.175	0.825
Yes	Yes	0.084	0.916
Yes	Yes	0.131	0.869
Yes	Yes	0.154	0.846
Yes	Yes	0.111	0.889
Yes	Yes	0.087	0.913
Yes	Yes	0.067	0.933
Yes	Yes	0.067	0.933
Yes	Yes	0.179	0.821
Yes	Yes	0.153	0.847
Yes	Yes	0.190	0.810
Yes	Yes	0.156	0.844
Yes	Yes	0.153	0.847
Yes	Yes	0.150	0.850
Yes	Yes	0.155	0.845
Yes	Yes	0.219	0.781
Yes	Yes	0.025	0.975
Yes	Yes	0.064	0.936
Yes	Yes	0.046	0.954
Yes	Yes	0.012	0.988

describe(results_RFW)

##              vars   n mean   sd median trimmed  mad  min  max range  skew
## GDDiag*         1 580 1.50 0.50    1.5     1.5 0.74 1.00 2.00  1.00  0.00
## .pred_class*    2 580 1.50 0.50    1.0     1.5 0.00 1.00 2.00  1.00  0.01
## .pred_No        3 580 0.51 0.37    0.5     0.5 0.57 0.01 1.00  0.99  0.04
## .pred_Yes       4 580 0.49 0.37    0.5     0.5 0.57 0.00 0.99  0.99 -0.04
##              kurtosis   se
## GDDiag*         -2.00 0.02
## .pred_class*    -2.00 0.02
## .pred_No        -1.73 0.02
## .pred_Yes       -1.73 0.02

results_RFW%>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction  No Yes
##        No  283   8
##        Yes   7 282

#Visualise Results
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_RF%>% 
  conf_mat(GDDiag,.pred_class) %>% 
  autoplot()

ev_met1_RFW<-ev_met1(results_RFW,truth = GDDiag, estimate = .pred_class)
Rec_RFW<-yardstick::recall(results_RFW, GDDiag, .pred_class)
ACC_RFW<-yardstick::accuracy(results_RFW, GDDiag, .pred_class)
#Plot Roc_Curve
curve_RFW <- results_RFW %>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_RFW

auc_RFW <- results_RFW %>% 
  roc_auc(GDDiag, .pred_No)
RFMETW<-list(auc_RFW,ev_met1_RFW, Rec_RFW, ACC_RFW)
kable(RFMETW)

.metric .estimator .estimate roc_auc binary 0.996

.metric .estimator .estimate ppv binary 0.973 f_meas binary 0.974

.metric .estimator .estimate recall binary 0.976

.metric .estimator .estimate accuracy binary 0.974

RFMETCurVeW<-list(RFMETW, curve_RFW)
RFMETCurVeW

## [[1]]
## [[1]][[1]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.996
## 
## [[1]][[2]]
## # A tibble: 2 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 ppv     binary         0.973
## 2 f_meas  binary         0.974
## 
## [[1]][[3]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 recall  binary         0.976
## 
## [[1]][[4]]
## # A tibble: 1 x 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy binary         0.974
## 
## 
## [[2]]

Logistic Regression

results_LR <- test_data_GD_b %>% select(GDDiag) %>% 
  bind_cols (LogReg_fit%>% 
              predict(new_data = test_data_GD_b)) %>% 
  bind_cols( LogReg_fit%>% 
              predict(new_data = test_data_GD_b, type = "prob"))
kable(results_LR)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	Yes	0.248	0.752
No	No	0.754	0.246
No	Yes	0.324	0.676
No	Yes	0.470	0.530
No	Yes	0.418	0.582
No	No	0.687	0.313
No	Yes	0.393	0.607
No	Yes	0.180	0.820
No	Yes	0.382	0.618
No	Yes	0.420	0.580
No	No	0.826	0.174
No	Yes	0.260	0.740
No	No	0.613	0.387
No	Yes	0.499	0.501
No	Yes	0.482	0.518
No	Yes	0.437	0.563
No	No	0.915	0.085
No	No	0.880	0.120
No	Yes	0.434	0.566
No	No	0.901	0.099
No	No	0.838	0.162
No	No	0.828	0.172
No	Yes	0.122	0.878
No	No	0.545	0.455
No	No	0.838	0.162
No	No	0.709	0.291
No	No	0.646	0.354
No	No	0.854	0.146
No	No	0.570	0.430
No	No	0.809	0.191
No	Yes	0.420	0.580
No	No	0.713	0.287
No	No	0.812	0.188
No	No	0.888	0.112
No	No	0.722	0.278
No	Yes	0.437	0.563
No	No	0.759	0.241
No	No	0.697	0.303
No	No	0.750	0.250
No	Yes	0.082	0.918
No	No	0.621	0.379
No	No	0.781	0.219
No	No	0.697	0.303
No	No	0.915	0.085
No	No	0.962	0.038
No	Yes	0.208	0.792
No	No	0.571	0.429
No	No	0.777	0.223
No	No	0.909	0.091
No	Yes	0.407	0.593
No	Yes	0.328	0.672
No	No	0.655	0.345
No	No	0.754	0.246
No	Yes	0.206	0.794
No	No	0.591	0.409
No	Yes	0.378	0.622
No	No	0.750	0.250
No	No	0.555	0.445
Yes	Yes	0.467	0.533
Yes	No	0.567	0.433
Yes	No	0.607	0.393
Yes	No	0.764	0.236
Yes	No	0.592	0.408
Yes	Yes	0.473	0.527
Yes	No	0.534	0.466
Yes	Yes	0.079	0.921
Yes	Yes	0.477	0.523
Yes	Yes	0.394	0.606
Yes	Yes	0.048	0.952
Yes	Yes	0.202	0.798
Yes	Yes	0.489	0.511
Yes	Yes	0.329	0.671
Yes	No	0.504	0.496
Yes	Yes	0.404	0.596
Yes	Yes	0.386	0.614
Yes	No	0.538	0.462
Yes	Yes	0.474	0.526
Yes	Yes	0.371	0.629
Yes	No	0.587	0.413
Yes	Yes	0.437	0.563
Yes	Yes	0.463	0.537
Yes	Yes	0.492	0.508
Yes	Yes	0.374	0.626
Yes	Yes	0.298	0.702
Yes	Yes	0.226	0.774
Yes	No	0.606	0.394
Yes	No	0.663	0.337
Yes	No	0.753	0.247
Yes	No	0.635	0.365
Yes	No	0.626	0.374
Yes	No	0.629	0.371
Yes	No	0.552	0.448
Yes	Yes	0.446	0.554
Yes	No	0.649	0.351
Yes	No	0.629	0.371
Yes	Yes	0.495	0.505
Yes	Yes	0.473	0.527
Yes	Yes	0.237	0.763
Yes	Yes	0.283	0.717
Yes	Yes	0.456	0.544
Yes	Yes	0.398	0.602
Yes	Yes	0.088	0.912
Yes	No	0.819	0.181
Yes	Yes	0.399	0.601
Yes	Yes	0.296	0.704
Yes	Yes	0.369	0.631
Yes	Yes	0.300	0.700
Yes	Yes	0.345	0.655
Yes	Yes	0.263	0.737
Yes	Yes	0.144	0.856
Yes	Yes	0.251	0.749
Yes	Yes	0.456	0.544
Yes	Yes	0.238	0.762
Yes	Yes	0.164	0.836
Yes	Yes	0.067	0.933
Yes	Yes	0.148	0.852

describe(results_LR)

##              vars   n mean   sd median trimmed  mad  min  max range  skew
## GDDiag*         1 116 1.50 0.50   1.50    1.50 0.74 1.00 2.00  1.00  0.00
## .pred_class*    2 116 1.53 0.50   2.00    1.54 0.00 1.00 2.00  1.00 -0.14
## .pred_No        3 116 0.51 0.23   0.49    0.51 0.24 0.05 0.96  0.91 -0.01
## .pred_Yes       4 116 0.49 0.23   0.51    0.49 0.24 0.04 0.95  0.91  0.01
##              kurtosis   se
## GDDiag*         -2.02 0.05
## .pred_class*    -2.00 0.05
## .pred_No        -0.83 0.02
## .pred_Yes       -0.83 0.02

results_LR%>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction No Yes
##        No  36  18
##        Yes 22  40

#Visualise Results
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_LR%>% 
  conf_mat(GDDiag,.pred_class) %>% 
  autoplot()

ev_met1_LR<-ev_met1(results_LR,truth = GDDiag, estimate = .pred_class)
Rec_LR<-yardstick::recall(results_LR, GDDiag, .pred_class)
ACC_LR<-yardstick::accuracy(results_LR, GDDiag, .pred_class)
#Plot Roc_Curve
curve_LR <- results_LR %>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_LR

auc_LR <- results_LR %>% 
  roc_auc(GDDiag, .pred_No)
LRMET<-list(auc_LR,ev_met1_LR, Rec_LR, ACC_LR)
kable(LRMET)

.metric .estimator .estimate roc_auc binary 0.718

.metric .estimator .estimate ppv binary 0.667 f_meas binary 0.643

.metric .estimator .estimate recall binary 0.621

.metric .estimator .estimate accuracy binary 0.655

LRMETCurVe<-list(LRMET, curve_LR)
LRMETCurVe

## [[1]]
## [[1]][[1]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.718
## 
## [[1]][[2]]
## # A tibble: 2 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 ppv     binary         0.667
## 2 f_meas  binary         0.643
## 
## [[1]][[3]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 recall  binary         0.621
## 
## [[1]][[4]]
## # A tibble: 1 x 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy binary         0.655
## 
## 
## [[2]]

LogReg_fit_Test<-LOGGLM_workflow%>%fit(test_data_GD_b)
LogReg_fit_Test

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: logistic_reg()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## 
## Call:  stats::glm(formula = ..y ~ ., family = stats::binomial, data = data)
## 
## Coefficients:
## (Intercept)          AGE    Gameyears      IMTotal      IDTotal    COMPTotal  
##      -0.250       -0.624       -0.246        1.085       -0.610        0.288  
## 
## Degrees of Freedom: 115 Total (i.e. Null);  110 Residual
## Null Deviance:       161 
## Residual Deviance: 133   AIC: 145

LogReg_fit_Test %>% 
  extract_fit_parsnip() %>% 
 #Make VIP plot
 vip()

results_LRW <- Whole_data_GD_b %>% select(GDDiag)%>% 
  bind_cols(LogReg_fit %>% 
              predict(new_data = Whole_data_GD_b))%>% 
  bind_cols(LogReg_fit%>% 
             predict(new_data = Whole_data_GD_b, type = "prob"))
kable(results_LRW)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	No	0.838	0.162
No	Yes	0.248	0.752
No	No	0.754	0.246
No	No	0.879	0.121
No	No	0.609	0.391
No	No	0.687	0.313
No	No	0.868	0.132
No	Yes	0.262	0.738
No	Yes	0.473	0.527
No	No	0.776	0.224
No	No	0.870	0.130
No	Yes	0.324	0.676
No	No	0.868	0.132
No	No	0.861	0.139
No	Yes	0.470	0.530
No	No	0.854	0.146
No	No	0.934	0.066
No	Yes	0.418	0.582
No	No	0.687	0.313
No	No	0.787	0.213
No	No	0.722	0.278
No	Yes	0.272	0.728
No	Yes	0.334	0.666
No	Yes	0.350	0.650
No	Yes	0.125	0.875
No	Yes	0.482	0.518
No	No	0.646	0.354
No	Yes	0.393	0.607
No	Yes	0.412	0.588
No	Yes	0.332	0.668
No	Yes	0.468	0.532
No	Yes	0.260	0.740
No	No	0.934	0.066
No	Yes	0.323	0.677
No	No	0.777	0.223
No	Yes	0.407	0.593
No	No	0.898	0.102
No	No	0.706	0.294
No	No	0.536	0.464
No	No	0.918	0.082
No	Yes	0.249	0.751
No	No	0.838	0.162
No	No	0.518	0.482
No	Yes	0.180	0.820
No	Yes	0.382	0.618
No	No	0.649	0.351
No	Yes	0.420	0.580
No	No	0.643	0.357
No	No	0.826	0.174
No	No	0.812	0.188
No	No	0.909	0.091
No	No	0.747	0.253
No	No	0.536	0.464
No	No	0.915	0.085
No	No	0.879	0.121
No	Yes	0.260	0.740
No	No	0.534	0.466
No	No	0.842	0.158
No	No	0.719	0.281
No	No	0.842	0.158
No	No	0.543	0.457
No	No	0.613	0.387
No	Yes	0.469	0.531
No	No	0.640	0.360
No	Yes	0.499	0.501
No	No	0.776	0.224
No	No	0.932	0.068
No	Yes	0.482	0.518
No	Yes	0.280	0.720
No	No	0.838	0.162
No	Yes	0.437	0.563
No	Yes	0.180	0.820
No	No	0.582	0.418
No	No	0.698	0.302
No	No	0.536	0.464
No	No	0.506	0.494
No	No	0.739	0.261
No	No	0.534	0.466
No	Yes	0.280	0.720
No	No	0.915	0.085
No	No	0.653	0.347
No	No	0.653	0.347
No	No	0.784	0.216
No	No	0.518	0.482
No	Yes	0.344	0.656
No	No	0.917	0.083
No	No	0.712	0.288
No	No	0.784	0.216
No	No	0.615	0.385
No	Yes	0.406	0.594
No	No	0.750	0.250
No	No	0.880	0.120
No	No	0.821	0.179
No	No	0.739	0.261
No	Yes	0.434	0.566
No	No	0.732	0.268
No	No	0.560	0.440
No	Yes	0.350	0.650
No	No	0.901	0.099
No	No	0.944	0.056
No	No	0.838	0.162
No	No	0.750	0.250
No	No	0.828	0.172
No	No	0.700	0.300
No	Yes	0.420	0.580
No	No	0.690	0.310
No	No	0.609	0.391
No	No	0.754	0.246
No	Yes	0.406	0.594
No	No	0.571	0.429
No	No	0.901	0.099
No	No	0.787	0.213
No	No	0.945	0.055
No	No	0.915	0.085
No	Yes	0.122	0.878
No	No	0.842	0.158
No	No	0.606	0.394
No	Yes	0.323	0.677
No	Yes	0.391	0.609
No	No	0.545	0.455
No	Yes	0.407	0.593
No	No	0.861	0.139
No	No	0.838	0.162
No	No	0.709	0.291
No	No	0.917	0.083
No	No	0.646	0.354
No	No	0.837	0.163
No	No	0.602	0.398
No	No	0.975	0.025
No	No	0.854	0.146
No	No	0.570	0.430
No	Yes	0.315	0.685
No	No	0.826	0.174
No	No	0.735	0.265
No	No	0.801	0.199
No	Yes	0.434	0.566
No	No	0.741	0.259
No	No	0.932	0.068
No	No	0.582	0.418
No	Yes	0.206	0.794
No	No	0.697	0.303
No	Yes	0.437	0.563
No	No	0.750	0.250
No	No	0.504	0.496
No	No	0.909	0.091
No	No	0.809	0.191
No	No	0.746	0.254
No	No	0.777	0.223
No	No	0.687	0.313
No	Yes	0.420	0.580
No	Yes	0.304	0.696
No	No	0.566	0.434
No	No	0.543	0.457
No	No	0.842	0.158
No	No	0.812	0.188
No	No	0.870	0.130
No	No	0.943	0.057
No	No	0.784	0.216
No	Yes	0.248	0.752
No	Yes	0.482	0.518
No	No	0.835	0.165
No	No	0.909	0.091
No	Yes	0.340	0.660
No	No	0.713	0.287
No	Yes	0.128	0.872
No	No	0.712	0.288
No	No	0.687	0.313
No	No	0.912	0.088
No	No	0.844	0.156
No	No	0.945	0.055
No	No	0.784	0.216
No	No	0.812	0.188
No	No	0.888	0.112
No	Yes	0.412	0.588
No	No	0.690	0.310
No	No	0.722	0.278
No	Yes	0.280	0.720
No	No	0.750	0.250
No	No	0.917	0.083
No	Yes	0.349	0.651
No	Yes	0.437	0.563
No	No	0.842	0.158
No	No	0.759	0.241
No	Yes	0.095	0.905
No	No	0.759	0.241
No	No	0.646	0.354
No	Yes	0.494	0.506
No	Yes	0.078	0.922
No	No	0.849	0.151
No	No	0.697	0.303
No	No	0.828	0.172
No	No	0.786	0.214
No	No	0.719	0.281
No	No	0.582	0.418
No	Yes	0.166	0.834
No	Yes	0.272	0.728
No	No	0.732	0.268
No	No	0.508	0.492
No	Yes	0.391	0.609
No	No	0.664	0.336
No	Yes	0.095	0.905
No	No	0.750	0.250
No	No	0.741	0.259
No	No	0.681	0.319
No	Yes	0.082	0.918
No	No	0.621	0.379
No	Yes	0.280	0.720
No	No	0.844	0.156
No	No	0.630	0.370
No	Yes	0.482	0.518
No	No	0.606	0.394
No	No	0.870	0.130
No	No	0.861	0.139
No	Yes	0.378	0.622
No	Yes	0.285	0.715
No	Yes	0.078	0.922
No	No	0.642	0.358
No	Yes	0.334	0.666
No	Yes	0.260	0.740
No	Yes	0.285	0.715
No	Yes	0.113	0.887
No	No	0.835	0.165
No	No	0.746	0.254
No	No	0.698	0.302
No	No	0.781	0.219
No	No	0.697	0.303
No	No	0.838	0.162
No	No	0.915	0.085
No	No	0.649	0.351
No	Yes	0.304	0.696
No	No	0.712	0.288
No	No	0.786	0.214
No	No	0.784	0.216
No	No	0.870	0.130
No	No	0.652	0.348
No	Yes	0.109	0.891
No	No	0.591	0.409
No	Yes	0.166	0.834
No	No	0.888	0.112
No	No	0.962	0.038
No	No	0.962	0.038
No	Yes	0.208	0.792
No	No	0.518	0.482
No	Yes	0.324	0.676
No	No	0.571	0.429
No	No	0.700	0.300
No	Yes	0.473	0.527
No	Yes	0.109	0.891
No	No	0.690	0.310
No	No	0.829	0.171
No	No	0.777	0.223
No	No	0.909	0.091
No	Yes	0.437	0.563
No	Yes	0.447	0.553
No	Yes	0.407	0.593
No	No	0.700	0.300
No	Yes	0.328	0.672
No	No	0.798	0.202
No	Yes	0.285	0.715
No	Yes	0.180	0.820
No	No	0.655	0.345
No	Yes	0.323	0.677
No	No	0.944	0.056
No	No	0.582	0.418
No	No	0.903	0.097
No	No	0.591	0.409
No	Yes	0.122	0.878
No	No	0.754	0.246
No	Yes	0.206	0.794
No	Yes	0.328	0.672
No	No	0.591	0.409
No	Yes	0.378	0.622
No	Yes	0.473	0.527
No	No	0.810	0.190
No	No	0.613	0.387
No	No	0.762	0.238
No	No	0.846	0.154
No	No	0.653	0.347
No	No	0.750	0.250
No	No	0.915	0.085
No	Yes	0.095	0.905
No	No	0.655	0.345
No	No	0.560	0.440
No	Yes	0.248	0.752
No	No	0.646	0.354
No	No	0.555	0.445
No	Yes	0.122	0.878
No	No	0.776	0.224
No	No	0.729	0.271
No	No	0.687	0.313
Yes	Yes	0.467	0.533
Yes	No	0.628	0.372
Yes	Yes	0.287	0.713
Yes	Yes	0.491	0.509
Yes	No	0.722	0.278
Yes	Yes	0.428	0.572
Yes	No	0.567	0.433
Yes	Yes	0.363	0.637
Yes	No	0.565	0.435
Yes	No	0.523	0.477
Yes	Yes	0.327	0.673
Yes	No	0.706	0.294
Yes	No	0.607	0.393
Yes	No	0.764	0.236
Yes	No	0.592	0.408
Yes	Yes	0.301	0.699
Yes	Yes	0.473	0.527
Yes	No	0.555	0.445
Yes	Yes	0.373	0.627
Yes	Yes	0.116	0.884
Yes	Yes	0.401	0.599
Yes	Yes	0.418	0.582
Yes	No	0.534	0.466
Yes	No	0.673	0.327
Yes	No	0.641	0.359
Yes	Yes	0.399	0.601
Yes	Yes	0.079	0.921
Yes	Yes	0.135	0.865
Yes	No	0.541	0.459
Yes	Yes	0.303	0.697
Yes	No	0.500	0.500
Yes	No	0.677	0.323
Yes	Yes	0.425	0.575
Yes	Yes	0.290	0.710
Yes	Yes	0.252	0.748
Yes	Yes	0.332	0.668
Yes	Yes	0.479	0.521
Yes	Yes	0.220	0.780
Yes	Yes	0.389	0.611
Yes	Yes	0.496	0.504
Yes	Yes	0.108	0.892
Yes	Yes	0.477	0.523
Yes	Yes	0.210	0.790
Yes	Yes	0.394	0.606
Yes	No	0.823	0.177
Yes	Yes	0.308	0.692
Yes	Yes	0.253	0.747
Yes	Yes	0.146	0.854
Yes	Yes	0.324	0.676
Yes	Yes	0.298	0.702
Yes	Yes	0.145	0.855
Yes	Yes	0.260	0.740
Yes	Yes	0.084	0.916
Yes	Yes	0.350	0.650
Yes	Yes	0.188	0.812
Yes	Yes	0.048	0.952
Yes	Yes	0.149	0.851
Yes	Yes	0.202	0.798
Yes	Yes	0.469	0.531
Yes	No	0.553	0.447
Yes	Yes	0.389	0.611
Yes	Yes	0.421	0.579
Yes	No	0.594	0.406
Yes	No	0.619	0.381
Yes	No	0.605	0.395
Yes	No	0.601	0.399
Yes	Yes	0.247	0.753
Yes	Yes	0.489	0.511
Yes	Yes	0.329	0.671
Yes	Yes	0.316	0.684
Yes	Yes	0.448	0.552
Yes	Yes	0.447	0.553
Yes	Yes	0.454	0.546
Yes	Yes	0.479	0.521
Yes	No	0.709	0.291
Yes	Yes	0.422	0.578
Yes	No	0.556	0.444
Yes	No	0.706	0.294
Yes	Yes	0.494	0.506
Yes	Yes	0.395	0.605
Yes	Yes	0.314	0.686
Yes	Yes	0.374	0.626
Yes	Yes	0.473	0.527
Yes	No	0.522	0.478
Yes	Yes	0.487	0.513
Yes	No	0.504	0.496
Yes	Yes	0.404	0.596
Yes	Yes	0.371	0.629
Yes	Yes	0.386	0.614
Yes	No	0.538	0.462
Yes	No	0.652	0.348
Yes	No	0.551	0.449
Yes	No	0.546	0.454
Yes	Yes	0.464	0.536
Yes	No	0.562	0.438
Yes	Yes	0.483	0.517
Yes	No	0.635	0.365
Yes	Yes	0.410	0.590
Yes	Yes	0.474	0.526
Yes	Yes	0.319	0.681
Yes	Yes	0.371	0.629
Yes	Yes	0.317	0.683
Yes	No	0.793	0.207
Yes	No	0.687	0.313
Yes	No	0.589	0.411
Yes	Yes	0.402	0.598
Yes	No	0.619	0.381
Yes	No	0.564	0.436
Yes	No	0.587	0.413
Yes	Yes	0.433	0.567
Yes	Yes	0.431	0.569
Yes	No	0.555	0.445
Yes	Yes	0.486	0.514
Yes	No	0.637	0.363
Yes	Yes	0.393	0.607
Yes	No	0.532	0.468
Yes	No	0.573	0.427
Yes	No	0.580	0.420
Yes	Yes	0.417	0.583
Yes	Yes	0.418	0.582
Yes	Yes	0.170	0.830
Yes	Yes	0.308	0.692
Yes	Yes	0.435	0.565
Yes	Yes	0.437	0.563
Yes	Yes	0.402	0.598
Yes	Yes	0.463	0.537
Yes	Yes	0.492	0.508
Yes	Yes	0.487	0.513
Yes	Yes	0.374	0.626
Yes	No	0.558	0.442
Yes	Yes	0.450	0.550
Yes	Yes	0.365	0.635
Yes	Yes	0.298	0.702
Yes	Yes	0.266	0.734
Yes	Yes	0.188	0.812
Yes	Yes	0.158	0.842
Yes	Yes	0.142	0.858
Yes	Yes	0.226	0.774
Yes	Yes	0.353	0.647
Yes	Yes	0.477	0.523
Yes	Yes	0.474	0.526
Yes	No	0.516	0.484
Yes	Yes	0.434	0.566
Yes	Yes	0.298	0.702
Yes	Yes	0.403	0.597
Yes	Yes	0.478	0.522
Yes	No	0.664	0.336
Yes	Yes	0.493	0.507
Yes	No	0.508	0.492
Yes	No	0.606	0.394
Yes	No	0.663	0.337
Yes	No	0.753	0.247
Yes	No	0.618	0.382
Yes	No	0.635	0.365
Yes	No	0.623	0.377
Yes	No	0.665	0.335
Yes	No	0.626	0.374
Yes	No	0.606	0.394
Yes	Yes	0.374	0.626
Yes	Yes	0.383	0.617
Yes	Yes	0.386	0.614
Yes	Yes	0.374	0.626
Yes	Yes	0.212	0.788
Yes	Yes	0.111	0.889
Yes	Yes	0.138	0.862
Yes	Yes	0.086	0.914
Yes	Yes	0.191	0.809
Yes	Yes	0.290	0.710
Yes	Yes	0.189	0.811
Yes	Yes	0.279	0.721
Yes	No	0.629	0.371
Yes	No	0.547	0.453
Yes	No	0.552	0.448
Yes	Yes	0.390	0.610
Yes	Yes	0.315	0.685
Yes	Yes	0.268	0.732
Yes	Yes	0.290	0.710
Yes	Yes	0.296	0.704
Yes	Yes	0.478	0.522
Yes	Yes	0.396	0.604
Yes	Yes	0.441	0.559
Yes	Yes	0.446	0.554
Yes	No	0.649	0.351
Yes	No	0.667	0.333
Yes	No	0.629	0.371
Yes	No	0.704	0.296
Yes	No	0.505	0.495
Yes	Yes	0.495	0.505
Yes	Yes	0.427	0.573
Yes	Yes	0.473	0.527
Yes	Yes	0.295	0.705
Yes	Yes	0.322	0.678
Yes	Yes	0.310	0.690
Yes	Yes	0.301	0.699
Yes	Yes	0.237	0.763
Yes	Yes	0.273	0.727
Yes	Yes	0.283	0.717
Yes	Yes	0.262	0.738
Yes	Yes	0.402	0.598
Yes	Yes	0.342	0.658
Yes	Yes	0.488	0.512
Yes	Yes	0.327	0.673
Yes	Yes	0.480	0.520
Yes	Yes	0.487	0.513
Yes	Yes	0.451	0.549
Yes	Yes	0.339	0.661
Yes	Yes	0.456	0.544
Yes	Yes	0.191	0.809
Yes	Yes	0.169	0.831
Yes	Yes	0.250	0.750
Yes	Yes	0.398	0.602
Yes	Yes	0.421	0.579
Yes	Yes	0.306	0.694
Yes	Yes	0.447	0.553
Yes	Yes	0.452	0.548
Yes	Yes	0.483	0.517
Yes	Yes	0.493	0.507
Yes	Yes	0.485	0.515
Yes	Yes	0.088	0.912
Yes	Yes	0.096	0.904
Yes	Yes	0.165	0.835
Yes	Yes	0.244	0.756
Yes	No	0.535	0.465
Yes	No	0.553	0.447
Yes	Yes	0.492	0.508
Yes	Yes	0.439	0.561
Yes	Yes	0.312	0.688
Yes	Yes	0.236	0.764
Yes	Yes	0.246	0.754
Yes	Yes	0.424	0.576
Yes	Yes	0.233	0.767
Yes	Yes	0.410	0.590
Yes	Yes	0.432	0.568
Yes	Yes	0.426	0.574
Yes	No	0.811	0.189
Yes	No	0.819	0.181
Yes	No	0.790	0.210
Yes	No	0.815	0.185
Yes	Yes	0.399	0.601
Yes	Yes	0.296	0.704
Yes	Yes	0.328	0.672
Yes	Yes	0.325	0.675
Yes	Yes	0.369	0.631
Yes	Yes	0.132	0.868
Yes	Yes	0.144	0.856
Yes	Yes	0.373	0.627
Yes	Yes	0.144	0.856
Yes	Yes	0.160	0.840
Yes	Yes	0.300	0.700
Yes	Yes	0.194	0.806
Yes	Yes	0.345	0.655
Yes	Yes	0.290	0.710
Yes	Yes	0.363	0.637
Yes	Yes	0.391	0.609
Yes	Yes	0.263	0.737
Yes	Yes	0.220	0.780
Yes	Yes	0.258	0.742
Yes	Yes	0.303	0.697
Yes	Yes	0.167	0.833
Yes	Yes	0.144	0.856
Yes	Yes	0.224	0.776
Yes	Yes	0.090	0.910
Yes	Yes	0.126	0.874
Yes	Yes	0.250	0.750
Yes	Yes	0.251	0.749
Yes	Yes	0.456	0.544
Yes	Yes	0.116	0.884
Yes	Yes	0.109	0.891
Yes	Yes	0.112	0.888
Yes	Yes	0.114	0.886
Yes	Yes	0.323	0.677
Yes	Yes	0.321	0.679
Yes	Yes	0.294	0.706
Yes	Yes	0.384	0.616
Yes	Yes	0.224	0.776
Yes	Yes	0.211	0.789
Yes	Yes	0.236	0.764
Yes	Yes	0.238	0.762
Yes	Yes	0.164	0.836
Yes	Yes	0.073	0.927
Yes	Yes	0.049	0.951
Yes	Yes	0.067	0.933
Yes	Yes	0.156	0.844
Yes	Yes	0.377	0.623
Yes	Yes	0.166	0.834
Yes	Yes	0.255	0.745
Yes	Yes	0.231	0.769
Yes	Yes	0.148	0.852
Yes	Yes	0.250	0.750
Yes	Yes	0.264	0.736

describe(results_LRW)

##              vars   n mean   sd median trimmed  mad  min  max range  skew
## GDDiag*         1 580 1.50 0.50   1.50    1.50 0.74 1.00 2.00  1.00  0.00
## .pred_class*    2 580 1.54 0.50   2.00    1.55 0.00 1.00 2.00  1.00 -0.15
## .pred_No        3 580 0.50 0.23   0.48    0.50 0.27 0.05 0.98  0.93  0.10
## .pred_Yes       4 580 0.50 0.23   0.52    0.50 0.27 0.02 0.95  0.93 -0.10
##              kurtosis   se
## GDDiag*         -2.00 0.02
## .pred_class*    -1.98 0.02
## .pred_No        -0.98 0.01
## .pred_Yes       -0.98 0.01

results_LRW%>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction  No Yes
##        No  197  71
##        Yes  93 219

#Visualise Results
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_LRW%>% 
  conf_mat(GDDiag,.pred_class) %>% 
  autoplot()

ev_met1_LRW<-ev_met1(results_LRW,truth = GDDiag, estimate = .pred_class)
Rec_LRW<-yardstick::recall(results_LRW, GDDiag, .pred_class)
ACC_LRW<-yardstick::accuracy(results_LRW, GDDiag, .pred_class)
#Plot Roc_Curve
curve_LRW <- results_LRW %>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_LRW

auc_LRW <- results_LRW %>% 
  roc_auc(GDDiag, .pred_No)
LRMETW<-list(auc_LRW,ev_met1_LRW, Rec_LRW, ACC_LRW)
kable(RFMETW)

.metric .estimator .estimate roc_auc binary 0.996

.metric .estimator .estimate ppv binary 0.973 f_meas binary 0.974

.metric .estimator .estimate recall binary 0.976

.metric .estimator .estimate accuracy binary 0.974

LRMETCurVeW<-list(LRMETW, curve_LRW)
LRMETCurVeW

## [[1]]
## [[1]][[1]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.763
## 
## [[1]][[2]]
## # A tibble: 2 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 ppv     binary         0.735
## 2 f_meas  binary         0.706
## 
## [[1]][[3]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 recall  binary         0.679
## 
## [[1]][[4]]
## # A tibble: 1 x 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy binary         0.717
## 
## 
## [[2]]

Lasso

results_Lasso<-test_data_GD_b %>% select(GDDiag) %>% 
  bind_cols( Lasso_fit%>% 
              predict(new_data = test_data_GD_b)) %>% 
  bind_cols( Lasso_fit%>% 
             predict(new_data = test_data_GD_b, type = "prob"))
kable(results_Lasso)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	Yes	0.374	0.626
No	No	0.593	0.407
No	Yes	0.433	0.567
No	Yes	0.395	0.605
No	No	0.520	0.480
No	No	0.583	0.417
No	Yes	0.459	0.541
No	Yes	0.421	0.579
No	Yes	0.453	0.547
No	Yes	0.453	0.547
No	No	0.670	0.330
No	Yes	0.417	0.583
No	No	0.534	0.466
No	No	0.542	0.458
No	No	0.504	0.496
No	Yes	0.466	0.534
No	No	0.713	0.287
No	No	0.690	0.310
No	No	0.522	0.478
No	No	0.700	0.300
No	No	0.654	0.346
No	No	0.650	0.350
No	Yes	0.351	0.649
No	No	0.518	0.482
No	No	0.676	0.324
No	No	0.600	0.400
No	No	0.558	0.442
No	No	0.648	0.352
No	No	0.540	0.460
No	No	0.611	0.389
No	Yes	0.453	0.547
No	No	0.558	0.442
No	No	0.588	0.412
No	No	0.692	0.308
No	No	0.612	0.388
No	Yes	0.466	0.534
No	No	0.622	0.378
No	No	0.576	0.424
No	No	0.585	0.415
No	Yes	0.294	0.706
No	No	0.580	0.420
No	No	0.619	0.381
No	No	0.576	0.424
No	No	0.713	0.287
No	No	0.735	0.265
No	Yes	0.360	0.640
No	Yes	0.478	0.522
No	No	0.617	0.383
No	No	0.700	0.300
No	Yes	0.440	0.560
No	Yes	0.431	0.569
No	No	0.521	0.479
No	No	0.593	0.407
No	Yes	0.345	0.655
No	No	0.560	0.440
No	Yes	0.420	0.580
No	No	0.556	0.444
No	No	0.531	0.469
Yes	Yes	0.455	0.545
Yes	No	0.549	0.451
Yes	No	0.547	0.453
Yes	No	0.570	0.430
Yes	No	0.540	0.460
Yes	No	0.517	0.483
Yes	Yes	0.493	0.507
Yes	Yes	0.327	0.673
Yes	No	0.504	0.496
Yes	Yes	0.436	0.564
Yes	Yes	0.213	0.787
Yes	Yes	0.374	0.626
Yes	Yes	0.478	0.522
Yes	Yes	0.411	0.589
Yes	No	0.510	0.490
Yes	Yes	0.467	0.533
Yes	Yes	0.458	0.542
Yes	No	0.534	0.466
Yes	No	0.520	0.480
Yes	Yes	0.480	0.520
Yes	No	0.532	0.468
Yes	Yes	0.495	0.505
Yes	No	0.512	0.488
Yes	No	0.513	0.487
Yes	Yes	0.481	0.519
Yes	Yes	0.410	0.590
Yes	Yes	0.371	0.629
Yes	No	0.534	0.466
Yes	No	0.536	0.464
Yes	No	0.565	0.435
Yes	No	0.527	0.473
Yes	No	0.550	0.450
Yes	Yes	0.490	0.510
Yes	Yes	0.456	0.544
Yes	No	0.512	0.488
Yes	No	0.557	0.443
Yes	No	0.549	0.451
Yes	Yes	0.413	0.587
Yes	Yes	0.414	0.586
Yes	Yes	0.377	0.623
Yes	Yes	0.414	0.586
Yes	No	0.522	0.478
Yes	Yes	0.481	0.519
Yes	Yes	0.341	0.659
Yes	No	0.640	0.360
Yes	Yes	0.462	0.538
Yes	Yes	0.428	0.572
Yes	Yes	0.466	0.534
Yes	Yes	0.408	0.592
Yes	Yes	0.405	0.595
Yes	Yes	0.371	0.629
Yes	Yes	0.345	0.655
Yes	Yes	0.476	0.524
Yes	No	0.525	0.475
Yes	Yes	0.326	0.674
Yes	Yes	0.303	0.697
Yes	Yes	0.248	0.752
Yes	Yes	0.345	0.655

describe(results_Lasso)

##              vars   n mean   sd median trimmed  mad  min  max range  skew
## GDDiag*         1 116 1.50 0.50   1.50    1.50 0.74 1.00 2.00  1.00  0.00
## .pred_class*    2 116 1.47 0.50   1.00    1.46 0.00 1.00 2.00  1.00  0.14
## .pred_No        3 116 0.50 0.11   0.51    0.50 0.10 0.21 0.73  0.52 -0.08
## .pred_Yes       4 116 0.50 0.11   0.49    0.50 0.10 0.27 0.79  0.52  0.08
##              kurtosis   se
## GDDiag*         -2.02 0.05
## .pred_class*    -2.00 0.05
## .pred_No        -0.20 0.01
## .pred_Yes       -0.20 0.01

results_Lasso %>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction No Yes
##        No  39  23
##        Yes 19  35

#Visualise Results
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_Lasso%>% 
  conf_mat(GDDiag,.pred_class) %>% 
  autoplot()

ev_met1_Lasso<-ev_met1(results_Lasso,truth = GDDiag, estimate = .pred_class)
ACC_Lasso<-yardstick::accuracy(results_Lasso, GDDiag,.pred_class)
Rec_Lasso<-yardstick::recall(results_Lasso, GDDiag, .pred_class)
#Plot Roc_Curve
curve_Lasso <- results_Lasso %>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_Lasso

auc_Lasso <- results_Lasso %>% 
  roc_auc(GDDiag, .pred_No)
LassoMET<-list(auc_Lasso,ev_met1_Lasso, Rec_Lasso, ACC_Lasso)
kable(LassoMET)

.metric .estimator .estimate roc_auc binary 0.724

.metric .estimator .estimate ppv binary 0.629 f_meas binary 0.650

.metric .estimator .estimate recall binary 0.672

.metric .estimator .estimate accuracy binary 0.638

LassoMETCurVe<-list(LassoMET, curve_Lasso)
LassoMETCurVe

## [[1]]
## [[1]][[1]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.724
## 
## [[1]][[2]]
## # A tibble: 2 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 ppv     binary         0.629
## 2 f_meas  binary         0.65 
## 
## [[1]][[3]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 recall  binary         0.672
## 
## [[1]][[4]]
## # A tibble: 1 x 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy binary         0.638
## 
## 
## [[2]]

Lasso_fit_Test<-lasso_workflow%>%fit(test_data_GD_b)
Lasso_fit_Test

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: multinom_reg()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## 
## Call:  glmnet::glmnet(x = maybe_matrix(x), y = y, family = "multinomial",      alpha = ~1) 
## 
##    Df  %Dev Lambda
## 1   0  0.00 0.1870
## 2   1  1.71 0.1700
## 3   1  3.14 0.1550
## 4   1  4.33 0.1410
## 5   1  5.34 0.1290
## 6   1  6.19 0.1170
## 7   1  6.92 0.1070
## 8   2  7.58 0.0973
## 9   2  8.41 0.0887
## 10  2  9.11 0.0808
## 11  2  9.71 0.0736
## 12  2 10.22 0.0671
## 13  2 10.65 0.0611
## 14  3 11.10 0.0557
## 15  4 11.73 0.0507
## 16  4 12.43 0.0462
## 17  5 13.15 0.0421
## 18  5 13.79 0.0384
## 19  5 14.34 0.0350
## 20  5 14.80 0.0319
## 21  5 15.20 0.0290
## 22  5 15.53 0.0265
## 23  5 15.82 0.0241
## 24  5 16.07 0.0220
## 25  5 16.27 0.0200
## 26  5 16.45 0.0182
## 27  5 16.60 0.0166
## 28  5 16.73 0.0151
## 29  5 16.83 0.0138
## 30  5 16.93 0.0126
## 31  5 17.00 0.0115
## 32  5 17.07 0.0104
## 33  5 17.12 0.0095
## 34  5 17.17 0.0087
## 35  5 17.21 0.0079
## 36  5 17.24 0.0072
## 37  5 17.26 0.0066
## 38  5 17.29 0.0060
## 39  5 17.31 0.0054
## 40  5 17.32 0.0050
## 41  5 17.34 0.0045
## 42  5 17.35 0.0041
## 43  5 17.36 0.0037
## 44  5 17.36 0.0034
## 45  5 17.37 0.0031
## 46  5 17.38 0.0028
## 
## ...
## and 10 more lines.

Lasso_fit_Test %>% 
  extract_fit_parsnip() %>% 
 #Make VIP plot
 vip()

Naive Bayes

results_NB <- test_data_GD_b %>% select(GDDiag) %>% 
 bind_cols(NB_fit %>% 
             predict(new_data = test_data_GD_b)) %>% 
  bind_cols( NB_fit%>% 
              predict(new_data = test_data_GD_b, type = "prob"))
kable(results_NB)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	Yes	0.185	0.815
No	No	0.757	0.243
No	Yes	0.160	0.840
No	No	0.972	0.028
No	Yes	0.123	0.877
No	Yes	0.460	0.540
No	Yes	0.244	0.756
No	Yes	0.142	0.858
No	Yes	0.308	0.692
No	No	0.643	0.357
No	No	0.934	0.066
No	Yes	0.293	0.707
No	Yes	0.276	0.724
No	Yes	0.486	0.514
No	Yes	0.498	0.502
No	No	0.502	0.498
No	No	0.993	0.007
No	No	0.997	0.003
No	Yes	0.119	0.881
No	No	0.990	0.010
No	No	0.935	0.065
No	No	0.913	0.087
No	Yes	0.180	0.820
No	Yes	0.244	0.756
No	No	0.950	0.050
No	No	0.590	0.410
No	Yes	0.351	0.649
No	No	0.986	0.014
No	Yes	0.291	0.709
No	No	0.851	0.149
No	No	0.643	0.357
No	No	0.782	0.218
No	No	0.848	0.152
No	No	0.997	0.003
No	No	0.819	0.181
No	No	0.502	0.498
No	No	0.782	0.218
No	No	0.522	0.478
No	No	0.813	0.187
No	Yes	0.054	0.946
No	No	0.594	0.406
No	No	0.869	0.131
No	No	0.522	0.478
No	No	0.993	0.007
No	No	0.998	0.002
No	Yes	0.098	0.902
No	No	0.559	0.441
No	No	0.834	0.166
No	No	0.997	0.003
No	No	0.763	0.237
No	Yes	0.347	0.653
No	No	0.505	0.495
No	No	0.757	0.243
No	Yes	0.162	0.838
No	No	0.784	0.216
No	Yes	0.304	0.696
No	No	0.842	0.158
No	Yes	0.272	0.728
Yes	Yes	0.418	0.582
Yes	No	0.615	0.385
Yes	Yes	0.292	0.708
Yes	No	0.764	0.236
Yes	No	0.727	0.273
Yes	Yes	0.440	0.560
Yes	Yes	0.416	0.584
Yes	Yes	0.160	0.840
Yes	Yes	0.389	0.611
Yes	Yes	0.336	0.664
Yes	Yes	0.209	0.791
Yes	Yes	0.112	0.888
Yes	Yes	0.279	0.721
Yes	Yes	0.276	0.724
Yes	Yes	0.386	0.614
Yes	No	0.507	0.493
Yes	No	0.519	0.481
Yes	No	0.578	0.422
Yes	Yes	0.378	0.622
Yes	Yes	0.242	0.758
Yes	Yes	0.232	0.768
Yes	Yes	0.213	0.787
Yes	Yes	0.324	0.676
Yes	Yes	0.397	0.603
Yes	Yes	0.244	0.756
Yes	Yes	0.221	0.779
Yes	Yes	0.212	0.788
Yes	Yes	0.300	0.700
Yes	No	0.530	0.470
Yes	No	0.732	0.268
Yes	Yes	0.392	0.608
Yes	Yes	0.380	0.620
Yes	No	0.601	0.399
Yes	No	0.523	0.477
Yes	Yes	0.140	0.860
Yes	Yes	0.439	0.561
Yes	Yes	0.290	0.710
Yes	No	0.702	0.298
Yes	No	0.607	0.393
Yes	Yes	0.091	0.909
Yes	Yes	0.129	0.871
Yes	Yes	0.162	0.838
Yes	Yes	0.122	0.878
Yes	Yes	0.107	0.893
Yes	No	0.781	0.219
Yes	Yes	0.327	0.673
Yes	Yes	0.224	0.776
Yes	Yes	0.118	0.882
Yes	Yes	0.171	0.829
Yes	Yes	0.187	0.813
Yes	Yes	0.136	0.864
Yes	Yes	0.188	0.812
Yes	Yes	0.124	0.876
Yes	Yes	0.166	0.834
Yes	Yes	0.114	0.886
Yes	Yes	0.205	0.795
Yes	Yes	0.247	0.753
Yes	Yes	0.060	0.940

describe(results_NB)

##              vars   n mean   sd median trimmed  mad  min  max range  skew
## GDDiag*         1 116 1.50 0.50   1.50    1.50 0.74 1.00 2.00  1.00  0.00
## .pred_class*    2 116 1.58 0.50   2.00    1.60 0.00 1.00 2.00  1.00 -0.31
## .pred_No        3 116 0.46 0.29   0.39    0.44 0.31 0.05 1.00  0.94  0.47
## .pred_Yes       4 116 0.54 0.29   0.61    0.56 0.31 0.00 0.95  0.94 -0.47
##              kurtosis   se
## GDDiag*         -2.02 0.05
## .pred_class*    -1.92 0.05
## .pred_No        -1.09 0.03
## .pred_Yes       -1.09 0.03

results_NB%>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction No Yes
##        No  36  13
##        Yes 22  45

#Visualise Results
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_NB%>% 
  conf_mat(GDDiag,.pred_class) %>% 
  autoplot()

ev_met1_NB<-ev_met1(results_NB,truth = GDDiag, estimate = .pred_class)
Rec_NB<-yardstick::recall(results_NB, GDDiag, .pred_class)
ACC_NB<-yardstick::accuracy(results_NB, GDDiag, .pred_class)
#Plot Roc_Curve
curve_NB <- results_NB %>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_NB

auc_NB <- results_NB %>% 
  roc_auc(GDDiag, .pred_No)
NBMET<-list(auc_NB,ev_met1_NB, Rec_NB, ACC_NB)
kable(NBMET)

.metric .estimator .estimate roc_auc binary 0.744

.metric .estimator .estimate ppv binary 0.735 f_meas binary 0.673

.metric .estimator .estimate recall binary 0.621

.metric .estimator .estimate accuracy binary 0.698

NBMETCurVe<-list(NBMET, curve_NB)
NBMETCurVe

## [[1]]
## [[1]][[1]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.744
## 
## [[1]][[2]]
## # A tibble: 2 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 ppv     binary         0.735
## 2 f_meas  binary         0.673
## 
## [[1]][[3]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 recall  binary         0.621
## 
## [[1]][[4]]
## # A tibble: 1 x 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy binary         0.698
## 
## 
## [[2]]

Kernel

results_Kern<-test_data_GD_b %>% select(GDDiag) %>% 
  bind_cols (Kernel_fit%>% 
              predict(new_data = test_data_GD_b)) %>% 
  bind_cols(Kernel_fit%>% 
              predict(new_data = test_data_GD_b, type = "prob"))
kable(results_Kern)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	Yes	0.200	0.800
No	No	0.753	0.247
No	Yes	0.288	0.712
No	Yes	0.534	0.466
No	Yes	0.376	0.624
No	No	0.709	0.291
No	Yes	0.359	0.641
No	Yes	0.160	0.840
No	Yes	0.405	0.595
No	Yes	0.447	0.553
No	No	0.863	0.137
No	Yes	0.220	0.780
No	No	0.615	0.385
No	No	0.570	0.430
No	Yes	0.532	0.468
No	Yes	0.423	0.577
No	No	0.949	0.051
No	No	0.892	0.108
No	Yes	0.401	0.599
No	No	0.923	0.077
No	No	0.897	0.103
No	No	0.867	0.133
No	Yes	0.120	0.880
No	Yes	0.478	0.522
No	No	0.865	0.135
No	No	0.717	0.283
No	No	0.654	0.346
No	No	0.880	0.120
No	No	0.601	0.399
No	No	0.852	0.148
No	Yes	0.447	0.553
No	No	0.768	0.232
No	No	0.844	0.156
No	No	0.911	0.089
No	No	0.773	0.227
No	Yes	0.423	0.577
No	No	0.763	0.237
No	No	0.734	0.266
No	No	0.819	0.181
No	Yes	0.090	0.910
No	No	0.643	0.357
No	No	0.795	0.205
No	No	0.734	0.266
No	No	0.949	0.051
No	No	0.973	0.027
No	Yes	0.165	0.835
No	Yes	0.562	0.438
No	No	0.760	0.240
No	No	0.927	0.073
No	Yes	0.376	0.624
No	Yes	0.321	0.679
No	No	0.703	0.297
No	No	0.753	0.247
No	Yes	0.186	0.814
No	No	0.637	0.363
No	Yes	0.392	0.608
No	No	0.769	0.231
No	Yes	0.504	0.496
Yes	Yes	0.426	0.574
Yes	No	0.623	0.377
Yes	No	0.620	0.380
Yes	No	0.848	0.152
Yes	No	0.646	0.354
Yes	No	0.583	0.417
Yes	Yes	0.484	0.516
Yes	Yes	0.126	0.874
Yes	Yes	0.471	0.529
Yes	Yes	0.380	0.620
Yes	Yes	0.064	0.936
Yes	Yes	0.205	0.795
Yes	Yes	0.470	0.530
Yes	Yes	0.322	0.678
Yes	Yes	0.549	0.451
Yes	Yes	0.456	0.544
Yes	Yes	0.427	0.573
Yes	No	0.591	0.409
Yes	Yes	0.449	0.551
Yes	Yes	0.330	0.670
Yes	No	0.584	0.416
Yes	Yes	0.490	0.510
Yes	Yes	0.559	0.441
Yes	Yes	0.484	0.516
Yes	Yes	0.333	0.667
Yes	Yes	0.295	0.705
Yes	Yes	0.244	0.756
Yes	No	0.583	0.417
Yes	No	0.742	0.258
Yes	No	0.838	0.162
Yes	No	0.689	0.311
Yes	No	0.657	0.343
Yes	No	0.682	0.318
Yes	Yes	0.546	0.454
Yes	Yes	0.428	0.572
Yes	No	0.689	0.311
Yes	No	0.629	0.371
Yes	Yes	0.508	0.492
Yes	Yes	0.484	0.516
Yes	Yes	0.197	0.803
Yes	Yes	0.226	0.774
Yes	Yes	0.422	0.578
Yes	Yes	0.357	0.643
Yes	Yes	0.114	0.886
Yes	No	0.827	0.173
Yes	Yes	0.330	0.670
Yes	Yes	0.236	0.764
Yes	Yes	0.330	0.670
Yes	Yes	0.299	0.701
Yes	Yes	0.328	0.672
Yes	Yes	0.210	0.790
Yes	Yes	0.184	0.816
Yes	Yes	0.238	0.762
Yes	Yes	0.424	0.576
Yes	Yes	0.240	0.760
Yes	Yes	0.171	0.829
Yes	Yes	0.083	0.917
Yes	Yes	0.148	0.852

describe(results_Kern)

##              vars   n mean   sd median trimmed  mad  min  max range  skew
## GDDiag*         1 116 1.50 0.50    1.5    1.50 0.74 1.00 2.00  1.00  0.00
## .pred_class*    2 116 1.57 0.50    2.0    1.59 0.00 1.00 2.00  1.00 -0.27
## .pred_No        3 116 0.52 0.24    0.5    0.52 0.28 0.06 0.97  0.91  0.03
## .pred_Yes       4 116 0.48 0.24    0.5    0.48 0.28 0.03 0.94  0.91 -0.03
##              kurtosis   se
## GDDiag*         -2.02 0.05
## .pred_class*    -1.94 0.05
## .pred_No        -1.06 0.02
## .pred_Yes       -1.06 0.02

results_Kern%>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction No Yes
##        No  34  16
##        Yes 24  42

#Visualise Results
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_Kern%>% 
  conf_mat(GDDiag,.pred_class) %>% 
  autoplot()

ev_met1_Kern<-ev_met1(results_Kern,truth = GDDiag, estimate = .pred_class)
Rec_Kern<-yardstick::recall(results_Kern, GDDiag, .pred_class)
ACC_Kern<-yardstick::accuracy(results_Kern, GDDiag, .pred_class)
#Plot Roc_Curve
curve_Kern <- results_Kern %>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_Kern

auc_Kern <- results_Kern %>% 
  roc_auc(GDDiag, .pred_No)
KernMET<-list(auc_Kern,ev_met1_Kern, Rec_Kern, ACC_Kern)
kable(KernMET)

.metric .estimator .estimate roc_auc binary 0.708

.metric .estimator .estimate ppv binary 0.68 f_meas binary 0.63

.metric .estimator .estimate recall binary 0.586

.metric .estimator .estimate accuracy binary 0.655

KernMETCurVe<-list(KernMET, curve_LR)
KernMETCurVe

## [[1]]
## [[1]][[1]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.708
## 
## [[1]][[2]]
## # A tibble: 2 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 ppv     binary         0.68 
## 2 f_meas  binary         0.630
## 
## [[1]][[3]]
## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 recall  binary         0.586
## 
## [[1]][[4]]
## # A tibble: 1 x 3
##   .metric  .estimator .estimate
##   <chr>    <chr>          <dbl>
## 1 accuracy binary         0.655
## 
## 
## [[2]]

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)

set.seed(123)
#xgb_tree

#creating a tuning model
tune_xgb_t <- boost_tree(
  trees = 1000,
  tree_depth = tune(), min_n = tune(),
  loss_reduction = tune(),                     ## first three: model complexity
  sample_size = tune(), mtry = tune(),         ## randomness
  learn_rate = tune()                          ## step size
) %>%
  set_engine("xgboost") %>%
  set_mode("classification")


#creating a tuning workflow
xgb_workflow_T<-workflow()%>% 
  add_recipe(GD_rec) %>% 
  add_model(tune_xgb_t)
#calling the workflow
xgb_workflow_T

## == Workflow ====================================================================
## Preprocessor: Recipe
## Model: boost_tree()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## Boosted Tree Model Specification (classification)
## 
## Main Arguments:
##   mtry = tune()
##   trees = 1000
##   min_n = tune()
##   tree_depth = tune()
##   learn_rate = tune()
##   loss_reduction = tune()
##   sample_size = tune()
## 
## Computational engine: xgboost

set.seed(345)
echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)

xgb_grid <- grid_latin_hypercube(
  tree_depth(),
  min_n(),
  loss_reduction(),
  sample_size = sample_prop(),
  finalize(mtry(), train_data_GD_b),
  learn_rate(),
  size = 30
)

xgb_res<- tune_grid(
  xgb_workflow_T,
  resamples = train_boot,
  grid = xgb_grid)

## Warning: package 'xgboost' was built under R version 4.1.3

xgb_res

## # Tuning results
## # Bootstrap sampling using stratification 
## # A tibble: 25 x 4
##    splits            id          .metrics           .notes          
##    <list>            <chr>       <list>             <list>          
##  1 <split [464/163]> Bootstrap01 <tibble [60 x 10]> <tibble [0 x 3]>
##  2 <split [464/170]> Bootstrap02 <tibble [60 x 10]> <tibble [0 x 3]>
##  3 <split [464/169]> Bootstrap03 <tibble [60 x 10]> <tibble [0 x 3]>
##  4 <split [464/170]> Bootstrap04 <tibble [60 x 10]> <tibble [0 x 3]>
##  5 <split [464/166]> Bootstrap05 <tibble [60 x 10]> <tibble [0 x 3]>
##  6 <split [464/166]> Bootstrap06 <tibble [60 x 10]> <tibble [0 x 3]>
##  7 <split [464/179]> Bootstrap07 <tibble [60 x 10]> <tibble [0 x 3]>
##  8 <split [464/170]> Bootstrap08 <tibble [60 x 10]> <tibble [0 x 3]>
##  9 <split [464/171]> Bootstrap09 <tibble [60 x 10]> <tibble [0 x 3]>
## 10 <split [464/172]> Bootstrap10 <tibble [60 x 10]> <tibble [0 x 3]>
## # i 15 more rows

set.seed(345)
echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)

set.seed(123)
xgb_res%>% 
  collect_metrics() %>% 
  slice_head(n = 10)

## # A tibble: 10 x 12
##     mtry min_n tree_depth    learn_rate loss_reduction sample_size .metric 
##    <int> <int>      <int>         <dbl>          <dbl>       <dbl> <chr>   
##  1     3    29          5 0.0000000133   0.000000749         0.674 accuracy
##  2     3    29          5 0.0000000133   0.000000749         0.674 roc_auc 
##  3     1    12         10 0.00000000155  0.00000000245       0.898 accuracy
##  4     1    12         10 0.00000000155  0.00000000245       0.898 roc_auc 
##  5     5     7          5 0.0000137      0.0000000203        0.372 accuracy
##  6     5     7          5 0.0000137      0.0000000203        0.372 roc_auc 
##  7     1     3         11 0.00268        0.495               0.336 accuracy
##  8     1     3         11 0.00268        0.495               0.336 roc_auc 
##  9     2    16         13 0.0000547      0.0229              0.955 accuracy
## 10     2    16         13 0.0000547      0.0229              0.955 roc_auc 
## # i 5 more variables: .estimator <chr>, mean <dbl>, n <int>, std_err <dbl>,
## #   .config <chr>

set.seed(345)
echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)

best_xgb <- xgb_res%>% 
  select_best("accuracy")
best_xgb

## # A tibble: 1 x 7
##    mtry min_n tree_depth learn_rate loss_reduction sample_size .config          
##   <int> <int>      <int>      <dbl>          <dbl>       <dbl> <chr>            
## 1     1     3         11    0.00268          0.495       0.336 Preprocessor1_Mo~

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Finalize the workoflow with the best model
final_wflow_xgb <- xgb_workflow_T %>% 
  finalize_workflow(best_xgb)
#Check the fit of the final Wflow on the training data
Tuned_xgb_fit<-final_wflow_xgb%>%fit(train_data_GD_b)
Tuned_xgb_fit

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: boost_tree()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## ##### xgb.Booster
## raw: 1.1 Mb 
## call:
##   xgboost::xgb.train(params = list(eta = 0.00268278907334154, max_depth = 11L, 
##     gamma = 0.495432291801306, colsample_bytree = 1, colsample_bynode = 0.2, 
##     min_child_weight = 3L, subsample = 0.335622152439319), data = x$data, 
##     nrounds = 1000, watchlist = x$watchlist, verbose = 0, nthread = 1, 
##     objective = "binary:logistic")
## params (as set within xgb.train):
##   eta = "0.00268278907334154", max_depth = "11", gamma = "0.495432291801306", colsample_bytree = "1", colsample_bynode = "0.2", min_child_weight = "3", subsample = "0.335622152439319", nthread = "1", objective = "binary:logistic", validate_parameters = "TRUE"
## xgb.attributes:
##   niter
## callbacks:
##   cb.evaluation.log()
## # of features: 5 
## niter: 1000
## nfeatures : 5 
## evaluation_log:
##     iter training_logloss
##        1            0.692
##        2            0.692
## ---                      
##      999            0.435
##     1000            0.435

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Test the tuned AI on the test data
results_tuned_xgb<-test_data_GD_b %>% select(GDDiag) %>% 
  bind_cols (Tuned_xgb_fit%>% 
              predict(new_data = test_data_GD_b)) %>% 
  bind_cols(Tuned_xgb_fit%>% 
              predict(new_data = test_data_GD_b, type = "prob"))
kable(results_tuned_xgb)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	Yes	0.366	0.634
No	No	0.752	0.248
No	Yes	0.347	0.653
No	Yes	0.493	0.507
No	Yes	0.297	0.703
No	No	0.703	0.297
No	Yes	0.393	0.607
No	Yes	0.377	0.623
No	Yes	0.387	0.613
No	No	0.511	0.489
No	No	0.833	0.167
No	Yes	0.425	0.575
No	Yes	0.481	0.519
No	No	0.688	0.312
No	No	0.610	0.390
No	No	0.531	0.469
No	No	0.901	0.099
No	No	0.786	0.214
No	Yes	0.328	0.672
No	No	0.857	0.143
No	No	0.800	0.200
No	No	0.774	0.226
No	Yes	0.341	0.659
No	Yes	0.445	0.555
No	No	0.796	0.204
No	No	0.683	0.317
No	No	0.568	0.432
No	No	0.812	0.188
No	Yes	0.439	0.561
No	No	0.773	0.227
No	No	0.511	0.489
No	No	0.709	0.291
No	No	0.744	0.256
No	No	0.856	0.144
No	No	0.720	0.280
No	No	0.531	0.469
No	No	0.766	0.234
No	No	0.707	0.293
No	No	0.883	0.117
No	Yes	0.304	0.696
No	No	0.653	0.347
No	No	0.789	0.211
No	No	0.707	0.293
No	No	0.901	0.099
No	No	0.882	0.118
No	Yes	0.334	0.666
No	No	0.523	0.477
No	No	0.738	0.262
No	No	0.857	0.143
No	Yes	0.471	0.529
No	No	0.635	0.365
No	No	0.741	0.259
No	No	0.752	0.248
No	Yes	0.317	0.683
No	No	0.822	0.178
No	No	0.526	0.474
No	No	0.596	0.404
No	Yes	0.477	0.523
Yes	Yes	0.472	0.528
Yes	No	0.663	0.337
Yes	Yes	0.375	0.625
Yes	No	0.784	0.216
Yes	No	0.731	0.269
Yes	No	0.600	0.400
Yes	No	0.527	0.473
Yes	Yes	0.470	0.530
Yes	Yes	0.352	0.648
Yes	No	0.567	0.433
Yes	Yes	0.322	0.678
Yes	Yes	0.230	0.770
Yes	Yes	0.297	0.703
Yes	Yes	0.261	0.739
Yes	Yes	0.352	0.648
Yes	Yes	0.378	0.622
Yes	Yes	0.307	0.693
Yes	Yes	0.431	0.569
Yes	Yes	0.316	0.684
Yes	Yes	0.281	0.719
Yes	Yes	0.256	0.744
Yes	Yes	0.281	0.719
Yes	Yes	0.297	0.703
Yes	Yes	0.319	0.681
Yes	Yes	0.281	0.719
Yes	Yes	0.191	0.809
Yes	Yes	0.320	0.680
Yes	Yes	0.448	0.552
Yes	No	0.504	0.496
Yes	No	0.758	0.242
Yes	Yes	0.406	0.594
Yes	Yes	0.427	0.573
Yes	No	0.545	0.455
Yes	Yes	0.472	0.528
Yes	Yes	0.156	0.844
Yes	Yes	0.417	0.583
Yes	Yes	0.316	0.684
Yes	Yes	0.434	0.566
Yes	Yes	0.402	0.598
Yes	Yes	0.218	0.782
Yes	Yes	0.225	0.775
Yes	Yes	0.383	0.617
Yes	Yes	0.173	0.827
Yes	Yes	0.278	0.722
Yes	No	0.689	0.311
Yes	Yes	0.366	0.634
Yes	Yes	0.412	0.588
Yes	Yes	0.156	0.844
Yes	Yes	0.230	0.770
Yes	Yes	0.245	0.755
Yes	Yes	0.281	0.719
Yes	Yes	0.287	0.713
Yes	Yes	0.313	0.687
Yes	Yes	0.353	0.647
Yes	Yes	0.249	0.751
Yes	Yes	0.242	0.758
Yes	Yes	0.241	0.759
Yes	Yes	0.217	0.783

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)

#Tuned xgb_Results
results_tuned_xgb %>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction No Yes
##        No  40  10
##        Yes 18  48

#visualise 
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_tuned_xgb %>% 
  conf_mat(GDDiag, .pred_class) %>% 
  autoplot()

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Plot Roc_Curve
curve_xgb_tuned <- results_tuned_xgb%>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_xgb_tuned

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
# Evaluate ROC_AUC
auc_xgb_tuned <- results_tuned_xgb %>% 
  roc_auc(GDDiag, .pred_No)
auc_xgb_tuned

## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.850

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
ev_met1_Tunxgb<-ev_met1(results_tuned_xgb,truth = GDDiag, estimate = .pred_class)
Rec_Txgb<-yardstick::recall(results_tuned_xgb, GDDiag, .pred_class)
ACC_Txgb<-yardstick::accuracy(results_tuned_xgb, GDDiag, .pred_class)
TunxgbMET<-list(auc_xgb_tuned,ev_met1_Tunxgb, Rec_Txgb, ACC_Txgb)
kable(TunxgbMET)

.metric .estimator .estimate roc_auc binary 0.85

.metric .estimator .estimate ppv binary 0.800 f_meas binary 0.741

.metric .estimator .estimate recall binary 0.69

.metric .estimator .estimate accuracy binary 0.759

Tune Lasso

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)

set.seed(123)
#Logistic Regression

#Creating a tuning model
tune_LR <- logistic_reg(penalty = tune(), mixture = tune())%>% 
  set_mode("classification")%>%
  set_engine("glmnet")


#Creating a tuning workflow
LR_workflow_T<-workflow()%>% 
  add_recipe(GD_rec) %>% 
  add_model(tune_LR)
#Calling the workflow
LR_workflow_T

## == Workflow ====================================================================
## Preprocessor: Recipe
## Model: logistic_reg()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## Logistic Regression Model Specification (classification)
## 
## Main Arguments:
##   penalty = tune()
##   mixture = tune()
## 
## Computational engine: glmnet

set.seed(345)
echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)

LR_grid <- grid_regular(parameters(tune_LR), levels = 20)

## Warning: `parameters.model_spec()` was deprecated in tune 0.1.6.9003.
## i Please use `hardhat::extract_parameter_set_dials()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

LR_res<- tune_grid(
  LR_workflow_T,
  resamples = train_boot,
  grid = LR_grid)

## Warning: package 'glmnet' was built under R version 4.1.3

## Warning: package 'Matrix' was built under R version 4.1.3

LR_res

## # Tuning results
## # Bootstrap sampling using stratification 
## # A tibble: 25 x 4
##    splits            id          .metrics           .notes          
##    <list>            <chr>       <list>             <list>          
##  1 <split [464/163]> Bootstrap01 <tibble [800 x 6]> <tibble [0 x 3]>
##  2 <split [464/170]> Bootstrap02 <tibble [800 x 6]> <tibble [0 x 3]>
##  3 <split [464/169]> Bootstrap03 <tibble [800 x 6]> <tibble [0 x 3]>
##  4 <split [464/170]> Bootstrap04 <tibble [800 x 6]> <tibble [0 x 3]>
##  5 <split [464/166]> Bootstrap05 <tibble [800 x 6]> <tibble [0 x 3]>
##  6 <split [464/166]> Bootstrap06 <tibble [800 x 6]> <tibble [0 x 3]>
##  7 <split [464/179]> Bootstrap07 <tibble [800 x 6]> <tibble [0 x 3]>
##  8 <split [464/170]> Bootstrap08 <tibble [800 x 6]> <tibble [0 x 3]>
##  9 <split [464/171]> Bootstrap09 <tibble [800 x 6]> <tibble [0 x 3]>
## 10 <split [464/172]> Bootstrap10 <tibble [800 x 6]> <tibble [0 x 3]>
## # i 15 more rows

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)

set.seed(123)
LR_res%>% 
  collect_metrics() %>% 
  slice_head(n = 10)

## # A tibble: 10 x 8
##     penalty mixture .metric  .estimator  mean     n std_err .config             
##       <dbl>   <dbl> <chr>    <chr>      <dbl> <int>   <dbl> <chr>               
##  1 1   e-10    0.05 accuracy binary     0.715    25 0.00533 Preprocessor1_Model~
##  2 1   e-10    0.05 roc_auc  binary     0.762    25 0.00541 Preprocessor1_Model~
##  3 3.36e-10    0.05 accuracy binary     0.715    25 0.00533 Preprocessor1_Model~
##  4 3.36e-10    0.05 roc_auc  binary     0.762    25 0.00541 Preprocessor1_Model~
##  5 1.13e- 9    0.05 accuracy binary     0.715    25 0.00533 Preprocessor1_Model~
##  6 1.13e- 9    0.05 roc_auc  binary     0.762    25 0.00541 Preprocessor1_Model~
##  7 3.79e- 9    0.05 accuracy binary     0.715    25 0.00533 Preprocessor1_Model~
##  8 3.79e- 9    0.05 roc_auc  binary     0.762    25 0.00541 Preprocessor1_Model~
##  9 1.27e- 8    0.05 accuracy binary     0.715    25 0.00533 Preprocessor1_Model~
## 10 1.27e- 8    0.05 roc_auc  binary     0.762    25 0.00541 Preprocessor1_Model~

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
best_LR <- LR_res %>% 
  select_best("accuracy")
best_LR

## # A tibble: 1 x 3
##   penalty mixture .config               
##     <dbl>   <dbl> <chr>                 
## 1  0.0264    0.35 Preprocessor1_Model137

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Finalize the workoflow with the best model
final_wflow_LR <- LR_workflow_T %>% 
  finalize_workflow(best_LR)
#Check the fit of the final Wflow on the training data
Tuned_LR_fit<-final_wflow_LR%>%fit(train_data_GD_b)
Tuned_LR_fit

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: logistic_reg()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## 
## Call:  glmnet::glmnet(x = maybe_matrix(x), y = y, family = "binomial",      alpha = ~0.35) 
## 
##    Df  %Dev Lambda
## 1   0  0.00  0.592
## 2   1  0.90  0.539
## 3   1  1.78  0.492
## 4   1  2.63  0.448
## 5   1  3.46  0.408
## 6   2  4.36  0.372
## 7   2  5.48  0.339
## 8   2  6.53  0.309
## 9   2  7.52  0.281
## 10  2  8.45  0.256
## 11  2  9.31  0.234
## 12  2 10.11  0.213
## 13  2 10.84  0.194
## 14  3 11.54  0.177
## 15  3 12.21  0.161
## 16  3 12.82  0.147
## 17  3 13.38  0.134
## 18  3 13.87  0.122
## 19  3 14.32  0.111
## 20  3 14.73  0.101
## 21  3 15.09  0.092
## 22  3 15.41  0.084
## 23  3 15.70  0.076
## 24  3 15.95  0.070
## 25  3 16.17  0.064
## 26  3 16.37  0.058
## 27  3 16.54  0.053
## 28  3 16.70  0.048
## 29  4 16.85  0.044
## 30  4 16.98  0.040
## 31  4 17.09  0.036
## 32  4 17.19  0.033
## 33  4 17.28  0.030
## 34  4 17.35  0.028
## 35  4 17.42  0.025
## 36  4 17.47  0.023
## 37  4 17.52  0.021
## 38  4 17.56  0.019
## 39  4 17.60  0.017
## 40  4 17.63  0.016
## 41  4 17.65  0.014
## 42  4 17.67  0.013
## 43  4 17.69  0.012
## 44  4 17.71  0.011
## 45  4 17.72  0.010
## 46  4 17.73  0.009
## 
## ...
## and 15 more lines.

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Test the tuned AI on the test data
results_tuned_LR<-test_data_GD_b %>% select(GDDiag) %>% 
  bind_cols (Tuned_LR_fit%>% 
              predict(new_data = test_data_GD_b)) %>% 
  bind_cols(Tuned_LR_fit%>% 
              predict(new_data = test_data_GD_b, type = "prob"))
kable(results_tuned_LR)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	Yes	0.271	0.729
No	No	0.681	0.319
No	Yes	0.349	0.651
No	Yes	0.470	0.530
No	Yes	0.435	0.565
No	No	0.660	0.340
No	Yes	0.415	0.585
No	Yes	0.217	0.783
No	Yes	0.394	0.606
No	Yes	0.431	0.569
No	No	0.789	0.211
No	Yes	0.295	0.705
No	No	0.600	0.400
No	No	0.507	0.493
No	Yes	0.494	0.506
No	Yes	0.456	0.544
No	No	0.884	0.116
No	No	0.820	0.180
No	Yes	0.446	0.554
No	No	0.856	0.144
No	No	0.799	0.201
No	No	0.783	0.217
No	Yes	0.167	0.833
No	No	0.516	0.484
No	No	0.804	0.196
No	No	0.678	0.322
No	No	0.632	0.368
No	No	0.794	0.206
No	No	0.562	0.438
No	No	0.764	0.236
No	Yes	0.431	0.569
No	No	0.684	0.316
No	No	0.779	0.221
No	No	0.837	0.163
No	No	0.684	0.316
No	Yes	0.456	0.544
No	No	0.732	0.268
No	No	0.669	0.331
No	No	0.720	0.280
No	Yes	0.118	0.882
No	No	0.594	0.406
No	No	0.725	0.275
No	No	0.669	0.331
No	No	0.884	0.116
No	No	0.935	0.065
No	Yes	0.241	0.759
No	No	0.539	0.461
No	No	0.741	0.259
No	No	0.860	0.140
No	Yes	0.392	0.608
No	Yes	0.364	0.636
No	No	0.637	0.363
No	No	0.681	0.319
No	Yes	0.232	0.768
No	No	0.590	0.410
No	Yes	0.405	0.595
No	No	0.682	0.318
No	No	0.528	0.472
Yes	Yes	0.476	0.524
Yes	No	0.557	0.443
Yes	No	0.596	0.404
Yes	No	0.729	0.271
Yes	No	0.586	0.414
Yes	Yes	0.480	0.520
Yes	No	0.517	0.483
Yes	Yes	0.117	0.883
Yes	Yes	0.484	0.516
Yes	Yes	0.422	0.578
Yes	Yes	0.077	0.923
Yes	Yes	0.244	0.756
Yes	Yes	0.481	0.519
Yes	Yes	0.346	0.654
Yes	No	0.504	0.496
Yes	Yes	0.425	0.575
Yes	Yes	0.411	0.589
Yes	No	0.533	0.467
Yes	Yes	0.476	0.524
Yes	Yes	0.387	0.613
Yes	No	0.571	0.429
Yes	Yes	0.447	0.553
Yes	Yes	0.472	0.528
Yes	Yes	0.496	0.504
Yes	Yes	0.390	0.610
Yes	Yes	0.332	0.668
Yes	Yes	0.266	0.734
Yes	No	0.585	0.415
Yes	No	0.641	0.359
Yes	No	0.719	0.281
Yes	No	0.613	0.387
Yes	No	0.611	0.389
Yes	No	0.598	0.402
Yes	No	0.518	0.482
Yes	Yes	0.458	0.542
Yes	No	0.631	0.369
Yes	No	0.607	0.393
Yes	Yes	0.465	0.535
Yes	Yes	0.450	0.550
Yes	Yes	0.266	0.734
Yes	Yes	0.309	0.691
Yes	Yes	0.452	0.548
Yes	Yes	0.419	0.581
Yes	Yes	0.128	0.872
Yes	No	0.778	0.222
Yes	Yes	0.400	0.600
Yes	Yes	0.318	0.682
Yes	Yes	0.392	0.608
Yes	Yes	0.333	0.667
Yes	Yes	0.374	0.626
Yes	Yes	0.280	0.720
Yes	Yes	0.185	0.815
Yes	Yes	0.291	0.709
Yes	Yes	0.454	0.546
Yes	Yes	0.239	0.761
Yes	Yes	0.209	0.791
Yes	Yes	0.103	0.897
Yes	Yes	0.192	0.808

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Tuned Results
results_tuned_LR %>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction No Yes
##        No  37  18
##        Yes 21  40

#visualise 
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_tuned_LR %>% 
  conf_mat(GDDiag, .pred_class) %>% 
  autoplot()

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Plot Roc_Curve
curve_LR_tuned <- results_tuned_LR%>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_LR_tuned

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
# Evaluate ROC_AUC
auc_LR_tuned <- results_tuned_LR %>% 
  roc_auc(GDDiag, .pred_No)
auc_LR_tuned

## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.720

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
ev_met1_TunLR<-ev_met1(results_tuned_LR,truth = GDDiag, estimate = .pred_class)
Rec_TLR<-yardstick::recall(results_tuned_LR, GDDiag, .pred_class)
ACC_TLR<-yardstick::accuracy(results_tuned_LR, GDDiag, .pred_class)
TunLRMET<-list(auc_LR_tuned,ev_met1_TunLR, Rec_TLR, ACC_TLR)
kable(TunLRMET)

.metric .estimator .estimate roc_auc binary 0.72

.metric .estimator .estimate ppv binary 0.673 f_meas binary 0.655

.metric .estimator .estimate recall binary 0.638

.metric .estimator .estimate accuracy binary 0.664

Tune Naive Bayes

set.seed(123)
#Naive Bayes

#Creating a tuning model
tune_NB <- naive_Bayes(smoothness = tune(), Laplace = tune ())%>% 
  set_mode("classification")%>%
  set_engine("naivebayes")


#Creating a tuning workflow
NB_workflow_T<-workflow()%>% 
  add_recipe(GD_rec) %>% 
  add_model(tune_NB)
#Calling the workflow
NB_workflow_T

## == Workflow ====================================================================
## Preprocessor: Recipe
## Model: naive_Bayes()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## Naive Bayes Model Specification (classification)
## 
## Main Arguments:
##   smoothness = tune()
##   Laplace = tune()
## 
## Computational engine: naivebayes

# Tuning/testing the workflow to the resamples
set.seed(345)
NB_grid <- grid_regular(parameters(tune_NB), levels = 20)

NB_res<- tune_grid(
  NB_workflow_T,
  resamples = train_boot,
  grid = NB_grid)

#Collect metrics
echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)

set.seed(123)
NB_res%>% 
  collect_metrics() %>% 
  slice_head(n = 10)

## # A tibble: 10 x 8
##    smoothness Laplace .metric  .estimator  mean     n std_err .config           
##         <dbl>   <dbl> <chr>    <chr>      <dbl> <int>   <dbl> <chr>             
##  1      0.5         0 accuracy binary     0.723    25 0.00711 Preprocessor1_Mod~
##  2      0.5         0 roc_auc  binary     0.774    25 0.00619 Preprocessor1_Mod~
##  3      0.553       0 accuracy binary     0.717    25 0.00729 Preprocessor1_Mod~
##  4      0.553       0 roc_auc  binary     0.774    25 0.00623 Preprocessor1_Mod~
##  5      0.605       0 accuracy binary     0.713    25 0.00642 Preprocessor1_Mod~
##  6      0.605       0 roc_auc  binary     0.773    25 0.00615 Preprocessor1_Mod~
##  7      0.658       0 accuracy binary     0.711    25 0.00563 Preprocessor1_Mod~
##  8      0.658       0 roc_auc  binary     0.771    25 0.00603 Preprocessor1_Mod~
##  9      0.711       0 accuracy binary     0.710    25 0.00509 Preprocessor1_Mod~
## 10      0.711       0 roc_auc  binary     0.770    25 0.00598 Preprocessor1_Mod~

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
best_NB <- NB_res %>% 
  select_best("accuracy")
best_NB

## # A tibble: 1 x 3
##   smoothness Laplace .config               
##        <dbl>   <dbl> <chr>                 
## 1        0.5       0 Preprocessor1_Model001

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Finalize the workoflow with the best model
final_wflow_NB <- NB_workflow_T %>% 
  finalize_workflow(best_NB)
#Check the fit of the final Wflow on the training data
Tuned_NB_fit<-final_wflow_NB%>%fit(train_data_GD_b)
Tuned_NB_fit

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: naive_Bayes()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## 
## ================================== Naive Bayes ================================== 
##  
##  Call: 
## naive_bayes.default(x = maybe_data_frame(x), y = y, laplace = ~0, 
##     usekernel = TRUE, adjust = ~0.5)
## 
## --------------------------------------------------------------------------------- 
##  
## Laplace smoothing: 0
## 
## --------------------------------------------------------------------------------- 
##  
##  A priori probabilities: 
## 
##  No Yes 
## 0.5 0.5 
## 
## --------------------------------------------------------------------------------- 
##  
##  Tables: 
## 
## --------------------------------------------------------------------------------- 
##  ::: AGE::No (KDE)
## --------------------------------------------------------------------------------- 
## 
## Call:
##  density.default(x = x, adjust = ..1, na.rm = TRUE)
## 
## Data: x (232 obs.);  Bandwidth 'bw' = 0.1489
## 
##        x               y        
##  Min.   :-2.07   Min.   :0.000  
##  1st Qu.:-0.70   1st Qu.:0.052  
##  Median : 0.68   Median :0.126  
##  Mean   : 0.68   Mean   :0.182  
##  3rd Qu.: 2.06   3rd Qu.:0.320  
##  Max.   : 3.43   Max.   :0.468  
## 
## --------------------------------------------------------------------------------- 
##  ::: AGE::Yes (KDE)
## --------------------------------------------------------------------------------- 
## 
## Call:
##  density.default(x = x, adjust = ..1, na.rm = TRUE)
## 
## Data: x (232 obs.);  Bandwidth 'bw' = 0.1196
## 
##        x                y        
##  Min.   :-1.984   Min.   :0.000  
## 
## ...
## and 144 more lines.

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Test the tuned AI on the test data
results_tuned_NB<-test_data_GD_b %>% select(GDDiag) %>% 
  bind_cols (Tuned_NB_fit%>% 
              predict(new_data = test_data_GD_b)) %>% 
  bind_cols(Tuned_NB_fit%>% 
              predict(new_data = test_data_GD_b, type = "prob"))
kable(results_tuned_NB)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	Yes	0.265	0.735
No	No	0.813	0.187
No	Yes	0.170	0.830
No	No	0.947	0.053
No	Yes	0.089	0.911
No	No	0.625	0.375
No	Yes	0.386	0.614
No	Yes	0.104	0.896
No	Yes	0.232	0.768
No	No	0.664	0.336
No	No	0.897	0.103
No	Yes	0.322	0.678
No	Yes	0.296	0.704
No	Yes	0.483	0.517
No	Yes	0.427	0.573
No	No	0.703	0.297
No	No	0.999	0.001
No	No	1.000	0.000
No	Yes	0.092	0.908
No	No	0.997	0.003
No	No	0.954	0.046
No	No	0.947	0.053
No	Yes	0.252	0.748
No	Yes	0.025	0.975
No	No	0.837	0.163
No	No	0.621	0.379
No	Yes	0.322	0.678
No	No	0.998	0.002
No	Yes	0.328	0.672
No	No	0.859	0.141
No	No	0.664	0.336
No	No	0.864	0.136
No	No	0.801	0.199
No	No	1.000	0.000
No	No	0.867	0.133
No	No	0.703	0.297
No	No	0.779	0.221
No	No	0.541	0.459
No	No	0.924	0.076
No	Yes	0.034	0.966
No	No	0.735	0.265
No	No	0.764	0.236
No	No	0.541	0.459
No	No	0.999	0.001
No	No	1.000	0.000
No	Yes	0.065	0.935
No	No	0.667	0.333
No	No	0.886	0.114
No	No	1.000	0.000
No	No	0.969	0.031
No	No	0.613	0.387
No	No	0.606	0.394
No	No	0.813	0.187
No	Yes	0.162	0.838
No	No	0.876	0.124
No	Yes	0.160	0.840
No	No	0.665	0.335
No	Yes	0.084	0.916
Yes	Yes	0.389	0.611
Yes	No	0.569	0.431
Yes	Yes	0.249	0.751
Yes	No	0.784	0.216
Yes	No	0.811	0.189
Yes	Yes	0.433	0.567
Yes	Yes	0.412	0.588
Yes	Yes	0.060	0.940
Yes	Yes	0.312	0.688
Yes	Yes	0.199	0.801
Yes	Yes	0.007	0.993
Yes	Yes	0.105	0.895
Yes	Yes	0.327	0.673
Yes	Yes	0.254	0.746
Yes	Yes	0.334	0.666
Yes	No	0.529	0.471
Yes	No	0.566	0.434
Yes	No	0.571	0.429
Yes	Yes	0.251	0.749
Yes	Yes	0.229	0.771
Yes	Yes	0.191	0.809
Yes	Yes	0.148	0.852
Yes	Yes	0.250	0.750
Yes	Yes	0.325	0.675
Yes	Yes	0.234	0.766
Yes	Yes	0.189	0.811
Yes	Yes	0.268	0.732
Yes	Yes	0.319	0.681
Yes	No	0.511	0.489
Yes	No	0.757	0.243
Yes	Yes	0.332	0.668
Yes	Yes	0.363	0.637
Yes	No	0.586	0.414
Yes	Yes	0.252	0.748
Yes	Yes	0.130	0.870
Yes	Yes	0.369	0.631
Yes	Yes	0.271	0.729
Yes	Yes	0.176	0.824
Yes	Yes	0.234	0.766
Yes	Yes	0.072	0.928
Yes	Yes	0.129	0.871
Yes	Yes	0.179	0.821
Yes	Yes	0.081	0.919
Yes	Yes	0.093	0.907
Yes	No	0.791	0.209
Yes	Yes	0.192	0.808
Yes	Yes	0.418	0.582
Yes	Yes	0.071	0.929
Yes	Yes	0.114	0.886
Yes	Yes	0.172	0.828
Yes	Yes	0.055	0.945
Yes	Yes	0.190	0.810
Yes	Yes	0.126	0.874
Yes	Yes	0.162	0.838
Yes	Yes	0.045	0.955
Yes	Yes	0.334	0.666
Yes	Yes	0.207	0.793
Yes	Yes	0.055	0.945

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Tuned Results
results_tuned_NB %>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction No Yes
##        No  38  10
##        Yes 20  48

#visualise CF
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_tuned_NB %>% 
  conf_mat(GDDiag, .pred_class) %>% 
  autoplot()

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Plot Roc_Curve
curve_NB_tuned <- results_tuned_NB %>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_NB_tuned

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
# Evaluate ROC_AUC
auc_NB_tuned <- results_tuned_NB %>% 
  roc_auc(GDDiag, .pred_No)
auc_NB_tuned

## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.773

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
ev_met1_TunNB<-ev_met1(results_tuned_NB,truth = GDDiag, estimate = .pred_class)
Rec_TNB<-yardstick::recall(results_tuned_NB, GDDiag, .pred_class)
ACC_TNB<-yardstick::accuracy(results_tuned_NB, GDDiag, .pred_class)
TunNBMET<-list(auc_NB_tuned,ev_met1_TunNB, Rec_TNB, ACC_TNB)
kable(TunNBMET)

.metric .estimator .estimate roc_auc binary 0.773

.metric .estimator .estimate ppv binary 0.792 f_meas binary 0.717

.metric .estimator .estimate recall binary 0.655

.metric .estimator .estimate accuracy binary 0.741

Tune Random Forests

set.seed(123)
#RF

#creating the tuning model
ranger_spec_T <- rand_forest(
  mtry = tune(),
  trees = 1000,
  min_n = tune()
)%>%
  set_mode("classification")%>%
  set_engine("ranger")
#creating the tuning workflow
RF_workflow_T<-workflow() %>% 
  add_recipe(GD_rec) %>% 
  add_model(ranger_spec_T)
#calling the workflow
RF_workflow_T

## == Workflow ====================================================================
## Preprocessor: Recipe
## Model: rand_forest()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## Random Forest Model Specification (classification)
## 
## Main Arguments:
##   mtry = tune()
##   trees = 1000
##   min_n = tune()
## 
## Computational engine: ranger

# tuning/testing the workflow via the resamples
set.seed(345)
RF_res <- tune_grid(
  RF_workflow_T,
  resamples = train_boot,
  grid = 20
)

## i Creating pre-processing data to finalize unknown parameter: mtry

#collect and visualize tuning metrics
RF_res %>%
  collect_metrics() %>%
  filter(.metric == "accuracy") %>%
  select(mean, min_n, mtry) %>%
  pivot_longer(min_n:mtry,
    values_to = "value",
    names_to = "parameter"
  )%>%
  ggplot(aes(value, mean, color = parameter)) +
  geom_point(show.legend = FALSE) +
  facet_wrap(~parameter, scales = "free_x") +
  labs(x = NULL, y = "Accuracy")

#collecting tuning metrics
RF_res %>% 
  collect_metrics() %>% 
  slice_head(n = 10)

## # A tibble: 10 x 8
##     mtry min_n .metric  .estimator  mean     n std_err .config              
##    <int> <int> <chr>    <chr>      <dbl> <int>   <dbl> <chr>                
##  1     2    35 accuracy binary     0.823    25 0.00741 Preprocessor1_Model01
##  2     2    35 roc_auc  binary     0.907    25 0.00573 Preprocessor1_Model01
##  3     4    19 accuracy binary     0.850    25 0.00673 Preprocessor1_Model02
##  4     4    19 roc_auc  binary     0.923    25 0.00566 Preprocessor1_Model02
##  5     4    37 accuracy binary     0.815    25 0.00659 Preprocessor1_Model03
##  6     4    37 roc_auc  binary     0.898    25 0.00602 Preprocessor1_Model03
##  7     4    20 accuracy binary     0.845    25 0.00715 Preprocessor1_Model04
##  8     4    20 roc_auc  binary     0.921    25 0.00569 Preprocessor1_Model04
##  9     2    32 accuracy binary     0.828    25 0.00713 Preprocessor1_Model05
## 10     2    32 roc_auc  binary     0.912    25 0.00568 Preprocessor1_Model05

#show the best model
RF_res %>% 
  show_best("accuracy")

## # A tibble: 5 x 8
##    mtry min_n .metric  .estimator  mean     n std_err .config              
##   <int> <int> <chr>    <chr>      <dbl> <int>   <dbl> <chr>                
## 1     1     6 accuracy binary     0.886    25 0.00665 Preprocessor1_Model08
## 2     2     3 accuracy binary     0.883    25 0.00656 Preprocessor1_Model14
## 3     3     8 accuracy binary     0.874    25 0.00713 Preprocessor1_Model19
## 4     5     5 accuracy binary     0.873    25 0.00650 Preprocessor1_Model18
## 5     3    11 accuracy binary     0.868    25 0.00689 Preprocessor1_Model13

# Select best model hyperparameters
best_RF <- RF_res %>% 
  select_best("accuracy")
best_RF

## # A tibble: 1 x 3
##    mtry min_n .config              
##   <int> <int> <chr>                
## 1     1     6 Preprocessor1_Model08

#Finalize the workoflow with the best SVM
final_wflow_RF <- RF_workflow_T %>% 
  finalize_workflow(best_RF)
#Check the fit of the final Wflow on the training data
Tuned_RF_fit<-final_wflow_RF%>%fit(train_data_GD_b)
Tuned_RF_fit

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: rand_forest()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## Ranger result
## 
## Call:
##  ranger::ranger(x = maybe_data_frame(x), y = y, mtry = min_cols(~1L,      x), num.trees = ~1000, min.node.size = min_rows(~6L, x),      num.threads = 1, verbose = FALSE, seed = sample.int(10^5,          1), probability = TRUE) 
## 
## Type:                             Probability estimation 
## Number of trees:                  1000 
## Sample size:                      464 
## Number of independent variables:  5 
## Mtry:                             1 
## Target node size:                 6 
## Variable importance mode:         none 
## Splitrule:                        gini 
## OOB prediction error (Brier s.):  0.0765

#Test the tuned AI on the test data
results_tuned_RF<-test_data_GD_b %>% select(GDDiag) %>% 
  bind_cols (Tuned_RF_fit%>% 
              predict(new_data = test_data_GD_b)) %>% 
  bind_cols(Tuned_RF_fit%>% 
              predict(new_data = test_data_GD_b, type = "prob"))
kable(results_tuned_RF)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	No	0.754	0.246
No	No	0.865	0.135
No	No	0.511	0.489
No	Yes	0.438	0.562
No	Yes	0.428	0.572
No	No	0.967	0.033
No	No	0.533	0.467
No	No	0.704	0.296
No	No	0.511	0.489
No	No	0.599	0.401
No	No	0.956	0.044
No	No	0.818	0.182
No	No	0.736	0.264
No	No	0.677	0.323
No	No	0.903	0.097
No	No	0.843	0.157
No	No	0.984	0.016
No	No	0.853	0.147
No	No	0.636	0.364
No	No	0.971	0.029
No	No	0.937	0.063
No	No	0.864	0.136
No	No	0.810	0.190
No	No	0.520	0.480
No	No	0.935	0.065
No	No	0.787	0.213
No	No	0.664	0.336
No	No	0.947	0.053
No	Yes	0.313	0.687
No	No	0.769	0.231
No	No	0.599	0.401
No	No	0.773	0.227
No	No	0.909	0.091
No	No	0.967	0.033
No	No	0.911	0.089
No	No	0.843	0.157
No	No	0.901	0.099
No	No	0.751	0.249
No	No	0.968	0.032
No	Yes	0.404	0.596
No	No	0.765	0.235
No	No	0.921	0.079
No	No	0.751	0.249
No	No	0.984	0.016
No	No	0.977	0.023
No	Yes	0.453	0.547
No	No	0.511	0.489
No	No	0.869	0.131
No	No	0.976	0.024
No	No	0.799	0.201
No	No	0.804	0.196
No	No	0.868	0.132
No	No	0.865	0.135
No	No	0.639	0.361
No	No	0.951	0.049
No	No	0.722	0.278
No	No	0.740	0.260
No	No	0.557	0.443
Yes	Yes	0.339	0.661
Yes	No	0.617	0.383
Yes	Yes	0.379	0.621
Yes	No	0.729	0.271
Yes	No	0.826	0.174
Yes	No	0.519	0.481
Yes	No	0.657	0.343
Yes	Yes	0.435	0.565
Yes	Yes	0.280	0.720
Yes	No	0.576	0.424
Yes	Yes	0.381	0.619
Yes	Yes	0.216	0.784
Yes	Yes	0.161	0.839
Yes	Yes	0.100	0.900
Yes	Yes	0.244	0.756
Yes	Yes	0.268	0.732
Yes	Yes	0.138	0.862
Yes	Yes	0.444	0.556
Yes	Yes	0.176	0.824
Yes	Yes	0.106	0.894
Yes	Yes	0.153	0.847
Yes	Yes	0.163	0.837
Yes	Yes	0.156	0.844
Yes	Yes	0.082	0.918
Yes	Yes	0.105	0.895
Yes	Yes	0.061	0.939
Yes	Yes	0.194	0.806
Yes	Yes	0.490	0.510
Yes	Yes	0.332	0.668
Yes	No	0.706	0.294
Yes	Yes	0.361	0.639
Yes	Yes	0.145	0.855
Yes	Yes	0.407	0.593
Yes	Yes	0.319	0.681
Yes	Yes	0.117	0.883
Yes	Yes	0.081	0.919
Yes	Yes	0.171	0.829
Yes	Yes	0.131	0.869
Yes	Yes	0.147	0.853
Yes	Yes	0.102	0.898
Yes	Yes	0.143	0.857
Yes	Yes	0.188	0.812
Yes	Yes	0.153	0.847
Yes	Yes	0.091	0.909
Yes	Yes	0.396	0.604
Yes	Yes	0.281	0.719
Yes	Yes	0.189	0.811
Yes	Yes	0.033	0.967
Yes	Yes	0.054	0.946
Yes	Yes	0.108	0.892
Yes	Yes	0.116	0.884
Yes	Yes	0.247	0.753
Yes	Yes	0.083	0.917
Yes	Yes	0.130	0.870
Yes	Yes	0.056	0.944
Yes	Yes	0.165	0.835
Yes	Yes	0.118	0.882
Yes	Yes	0.102	0.898

`

#Tuned__Results
results_tuned_RF %>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction No Yes
##        No  53   7
##        Yes  5  51

#visualise 
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_tuned_RF %>% 
  conf_mat(GDDiag, .pred_class) %>% 
  autoplot()

#Plot Roc_Curve
curve_RF_tuned <- results_tuned_RF %>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_RF_tuned

# Evaluate ROC_AOC
auc_RF_tuned <- results_tuned_RF %>% 
  roc_auc(GDDiag, .pred_No)
ev_met1_TunRF<-ev_met1(results_tuned_RF,truth = GDDiag, estimate = .pred_class)
Rec_TRF<-yardstick::recall(results_tuned_RF, GDDiag, .pred_class)
ACC_TRF<-yardstick::accuracy(results_tuned_RF, GDDiag, .pred_class)
TunRFMET<-list(auc_RF_tuned,ev_met1_TunRF, Rec_TRF, ACC_TRF)
kable(TunRFMET)

.metric .estimator .estimate roc_auc binary 0.959

.metric .estimator .estimate ppv binary 0.883 f_meas binary 0.898

.metric .estimator .estimate recall binary 0.914

.metric .estimator .estimate accuracy binary 0.897

Tune Lasso

set.seed(123)
#LASSO

#creating a tuning model
tune_Lasso <- multinom_reg(penalty =tune(), mixture = 1)%>%
  set_mode("classification")%>%
  set_engine("glmnet")

#creating a tuning workflow
Lasso_workflow_T<-workflow()%>% 
  add_recipe(GD_rec) %>% 
  add_model(tune_Lasso)
#calling the workflow
Lasso_workflow_T

## == Workflow ====================================================================
## Preprocessor: Recipe
## Model: multinom_reg()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## Multinomial Regression Model Specification (classification)
## 
## Main Arguments:
##   penalty = tune()
##   mixture = 1
## 
## Computational engine: glmnet

set.seed(123)
lamda_grid <- grid_regular(penalty(), levels = 50)
lamda_grid

## # A tibble: 50 x 1
##     penalty
##       <dbl>
##  1 1   e-10
##  2 1.60e-10
##  3 2.56e-10
##  4 4.09e-10
##  5 6.55e-10
##  6 1.05e- 9
##  7 1.68e- 9
##  8 2.68e- 9
##  9 4.29e- 9
## 10 6.87e- 9
## # i 40 more rows

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
doParallel::registerDoParallel()

set.seed(123)
lasso_grid <- tune_grid(
  Lasso_workflow_T,
  resamples = train_boot,
  grid = lamda_grid)

lasso_grid %>%
  collect_metrics()

## # A tibble: 100 x 7
##     penalty .metric  .estimator  mean     n std_err .config              
##       <dbl> <chr>    <chr>      <dbl> <int>   <dbl> <chr>                
##  1 1   e-10 accuracy binary     0.714    25 0.00529 Preprocessor1_Model01
##  2 1   e-10 roc_auc  binary     0.763    25 0.00544 Preprocessor1_Model01
##  3 1.60e-10 accuracy binary     0.714    25 0.00529 Preprocessor1_Model02
##  4 1.60e-10 roc_auc  binary     0.763    25 0.00544 Preprocessor1_Model02
##  5 2.56e-10 accuracy binary     0.714    25 0.00529 Preprocessor1_Model03
##  6 2.56e-10 roc_auc  binary     0.763    25 0.00544 Preprocessor1_Model03
##  7 4.09e-10 accuracy binary     0.714    25 0.00529 Preprocessor1_Model04
##  8 4.09e-10 roc_auc  binary     0.763    25 0.00544 Preprocessor1_Model04
##  9 6.55e-10 accuracy binary     0.714    25 0.00529 Preprocessor1_Model05
## 10 6.55e-10 roc_auc  binary     0.763    25 0.00544 Preprocessor1_Model05
## # i 90 more rows

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
lasso_grid %>%
  collect_metrics() %>%
  ggplot(aes(penalty, mean, color = .metric)) +
  geom_errorbar(aes(
    ymin = mean - std_err,
    ymax = mean + std_err
  ),
  alpha = 0.5
  ) +
  geom_line(size = 1.5) +
  facet_wrap(~.metric, scales = "free", nrow = 2) +
  scale_x_log10() +
  theme(legend.position = "none")

## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## i Please use `linewidth` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
Best_Lasso <- lasso_grid%>%
  select_best("accuracy")
Best_Lasso

## # A tibble: 1 x 2
##   penalty .config              
##     <dbl> <chr>                
## 1 0.00569 Preprocessor1_Model39

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Finalize the workoflow with the best AI
final_wflow_Lasso <-Lasso_workflow_T%>%
  finalize_workflow(Best_Lasso)
#Check the fit of the final Wflow on the training data
Tuned_Lasso_fit<-final_wflow_Lasso%>%fit(train_data_GD_b)
Tuned_Lasso_fit

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: multinom_reg()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## 
## Call:  glmnet::glmnet(x = maybe_matrix(x), y = y, family = "multinomial",      alpha = ~1) 
## 
##    Df  %Dev Lambda
## 1   0  0.00 0.2070
## 2   1  2.11 0.1890
## 3   1  3.87 0.1720
## 4   1  5.35 0.1570
## 5   1  6.59 0.1430
## 6   1  7.65 0.1300
## 7   2  8.88 0.1190
## 8   2 10.14 0.1080
## 9   2 11.22 0.0984
## 10  2 12.14 0.0897
## 11  2 12.92 0.0817
## 12  2 13.59 0.0745
## 13  2 14.17 0.0679
## 14  2 14.66 0.0618
## 15  2 15.07 0.0563
## 16  2 15.43 0.0513
## 17  2 15.73 0.0468
## 18  2 15.99 0.0426
## 19  2 16.21 0.0388
## 20  3 16.42 0.0354
## 21  3 16.61 0.0322
## 22  3 16.78 0.0294
## 23  3 16.91 0.0268
## 24  3 17.03 0.0244
## 25  3 17.13 0.0222
## 26  3 17.21 0.0202
## 27  3 17.29 0.0184
## 28  4 17.35 0.0168
## 29  4 17.42 0.0153
## 30  4 17.48 0.0140
## 31  4 17.53 0.0127
## 32  4 17.58 0.0116
## 33  4 17.61 0.0106
## 34  4 17.64 0.0096
## 35  4 17.66 0.0088
## 36  4 17.69 0.0080
## 37  4 17.70 0.0073
## 38  4 17.72 0.0066
## 39  4 17.73 0.0060
## 40  4 17.74 0.0055
## 41  4 17.75 0.0050
## 42  4 17.75 0.0046
## 43  4 17.76 0.0042
## 44  4 17.77 0.0038
## 45  4 17.77 0.0035
## 46  4 17.77 0.0032
## 
## ...
## and 7 more lines.

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Test the tuned AI on the test data
results_tuned_Lasso<-test_data_GD_b%>% select(GDDiag) %>% 
  bind_cols(Tuned_Lasso_fit%>% 
              predict(new_data = test_data_GD_b)) %>% 
  bind_cols(Tuned_Lasso_fit%>% 
              predict(new_data = test_data_GD_b, type = "prob"))
kable(results_tuned_Lasso)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	Yes	0.250	0.750
No	No	0.723	0.277
No	Yes	0.333	0.667
No	Yes	0.472	0.528
No	Yes	0.429	0.571
No	No	0.681	0.319
No	Yes	0.402	0.598
No	Yes	0.195	0.805
No	Yes	0.380	0.620
No	Yes	0.420	0.580
No	No	0.816	0.184
No	Yes	0.274	0.726
No	No	0.612	0.388
No	No	0.501	0.499
No	Yes	0.486	0.514
No	Yes	0.446	0.554
No	No	0.907	0.093
No	No	0.860	0.140
No	Yes	0.442	0.558
No	No	0.887	0.113
No	No	0.824	0.176
No	No	0.812	0.188
No	Yes	0.138	0.862
No	No	0.534	0.466
No	No	0.831	0.169
No	No	0.701	0.299
No	No	0.646	0.354
No	No	0.829	0.171
No	No	0.567	0.433
No	No	0.791	0.209
No	Yes	0.420	0.580
No	No	0.702	0.298
No	No	0.804	0.196
No	No	0.870	0.130
No	No	0.706	0.294
No	Yes	0.446	0.554
No	No	0.759	0.241
No	No	0.687	0.313
No	No	0.739	0.261
No	Yes	0.094	0.906
No	No	0.610	0.390
No	No	0.758	0.242
No	No	0.687	0.313
No	No	0.907	0.093
No	No	0.954	0.046
No	Yes	0.220	0.780
No	No	0.550	0.450
No	No	0.771	0.229
No	No	0.892	0.108
No	Yes	0.395	0.605
No	Yes	0.341	0.659
No	No	0.649	0.351
No	No	0.723	0.277
No	Yes	0.207	0.793
No	No	0.596	0.404
No	Yes	0.385	0.615
No	No	0.715	0.285
No	No	0.543	0.457
Yes	Yes	0.473	0.527
Yes	No	0.561	0.439
Yes	No	0.606	0.394
Yes	No	0.748	0.252
Yes	No	0.591	0.409
Yes	Yes	0.470	0.530
Yes	No	0.526	0.474
Yes	Yes	0.092	0.908
Yes	Yes	0.482	0.518
Yes	Yes	0.411	0.589
Yes	Yes	0.055	0.945
Yes	Yes	0.216	0.784
Yes	Yes	0.480	0.520
Yes	Yes	0.326	0.674
Yes	Yes	0.500	0.500
Yes	Yes	0.409	0.591
Yes	Yes	0.394	0.606
Yes	No	0.534	0.466
Yes	Yes	0.476	0.524
Yes	Yes	0.377	0.623
Yes	No	0.581	0.419
Yes	Yes	0.435	0.565
Yes	Yes	0.461	0.539
Yes	Yes	0.495	0.505
Yes	Yes	0.380	0.620
Yes	Yes	0.307	0.693
Yes	Yes	0.235	0.765
Yes	No	0.599	0.401
Yes	No	0.652	0.348
Yes	No	0.737	0.263
Yes	No	0.623	0.377
Yes	No	0.622	0.378
Yes	No	0.608	0.392
Yes	No	0.527	0.473
Yes	Yes	0.452	0.548
Yes	No	0.643	0.357
Yes	No	0.621	0.379
Yes	Yes	0.467	0.533
Yes	Yes	0.449	0.551
Yes	Yes	0.244	0.756
Yes	Yes	0.291	0.709
Yes	Yes	0.456	0.544
Yes	Yes	0.409	0.591
Yes	Yes	0.103	0.897
Yes	No	0.809	0.191
Yes	Yes	0.397	0.603
Yes	Yes	0.303	0.697
Yes	Yes	0.379	0.621
Yes	Yes	0.310	0.690
Yes	Yes	0.354	0.646
Yes	Yes	0.264	0.736
Yes	Yes	0.153	0.847
Yes	Yes	0.272	0.728
Yes	Yes	0.458	0.542
Yes	Yes	0.228	0.772
Yes	Yes	0.177	0.823
Yes	Yes	0.076	0.924
Yes	Yes	0.162	0.838

#Tuned Results
results_tuned_Lasso %>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction No Yes
##        No  37  17
##        Yes 21  41

#visualise
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_tuned_Lasso %>% 
  conf_mat(GDDiag, .pred_class) %>% 
  autoplot()

#Plot Roc_Curve
curve_Lasso_tuned <- results_tuned_Lasso %>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_Lasso_tuned

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
# Evaluate ROC_AOC
auc_Lasso_tuned <- results_tuned_Lasso %>% 
  roc_auc(GDDiag, .pred_No)
auc_Lasso_tuned

## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.721

ev_met1_TunLasso<-ev_met1(results_tuned_Lasso,truth = GDDiag, estimate = .pred_class)
Rec_TLasso<-yardstick::recall(results_tuned_Lasso, GDDiag, .pred_class)
ACC_TLasso<-yardstick::accuracy(results_tuned_Lasso, GDDiag, .pred_class)
TunLassoMET<-list(auc_Lasso_tuned,ev_met1_TunLasso, Rec_TLasso, ACC_TLasso)
kable(TunLassoMET)

.metric .estimator .estimate roc_auc binary 0.721

.metric .estimator .estimate ppv binary 0.685 f_meas binary 0.661

.metric .estimator .estimate recall binary 0.638

.metric .estimator .estimate accuracy binary 0.672

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)

knn_model <- nearest_neighbor(neighbors = tune()) %>% 
             set_engine('kknn') %>% 
             set_mode('classification')

knn_wf <- workflow() %>% 
          add_model(knn_model) %>% 
          add_recipe(GD_rec)

k_grid <- tibble(neighbors = c(10, 15, 25, 45, 60, 80, 100, 120, 140, 180))

knn_tuning <- knn_wf %>% 
              tune_grid(resamples = train_boot,
                        grid = k_grid)

best_k <- knn_tuning %>% 
          select_best(metric = 'accuracy')

final_knn_wf <- knn_wf %>% 
                finalize_workflow(best_k)

Tuned_knn_fit<-final_knn_wf%>%fit(train_data_GD_b)
Tuned_knn_fit

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: nearest_neighbor()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## 
## Call:
## kknn::train.kknn(formula = ..y ~ ., data = data, ks = min_rows(10,     data, 5))
## 
## Type of response variable: nominal
## Minimal misclassification: 0.172
## Best kernel: optimal
## Best k: 10

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
results_tuned_knn<-test_data_GD_b%>% select(GDDiag) %>% 
  bind_cols(Tuned_knn_fit%>% 
              predict(new_data = test_data_GD_b)) %>% 
  bind_cols(Tuned_knn_fit%>% 
              predict(new_data = test_data_GD_b, type = "prob"))
kable(results_tuned_knn)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	Yes	0.493	0.507
No	No	1.000	0.000
No	Yes	0.250	0.750
No	Yes	0.460	0.540
No	Yes	0.378	0.622
No	No	1.000	0.000
No	Yes	0.205	0.795
No	Yes	0.444	0.556
No	Yes	0.437	0.563
No	Yes	0.250	0.750
No	No	1.000	0.000
No	No	0.558	0.442
No	No	1.000	0.000
No	Yes	0.156	0.844
No	No	0.647	0.353
No	No	0.553	0.447
No	No	1.000	0.000
No	No	1.000	0.000
No	No	0.608	0.392
No	No	1.000	0.000
No	No	1.000	0.000
No	No	1.000	0.000
No	No	0.560	0.440
No	Yes	0.311	0.689
No	No	1.000	0.000
No	Yes	0.060	0.940
No	No	0.859	0.141
No	No	1.000	0.000
No	Yes	0.029	0.971
No	No	0.945	0.055
No	Yes	0.250	0.750
No	No	1.000	0.000
No	No	1.000	0.000
No	No	1.000	0.000
No	No	0.940	0.060
No	No	0.553	0.447
No	No	0.810	0.190
No	Yes	0.258	0.742
No	No	1.000	0.000
No	Yes	0.444	0.556
No	No	0.635	0.365
No	No	1.000	0.000
No	Yes	0.258	0.742
No	No	1.000	0.000
No	No	1.000	0.000
No	Yes	0.243	0.757
No	Yes	0.000	1.000
No	No	0.851	0.149
No	No	1.000	0.000
No	No	0.717	0.283
No	Yes	0.325	0.675
No	No	0.993	0.007
No	No	1.000	0.000
No	No	0.587	0.413
No	Yes	0.475	0.525
No	Yes	0.414	0.586
No	No	0.602	0.398
No	Yes	0.353	0.647
Yes	Yes	0.271	0.729
Yes	Yes	0.469	0.531
Yes	Yes	0.029	0.971
Yes	Yes	0.370	0.630
Yes	Yes	0.320	0.680
Yes	Yes	0.464	0.536
Yes	No	0.562	0.438
Yes	Yes	0.170	0.830
Yes	Yes	0.096	0.904
Yes	Yes	0.178	0.822
Yes	Yes	0.270	0.730
Yes	Yes	0.007	0.993
Yes	Yes	0.007	0.993
Yes	Yes	0.055	0.945
Yes	Yes	0.317	0.683
Yes	Yes	0.127	0.873
Yes	Yes	0.096	0.904
Yes	No	0.536	0.464
Yes	Yes	0.000	1.000
Yes	Yes	0.000	1.000
Yes	Yes	0.305	0.695
Yes	Yes	0.226	0.774
Yes	Yes	0.464	0.536
Yes	Yes	0.007	0.993
Yes	Yes	0.000	1.000
Yes	Yes	0.176	0.824
Yes	Yes	0.000	1.000
Yes	Yes	0.288	0.712
Yes	Yes	0.168	0.832
Yes	Yes	0.370	0.630
Yes	Yes	0.159	0.841
Yes	Yes	0.187	0.813
Yes	Yes	0.094	0.906
Yes	Yes	0.130	0.870
Yes	Yes	0.273	0.727
Yes	Yes	0.142	0.858
Yes	Yes	0.045	0.955
Yes	Yes	0.055	0.945
Yes	Yes	0.029	0.971
Yes	Yes	0.197	0.803
Yes	Yes	0.060	0.940
Yes	Yes	0.067	0.933
Yes	Yes	0.000	1.000
Yes	Yes	0.000	1.000
Yes	Yes	0.135	0.865
Yes	Yes	0.000	1.000
Yes	Yes	0.000	1.000
Yes	Yes	0.029	0.971
Yes	Yes	0.007	0.993
Yes	Yes	0.094	0.906
Yes	Yes	0.276	0.724
Yes	Yes	0.000	1.000
Yes	Yes	0.116	0.884
Yes	Yes	0.067	0.933
Yes	Yes	0.007	0.993
Yes	Yes	0.116	0.884
Yes	Yes	0.060	0.940
Yes	Yes	0.075	0.925

#Tuned___Results
results_tuned_knn %>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction No Yes
##        No  36   2
##        Yes 22  56

#visualise 
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_tuned_knn %>% 
  conf_mat(GDDiag, .pred_class) %>% 
  autoplot()

#Plot Roc_Curve
curve_knn_tuned <- results_tuned_knn %>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_knn_tuned

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
# Evaluate ROC_AOC
auc_knn_tuned <- results_tuned_knn %>% 
  roc_auc(GDDiag, .pred_No)
auc_knn_tuned

## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.904

ev_met1_Tunknn<-ev_met1(results_tuned_knn,truth = GDDiag, estimate = .pred_class)
Rec_Tknn<-yardstick::recall(results_tuned_knn, GDDiag, .pred_class)
ACC_Tknn<-yardstick::accuracy(results_tuned_knn, GDDiag, .pred_class)
TunknnMET<-list(auc_knn_tuned,ev_met1_Tunknn, Rec_Tknn, ACC_Tknn)
kable(TunknnMET)

.metric .estimator .estimate roc_auc binary 0.904

.metric .estimator .estimate ppv binary 0.947 f_meas binary 0.750

.metric .estimator .estimate recall binary 0.621

.metric .estimator .estimate accuracy binary 0.793

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)

set.seed(123)


#creating a tuning model
svm_mod_T <-
  svm_rbf(cost = tune(), rbf_sigma = tune()) %>%
  set_mode("classification") %>%
  set_engine("kernlab")


#creating a tuning workflow
SVM_workflow_T<-workflow()%>% 
  add_recipe(GD_rec) %>% 
  add_model(svm_mod_T)
#calling the workflow
SVM_workflow_T

## == Workflow ====================================================================
## Preprocessor: Recipe
## Model: svm_rbf()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## Radial Basis Function Support Vector Machine Model Specification (classification)
## 
## Main Arguments:
##   cost = tune()
##   rbf_sigma = tune()
## 
## Computational engine: kernlab

set.seed(345)
echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)

SVM_grid <- grid_regular(cost(),rbf_sigma(), levels = 10)

SVM_res<- tune_grid(
  SVM_workflow_T,
  resamples = train_boot,
  grid = SVM_grid)


SVM_res

## # Tuning results
## # Bootstrap sampling using stratification 
## # A tibble: 25 x 4
##    splits            id          .metrics           .notes          
##    <list>            <chr>       <list>             <list>          
##  1 <split [464/163]> Bootstrap01 <tibble [200 x 6]> <tibble [0 x 3]>
##  2 <split [464/170]> Bootstrap02 <tibble [200 x 6]> <tibble [0 x 3]>
##  3 <split [464/169]> Bootstrap03 <tibble [200 x 6]> <tibble [0 x 3]>
##  4 <split [464/170]> Bootstrap04 <tibble [200 x 6]> <tibble [0 x 3]>
##  5 <split [464/166]> Bootstrap05 <tibble [200 x 6]> <tibble [0 x 3]>
##  6 <split [464/166]> Bootstrap06 <tibble [200 x 6]> <tibble [0 x 3]>
##  7 <split [464/179]> Bootstrap07 <tibble [200 x 6]> <tibble [0 x 3]>
##  8 <split [464/170]> Bootstrap08 <tibble [200 x 6]> <tibble [0 x 3]>
##  9 <split [464/171]> Bootstrap09 <tibble [200 x 6]> <tibble [0 x 3]>
## 10 <split [464/172]> Bootstrap10 <tibble [200 x 6]> <tibble [0 x 3]>
## # i 15 more rows

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)

set.seed(123)
SVM_res%>% 
  collect_metrics() %>% 
  slice_head(n = 10)

## # A tibble: 10 x 8
##        cost    rbf_sigma .metric  .estimator  mean     n std_err .config        
##       <dbl>        <dbl> <chr>    <chr>      <dbl> <int>   <dbl> <chr>          
##  1 0.000977 0.0000000001 accuracy binary     0.681    25 0.00677 Preprocessor1_~
##  2 0.000977 0.0000000001 roc_auc  binary     0.248    25 0.00540 Preprocessor1_~
##  3 0.00310  0.0000000001 accuracy binary     0.681    25 0.00677 Preprocessor1_~
##  4 0.00310  0.0000000001 roc_auc  binary     0.248    25 0.00540 Preprocessor1_~
##  5 0.00984  0.0000000001 accuracy binary     0.681    25 0.00677 Preprocessor1_~
##  6 0.00984  0.0000000001 roc_auc  binary     0.248    25 0.00540 Preprocessor1_~
##  7 0.0312   0.0000000001 accuracy binary     0.681    25 0.00677 Preprocessor1_~
##  8 0.0312   0.0000000001 roc_auc  binary     0.248    25 0.00540 Preprocessor1_~
##  9 0.0992   0.0000000001 accuracy binary     0.681    25 0.00677 Preprocessor1_~
## 10 0.0992   0.0000000001 roc_auc  binary     0.248    25 0.00540 Preprocessor1_~

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
best_SVM <- SVM_res %>% 
  select_best("accuracy")
best_SVM

## # A tibble: 1 x 3
##    cost rbf_sigma .config               
##   <dbl>     <dbl> <chr>                 
## 1    32         1 Preprocessor1_Model100

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Finalize the workoflow with the best model
final_wflow_SVM <- SVM_workflow_T %>% 
  finalize_workflow(best_SVM)
#Check the fit of the final Wflow on the training data
Tuned_SVM_fit<-final_wflow_SVM%>%fit(train_data_GD_b)
Tuned_SVM_fit

## == Workflow [trained] ==========================================================
## Preprocessor: Recipe
## Model: svm_rbf()
## 
## -- Preprocessor ----------------------------------------------------------------
## 4 Recipe Steps
## 
## * step_smote()
## * step_zv()
## * step_nzv()
## * step_corr()
## 
## -- Model -----------------------------------------------------------------------
## Support Vector Machine object of class "ksvm" 
## 
## SV type: C-svc  (classification) 
##  parameter : cost C = 32 
## 
## Gaussian Radial Basis kernel function. 
##  Hyperparameter : sigma =  1 
## 
## Number of Support Vectors : 194 
## 
## Objective Function Value : -420 
## Training error : 0 
## Probability model included.

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Test the tuned AI on the test data
results_tuned_SVM<-test_data_GD_b %>% select(GDDiag) %>% 
  bind_cols (Tuned_SVM_fit%>% 
              predict(new_data = test_data_GD_b)) %>% 
  bind_cols(Tuned_SVM_fit%>% 
              predict(new_data = test_data_GD_b, type = "prob"))
kable(results_tuned_SVM)

GDDiag	.pred_class	.pred_No	.pred_Yes
No	No	0.961	0.039
No	No	0.961	0.039
No	No	0.961	0.039
No	No	0.844	0.156
No	No	0.889	0.111
No	No	0.961	0.039
No	Yes	0.252	0.748
No	No	0.961	0.039
No	No	0.723	0.277
No	No	0.961	0.039
No	No	0.999	0.001
No	No	0.961	0.039
No	No	1.000	0.000
No	Yes	0.106	0.894
No	No	0.961	0.039
No	No	0.961	0.039
No	No	0.978	0.022
No	No	0.893	0.107
No	No	0.961	0.039
No	No	0.961	0.039
No	No	1.000	0.000
No	No	0.998	0.002
No	No	0.985	0.015
No	No	0.658	0.342
No	No	0.982	0.018
No	Yes	0.040	0.960
No	No	0.998	0.002
No	No	0.961	0.039
No	Yes	0.013	0.987
No	No	0.998	0.002
No	No	0.961	0.039
No	No	0.992	0.008
No	No	0.961	0.039
No	No	0.961	0.039
No	No	0.980	0.020
No	No	0.961	0.039
No	No	0.962	0.038
No	No	0.961	0.039
No	No	1.000	0.000
No	No	0.694	0.306
No	No	0.990	0.010
No	No	0.972	0.028
No	No	0.961	0.039
No	No	0.978	0.022
No	No	0.961	0.039
No	No	0.628	0.372
No	Yes	0.212	0.788
No	No	0.961	0.039
No	No	0.962	0.038
No	No	0.961	0.039
No	No	0.961	0.039
No	No	1.000	0.000
No	No	0.961	0.039
No	No	0.962	0.038
No	No	0.961	0.039
No	No	0.961	0.039
No	No	0.961	0.039
No	No	0.703	0.297
Yes	Yes	0.113	0.887
Yes	Yes	0.312	0.688
Yes	Yes	0.089	0.911
Yes	Yes	0.258	0.742
Yes	Yes	0.054	0.946
Yes	Yes	0.115	0.885
Yes	Yes	0.338	0.662
Yes	Yes	0.306	0.694
Yes	Yes	0.156	0.844
Yes	Yes	0.087	0.913
Yes	Yes	0.093	0.907
Yes	Yes	0.071	0.929
Yes	Yes	0.035	0.965
Yes	Yes	0.025	0.975
Yes	Yes	0.060	0.940
Yes	Yes	0.413	0.587
Yes	Yes	0.070	0.930
Yes	No	0.891	0.109
Yes	Yes	0.006	0.994
Yes	Yes	0.018	0.982
Yes	Yes	0.539	0.461
Yes	Yes	0.348	0.652
Yes	Yes	0.194	0.806
Yes	Yes	0.076	0.924
Yes	Yes	0.016	0.984
Yes	Yes	0.298	0.702
Yes	Yes	0.032	0.968
Yes	Yes	0.135	0.865
Yes	Yes	0.064	0.936
Yes	Yes	0.199	0.801
Yes	Yes	0.012	0.988
Yes	Yes	0.348	0.652
Yes	Yes	0.111	0.889
Yes	Yes	0.273	0.727
Yes	Yes	0.162	0.838
Yes	Yes	0.119	0.881
Yes	Yes	0.228	0.772
Yes	Yes	0.093	0.907
Yes	Yes	0.109	0.891
Yes	Yes	0.310	0.690
Yes	Yes	0.041	0.959
Yes	Yes	0.116	0.884
Yes	Yes	0.025	0.975
Yes	Yes	0.054	0.946
Yes	Yes	0.094	0.906
Yes	Yes	0.135	0.865
Yes	Yes	0.075	0.925
Yes	Yes	0.037	0.963
Yes	Yes	0.058	0.942
Yes	Yes	0.042	0.958
Yes	Yes	0.155	0.845
Yes	Yes	0.086	0.914
Yes	Yes	0.064	0.936
Yes	Yes	0.141	0.859
Yes	Yes	0.095	0.905
Yes	Yes	0.324	0.676
Yes	Yes	0.091	0.909
Yes	Yes	0.087	0.913

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Tuned Results
results_tuned_SVM %>% 
  conf_mat(truth = GDDiag, estimate = .pred_class)

##           Truth
## Prediction No Yes
##        No  53   1
##        Yes  5  57

#visualise 
update_geom_defaults(geom = "rect", new = list(fill = "midnightblue", alpha = 0.7))
results_tuned_SVM %>% 
  conf_mat(GDDiag, .pred_class) %>% 
  autoplot()

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
#Plot Roc_Curve
curve_SVM_tuned <- results_tuned_SVM%>% 
  roc_curve(GDDiag, .pred_No) %>% 
  autoplot
curve_SVM_tuned

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
# Evaluate ROC_AUC
auc_SVM_tuned <- results_tuned_SVM %>% 
  roc_auc(GDDiag, .pred_No)
auc_SVM_tuned

## # A tibble: 1 x 3
##   .metric .estimator .estimate
##   <chr>   <chr>          <dbl>
## 1 roc_auc binary         0.950

echo=FALSE
error=FALSE
warning=FALSE
options(scipen = 999, digits=3, max.print=999999, show.signif.stars=TRUE)
ev_met1_TunSVM<-ev_met1(results_tuned_SVM,truth = GDDiag, estimate = .pred_class)
Rec_TSVM<-yardstick::recall(results_tuned_SVM, GDDiag, .pred_class)
ACC_TSVM<-yardstick::accuracy(results_tuned_SVM, GDDiag, .pred_class)
TunSVMMET<-list(auc_SVM_tuned,ev_met1_TunSVM, Rec_TSVM, ACC_TSVM)
kable(TunSVMMET)

.metric .estimator .estimate roc_auc binary 0.95

.metric .estimator .estimate ppv binary 0.981 f_meas binary 0.946

.metric .estimator .estimate recall binary 0.914

.metric .estimator .estimate accuracy binary 0.948