Machine Learning

Loading the tidyverse

library(tidyverse)

Loading the dataset to our enviroment

password <- read.csv(file.choose())

I’ll create 10 variables I think will help to classify the passwords. Among them:

Dummy variables for upper and lower case letters, numbers, vowels and punctuation. Also ratio variables for these same variables. Lastly, a numerical variable with the number of characters per password.

password<-password %>% mutate(Upper= ifelse(str_detect(password,"[A-Z]"),1,0),Digits=ifelse(str_detect(password,"[0-9]"),1,0),punct=ifelse(str_detect(password,"[:punct:]"),1,0),length=str_count(password),ratio_upper_tot=str_count(password,"[A-Z]") /str_count(password),ratio_digits_tot=str_count(password,"[0-9]") /str_count(password),ratio_punct_tot=str_count(password,"[:punct:]") /str_count(password),ratio_lower_tot=str_count(password,"[a-z]") /str_count(password),ratio_vowels_tot=str_count(password,"[a|e|i|o|u|A|E|I|O|U]") /str_count(password),vowels= ifelse(str_detect(password,"[a|e|i|o|u|A|E|I|O|U]"),1,0))

Let’s count

password %>% count(strength,sort=TRUE)

deleting the rows with na’s

password<-password %>% na.omit(strength)

converting all factors to strings

password <- password %>% mutate(across(where(is_character),as_factor))

Deleting the password variable in order to run our model

password<-password[,-1]

I’ll start by creating a test and train set. I’ll stratify it by our outcome. I’ll also use a k-fold cross validation of k = 5

library(tidymodels)
library(finetune)


set.seed(2021)
spl <- initial_split(password,strata=strength)
train <- training(spl)
test <- testing(spl)


mset <-metric_set(roc_auc)

grid_control <- control_grid(save_pred = TRUE,
                             save_workflow = TRUE,
                             extract = extract_model)
set.seed(2021)
train_fold5 <- train %>%
  vfold_cv(5)

Creating our model specification for a Xgboost model and then I’ll put the preprocessing and model together in a workflow().

xg_rec <- recipe(strength ~.,data = train)

xg_mod <- boost_tree("classification",
                     mtry = tune(),
                     trees = tune(),
                     learn_rate = tune()) %>%
  set_engine("xgboost")


xg_wf <- workflow() %>%
  add_recipe(xg_rec) %>%
  add_model(xg_mod)

Tuning the model

doParallel::registerDoParallel()

xg_tune <- xg_wf %>%
  tune_grid(train_fold5,
            metrics = mset,
            control = grid_control,
            grid = crossing(mtry = c(7),
                            trees = seq(250, 800, 50),
                            learn_rate = c(.008, .01)))

It took two hours to train! Time to look at the results

autoplot(xg_tune)

It seems like the models with the 0.010 learning rate perform better.

xg_tune %>%
  collect_metrics() %>%
  arrange(mean)

Picking the best model.

  best_log.loss <- select_best(xg_tune, "roc_auc")
  best_log.loss

NA
NA

Puting the model in the workflow

 
  final_xgb <- finalize_workflow(
    xg_wf,
    best_log.loss
  )
  
  final_xgb

== Workflow ==========================================================================================
Preprocessor: Recipe
Model: boost_tree()

-- Preprocessor --------------------------------------------------------------------------------------
0 Recipe Steps

-- Model ---------------------------------------------------------------------------------------------
Boosted Tree Model Specification (classification)

Main Arguments:
  mtry = 7
  trees = 800
  learn_rate = 0.01

Computational engine: xgboost 

Looking at the most important variables in our model. This took approximately 30 minutes.

 library(vip)

package 㤼㸱vip㤼㸲 was built under R version 4.0.5
Attaching package: 㤼㸱vip㤼㸲

The following object is masked from 㤼㸱package:utils㤼㸲:

    vi

  
  final_xgb %>%
    fit(data = train) %>%
    pull_workflow_fit() %>%
    vip(geom = "point", num_features = 20)  

`pull_workflow_fit()` was deprecated in workflows 0.2.3.
Please use `extract_fit_parsnip()` instead.

NA
NA

Performance of the final model

final_res <- last_fit(final_xgb, spl)
  

collect_metrics(final_res) 

NA

Looking at the difference in performance across classes with a confusion matrix.

xg_conf <- final_res %>%
  unnest(.predictions) %>%
  conf_mat(strength, .pred_class)

xg_conf

          Truth
Prediction moderate strong   weak
  moderate   124187      2     12
  strong          7  20782      0
  weak            6      0  22413

The model seems to be performing quite well. There are only a few observations that are misclassified. 13 for moderate, 2 for strong and 12 for weak. Xgboost is computationally expensive, but the results are really good.