reprex for https://github.com/berndbischl/parallelMap/issues/72

reprex-multicore-issue

remotes::install_github("mlr-org/mlr@0c8185963f13303e143d634dc5bcd199edb01442")
library(mlr)
library(ParamHelpers)
library(parallelMap)
library(magrittr)

inner <- makeResampleDesc("CV", iters = 2)
outer <- makeResampleDesc("CV", iters = 4)

lrn_xgboost <- makeLearner(
  "regr.xgboost",
  par.vals = list(
    objective = "reg:linear",
    eval_metric = "error"
  )
)

tune.ctrl_xgboost <- makeTuneControlRandom(maxit = 5L)

ps_xgboost_filter <- makeParamSet(
  makeIntegerParam("nrounds", lower = 10, upper = 600),
  makeNumericParam("colsample_bytree", lower = 0.3, upper = 0.7),
  makeNumericParam("subsample", lower = 0.25, upper = 1),
  makeIntegerParam("max_depth", lower = 1, upper = 10),
  makeNumericParam("gamma", lower = 0, upper = 10),
  makeNumericParam("eta", lower = 0.001, upper = 0.6),
  makeNumericParam("min_child_weight", lower = 0, upper = 20),
  makeNumericParam("fw.perc", lower = 0, upper = 1)
)


filter_wrapper_xgboost_borda <- makeFilterWrapper(lrn_xgboost,
  fw.method = "E-Borda", cache = TRUE,
  fw.base.methods = c(
    "FSelectorRcpp_information.gain",
    "linear.correlation",
    "praznik_MRMR", "praznik_CMIM",
    "carscore"
  ),
  more.args = list("FSelectorRcpp_information.gain" = list(equal = TRUE)) # FSelectorRcpp
)

filter_wrapper_xgboost_gain.ratio <- makeFilterWrapper(lrn_xgboost, fw.method = "FSelectorRcpp_gain.ratio", cache = TRUE, equal = TRUE)
filter_wrapper_xgboost_info.gain <- makeFilterWrapper(lrn_xgboost, fw.method = "FSelectorRcpp_information.gain", cache = TRUE, equal = TRUE)
filter_wrapper_xgboost_variance <- makeFilterWrapper(lrn_xgboost, fw.method = "variance", cache = TRUE)
filter_wrapper_xgboost_rank.cor <- makeFilterWrapper(lrn_xgboost, fw.method = "rank.correlation", cache = TRUE)
filter_wrapper_xgboost_linear.cor <- makeFilterWrapper(lrn_xgboost, fw.method = "linear.correlation", cache = TRUE)
filter_wrapper_xgboost_mrmr <- makeFilterWrapper(lrn_xgboost, fw.method = "praznik_MRMR", cache = TRUE)
filter_wrapper_xgboost_cmim <- makeFilterWrapper(lrn_xgboost, fw.method = "praznik_CMIM", cache = TRUE)
filter_wrapper_xgboost_carscore <- makeFilterWrapper(lrn_xgboost, fw.method = "carscore", cache = TRUE)


# XGBOOST -----------------------------------------------------------------

xgboost_borda <- makeTuneWrapper(filter_wrapper_xgboost_borda,
  resampling = inner,
  par.set = ps_xgboost_filter,
  control = tune.ctrl_xgboost,
  show.info = TRUE, measures = list(rmse)
) %>%
  magrittr::inset("id", "XGBoost Borda")

xgboost_info.gain <- makeTuneWrapper(filter_wrapper_xgboost_info.gain,
  resampling = inner,
  par.set = ps_xgboost_filter,
  control = tune.ctrl_xgboost, show.info = TRUE,
  measures = list(rmse)
) %>%
  magrittr::inset("id", "XGBoost Info Gain")

xgboost_gain.ratio <- makeTuneWrapper(filter_wrapper_xgboost_gain.ratio,
  resampling = inner,
  par.set = ps_xgboost_filter,
  control = tune.ctrl_xgboost, show.info = TRUE,
  measures = list(rmse)
) %>%
  magrittr::inset("id", "XGBoost Gain Ratio")


xgboost_variance <- makeTuneWrapper(filter_wrapper_xgboost_variance,
  resampling = inner,
  par.set = ps_xgboost_filter,
  control = tune.ctrl_xgboost, show.info = TRUE,
  measures = list(rmse)
) %>%
  magrittr::inset("id", "XGBoost Variance")

xgboost_rank.cor <- makeTuneWrapper(filter_wrapper_xgboost_rank.cor,
  resampling = inner,
  par.set = ps_xgboost_filter,
  control = tune.ctrl_xgboost, show.info = TRUE,
  measures = list(rmse)
) %>%
  magrittr::inset("id", "XGBoost Spearman")

xgboost_linear.cor <- makeTuneWrapper(filter_wrapper_xgboost_linear.cor,
  resampling = inner,
  par.set = ps_xgboost_filter,
  control = tune.ctrl_xgboost, show.info = TRUE,
  measures = list(rmse)
) %>%
  magrittr::inset("id", "XGBoost Pearson")

xgboost_mrmr <- makeTuneWrapper(filter_wrapper_xgboost_mrmr,
  resampling = inner,
  par.set = ps_xgboost_filter,
  control = tune.ctrl_xgboost, show.info = TRUE,
  measures = list(rmse)
) %>%
  magrittr::inset("id", "XGBoost MRMR")

xgboost_cmim <- makeTuneWrapper(filter_wrapper_xgboost_cmim,
  resampling = inner,
  par.set = ps_xgboost_filter,
  control = tune.ctrl_xgboost, show.info = TRUE,
  measures = list(rmse)
) %>%
  magrittr::inset("id", "XGBoost CMIM")

xgboost_carscore <- makeTuneWrapper(filter_wrapper_xgboost_carscore,
  resampling = inner,
  par.set = ps_xgboost_filter,
  control = tune.ctrl_xgboost, show.info = TRUE,
  measures = list(rmse)
) %>%
  magrittr::inset("id", "XGBoost Car")


parallelStart(
  mode = "multicore",
  level = "mlr.resample",
  cpus = 4
)
set.seed(12345)


learner_list = list(xgboost_carscore, xgboost_cmim,
  xgboost_mrmr, xgboost_linear.cor, xgboost_gain.ratio,
  xgboost_variance, xgboost_borda)

bh.task_cust = dropFeatures(bh.task, "chas")
task_list = list(bh.task_cust)

bmr <- benchmark(
  learners = learner_list,
  tasks = task_list,
  models = FALSE,
  keep.pred = TRUE,
  resamplings = outer,
  show.info = TRUE,
  measures = list(rmse, timetrain)
)

parallelStop()