From fe24b61dc2726eb36cd8bb2b4f143b990f7d7169 Mon Sep 17 00:00:00 2001 From: Zach Deane-Mayer Date: Wed, 26 Jun 2024 17:57:46 -0400 Subject: [PATCH] fix all skipped tests --- R/caretList.R | 2 +- R/helper_functions.R | 5 +---- tests/testthat/test-a-skip.R | 7 +++---- tests/testthat/test-caretStack.R | 6 ++++-- tests/testthat/test-ensembleMethods.R | 29 +++++++++++++------------- tests/testthat/test-helper_functions.R | 5 ++--- tests/testthat/test-parallel.R | 1 + 7 files changed, 26 insertions(+), 29 deletions(-) diff --git a/R/caretList.R b/R/caretList.R index a87931eb..1706cc7d 100644 --- a/R/caretList.R +++ b/R/caretList.R @@ -88,7 +88,7 @@ trControlCheck <- function(x, y) { stop("Please pass exactly 1 argument to savePredictions, e.g. savePredictions='final'") } - if (x$savePredictions) { + if (x$savePredictions %in% c(TRUE)) { warning("x$savePredictions == TRUE is depreciated. Setting to 'final' instead.") x$savePredictions <- "final" } diff --git a/R/helper_functions.R b/R/helper_functions.R index 7154936a..1a45e9d6 100644 --- a/R/helper_functions.R +++ b/R/helper_functions.R @@ -259,10 +259,7 @@ extractModelTypes <- function(list_of_models) { #' @importFrom data.table data.table setorderv bestPreds <- function(x) { stopifnot(is(x, "train")) - stopifnot({ - x$control$savePredictions %in% c("all", "final") | - x$control$savePredictions - }) + stopifnot(x$control$savePredictions %in% c("all", "final", TRUE)) a <- data.table(x$bestTune, key = names(x$bestTune)) b <- data.table(x$pred, key = names(x$bestTune)) b <- b[a, ] diff --git a/tests/testthat/test-a-skip.R b/tests/testthat/test-a-skip.R index 05fb9e9a..ad649b42 100644 --- a/tests/testthat/test-a-skip.R +++ b/tests/testthat/test-a-skip.R @@ -1,10 +1,9 @@ context("Test skips are working correctly") test_that("Skips work correctly", { skip("Basic skip failed") + expect_equal(1, 0) }) -test_that("Skips work correctly", { - skip_on_travis() -}) -test_that("Skips work correctly", { +test_that("Skips work correctly on CRAN", { skip_on_cran() + expect_equal(1, 1) }) diff --git a/tests/testthat/test-caretStack.R b/tests/testthat/test-caretStack.R index eae88416..2f46949c 100644 --- a/tests/testthat/test-caretStack.R +++ b/tests/testthat/test-caretStack.R @@ -1,4 +1,3 @@ -context("Does stacking and prediction work?") library(caret) data(models.reg) @@ -9,6 +8,9 @@ data(models.class) data(X.class) data(Y.class) + +context("Does stacking and prediction work?") + test_that("We can stack regression models", { set.seed(96367) ens.reg <- caretStack( @@ -43,7 +45,6 @@ test_that("We can stack classification models", { }) test_that("caretStack plots", { - skip_if_not_installed("gbm") test_plot_file <- "caretEnsemble_test_plots.png" ens.reg <- caretStack( models.reg, @@ -55,6 +56,7 @@ test_that("caretStack plots", { dotplot(ens.reg, metric = "RMSE") dev.off() unlink(test_plot_file) + expect_is(ens.reg, "caretStack") }) context("Prediction errors for caretStack work as expected") diff --git a/tests/testthat/test-ensembleMethods.R b/tests/testthat/test-ensembleMethods.R index 7f3b111d..c87618af 100644 --- a/tests/testthat/test-ensembleMethods.R +++ b/tests/testthat/test-ensembleMethods.R @@ -29,22 +29,21 @@ test_that("We can get variable importance in ensembles", { expect_is(varImp(ens.reg, scale = TRUE, weight = TRUE), "data.frame") }) -test_that("We get warnings when scale is set to FALSE and weight is TRUE", { - skip_on_cran() +test_that("varImp works for caretEnsembles", { set.seed(2239) - ens.class <- caretEnsemble(models.class, trControl = trainControl(method = "none")) - # varImp struggles with the rf in our test suite, why? - models.subset <- models.reg[2:4] - class(models.subset) <- "caretList" - ens.reg <- caretEnsemble(models.subset, trControl = trainControl(method = "none")) - i <- varImp(ens.reg, scale = FALSE, weight = TRUE) - i <- varImp(ens.class, scale = FALSE, weight = TRUE) - i <- varImp(ens.reg, scale = FALSE, weight = TRUE) - i <- varImp(ens.class, scale = FALSE, weight = TRUE) - i <- varImp(ens.reg, scale = FALSE) - i <- varImp(ens.class, scale = FALSE) - i <- varImp(ens.reg, scale = FALSE) - i <- varImp(ens.class, scale = FALSE) + for (models in list(models.class, models.reg)) { + ens <- caretEnsemble(models, trControl = trainControl(method = "none")) + expected_names <- c("overall", names(ens$models)) + expected_row_names <- c("Intercept", "Speciesversicolor", "Speciesvirginica", "Petal.Width", "Sepal.Width", "Petal.Length") + for (s in c(TRUE, FALSE)) { + for (w in c(TRUE, FALSE)) { + i <- varImp(ens, scale = s, weight = w) + expect_is(i, "data.frame") + expect_equal(names(i), expected_names) + expect_equal(row.names(i), expected_row_names) + } + } + } }) test_that("We get the right dimensions back", { diff --git a/tests/testthat/test-helper_functions.R b/tests/testthat/test-helper_functions.R index d0333665..77d311b6 100644 --- a/tests/testthat/test-helper_functions.R +++ b/tests/testthat/test-helper_functions.R @@ -110,8 +110,8 @@ w1 <- c(0.1, 0.1, 0.1, 0.7) test_that("wtd.sd applies weights correctly", { expect_error(caretEnsemble:::wtd.sd(x)) - expect_false(sd(x1) == wtd.sd(x1, w = x2)) - expect_false(sd(x1) == wtd.sd(x1, w = x2)) + expect_false(sd(x1) == caretEnsemble:::wtd.sd(x1, w = x2)) + expect_false(sd(x1) == caretEnsemble:::wtd.sd(x1, w = x2)) expect_equal(caretEnsemble:::wtd.sd(y, w = w1), 7.84, tolerance = .001) expect_equal(caretEnsemble:::wtd.sd(y, w = w1 * 100), caretEnsemble:::wtd.sd(y, w = w1)) }) @@ -131,7 +131,6 @@ test_that("wtd.sd handles NA values correctly", { test_that("Checks generate errors", { skip_on_cran() - skip_if_not_installed("rpart") set.seed(42) myControl <- trainControl(method = "cv", number = 5, savePredictions = "final") suppressWarnings( diff --git a/tests/testthat/test-parallel.R b/tests/testthat/test-parallel.R index 258d3da9..648f07c4 100644 --- a/tests/testthat/test-parallel.R +++ b/tests/testthat/test-parallel.R @@ -3,6 +3,7 @@ context("Parallelization works") test_that("predict.caretEnsemble works in parallel", { skip_on_cran() + pbapply::pboptions(type = "none") X_reg <- model.matrix(~., iris[, -1]) X_reg_big <- do.call(rbind, lapply(1:100, function(x) X_reg)) Y_reg <- iris[, 1]