Pre-processing Recipe

I will use the recipes package to provide a specification of all the transformations to the data set before I fit any models, which will ensure that the same transformations are applied to the training, test and quiz data in the same way. Furthermore, it helps avoid information leakage as the transformations will be applied to all data sets using the statistics calculated for the training data. Specifically, I will remove all variables with missing values as well as other attributes discussed above, perform a transformation to try to make all predictors more symmetric (which is useful for models that benefit from predictors with distributions close to the Gaussian), normalize all variables (particularly important for the KNN and glmnet models) and then removing any predictors, if any, with very small variance. Note that we could define different pre-processing steps if required by the various models we will be tuning.

# Creating a vector with the names of all variables that should be removed because they contain NAs

cols_rm <- train %>%
  select(where(~ any(is.na(.)))) %>%
  colnames()

model_recipe <- recipe(classe ~ ., data = train) %>%
  step_rm(all_of(!!cols_rm), all_nominal_predictors(),
          cvtd_timestamp, num_window,
          new_window) %>%
  step_YeoJohnson(all_numeric_predictors()) %>%
  step_normalize(all_numeric_predictors()) %>%
  step_nzv(all_numeric_predictors())

# Below rows can be used to perform the transformation on the training set. Since we will be using the workflow package, this is not required.

# model_recipe_prepped <- model_recipe %>% prep()
# baked_recipe <- model_recipe_prepped %>% bake(new_data = NULL)

Model Specification

In this section I will use the parsnip package to create model specifications and set which model parameters will need to be tuned to ensure higher model performance. I will be trying four different models:

1. Random Forests (rf) - with 1000 trees and we will tune the number of predictors at each node split and the minimum number of data points in a node required for the node to be further split.

2. K Nearest Neighbours (knn) - with a tunable number k of neighbours, kernel function with which to weight distances, and the parameter for the Minkowski distance.

3. Multinomial Logistic Regression with Regularization (lm) - with a tunable regularization penalty.

4. Boosted Trees (boost) - where we tune the number of trees, the learning rate, tree depth, number of predictors at each node split and the minimum number of data points in a node.

With parsnip we can create the specification in a similar manner across models and specify “computational engines” - practically R functions/packages that implement the calculations.

rf_model <- rand_forest(
                        mtry = tune(),
                        min_n = tune(),
                        trees = 1000
                        ) %>%
            set_engine("ranger") %>%
            set_mode("classification")


# rf_fit <- fit(rf_model, classe ~ ., data = baked_recipe) # This call could be used to fit the model to the training data, but we will be using the workflows interface

knn_model <- nearest_neighbor(
                              neighbors = tune(),
                              weight_func = tune(),
                              dist_power = tune()
                              ) %>%
             set_engine("kknn") %>%
             set_mode("classification")

# knn_fit <- fit(knn_model, classe ~ ., data = baked_recipe)

lasso_model <- multinom_reg(
                             penalty = tune(),
                             mixture = 1
                             ) %>%
                set_engine("glmnet")

# lasso_fit <- fit(lasso_model, classe ~ ., data = baked_recipe)

boost_model <- boost_tree(
                          trees = tune(),
                          mtry = tune(),
                          min_n = tune(),
                          learn_rate = tune(),
                          tree_depth = tune()
                          ) %>%
               set_engine("xgboost") %>%
               set_mode("classification")

# boost_fit <- fit(boost_model, classe ~ ., data = baked_recipe)

Instead of building one workflow per model, we use the workflowsets package to pair the single pre-processing recipe with each of the four model specs in one go. The resulting workflow_set is a tibble with one row per model, and the rest of the modelling section operates on it directly.

wfs <- workflow_set(
  preproc = list(rec = model_recipe),
  models  = list(rf = rf_model, knn = knn_model, lasso = lasso_model, boost = boost_model)
)

wfs

# A workflow set/tibble: 4 × 4
  wflow_id  info             option    result    
  <chr>     <list>           <list>    <list>    
1 rec_rf    <tibble [1 × 4]> <opts[0]> <list [0]>
2 rec_knn   <tibble [1 × 4]> <opts[0]> <list [0]>
3 rec_lasso <tibble [1 × 4]> <opts[0]> <list [0]>
4 rec_boost <tibble [1 × 4]> <opts[0]> <list [0]>

Model Tuning

Let us tune the different model parameters using 10-fold cross-validation. To create the grid with the combinations of parameters we can use a space-filling design with 30 points, based on which 30 combinations of the parameters will be picked such that they cover the most area in the design space. The dials package contains sensible default ranges for the most common hyperparameters that are tuned in models. The user can modify those if required, and for some, the default range depends on the number of features. One such example is the mtry parameter in random forests and boosted trees algorithms, whose max value is equal to the number of predictors in the processed data set. Since the number of predictors is known after preparing the recipe, we use finalize() to set the upper bound of mtry for the two affected models and then attach those parameter sets to the relevant rows of the workflow set via option_add().

# Number of predictors after pre-processing — needed to finalize mtry for rf and boost.

trained_data <- model_recipe %>% prep() %>% bake(new_data = NULL)

rf_param    <- extract_parameter_set_dials(rf_model)    %>% finalize(trained_data)
boost_param <- extract_parameter_set_dials(boost_model) %>% finalize(trained_data)

wfs <- wfs %>%
  option_add(param_info = rf_param,    id = "rec_rf") %>%
  option_add(param_info = boost_param, id = "rec_boost")

rf_param %>% extract_parameter_dials("mtry")

# Randomly Selected Predictors (quantitative)

Range: [1, 53]

When tuning a model, it is always important to consider what we are trying to optimize the model (e.g. achieve highest possible accuracy, maximize true positives, etc). For our problem, the aim is to accurately predict the class of each observation, so at the end of the tuning process we will pick the hyperparameters that achieve highest accuracy. We pass an explicit metric_set(accuracy, roc_auc) to workflow_map() so that probability predictions (roc_auc) are also produced — they’re needed downstream by stacks. Parallel execution is handled by the future framework, which tune 1.2.0 adopted in 2024 in place of the older foreach/doParallel setup.

set.seed(9876)

folds <- vfold_cv(data = train, v = 10, strata = classe)

plan(multisession, workers = 10)

tuned_set <- wfs %>%
  workflow_map(
    "tune_grid",
    resamples = folds,
    grid      = 30,
    metrics   = metric_set(accuracy, roc_auc),
    control   = control_grid(
      save_pred     = TRUE,
      save_workflow = TRUE,
      allow_par     = TRUE,
      parallel_over = "resamples"
    ),
    seed    = 1992,
    verbose = TRUE
  )

Warning: Using `all_of()` outside of a selecting function was deprecated in tidyselect
1.2.0.
ℹ See details at
  <https://tidyselect.r-lib.org/reference/faq-selection-context.html>

i 1 of 4 tuning:     rec_rf

Warning: Using `all_of()` outside of a selecting function was deprecated in tidyselect
1.2.0.
ℹ See details at
  <https://tidyselect.r-lib.org/reference/faq-selection-context.html>

→ A | warning: ! 53 columns were requested but there were 52 predictors in the data.
               ℹ 52 predictors will be used.

Warning: Using `all_of()` outside of a selecting function was deprecated in tidyselect
1.2.0.
ℹ See details at
  <https://tidyselect.r-lib.org/reference/faq-selection-context.html>

→ A | warning: ! 53 columns were requested but there were 52 predictors in the data.
               ℹ 52 predictors will be used.

Warning: Using `all_of()` outside of a selecting function was deprecated in tidyselect
1.2.0.
ℹ See details at
  <https://tidyselect.r-lib.org/reference/faq-selection-context.html>

→ A | warning: ! 53 columns were requested but there were 52 predictors in the data.
               ℹ 52 predictors will be used.

Warning: Using `all_of()` outside of a selecting function was deprecated in tidyselect
1.2.0.
ℹ See details at
  <https://tidyselect.r-lib.org/reference/faq-selection-context.html>

→ A | warning: ! 53 columns were requested but there were 52 predictors in the data.
               ℹ 52 predictors will be used.

Warning: Using `all_of()` outside of a selecting function was deprecated in tidyselect
1.2.0.
ℹ See details at
  <https://tidyselect.r-lib.org/reference/faq-selection-context.html>

→ A | warning: ! 53 columns were requested but there were 52 predictors in the data.
               ℹ 52 predictors will be used.

Warning: Using `all_of()` outside of a selecting function was deprecated in tidyselect
1.2.0.
ℹ See details at
  <https://tidyselect.r-lib.org/reference/faq-selection-context.html>

→ A | warning: ! 53 columns were requested but there were 52 predictors in the data.
               ℹ 52 predictors will be used.

Warning: Using `all_of()` outside of a selecting function was deprecated in tidyselect
1.2.0.
ℹ See details at
  <https://tidyselect.r-lib.org/reference/faq-selection-context.html>

→ A | warning: ! 53 columns were requested but there were 52 predictors in the data.
               ℹ 52 predictors will be used.

Warning: Using `all_of()` outside of a selecting function was deprecated in tidyselect
1.2.0.
ℹ See details at
  <https://tidyselect.r-lib.org/reference/faq-selection-context.html>

→ A | warning: ! 53 columns were requested but there were 52 predictors in the data.
               ℹ 52 predictors will be used.

Warning: Using `all_of()` outside of a selecting function was deprecated in tidyselect
1.2.0.
ℹ See details at
  <https://tidyselect.r-lib.org/reference/faq-selection-context.html>

→ A | warning: ! 53 columns were requested but there were 52 predictors in the data.
               ℹ 52 predictors will be used.

Warning: Using `all_of()` outside of a selecting function was deprecated in tidyselect
1.2.0.
ℹ See details at
  <https://tidyselect.r-lib.org/reference/faq-selection-context.html>

→ A | warning: ! 53 columns were requested but there were 52 predictors in the data.
               ℹ 52 predictors will be used.

✔ 1 of 4 tuning:     rec_rf (38m 46.7s)

i 2 of 4 tuning:     rec_knn

✔ 2 of 4 tuning:     rec_knn (54m 56.8s)

i 3 of 4 tuning:     rec_lasso

✔ 3 of 4 tuning:     rec_lasso (1m 10.9s)

i 4 of 4 tuning:     rec_boost

✔ 4 of 4 tuning:     rec_boost (11m 27.9s)

plan(sequential)

In-sample Accuracy

One can use the collect_metrics() function — or its workflow-set counterparts like extract_workflow_set_result() and rank_results() — to visualize the average accuracy for each combination of parameters (averaging across resamples), and see the various hyperparameters that achieve such accuracy.

tuned_set %>% extract_workflow_set_result("rec_rf") %>% autoplot(metric = "accuracy")

We can see that for the random forests model a combination of around 15-20 predictors and a minimal node size in the range between 5-15 seem to be optimal.

tuned_set %>% extract_workflow_set_result("rec_knn") %>% autoplot(metric = "accuracy")

For K-NN, a small number of neighbours is preferred, while Minkowski Distance of order 0.25 seems to perform best.

tuned_set %>% extract_workflow_set_result("rec_lasso") %>% autoplot(metric = "accuracy")

Small penalty is preferred for the LASSO model and it seems that up to a point, similar accuracy levels are achieved.

tuned_set %>% extract_workflow_set_result("rec_boost") %>% autoplot(metric = "accuracy")

For boosted trees, it seems that a higher learning rate is better. Higher tree depth (especially in the range of 9-14) seems to provide best results, while the number of trees and the minimal node size seem to have a wide range of values for which we achieve increased accuracy.

Let us select the best models from each type of model and compare in-sample accuracy. rank_results() will pull the best configuration per workflow in one call.

model_labels <- c(
  rec_rf    = "Random Forest",
  rec_knn   = "K-NN",
  rec_lasso = "Logistic Reg",
  rec_boost = "Boosted Trees"
)

rank_results(tuned_set, rank_metric = "accuracy", select_best = TRUE) %>%
  filter(.metric == "accuracy") %>%
  transmute(model = model_labels[wflow_id], accuracy = mean) %>%
  arrange(desc(accuracy)) %>%
  knitr::kable()

We can see that the random forests, K-NN, and boosted trees models perform exceptionally on the resamples of the train data, while even the best lasso logistic regression model performs much worse than the other three. However, there is high chance that our models have overfit on the training data and actually will not perform as well when generalizing to new data. This is where out-of-sample data comes to play, as we will use the portion of the data we set aside at the beginning to calculate accuracy on new data.

Out-of-sample Accuracy

Now that we have a set of hyperparameters that optimize performance for each model, we can update each workflow with its best parameters, fit on the entire training set and predict on the held-out test set. With workflowsets this becomes a single map over the rows of the tuned set rather than four separate finalize-and-fit blocks.

last_fits <- tibble(
  wflow_id = c("rec_rf", "rec_knn", "rec_lasso", "rec_boost"),
  pretty   = c("Random Forest", "K-NN", "LASSO LogReg", "Boosted Trees"),
  seed     = c(1209L, 1387L, NA_integer_, 54678L)
) %>%
  mutate(
    final_wf  = map(wflow_id, ~ {
      wf   <- extract_workflow(tuned_set, .x)
      best <- tuned_set %>% extract_workflow_set_result(.x) %>% select_best(metric = "accuracy")
      finalize_workflow(wf, best)
    }),
    final_fit = map2(final_wf, seed, ~ {
      if (!is.na(.y)) set.seed(.y)
      last_fit(.x, split)
    })
  )

last_fits %>%
  transmute(model = pretty, .metrics = map(final_fit, collect_metrics)) %>%
  unnest(.metrics) %>%
  filter(.metric == "accuracy") %>%
  select(model, accuracy = .estimate) %>%
  arrange(desc(accuracy)) %>%
  knitr::kable()

We can see that the boosted trees and k nearest neighbours models perform great, with random forest trailing slightly behind. The LASSO logistic regression model has much lower performance and would not be preferred. At this point we could walk away with a model that has a 99.8% accuracy on unseen data. However, we can take it a couple of steps further to see if we can achieve even greater accuracy, as we’ll see in the next sections.