The hardware and bandwidth for this mirror is donated by METANET, the Webhosting and Full Service-Cloud Provider.
If you wish to report a bug, or if you are interested in having us mirror your free-software or open-source project, please feel free to contact us at mirror[@]metanet.ch.

glmnet: Regression

# 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("BostonHousing")
dataset <- BostonHousing |>
  data.table::as.data.table() |>
  na.omit()

feature_cols <- colnames(dataset)[1:13]
target_col <- "medv"

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" = 10L)

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 <- log(dataset[data_split$train, get(target_col)])


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

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 = "gaussian",
  type.measure = "mse",
  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("rmsle")
performance_metric_args <- NULL
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(
  iters.n = 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
#> 1:          1        0.03927487 0.0004916239  0.70 gaussian          mse        TRUE
#> 2:          2        0.03926677 0.0003174538  0.90 gaussian          mse        TRUE
#> 3:          3        0.03926382 0.0004005028  0.65 gaussian          mse        TRUE
#> 4:          4        0.03924418 0.0021612791  0.10 gaussian          mse        TRUE
#> 5:          5        0.03926592 0.0006968102  0.45 gaussian          mse        TRUE
#> 6:          6        0.03923310 0.0029793717  0.05 gaussian          mse        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)
#> 
#> Registering parallel backend using 4 cores.

head(tuner_results_bayesian)
#>    Epoch setting_id alpha gpUtility acqOptimum inBounds Elapsed       Score metric_optim_mean       lambda errorMessage   family
#> 1:     0          1  0.70        NA      FALSE     TRUE   0.991 -0.03927487        0.03927487 0.0004916239           NA gaussian
#> 2:     0          2  0.90        NA      FALSE     TRUE   0.962 -0.03926677        0.03926677 0.0003174538           NA gaussian
#> 3:     0          3  0.65        NA      FALSE     TRUE   0.976 -0.03926382        0.03926382 0.0004005028           NA gaussian
#> 4:     0          4  0.10        NA      FALSE     TRUE   0.962 -0.03924418        0.03924418 0.0021612791           NA gaussian
#> 5:     0          5  0.45        NA      FALSE     TRUE   0.023 -0.03926592        0.03926592 0.0006968102           NA gaussian
#> 6:     0          6  0.05        NA      FALSE     TRUE   0.025 -0.03923310        0.03923310 0.0029793717           NA gaussian
#>    type.measure standardize
#> 1:          mse        TRUE
#> 2:          mse        TRUE
#> 3:          mse        TRUE
#> 4:          mse        TRUE
#> 5:          mse        TRUE
#> 6:          mse        TRUE

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[-1]

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      lambda   family type.measure standardize
#> 1: Fold1  0.05530167 0.01159355 0.004207556 gaussian          mse        TRUE
#> 2: Fold2  0.05239743 0.01159355 0.004207556 gaussian          mse        TRUE
#> 3: Fold3  0.05055533 0.01159355 0.004207556 gaussian          mse        TRUE

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
#> 1: Fold1  0.05526202 0.008388831  0.05 gaussian          mse        TRUE
#> 2: Fold2  0.05418003 0.018892213  0.25 gaussian          mse        TRUE
#> 3: Fold3  0.05059097 0.012894705  0.05 gaussian          mse        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 = 312
)

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
#> 
#> Registering parallel backend using 4 cores.
#> 
#> CV fold: Fold2
#> CV progress [====================================================================>-----------------------------------] 2/3 ( 67%)
#> 
#> Registering parallel backend using 4 cores.
#> 
#> CV fold: Fold3
#> CV progress [========================================================================================================] 3/3 (100%)
#>                                                                                                                                   
#> Registering parallel backend using 4 cores.

head(validator_results)
#>     fold performance       alpha      lambda   family type.measure standardize
#> 1: Fold1  0.05541775 0.001528976 0.022251620 gaussian          mse        TRUE
#> 2: Fold2  0.05293442 0.001528976 0.022305296 gaussian          mse        TRUE
#> 3: Fold3  0.05056405 0.036876500 0.002985073 gaussian          mse        TRUE

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 = "regression"
)
perf_glmnet
#>    model performance        mse        msle       mae       mape      rmse      rmsle       rsq      sse
#> 1: Fold1  0.05117877 0.03938447 0.002619267 0.1365514 0.04579938 0.1984552 0.05117877 0.7438377 6.104593
#> 2: Fold2  0.05218917 0.03992086 0.002723709 0.1407370 0.04763746 0.1998021 0.05218917 0.7403489 6.187734
#> 3: Fold3  0.04952504 0.03651949 0.002452730 0.1373768 0.04651953 0.1911007 0.04952504 0.7624719 5.660522

These binaries (installable software) and packages are in development.
They may not be fully stable and should be used with caution. We make no claims about them.