tests/testthat/test_parallelization.R

In LudvigOlsen/cvms: Cross-Validation for Model Selection

library(cvms)
context("parallelization")

# Does not actually make checks regarding the parallelization (currently)

# Has been commented as doParallel might not be available on all platforms
# Uncomment to run and comment before CRAN submission


test_that("parallelization works with cross_validate()", {
  testthat::skip(message = "Skipping parallel tests")

  # library(doParallel)
  #
  # # Load data and fold it
  # set.seed(1)
  # dat <- groupdata2::fold(participant.scores, k = 5)
  #
  # wrks <- tryCatch({foreach::getDoParWorkers()}, error = function(e) {
  #   print(e)
  #   NULL
  # })
  #
  # if (!is.null(wrks) && wrks > 1){
  #   doParallel::registerDoParallel(wrks)
  #
  # } else {
  #
  #   # Register more cores than available
  #   # This might be slower than sequential
  #   doParallel::registerDoParallel(4)
  # }
  #
  #
  #   par_time <- system.time({cv_par <- cross_validate(dat,
  #                                                     models = rep(c("diagnosis~score","diagnosis~age"), 5),
  #                                                     fold_cols = '.folds', family='binomial',
  #                                                     REML = FALSE, model_verbose=FALSE,
  #                                                     positive=1, parallel = TRUE)})
  #
  #   non_par_time <- system.time({cv_not_par <- cross_validate(dat,
  #                                                             models = rep(c("diagnosis~score","diagnosis~age"), 5),
  #                                                             fold_cols = '.folds', family='binomial',
  #                                                             REML = FALSE, model_verbose=FALSE,
  #                                                             positive=1, parallel = FALSE)})
  #
  #   # expect_true(non_par_time[[3]] > par_time[[3]])
  #
  #   expect_equal(cv_par$`Balanced Accuracy`, cv_not_par$`Balanced Accuracy`)
  #   expect_equal(cv_par$AUC, cv_not_par$AUC)
  #   expect_equal(cv_par$Fixed, cv_not_par$Fixed)
})


test_that("parallelization works with validate()", {
  testthat::skip(message = "Skipping parallel tests")

  # library(doParallel)
  #
  # # Load data and fold it
  # set.seed(1)
  # dat <- groupdata2::partition(participant.scores, p = 0.7, list_out = FALSE)
  #
  # wrks <- tryCatch({foreach::getDoParWorkers()}, error = function(e) {
  #   print(e)
  #   NULL
  # })
  #
  # if (!is.null(wrks) && wrks > 1){
  #   doParallel::registerDoParallel(wrks)
  # } else {
  #
  #   # Register more cores than available
  #   # This might be slower than sequential
  #   doParallel::registerDoParallel(4)
  # }
  #
  #
  #   par_time <- system.time({v_par <- validate(dat,
  #                                              models = rep(c("diagnosis~score","diagnosis~age"), 5),
  #                                              partitions_col = '.partitions', family = 'binomial',
  #                                              REML = FALSE, model_verbose = FALSE,
  #                                              positive = 1, parallel = TRUE)})
  #
  #   non_par_time <- system.time({v_not_par <- validate(dat,
  #                                                       models = rep(c("diagnosis~score","diagnosis~age"), 5),
  #                                                       partitions_col = '.partitions', family = 'binomial',
  #                                                       REML = FALSE, model_verbose = FALSE,
  #                                                       positive = 1, parallel = FALSE)})
  #
  #   # expect_true(non_par_time[[3]] > par_time[[3]])
  #
  #   expect_equal(v_par$`Balanced Accuracy`, v_not_par$`Balanced Accuracy`)
  #   expect_equal(v_par$AUC, v_not_par$AUC)
  #   expect_equal(v_par$Fixed, v_not_par$Fixed)
  #
})

test_that("parallelization works with binomial baseline()", {

  # testthat::skip(message = "Skipping parallel tests")
  #
  # library(doParallel)
  #
  # wrks <- tryCatch({foreach::getDoParWorkers()}, error = function(e) {
  #   print(e)
  #   NULL
  # })
  #
  # if (!is.null(wrks) && wrks > 1){
  #   doParallel::registerDoParallel(wrks)
  # } else {
  #
  #   # Register more cores than available
  #   # This might be slower than sequential
  #   doParallel::registerDoParallel(4)
  # }
  #
  #
  # set.seed(1)
  # par_time <- system.time({b_par <- baseline(test_data = participant.scores,
  #                                            # train_data = train_data,
  #                                            dependent_col = "diagnosis",
  #                                            n = 10,
  #                                            family = "binomial",
  #                                            parallel = TRUE)})
  #
  # set.seed(1)
  # non_par_time <- system.time({b_not_par <- baseline(test_data = participant.scores,
  #                                                # train_data = train_data,
  #                                                dependent_col = "diagnosis",
  #                                                n = 10,
  #                                                family = "binomial",
  #                                                parallel = FALSE)})
  #
  # expect_equal(b_par$summarized_metrics$`Balanced Accuracy`, b_not_par$summarized_metrics$`Balanced Accuracy`)
  # expect_equal(b_par$summarized_metrics$AUC, b_not_par$summarized_metrics$AUC)
})

test_that("parallelization works with gaussian baseline()", {
  testthat::skip(message = "Skipping parallel tests")

  # library(doParallel)
  #
  # # Load data and fold it
  # set.seed(1)
  # dat <- groupdata2::partition(participant.scores, p = 0.6, list_out = TRUE)
  # train_data <- dat[[1]]
  # test_data <- dat[[2]]
  #
  # wrks <- tryCatch({foreach::getDoParWorkers()}, error = function(e) {
  #   print(e)
  #   NULL
  # })
  #
  # if (!is.null(wrks) && wrks > 1){
  #   doParallel::registerDoParallel(wrks)
  # } else {
  #
  #   # Register more cores than available
  #   # This might be slower than sequential
  #   doParallel::registerDoParallel(4)
  # }
  #
  #
  # set.seed(1)
  # par_time <- system.time({b_par <- baseline(test_data = test_data,
  #                                            train_data = train_data,
  #                                            dependent_col = "score",
  #                                            n = 10,
  #                                            family = "gaussian",
  #                                            parallel = TRUE)})
  #
  # set.seed(1)
  # non_par_time <- system.time({b_not_par <- baseline(test_data = test_data,
  #                                                    train_data = train_data,
  #                                                    dependent_col = "score",
  #                                                    n = 10,
  #                                                    family = "gaussian",
  #                                                    parallel = FALSE)})
  #
  # expect_equal(b_par$summarized_metrics$MAE,b_not_par$summarized_metrics$MAE)
  # expect_equal(b_par$summarized_metrics$RMSE,b_not_par$summarized_metrics$RMSE)
  # expect_equal(b_par$summarized_metrics$`Training Rows`, b_not_par$summarized_metrics$`Training Rows`)
})