glmnet: Binary Classification

# nolint start
library(mlexperiments)
library(mllrnrs)

See https://github.com/kapsner/mllrnrs/blob/main/R/learner_glmnet.R for implementation details.

Preprocessing

Import and Prepare Data

library(mlbench)
data("BreastCancer")
dataset <- BreastCancer |>
  data.table::as.data.table() |>
  na.omit()
feature_cols <- colnames(dataset)[2:10]
target_col <- "Class"

General Configurations

seed <- 123
if (isTRUE(as.logical(Sys.getenv("_R_CHECK_LIMIT_CORES_")))) {
  # on cran
  ncores <- 2L
} else {
  ncores <- ifelse(
    test = parallel::detectCores() > 4,
    yes = 4L,
    no = ifelse(
      test = parallel::detectCores() < 2L,
      yes = 1L,
      no = parallel::detectCores()
    )
  )
}
options("mlexperiments.bayesian.max_init" = 4L)

Generate Training- and Test Data

data_split <- splitTools::partition(
  y = dataset[, get(target_col)],
  p = c(train = 0.7, test = 0.3),
  type = "stratified",
  seed = seed
)

train_x <- model.matrix(
  ~ -1 + .,
  dataset[data_split$train, .SD, .SDcols = feature_cols]
)
train_y <- as.integer(dataset[data_split$train, get(target_col)]) - 1L


test_x <- model.matrix(
  ~ -1 + .,
  dataset[data_split$test, .SD, .SDcols = feature_cols]
)
test_y <- as.integer(dataset[data_split$test, get(target_col)]) - 1L

Generate Training Data Folds

fold_list <- splitTools::create_folds(
  y = train_y,
  k = 3,
  type = "stratified",
  seed = seed
)

Experiments

Prepare Experiments

# required learner arguments, not optimized
learner_args <- list(
  family = "binomial",
  type.measure = "class",
  standardize = TRUE
)

# set arguments for predict function and performance metric,
# required for mlexperiments::MLCrossValidation and
# mlexperiments::MLNestedCV
predict_args <- list(type = "response")
performance_metric <- metric("auc")
performance_metric_args <- list(positive = "1", negative = "0")
return_models <- FALSE

# required for grid search and initialization of bayesian optimization
parameter_grid <- expand.grid(
  alpha = seq(0, 1, 0.05)
)
# reduce to a maximum of 10 rows
if (nrow(parameter_grid) > 10) {
  set.seed(123)
  sample_rows <- sample(seq_len(nrow(parameter_grid)), 10, FALSE)
  parameter_grid <- kdry::mlh_subset(parameter_grid, sample_rows)
}

# required for bayesian optimization
parameter_bounds <- list(
  alpha = c(0., 1.)
)
optim_args <- list(
  n_iter = ncores,
  kappa = 3.5,
  acq = "ucb"
)

Hyperparameter Tuning

tuner <- mlexperiments::MLTuneParameters$new(
  learner = mllrnrs::LearnerGlmnet$new(
    metric_optimization_higher_better = FALSE
  ),
  strategy = "grid",
  ncores = ncores,
  seed = seed
)

tuner$parameter_grid <- parameter_grid
tuner$learner_args <- learner_args
tuner$split_type <- "stratified"

tuner$set_data(
  x = train_x,
  y = train_y
)

tuner_results_grid <- tuner$execute(k = 3)
#>
#> Parameter settings [=====================>-----------------------------------------------------------------------------------------] 2/10 ( 20%)
#>
#> Parameter settings [================================>------------------------------------------------------------------------------] 3/10 ( 30%)
#>
#> Parameter settings [===========================================>-------------------------------------------------------------------] 4/10 ( 40%)
#>
#> Parameter settings [=======================================================>-------------------------------------------------------] 5/10 ( 50%)
#>
#> Parameter settings [==================================================================>--------------------------------------------] 6/10 ( 60%)
#>
#> Parameter settings [=============================================================================>---------------------------------] 7/10 ( 70%)
#>
#> Parameter settings [========================================================================================>----------------------] 8/10 ( 80%)
#>
#> Parameter settings [===================================================================================================>-----------] 9/10 ( 90%)
#>
#> Parameter settings [==============================================================================================================] 10/10 (100%)

head(tuner_results_grid)
#>    setting_id metric_optim_mean     lambda alpha   family type.measure standardize
#>         <int>             <num>      <num> <num>   <char>       <char>      <lgcl>
#> 1:          1        0.04192872 0.05491445  0.70 binomial        class        TRUE
#> 2:          2        0.04192872 0.03545962  0.90 binomial        class        TRUE
#> 3:          3        0.04192872 0.07123270  0.65 binomial        class        TRUE
#> 4:          4        0.03773585 0.18262170  0.10 binomial        class        TRUE
#> 5:          5        0.04192872 0.04058260  0.45 binomial        class        TRUE
#> 6:          6        0.03563941 0.43993696  0.05 binomial        class        TRUE

Bayesian Optimization

tuner <- mlexperiments::MLTuneParameters$new(
  learner = mllrnrs::LearnerGlmnet$new(
    metric_optimization_higher_better = FALSE
  ),
  strategy = "bayesian",
  ncores = ncores,
  seed = seed
)

tuner$parameter_grid <- parameter_grid
tuner$parameter_bounds <- parameter_bounds

tuner$learner_args <- learner_args
tuner$optim_args <- optim_args

tuner$split_type <- "stratified"

tuner$set_data(
  x = train_x,
  y = train_y
)

tuner_results_bayesian <- tuner$execute(k = 3)
#>
#> Number of rows of initialization grid > than 'options("mlexperiments.bayesian.max_init")'...
#> ... reducing initialization grid to 4 rows.
#> elapsed = 1.339  Round = 1   alpha = 0.6500  Value = -0.04192872
#> elapsed = 1.405  Round = 2   alpha = 0.1500  Value = -0.03773585
#> elapsed = 1.394  Round = 3   alpha = 0.9000  Value = -0.04192872
#> elapsed = 1.381  Round = 4   alpha = 0.5000  Value = -0.04192872
#> elapsed = 1.333  Round = 5   alpha = 2.220446e-16    Value = -0.03354298
#> elapsed = 1.349  Round = 6   alpha = 2.220446e-16    Value = -0.03354298
#> elapsed = 1.296  Round = 7   alpha = 2.220446e-16    Value = -0.03354298
#> elapsed = 1.248  Round = 8   alpha = 2.220446e-16    Value = -0.03354298
#>
#>  Best Parameters Found:
#> Round = 5    alpha = 2.220446e-16    Value = -0.03354298

head(tuner_results_bayesian)
#>    setting_id        alpha       Value   family type.measure standardize metric_optim_mean
#>         <int>        <num>       <num>   <char>       <char>      <lgcl>             <num>
#> 1:          1 6.500000e-01 -0.04192872 binomial        class        TRUE        0.04192872
#> 2:          2 1.500000e-01 -0.03773585 binomial        class        TRUE        0.03773585
#> 3:          3 9.000000e-01 -0.04192872 binomial        class        TRUE        0.04192872
#> 4:          4 5.000000e-01 -0.04192872 binomial        class        TRUE        0.04192872
#> 5:          5 2.220446e-16 -0.03354298 binomial        class        TRUE        0.03354298
#> 6:          6 2.220446e-16 -0.03354298 binomial        class        TRUE        0.03354298

k-Fold Cross Validation

validator <- mlexperiments::MLCrossValidation$new(
  learner = mllrnrs::LearnerGlmnet$new(
    metric_optimization_higher_better = FALSE
  ),
  fold_list = fold_list,
  ncores = ncores,
  seed = seed
)

validator$learner_args <- tuner$results$best.setting

validator$predict_args <- predict_args
validator$performance_metric <- performance_metric
validator$performance_metric_args <- performance_metric_args
validator$return_models <- return_models

validator$set_data(
  x = train_x,
  y = train_y
)

validator_results <- validator$execute()
#>
#> CV fold: Fold1
#>
#> CV fold: Fold2
#>
#> CV fold: Fold3

head(validator_results)
#>      fold performance        alpha   family type.measure standardize    lambda
#>    <char>       <num>        <num>   <char>       <char>      <lgcl>     <num>
#> 1:  Fold1   0.9964695 2.220446e-16 binomial        class        TRUE 0.5842556
#> 2:  Fold2   0.9949723 2.220446e-16 binomial        class        TRUE 0.5842556
#> 3:  Fold3   0.9860920 2.220446e-16 binomial        class        TRUE 0.5842556

Nested Cross Validation

validator <- mlexperiments::MLNestedCV$new(
  learner = mllrnrs::LearnerGlmnet$new(
    metric_optimization_higher_better = FALSE
  ),
  strategy = "grid",
  fold_list = fold_list,
  k_tuning = 3L,
  ncores = ncores,
  seed = seed
)

validator$parameter_grid <- parameter_grid
validator$learner_args <- learner_args
validator$split_type <- "stratified"

validator$predict_args <- predict_args
validator$performance_metric <- performance_metric
validator$performance_metric_args <- performance_metric_args
validator$return_models <- return_models

validator$set_data(
  x = train_x,
  y = train_y
)

validator_results <- validator$execute()
#>
#> CV fold: Fold1
#>
#>
#> Parameter settings [=====================>-----------------------------------------------------------------------------------------] 2/10 ( 20%)
#>
#> Parameter settings [================================>------------------------------------------------------------------------------] 3/10 ( 30%)
#>
#> Parameter settings [===========================================>-------------------------------------------------------------------] 4/10 ( 40%)
#>
#> Parameter settings [=======================================================>-------------------------------------------------------] 5/10 ( 50%)
#>
#> Parameter settings [==================================================================>--------------------------------------------] 6/10 ( 60%)
#>
#> Parameter settings [=============================================================================>---------------------------------] 7/10 ( 70%)
#>
#> Parameter settings [========================================================================================>----------------------] 8/10 ( 80%)
#>
#> Parameter settings [===================================================================================================>-----------] 9/10 ( 90%)
#>
#> Parameter settings [==============================================================================================================] 10/10 (100%)
#>
#> CV fold: Fold2
#> CV progress [==============================================================================>----------------------------------------] 2/3 ( 67%)
#>
#> Parameter settings [=====================>-----------------------------------------------------------------------------------------] 2/10 ( 20%)
#>
#> Parameter settings [================================>------------------------------------------------------------------------------] 3/10 ( 30%)
#>
#> Parameter settings [===========================================>-------------------------------------------------------------------] 4/10 ( 40%)
#>
#> Parameter settings [=======================================================>-------------------------------------------------------] 5/10 ( 50%)
#>
#> Parameter settings [==================================================================>--------------------------------------------] 6/10 ( 60%)
#>
#> Parameter settings [=============================================================================>---------------------------------] 7/10 ( 70%)
#>
#> Parameter settings [========================================================================================>----------------------] 8/10 ( 80%)
#>
#> Parameter settings [===================================================================================================>-----------] 9/10 ( 90%)
#>
#> Parameter settings [==============================================================================================================] 10/10 (100%)
#>
#> CV fold: Fold3
#> CV progress [=======================================================================================================================] 3/3 (100%)
#>
#>
#> Parameter settings [=====================>-----------------------------------------------------------------------------------------] 2/10 ( 20%)
#>
#> Parameter settings [================================>------------------------------------------------------------------------------] 3/10 ( 30%)
#>
#> Parameter settings [===========================================>-------------------------------------------------------------------] 4/10 ( 40%)
#>
#> Parameter settings [=======================================================>-------------------------------------------------------] 5/10 ( 50%)
#>
#> Parameter settings [==================================================================>--------------------------------------------] 6/10 ( 60%)
#>
#> Parameter settings [=============================================================================>---------------------------------] 7/10 ( 70%)
#>
#> Parameter settings [========================================================================================>----------------------] 8/10 ( 80%)
#>
#> Parameter settings [===================================================================================================>-----------] 9/10 ( 90%)
#>
#> Parameter settings [==============================================================================================================] 10/10 (100%)

head(validator_results)
#>      fold performance       lambda alpha   family type.measure standardize
#>    <char>       <num>        <num> <num>   <char>       <char>      <lgcl>
#> 1:  Fold1   0.9945278 0.0659301965   0.7 binomial        class        TRUE
#> 2:  Fold2   0.9878641 0.0005681186   0.1 binomial        class        TRUE
#> 3:  Fold3   0.9826580 0.0183223796   0.7 binomial        class        TRUE

Inner Bayesian Optimization

validator <- mlexperiments::MLNestedCV$new(
  learner = mllrnrs::LearnerGlmnet$new(
    metric_optimization_higher_better = FALSE
  ),
  strategy = "bayesian",
  fold_list = fold_list,
  k_tuning = 3L,
  ncores = ncores,
  seed = 123
)

validator$parameter_grid <- parameter_grid
validator$learner_args <- learner_args
validator$split_type <- "stratified"


validator$parameter_bounds <- parameter_bounds
validator$optim_args <- optim_args

validator$predict_args <- predict_args
validator$performance_metric <- performance_metric
validator$performance_metric_args <- performance_metric_args
validator$return_models <- TRUE

validator$set_data(
  x = train_x,
  y = train_y
)

validator_results <- validator$execute()
#>
#> CV fold: Fold1
#>
#> Number of rows of initialization grid > than 'options("mlexperiments.bayesian.max_init")'...
#> ... reducing initialization grid to 4 rows.
#> elapsed = 1.26   Round = 1   alpha = 0.6500  Value = -0.04075235
#> elapsed = 1.309  Round = 2   alpha = 0.1500  Value = -0.04388715
#> elapsed = 1.57   Round = 3   alpha = 0.9000  Value = -0.04388715
#> elapsed = 1.345  Round = 4   alpha = 0.5000  Value = -0.04075235
#> elapsed = 1.346  Round = 5   alpha = 0.3571908   Value = -0.04075235
#> elapsed = 1.267  Round = 6   alpha = 2.220446e-16    Value = -0.04702194
#> elapsed = 1.327  Round = 7   alpha = 0.5882765   Value = -0.04075235
#> elapsed = 1.346  Round = 8   alpha = 0.4093469   Value = -0.04075235
#>
#>  Best Parameters Found:
#> Round = 1    alpha = 0.6500  Value = -0.04075235
#>
#> CV fold: Fold2
#> CV progress [==============================================================================>----------------------------------------] 2/3 ( 67%)
#>
#> Number of rows of initialization grid > than 'options("mlexperiments.bayesian.max_init")'...
#> ... reducing initialization grid to 4 rows.
#> elapsed = 1.332  Round = 1   alpha = 0.6500  Value = -0.03459119
#> elapsed = 1.335  Round = 2   alpha = 0.1500  Value = -0.02201258
#> elapsed = 1.385  Round = 3   alpha = 0.9000  Value = -0.03459119
#> elapsed = 1.359  Round = 4   alpha = 0.5000  Value = -0.03144654
#> elapsed = 1.20   Round = 5   alpha = 2.220446e-16    Value = -0.02830189
#> elapsed = 1.241  Round = 6   alpha = 0.2802528   Value = -0.03144654
#> elapsed = 1.31   Round = 7   alpha = 0.1410561   Value = -0.02201258
#> elapsed = 1.252  Round = 8   alpha = 1.0000  Value = -0.03459119
#>
#>  Best Parameters Found:
#> Round = 2    alpha = 0.1500  Value = -0.02201258
#>
#> CV fold: Fold3
#> CV progress [=======================================================================================================================] 3/3 (100%)
#>
#> Number of rows of initialization grid > than 'options("mlexperiments.bayesian.max_init")'...
#> ... reducing initialization grid to 4 rows.
#> elapsed = 1.288  Round = 1   alpha = 0.6500  Value = -0.03470032
#> elapsed = 1.515  Round = 2   alpha = 0.1500  Value = -0.03470032
#> elapsed = 1.452  Round = 3   alpha = 0.9000  Value = -0.04416404
#> elapsed = 1.469  Round = 4   alpha = 0.5000  Value = -0.03470032
#> elapsed = 1.431  Round = 5   alpha = 2.220446e-16    Value = -0.03154574
#> elapsed = 1.519  Round = 6   alpha = 0.327741    Value = -0.03470032
#> elapsed = 1.468  Round = 7   alpha = 0.0437213   Value = -0.03470032
#> elapsed = 1.336  Round = 8   alpha = 0.7564927   Value = -0.03785489
#>
#>  Best Parameters Found:
#> Round = 5    alpha = 2.220446e-16    Value = -0.03154574

head(validator_results)
#>      fold performance        alpha   family type.measure standardize      lambda
#>    <char>       <num>        <num>   <char>       <char>      <lgcl>       <num>
#> 1:  Fold1   0.9945278 6.500000e-01 binomial        class        TRUE 0.077924333
#> 2:  Fold2   0.9880374 1.500000e-01 binomial        class        TRUE 0.000345099
#> 3:  Fold3   0.9855769 2.220446e-16 binomial        class        TRUE 0.340660940

Holdout Test Dataset Performance

Predict Outcome in Holdout Test Dataset

preds_glmnet <- mlexperiments::predictions(
  object = validator,
  newdata = test_x
)

Evaluate Performance on Holdout Test Dataset

perf_glmnet <- mlexperiments::performance(
  object = validator,
  prediction_results = preds_glmnet,
  y_ground_truth = test_y,
  type = "binary"
)
perf_glmnet
#>     model performance       AUC      Brier BrierScaled       BAC    TP    TN    FP    FN       TPR       TNR         FPR        FNR       PPV
#>    <char>       <num>     <num>      <num>       <num>     <num> <int> <int> <int> <int>     <num>     <num>       <num>      <num>     <num>
#> 1:  Fold1   0.9789594 0.9789594 0.04598681   0.7977305 0.9268242    62   133     1    10 0.8611111 0.9925373 0.007462687 0.13888889 0.9841270
#> 2:  Fold2   0.9903607 0.9903607 0.03577667   0.8426390 0.9439262    65   132     2     7 0.9027778 0.9850746 0.014925373 0.09722222 0.9701493
#> 3:  Fold3   0.9906716 0.9906716 0.04029932   0.8227465 0.9401949    65   131     3     7 0.9027778 0.9776119 0.022388060 0.09722222 0.9558824
#>          NPV        FDR       MCC        F1     GMEAN       GPR       ACC       MMCE        BER
#>        <num>      <num>     <num>     <num>     <num>     <num>     <num>      <num>      <num>
#> 1: 0.9300699 0.01587302 0.8834041 0.9185185 0.9244917 0.9205665 0.9466019 0.05339806 0.07317579
#> 2: 0.9496403 0.02985075 0.9036799 0.9352518 0.9430289 0.9358575 0.9563107 0.04368932 0.05607380
#> 3: 0.9492754 0.04411765 0.8926878 0.9285714 0.9394500 0.9289507 0.9514563 0.04854369 0.05980514