diff --git a/R/nullmodel_data.R b/R/nullmodel_data.R index 697de1314..42aa52c7a 100644 --- a/R/nullmodel_data.R +++ b/R/nullmodel_data.R @@ -29,7 +29,7 @@ set_encoding( predictor_indicators = "traditional", compute_intercept = FALSE, remove_intercept = FALSE, - allow_sparse_x = FALSE + allow_sparse_x = TRUE ) ) @@ -53,7 +53,7 @@ set_encoding( predictor_indicators = "traditional", compute_intercept = FALSE, remove_intercept = FALSE, - allow_sparse_x = FALSE + allow_sparse_x = TRUE ) ) diff --git a/tests/testthat/_snaps/nullmodel.md b/tests/testthat/_snaps/nullmodel.md new file mode 100644 index 000000000..ee456ea2b --- /dev/null +++ b/tests/testthat/_snaps/nullmodel.md @@ -0,0 +1,48 @@ +# bad input + + Code + translate(set_engine(null_model(mode = "regression"))) + Condition + Error in `set_engine()`: + ! Missing engine. Possible mode/engine combinations are: classification {parsnip} and regression {parsnip}. + +--- + + Code + translate(set_engine(null_model(), "wat?")) + Condition + Error in `set_engine()`: + x Engine "wat?" is not supported for `null_model()` + i See `show_engines("null_model")`. + +# nullmodel execution + + Code + res <- fit(set_engine(null_model(mode = "regression"), "parsnip"), hpc_bad_form, + data = hpc) + Condition + Error: + ! object 'term' not found + +# null_model printing + + Code + print(null_model(mode = "classification")) + Output + Null Model Specification (classification) + + Computational engine: parsnip + + +--- + + Code + print(translate(set_engine(null_model(mode = "classification"), "parsnip"))) + Output + Null Model Specification (classification) + + Computational engine: parsnip + + Model fit template: + parsnip::nullmodel(x = missing_arg(), y = missing_arg()) + diff --git a/tests/testthat/test-nullmodel.R b/tests/testthat/test-nullmodel.R index 9195aa706..47e31bbf1 100644 --- a/tests/testthat/test-nullmodel.R +++ b/tests/testthat/test-nullmodel.R @@ -147,3 +147,85 @@ test_that("check_args() works", { # Here for completeness, no checking is done expect_true(TRUE) }) + +# ------------------------------------------------------------------------------ + +test_that("null_model works with sparse matrix data - regression", { + skip_if_not_installed("sparsevctrs") + + # Make materialization of sparse vectors throw an error + withr::local_options("sparsevctrs.verbose_materialize" = 3) + + hotel_data <- sparse_hotel_rates() + + spec <- null_model(mode = "regression") |> + set_engine("parsnip") + + expect_no_error( + null_fit <- fit_xy(spec, x = hotel_data[, -1], y = hotel_data[, 1]) + ) + + expect_no_error( + preds <- predict(null_fit, hotel_data) + ) + + # All predictions should be the mean of the outcome + expect_true(all(preds$.pred == preds$.pred[1])) +}) + +test_that("null_model works with sparse matrix data - classification", { + skip_if_not_installed("sparsevctrs") + + # Make materialization of sparse vectors throw an error + withr::local_options("sparsevctrs.verbose_materialize" = 3) + + hotel_data <- sparse_hotel_rates() + + # Create a factor outcome for classification + y_class <- factor(ifelse(hotel_data[, 1] > median(hotel_data[, 1]), "high", "low")) + + spec <- null_model(mode = "classification") |> + set_engine("parsnip") + + expect_no_error( + null_fit <- fit_xy(spec, x = hotel_data[, -1], y = y_class) + ) + + expect_no_error( + preds <- predict(null_fit, hotel_data) + ) + + # All predictions should be the same (most prevalent class) + expect_true(all(preds$.pred_class == preds$.pred_class[1])) + + expect_no_error( + probs <- predict(null_fit, hotel_data, type = "prob") + ) + + # All probability predictions should be identical + expect_true(all(probs$.pred_high == probs$.pred_high[1])) + expect_true(all(probs$.pred_low == probs$.pred_low[1])) +}) + +test_that("null_model works with sparse tibble data - regression", { + skip_if_not_installed("sparsevctrs") + + # Make materialization of sparse vectors throw an error + withr::local_options("sparsevctrs.verbose_materialize" = 3) + + hotel_data <- sparse_hotel_rates(tibble = TRUE) + + spec <- null_model(mode = "regression") |> + set_engine("parsnip") + + expect_no_error( + null_fit <- fit_xy(spec, x = hotel_data[, -1], y = hotel_data[, 1]) + ) + + expect_no_error( + preds <- predict(null_fit, hotel_data) + ) + + # All predictions should be the mean of the outcome + expect_true(all(preds$.pred == preds$.pred[1])) +})