The hardware and bandwidth for this mirror is donated by dogado GmbH, the Webhosting and Full Service-Cloud Provider. Check out our Wordpress Tutorial.
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[@]dogado.de.

rpart: Binary Classification

# nolint start
library(mlexperiments)

See https://github.com/kapsner/mlexperiments/blob/main/R/learner_rpart.R for implementation details.

Preprocessing

Import and Prepare Data

library(mlbench)
data("BreastCancer")
dataset <- BreastCancer |>
  data.table::as.data.table() |>
  na.omit()

seed <- 123
feature_cols <- colnames(dataset)[2:10]
target_col <- "Class"
to_num <- c(
  "Cl.thickness",
  "Cell.size",
  "Cell.shape",
  "Marg.adhesion",
  "Epith.c.size"
)
dataset[, (to_num) := lapply(.SD, as.numeric), .SDcols = to_num]

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


test_x <- model.matrix(
  ~ -1 + .,
  dataset[data_split$test, .SD, .SDcols = feature_cols]
)
test_y <- 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(method = "class")

# set arguments for predict function and performance metric,
# required for mlexperiments::MLCrossValidation and
# mlexperiments::MLNestedCV
predict_args <- list(type = "prob")
performance_metric <- metric("AUC")
performance_metric_args <- list(
  positive = "malignant",
  negative = "benign"
)
return_models <- FALSE

# required for grid search and initialization of bayesian optimization
parameter_grid <- expand.grid(
  minsplit = seq(2L, 10L, 1L),
  cp = seq(0.01, 0.1, 0.01),
  maxdepth = seq(2L, 10L, 2L)
)
# 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(
  minsplit = c(2L, 10L),
  cp = c(0.01, 0.1),
  maxdepth = c(2L, 10L)
)
optim_args <- list(
  n_iter = ncores,
  kappa = 3.5,
  acq = "ucb"
)

Hyperparameter Tuning

tuner <- mlexperiments::MLTuneParameters$new(
  learner = LearnerRpart$new(),
  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)
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> Parameter settings [============================>-------------------------------------------------------------------] 3/10 ( 30%)
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> Parameter settings [=====================================>----------------------------------------------------------] 4/10 ( 40%)
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> Parameter settings [===============================================>------------------------------------------------] 5/10 ( 50%)
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> Parameter settings [=========================================================>--------------------------------------] 6/10 ( 60%)
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> Parameter settings [==================================================================>-----------------------------] 7/10 ( 70%)
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> Parameter settings [============================================================================>-------------------] 8/10 ( 80%)
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> Parameter settings [=====================================================================================>----------] 9/10 ( 90%)
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> Parameter settings [===============================================================================================] 10/10 (100%)
#>  Classification: using 'mean misclassification error' as optimization metric.

head(tuner_results_grid)
#>    setting_id metric_optim_mean minsplit    cp maxdepth method
#>         <int>             <num>    <int> <num>    <int> <char>
#> 1:          1        0.04823229        2  0.07       10  class
#> 2:          2        0.04823229        9  0.10        4  class
#> 3:          3        0.06698229        6  0.02        2  class
#> 4:          4        0.04823229        7  0.02        6  class
#> 5:          5        0.04823229        4  0.08       10  class
#> 6:          6        0.04823229       10  0.04        8  class

Bayesian Optimization

tuner <- mlexperiments::MLTuneParameters$new(
  learner = LearnerRpart$new(),
  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.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#> elapsed = 0.121  Round = 1   minsplit = 6.0000   cp = 0.0200 maxdepth = 2.0000   Value = -0.06698229
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#> elapsed = 0.13   Round = 2   minsplit = 2.0000   cp = 0.0800 maxdepth = 6.0000   Value = -0.04823229
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#> elapsed = 0.131  Round = 3   minsplit = 9.0000   cp = 0.1000 maxdepth = 4.0000   Value = -0.04823229
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#> elapsed = 0.036  Round = 4   minsplit = 3.0000   cp = 0.0400 maxdepth = 8.0000   Value = -0.04823229
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#> elapsed = 0.136  Round = 5   minsplit = 10.0000  cp = 0.1000 maxdepth = 10.0000  Value = -0.04823229
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#> elapsed = 0.122  Round = 6   minsplit = 7.0000   cp = 0.0810495  maxdepth = 8.0000   Value = -0.04823229
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#> elapsed = 0.155  Round = 7   minsplit = 4.0000   cp = 0.05388637 maxdepth = 2.0000   Value = -0.06698229
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#> elapsed = 0.10   Round = 8   minsplit = 8.0000   cp = 0.03326189 maxdepth = 9.0000   Value = -0.04823229
#>
#>  Best Parameters Found:
#> Round = 2    minsplit = 2.0000   cp = 0.0800 maxdepth = 6.0000   Value = -0.04823229

head(tuner_results_bayesian)
#>    setting_id minsplit        cp maxdepth       Value method metric_optim_mean
#>         <int>    <num>     <num>    <num>       <num> <char>             <num>
#> 1:          1        6 0.0200000        2 -0.06698229  class        0.06698229
#> 2:          2        2 0.0800000        6 -0.04823229  class        0.04823229
#> 3:          3        9 0.1000000        4 -0.04823229  class        0.04823229
#> 4:          4        3 0.0400000        8 -0.04823229  class        0.04823229
#> 5:          5       10 0.1000000       10 -0.04823229  class        0.04823229
#> 6:          6        7 0.0810495        8 -0.04823229  class        0.04823229

k-Fold Cross Validation

validator <- mlexperiments::MLCrossValidation$new(
  learner = LearnerRpart$new(),
  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    cp maxdepth method
#>    <char>       <num> <num>    <num> <char>
#> 1:  Fold1   0.9613416  0.08        6  class
#> 2:  Fold2   0.9230236  0.08        6  class
#> 3:  Fold3   0.9751030  0.08        6  class

Nested Cross Validation

validator <- mlexperiments::MLNestedCV$new(
  learner = LearnerRpart$new(),
  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 <- TRUE

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

validator_results <- validator$execute()
#>
#> CV fold: Fold1
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> Parameter settings [====================================================================================================] 10/10 (100%)
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> CV fold: Fold2
#> CV progress [========================================================================>------------------------------------] 2/3 ( 67%)
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> Parameter settings [==========================================================================================>----------] 9/10 ( 90%)
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> Parameter settings [====================================================================================================] 10/10 (100%)
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> CV fold: Fold3
#> CV progress [=============================================================================================================] 3/3 (100%)
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#>  Classification: using 'mean misclassification error' as optimization metric.
#>
#> Parameter settings [====================================================================================================] 10/10 (100%)
#>  Classification: using 'mean misclassification error' as optimization metric.

head(validator_results)
#>      fold performance minsplit    cp maxdepth method
#>    <char>       <num>    <int> <num>    <int> <char>
#> 1:  Fold1   0.9613416        6  0.02        2  class
#> 2:  Fold2   0.9230236        2  0.07       10  class
#> 3:  Fold3   0.9751030        2  0.07       10  class

Comparison with Logistic Regression

See https://github.com/kapsner/mlexperiments/blob/main/R/learner_glm.R for implementation details.

validator_glm <- mlexperiments::MLCrossValidation$new(
  learner = LearnerGlm$new(),
  fold_list = fold_list,
  ncores = ncores,
  seed = seed
)

validator_glm$learner_args <- list(family = binomial(link = "logit"))
validator_glm$predict_args <- list(type = "response")
validator_glm$performance_metric <- performance_metric
validator_glm$performance_metric_args <- performance_metric_args
validator_glm$return_models <- TRUE

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

validator_glm_results <- validator_glm$execute()
#>
#> CV fold: Fold1
#> Parameter 'ncores' is ignored for learner 'LearnerGlm'.
#> Warning: glm.fit: algorithm did not converge
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#> Warning in predict.lm(object, newdata, se.fit, scale = 1, type = if (type == : prediction from rank-deficient fit; attr(*, "non-estim")
#> has doubtful cases
#>
#> CV fold: Fold2
#> Parameter 'ncores' is ignored for learner 'LearnerGlm'.
#> Warning: glm.fit: algorithm did not converge
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred
#>
#> CV fold: Fold3
#> CV progress [=============================================================================================================] 3/3 (100%)
#>                                                                                                                                        Parameter 'ncores' is ignored for learner 'LearnerGlm'.
#> Warning: glm.fit: algorithm did not converge
#> Warning: glm.fit: fitted probabilities numerically 0 or 1 occurred

head(validator_glm_results)
#>      fold performance
#>    <char>       <num>
#> 1:  Fold1   0.9239188
#> 2:  Fold2   0.8978849
#> 3:  Fold3   0.9184409

Test Fold Equality

mlexperiments::validate_fold_equality(
  experiments = list(validator, validator_glm)
)
#> 
#> Testing for identical folds in 1 and 2.
#> 
#> Testing for identical folds in 2 and 1.

Predict Outcome in Holdout Test Dataset

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

preds_glm <- mlexperiments::predictions(
  object = validator_glm,
  newdata = test_x
)

Evaluate Performance on Holdout Test Dataset

perf_rpart <- mlexperiments::performance(
  object = validator,
  prediction_results = preds_rpart,
  y_ground_truth = test_y,
  type = "binary"
)

perf_glm <- mlexperiments::performance(
  object = validator_glm,
  prediction_results = preds_glm,
  y_ground_truth = test_y,
  type = "binary"
)
# combine results for plotting
final_results <- rbind(
  cbind(algorithm = "rpart", perf_rpart),
  cbind(algorithm = "glm", perf_glm)
)
# p <- ggpubr::ggdotchart(
#   data = final_results,
#   x = "algorithm",
#   y = "AUC",
#   color = "model",
#   rotate = TRUE
# )
# p

Model Comparison

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.
Health stats visible at Monitor.