mlexperiments_starter.R
In mlexperiments: Machine Learning Experiments

## ----include = FALSE----------------------------------------------------------
# nolint start


## ----eval=FALSE---------------------------------------------------------------
# knn_fit <- function(x, y, ncores, seed, ...) {
#   kwargs <- list(...)
#   stopifnot("k" %in% names(kwargs))
#   args <- kdry::list.append(list(train = x, cl = y), kwargs)
#   args$prob <- TRUE
#   set.seed(seed)
#   fit <- do.call(class::knn, args)
#   return(fit)
# }


## ----eval=FALSE---------------------------------------------------------------
# knn_predict <- function(model, newdata, ncores, ...) {
#   kwargs <- list(...)
#   stopifnot("type" %in% names(kwargs))
#   if (kwargs$type == "response") {
#     return(model)
#   } else if (kwargs$type == "prob") {
#     # there is no knn-model but the probabilities predicted for the test data
#     return(attributes(model)$prob)
#   }
# }


## ----eval=FALSE---------------------------------------------------------------
# knn_optimization <- function(x, y, params, fold_list, ncores, seed) {
#   stopifnot(is.list(params), "k" %in% names(params))
#   # initialize a dataframe to store the results
#   results_df <- data.table::data.table(
#     "fold" = character(0),
#     "metric" = numeric(0)
#   )
#   # we do not need test here as it is defined explicitly below
#   params[["test"]] <- NULL
#   # loop over the folds
#   for (fold in names(fold_list)) {
#     # get row-ids of the current fold
#     train_idx <- fold_list[[fold]]
#     # create learner-arguments
#     args <- kdry::list.append(
#       list(
#         x = kdry::mlh_subset(x, train_idx),
#         test = kdry::mlh_subset(x, -train_idx),
#         y = kdry::mlh_subset(y, train_idx),
#         use.all = FALSE,
#         ncores = ncores,
#         seed = seed
#       ),
#       params
#     )
#     set.seed(seed)
#     cvfit <- do.call(knn_fit, args)
#     # optimize error rate
#     FUN <- metric("ce") # nolint
#     err <- FUN(predictions = knn_predict(
#       model = cvfit,
#       newdata = kdry::mlh_subset(x, -train_idx),
#       ncores = ncores,
#       type = "response"
#       ),
#       ground_truth = kdry::mlh_subset(y, -train_idx)
#     )
#     results_df <- data.table::rbindlist(
#       l = list(results_df, list("fold" = fold, "validation_metric" = err)),
#       fill = TRUE
#     )
#   }
#   res <- list("metric_optim_mean" = mean(results_df$validation_metric))
#   return(res)
# }


## ----eval=FALSE---------------------------------------------------------------
# knn_bsF <- function(...) { # nolint
#   params <- list(...)
#   # call to knn_optimization here with ncores = 1, since the Bayesian search
#   # is parallelized already / "FUN is fitted n times in m threads"
#   set.seed(seed)#, kind = "L'Ecuyer-CMRG")
#   bayes_opt_knn <- knn_optimization(
#     x = x,
#     y = y,
#     params = params,
#     fold_list = method_helper$fold_list,
#     ncores = 1L, # important, as bayesian search is already parallelized
#     seed = seed
#   )
#   ret <- kdry::list.append(
#     list("Score" = bayes_opt_knn$metric_optim_mean),
#     bayes_opt_knn
#   )
#   return(ret)
# }


## ----eval=FALSE---------------------------------------------------------------
# # define the objects / functions that need to be exported to each cluster
# # for parallelizing the Bayesian optimization.
# knn_ce <- function() {
#   c("knn_optimization", "knn_fit", "knn_predict", "metric", ".format_xy")
# }


## ----eval=FALSE---------------------------------------------------------------
# LearnerKnn <- R6::R6Class( # nolint
#   classname = "LearnerKnn",
#   inherit = mlexperiments::MLLearnerBase,
#   public = list(
#     initialize = function() {
#       if (!requireNamespace("class", quietly = TRUE)) {
#         stop(
#           paste0(
#             "Package \"class\" must be installed to use ",
#             "'learner = \"LearnerKnn\"'."
#           ),
#           call. = FALSE
#         )
#       }
#       super$initialize(
#         metric_optimization_higher_better = FALSE # classification error
#       )
# 
#       private$fun_fit <- knn_fit
#       private$fun_predict <- knn_predict
#       private$fun_optim_cv <- knn_optimization
#       private$fun_bayesian_scoring_function <- knn_bsF
# 
#       self$environment <- "mlexperiments"
#       self$cluster_export <- knn_ce()
#     }
#   )
# )


## -----------------------------------------------------------------------------
library(mlexperiments)
library(mlbench)

data("DNA")
dataset <- DNA |>
  data.table::as.data.table() |>
  na.omit()

seed <- 123
feature_cols <- colnames(dataset)[1:180]

train_x <- model.matrix(
  ~ -1 + .,
  dataset[, .SD, .SDcols = feature_cols]
)
train_y <- dataset[, get("Class")]

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


## -----------------------------------------------------------------------------
param_list_knn <- expand.grid(
  k = seq(4, 68, 8),
  l = 0,
  test = parse(text = "fold_test$x")
)

knn_bounds <- list(k = c(2L, 80L))

optim_args <- list(
  iters.n = ncores,
  kappa = 3.5,
  acq = "ucb"
)


## -----------------------------------------------------------------------------
knn_tune_bayesian <- mlexperiments::MLTuneParameters$new(
  learner = LearnerKnn$new(),
  strategy = "bayesian",
  ncores = ncores,
  seed = seed
)

knn_tune_bayesian$parameter_bounds <- knn_bounds
knn_tune_bayesian$parameter_grid <- param_list_knn
knn_tune_bayesian$split_type <- "stratified"
knn_tune_bayesian$optim_args <- optim_args

# set data
knn_tune_bayesian$set_data(
  x = train_x,
  y = train_y
)

results <- knn_tune_bayesian$execute(k = 3)
#> 
#> Registering parallel backend using 4 cores.

head(results)
#>    Epoch setting_id  k gpUtility acqOptimum inBounds Elapsed      Score metric_optim_mean errorMessage l
#> 1:     0          1  4        NA      FALSE     TRUE   2.153 -0.2247332         0.2247332           NA 0
#> 2:     0          2 12        NA      FALSE     TRUE   2.274 -0.1600753         0.1600753           NA 0
#> 3:     0          3 20        NA      FALSE     TRUE   2.006 -0.1381042         0.1381042           NA 0
#> 4:     0          4 28        NA      FALSE     TRUE   2.329 -0.1403013         0.1403013           NA 0
#> 5:     0          5 36        NA      FALSE     TRUE   2.109 -0.1315129         0.1315129           NA 0
#> 6:     0          6 44        NA      FALSE     TRUE   2.166 -0.1258632         0.1258632           NA 0


## -----------------------------------------------------------------------------
knn_tune_grid <- mlexperiments::MLTuneParameters$new(
  learner = LearnerKnn$new(),
  strategy = "grid",
  ncores = ncores,
  seed = seed
)

knn_tune_grid$parameter_grid <- param_list_knn
knn_tune_grid$split_type <- "stratified"

# set data
knn_tune_grid$set_data(
  x = train_x,
  y = train_y
)

results <- knn_tune_grid$execute(k = 3)
#> 
#> Parameter settings [=====================>---------------------------------------------------------------------------] 2/9 ( 22%)
#> Parameter settings [===============================>-----------------------------------------------------------------] 3/9 ( 33%)
#> Parameter settings [==========================================>------------------------------------------------------] 4/9 ( 44%)
#> Parameter settings [=====================================================>-------------------------------------------] 5/9 ( 56%)
#> Parameter settings [================================================================>--------------------------------] 6/9 ( 67%)
#> Parameter settings [==========================================================================>----------------------] 7/9 ( 78%)
#> Parameter settings [=====================================================================================>-----------] 8/9 ( 89%)
#> Parameter settings [=================================================================================================] 9/9 (100%)                                                                                                                                  

head(results)
#>    setting_id metric_optim_mean  k l
#> 1:          1         0.2187696  4 0
#> 2:          2         0.1597615 12 0
#> 3:          3         0.1349655 20 0
#> 4:          4         0.1406152 28 0
#> 5:          5         0.1318267 36 0
#> 6:          6         0.1258632 44 0


## -----------------------------------------------------------------------------
fold_list <- splitTools::create_folds(
  y = train_y,
  k = 3,
  type = "stratified",
  seed = seed
)
str(fold_list)
#> List of 3
#>  $ Fold1: int [1:2124] 1 2 3 4 5 7 9 10 11 12 ...
#>  $ Fold2: int [1:2124] 1 2 3 6 8 9 11 13 16 17 ...
#>  $ Fold3: int [1:2124] 4 5 6 7 8 10 12 14 15 16 ...


## -----------------------------------------------------------------------------
knn_cv <- mlexperiments::MLCrossValidation$new(
  learner = LearnerKnn$new(),
  fold_list = fold_list,
  seed = seed
)

best_grid_result <- knn_tune_grid$results$best.setting
best_grid_result
#> $setting_id
#> [1] 9
#> 
#> $k
#> [1] 68
#> 
#> $l
#> [1] 0
#> 
#> $test
#> expression(fold_test$x)

knn_cv$learner_args <- best_grid_result[-1]

knn_cv$predict_args <- list(type = "response")
knn_cv$performance_metric <- metric("bacc")
knn_cv$return_models <- TRUE

# set data
knn_cv$set_data(
  x = train_x,
  y = train_y
)

results <- knn_cv$execute()
#> 
#> CV fold: Fold1
#> 
#> CV fold: Fold2
#> CV progress [====================================================================>-----------------------------------] 2/3 ( 67%)
#> 
#> CV fold: Fold3
#> CV progress [========================================================================================================] 3/3 (100%)
#>                                                                                                                                   

head(results)
#>     fold performance  k l
#> 1: Fold1   0.8912781 68 0
#> 2: Fold2   0.8832388 68 0
#> 3: Fold3   0.8657147 68 0


## -----------------------------------------------------------------------------
knn_cv_nested_bayesian <- mlexperiments::MLNestedCV$new(
  learner = LearnerKnn$new(),
  strategy = "bayesian",
  fold_list = fold_list,
  k_tuning = 3L,
  ncores = ncores,
  seed = seed
)

knn_cv_nested_bayesian$parameter_grid <- param_list_knn
knn_cv_nested_bayesian$parameter_bounds <- knn_bounds
knn_cv_nested_bayesian$split_type <- "stratified"
knn_cv_nested_bayesian$optim_args <- optim_args

knn_cv_nested_bayesian$predict_args <- list(type = "response")
knn_cv_nested_bayesian$performance_metric <- metric("bacc")

# set data
knn_cv_nested_bayesian$set_data(
  x = train_x,
  y = train_y
)

results <- knn_cv_nested_bayesian$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(results)
#>     fold performance  k l
#> 1: Fold1   0.8912781 68 0
#> 2: Fold2   0.8832388 68 0
#> 3: Fold3   0.8657147 68 0


## -----------------------------------------------------------------------------
knn_cv_nested_grid <- mlexperiments::MLNestedCV$new(
  learner = LearnerKnn$new(),
  strategy = "grid",
  fold_list = fold_list,
  k_tuning = 3L,
  ncores = ncores,
  seed = seed
)

knn_cv_nested_grid$parameter_grid <- param_list_knn
knn_cv_nested_grid$split_type <- "stratified"

knn_cv_nested_grid$predict_args <- list(type = "response")
knn_cv_nested_grid$performance_metric <- metric("bacc")

# set data
knn_cv_nested_grid$set_data(
  x = train_x,
  y = train_y
)

results <- knn_cv_nested_grid$execute()
#> 
#> CV fold: Fold1
#> 
#> Parameter settings [=====================>---------------------------------------------------------------------------] 2/9 ( 22%)
#> Parameter settings [===============================>-----------------------------------------------------------------] 3/9 ( 33%)
#> Parameter settings [==========================================>------------------------------------------------------] 4/9 ( 44%)
#> Parameter settings [=====================================================>-------------------------------------------] 5/9 ( 56%)
#> Parameter settings [================================================================>--------------------------------] 6/9 ( 67%)
#> Parameter settings [==========================================================================>----------------------] 7/9 ( 78%)
#> Parameter settings [=====================================================================================>-----------] 8/9 ( 89%)
#> Parameter settings [=================================================================================================] 9/9 (100%)                                                                                                                                  
#> CV fold: Fold2
#> CV progress [====================================================================>-----------------------------------] 2/3 ( 67%)
#> 
#> Parameter settings [=====================>---------------------------------------------------------------------------] 2/9 ( 22%)
#> Parameter settings [===============================>-----------------------------------------------------------------] 3/9 ( 33%)
#> Parameter settings [==========================================>------------------------------------------------------] 4/9 ( 44%)
#> Parameter settings [=====================================================>-------------------------------------------] 5/9 ( 56%)
#> Parameter settings [================================================================>--------------------------------] 6/9 ( 67%)
#> Parameter settings [==========================================================================>----------------------] 7/9 ( 78%)
#> Parameter settings [=====================================================================================>-----------] 8/9 ( 89%)
#> Parameter settings [=================================================================================================] 9/9 (100%)                                                                                                                                  
#> CV fold: Fold3
#> CV progress [========================================================================================================] 3/3 (100%)
#>                                                                                                                                   
#> Parameter settings [=====================>---------------------------------------------------------------------------] 2/9 ( 22%)
#> Parameter settings [===============================>-----------------------------------------------------------------] 3/9 ( 33%)
#> Parameter settings [==========================================>------------------------------------------------------] 4/9 ( 44%)
#> Parameter settings [=====================================================>-------------------------------------------] 5/9 ( 56%)
#> Parameter settings [================================================================>--------------------------------] 6/9 ( 67%)
#> Parameter settings [==========================================================================>----------------------] 7/9 ( 78%)
#> Parameter settings [=====================================================================================>-----------] 8/9 ( 89%)
#> Parameter settings [=================================================================================================] 9/9 (100%)                                                                                                                                  

head(results)
#>     fold performance  k l
#> 1: Fold1   0.8959736 52 0
#> 2: Fold2   0.8832388 68 0
#> 3: Fold3   0.8657147 68 0


## ----include=FALSE------------------------------------------------------------
# nolint end