Skip to content

Commit 47aada0

Browse files
topepotopepo
committed
updates for hard checks
1 parent 28bea10 commit 47aada0

16 files changed

+107
-48
lines changed

‎tests/testthat/_snaps/linear_reg.md‎

Lines changed: 36 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -139,6 +139,42 @@
139139
Error in `fit()`:
140140
! `penalty` must be a number larger than or equal to 0 or `NULL`, not the number -1.
141141

142+
# prevent using a Poisson family
143+
144+
Code
145+
fit(set_engine(linear_reg(penalty = 1), "glmnet", family = poisson), mpg ~ .,
146+
data = mtcars)
147+
Condition
148+
Error in `linear_reg()`:
149+
! A Poisson family was requested for `linear_reg()`. Please use `poisson_reg()` and the engines in the poissonreg package.
150+
151+
---
152+
153+
Code
154+
fit(set_engine(linear_reg(penalty = 1), "glmnet", family = stats::poisson),
155+
mpg ~ ., data = mtcars)
156+
Condition
157+
Error in `linear_reg()`:
158+
! A Poisson family was requested for `linear_reg()`. Please use `poisson_reg()` and the engines in the poissonreg package.
159+
160+
---
161+
162+
Code
163+
fit(set_engine(linear_reg(penalty = 1), "glmnet", family = stats::poisson()),
164+
mpg ~ ., data = mtcars)
165+
Condition
166+
Error in `linear_reg()`:
167+
! A Poisson family was requested for `linear_reg()`. Please use `poisson_reg()` and the engines in the poissonreg package.
168+
169+
---
170+
171+
Code
172+
fit(set_engine(linear_reg(penalty = 1), "glmnet", family = "poisson"), mpg ~ .,
173+
data = mtcars)
174+
Condition
175+
Error in `linear_reg()`:
176+
! A Poisson family was requested for `linear_reg()`. Please use `poisson_reg()` and the engines in the poissonreg package.
177+
142178
# tunables
143179

144180
Code

‎tests/testthat/helper-objects.R‎

Lines changed: 47 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,3 @@
1-
library(modeldata)
2-
3-
data("wa_churn")
4-
data("lending_club")
5-
data("hpc_data")
6-
7-
# ------------------------------------------------------------------------------
81

92
ctrl <- control_parsnip(verbosity = 1, catch = FALSE)
103
caught_ctrl <- control_parsnip(verbosity = 1, catch = TRUE)
@@ -25,53 +18,64 @@ is_tf_ok <- function() {
2518
res
2619
}
2720

28-
# ------------------------------------------------------------------------------
29-
# for quantile regression tests
21+
if (rlang::is_installed("modeldata")) {
22+
# ------------------------------------------------------------------------------
3023

31-
data("Sacramento")
24+
library(modeldata)
3225

33-
Sacramento_small <-
34-
modeldata::Sacramento |>
35-
dplyr::mutate(price = log10(price)) |>
36-
dplyr::select(price, beds, baths, sqft, latitude, longitude)
26+
data("wa_churn")
27+
data("lending_club")
28+
data("hpc_data")
29+
data(two_class_dat, package = "modeldata")
3730

38-
sac_train <- Sacramento_small[-(1:5), ]
39-
sac_test <- Sacramento_small[ 1:5 , ]
31+
# ------------------------------------------------------------------------------
32+
# for quantile regression tests
4033

41-
# ------------------------------------------------------------------------------
42-
# For sparse tibble testing
34+
data("Sacramento")
4335

44-
sparse_hotel_rates <- function(tibble = FALSE) {
45-
# 99.2 sparsity
46-
hotel_rates <- modeldata::hotel_rates
36+
Sacramento_small <-
37+
modeldata::Sacramento |>
38+
dplyr::mutate(price = log10(price)) |>
39+
dplyr::select(price, beds, baths, sqft, latitude, longitude)
4740

48-
prefix_colnames <- function(x, prefix) {
49-
colnames(x) <- paste(colnames(x), prefix, sep = "_")
50-
x
51-
}
41+
sac_train <- Sacramento_small[-(1:5), ]
42+
sac_test <- Sacramento_small[ 1:5 , ]
5243

53-
dummies_country <- hardhat::fct_encode_one_hot(hotel_rates$country)
54-
dummies_company <- hardhat::fct_encode_one_hot(hotel_rates$company)
55-
dummies_agent <- hardhat::fct_encode_one_hot(hotel_rates$agent)
44+
# ------------------------------------------------------------------------------
45+
# For sparse tibble testing
5646

57-
res <- dplyr::bind_cols(
58-
hotel_rates["avg_price_per_room"],
59-
prefix_colnames(dummies_country, "country"),
60-
prefix_colnames(dummies_company, "company"),
61-
prefix_colnames(dummies_agent, "agent")
62-
)
47+
sparse_hotel_rates <- function(tibble = FALSE) {
48+
# 99.2 sparsity
49+
hotel_rates <- modeldata::hotel_rates
6350

64-
res <- as.matrix(res)
65-
res <- Matrix::Matrix(res, sparse = TRUE)
51+
prefix_colnames <- function(x, prefix) {
52+
colnames(x) <- paste(colnames(x), prefix, sep = "_")
53+
x
54+
}
6655

67-
if (tibble) {
68-
res <- sparsevctrs::coerce_to_sparse_tibble(res)
56+
dummies_country <- hardhat::fct_encode_one_hot(hotel_rates$country)
57+
dummies_company <- hardhat::fct_encode_one_hot(hotel_rates$company)
58+
dummies_agent <- hardhat::fct_encode_one_hot(hotel_rates$agent)
6959

70-
# materialize outcome
71-
withr::local_options("sparsevctrs.verbose_materialize" = NULL)
72-
res$avg_price_per_room <- res$avg_price_per_room[]
73-
}
60+
res <- dplyr::bind_cols(
61+
hotel_rates["avg_price_per_room"],
62+
prefix_colnames(dummies_country, "country"),
63+
prefix_colnames(dummies_company, "company"),
64+
prefix_colnames(dummies_agent, "agent")
65+
)
7466

75-
res
67+
res <- as.matrix(res)
68+
res <- Matrix::Matrix(res, sparse = TRUE)
69+
70+
if (tibble) {
71+
res <- sparsevctrs::coerce_to_sparse_tibble(res)
72+
73+
# materialize outcome
74+
withr::local_options("sparsevctrs.verbose_materialize" = NULL)
75+
res$avg_price_per_room <- res$avg_price_per_room[]
76+
}
77+
78+
res
79+
}
7680
}
7781

‎tests/testthat/test-augment.R‎

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -48,6 +48,8 @@ test_that('regression models', {
4848

4949

5050
test_that('classification models', {
51+
skip_if_not_installed("modeldata")
52+
5153
data(two_class_dat, package = "modeldata")
5254
x <- logistic_reg() |> set_engine("glm")
5355

@@ -81,6 +83,7 @@ test_that('classification models', {
8183

8284
test_that('augment for model without class probabilities', {
8385
skip_if_not_installed("LiblineaR")
86+
skip_if_not_installed("modeldata")
8487

8588
data(two_class_dat, package = "modeldata")
8689
x <- svm_linear(mode = "classification") |> set_engine("LiblineaR")

‎tests/testthat/test-boost_tree.R‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -37,6 +37,7 @@ test_that('argument checks for data dimensions', {
3737
})
3838

3939
test_that('boost_tree can be fit with 1 predictor if validation is used', {
40+
skip_if_not_installed("earth")
4041
skip_on_cran()
4142
spec <- boost_tree(trees = 1) |>
4243
set_engine("xgboost", validation = 0.5) |>

‎tests/testthat/test-boost_tree_C5.0.R‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -129,7 +129,7 @@ test_that('submodel prediction', {
129129
## -----------------------------------------------------------------------------
130130

131131
test_that('argument checks for data dimensions', {
132-
132+
skip_if_not_installed("modeldata")
133133
skip_if_not_installed("C50")
134134

135135
data(penguins, package = "modeldata")

‎tests/testthat/test-boost_tree_xgboost.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -466,7 +466,7 @@ test_that('xgboost data and sparse matrices', {
466466
## -----------------------------------------------------------------------------
467467

468468
test_that('argument checks for data dimensions', {
469-
469+
skip_if_not_installed("modeldata")
470470
skip_if_not_installed("xgboost")
471471
skip_on_cran()
472472

@@ -500,6 +500,7 @@ test_that("fit and prediction with `event_level`", {
500500

501501
skip_if_not_installed("xgboost")
502502
skip_on_cran()
503+
skip_if_not_installed("modeldata")
503504

504505
ctrl$verbosity <- 0L
505506

‎tests/testthat/test-convert_data.R‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -618,6 +618,8 @@ test_that("bad args", {
618618
## -----------------------------------------------------------------------------
619619

620620
test_that("convert to matrix", {
621+
skip_if_not_installed("modeldata")
622+
621623
expect_true(inherits(parsnip::maybe_matrix(mtcars), "matrix"))
622624
expect_true(inherits(parsnip::maybe_matrix(tibble::as_tibble(mtcars)), "matrix"))
623625
expect_true(inherits(parsnip::maybe_matrix(as.matrix(mtcars)), "matrix"))

‎tests/testthat/test-decision_tree.R‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -28,6 +28,7 @@ test_that('bad input', {
2828
# ------------------------------------------------------------------------------
2929

3030
test_that('argument checks for data dimensions', {
31+
skip_if_not_installed("modeldata")
3132

3233
data(penguins, package = "modeldata")
3334
penguins <- na.omit(penguins)

‎tests/testthat/test-gen_additive_model.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,10 +1,11 @@
1-
data(two_class_dat, package = "modeldata")
1+
22

33
# ------------------------------------------------------------------------------
44

55

66
test_that('regression', {
77
skip_if_not_installed("mgcv")
8+
skip_if_not_installed("modeldata")
89

910
reg_mod <-
1011
gen_additive_mod(select_features = TRUE) |>

‎tests/testthat/test-linear_reg.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -361,7 +361,8 @@ test_that("check_args() works", {
361361

362362

363363
test_that("prevent using a Poisson family", {
364-
skip_if(rlang::is_installed("glmnet"))
364+
skip_if_not_installed("glmnet")
365+
365366
expect_snapshot(
366367
linear_reg(penalty = 1) |>
367368
set_engine("glmnet", family = poisson) |>

0 commit comments

Comments
 (0)