Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
10 changes: 4 additions & 6 deletions tests/testthat/test-boost_tree_C5.0.R
Original file line number Diff line number Diff line change
Expand Up @@ -13,24 +13,22 @@ test_that('C5.0 execution', {

skip_if_not_installed("C50")

expect_error(
expect_no_condition(
res <- fit(
lc_basic,
Class ~ log(funded_amnt) + int_rate,
data = lending_club,
control = ctrl
),
regexp = NA
)
)

expect_error(
expect_no_condition(
res <- fit_xy(
lc_basic,
x = lending_club[, num_pred],
y = lending_club$Class,
control = ctrl
),
regexp = NA
)
)

expect_true(has_multi_predict(res))
Expand Down
91 changes: 42 additions & 49 deletions tests/testthat/test-boost_tree_xgboost.R
Original file line number Diff line number Diff line change
Expand Up @@ -18,29 +18,25 @@ test_that('xgboost execution, classification', {
wts <- ifelse(runif(nrow(hpc)) < .1, 0, 1)
wts <- importance_weights(wts)

expect_error({
expect_no_condition({
set.seed(1)
res_f <- parsnip::fit(
hpc_xgboost,
class ~ compounds + input_fields,
data = hpc,
control = ctrl
)
},
regexp = NA
)
expect_error({
})
expect_no_condition({
set.seed(1)
res_xy <- parsnip::fit_xy(
hpc_xgboost,
x = hpc[, c("compounds", "input_fields")],
y = hpc$class,
control = ctrl
)
},
regexp = NA
)
expect_error({
})
expect_no_condition({
set.seed(1)
res_f_wts <- parsnip::fit(
hpc_xgboost,
Expand All @@ -49,10 +45,8 @@ test_that('xgboost execution, classification', {
control = ctrl,
case_weights = wts
)
},
regexp = NA
)
expect_error({
})
expect_no_condition({
set.seed(1)
res_xy_wts <- parsnip::fit_xy(
hpc_xgboost,
Expand All @@ -61,9 +55,7 @@ test_that('xgboost execution, classification', {
control = ctrl,
case_weights = wts
)
},
regexp = NA
)
})

expect_equal(res_f$fit$evaluation_log, res_xy$fit$evaluation_log)
expect_equal(res_f_wts$fit$evaluation_log, res_xy_wts$fit$evaluation_log)
Expand Down Expand Up @@ -140,24 +132,22 @@ test_that('xgboost execution, regression', {

ctrl$verbosity <- 0L

expect_error(
expect_no_condition(
res <- parsnip::fit(
car_basic,
mpg ~ .,
data = mtcars,
control = ctrl
),
regexp = NA
)
)

expect_error(
expect_no_condition(
res <- parsnip::fit_xy(
car_basic,
x = mtcars[, num_pred],
y = mtcars$mpg,
control = ctrl
),
regexp = NA
)
)

expect_error(
Expand Down Expand Up @@ -285,32 +275,29 @@ test_that('validation sets', {

ctrl$verbosity <- 0L

expect_error(
expect_no_condition(
reg_fit <-
boost_tree(trees = 20, mode = "regression") %>%
set_engine("xgboost", validation = .1) %>%
fit(mpg ~ ., data = mtcars[-(1:4), ]),
regex = NA
fit(mpg ~ ., data = mtcars[-(1:4), ])
)

expect_equal(colnames(extract_fit_engine(reg_fit)$evaluation_log)[2], "validation_rmse")

expect_error(
expect_no_condition(
reg_fit <-
boost_tree(trees = 20, mode = "regression") %>%
set_engine("xgboost", validation = .1, eval_metric = "mae") %>%
fit(mpg ~ ., data = mtcars[-(1:4), ]),
regex = NA
fit(mpg ~ ., data = mtcars[-(1:4), ])
)

expect_equal(colnames(extract_fit_engine(reg_fit)$evaluation_log)[2], "validation_mae")

expect_error(
expect_no_condition(
reg_fit <-
boost_tree(trees = 20, mode = "regression") %>%
set_engine("xgboost", eval_metric = "mae") %>%
fit(mpg ~ ., data = mtcars[-(1:4), ]),
regex = NA
fit(mpg ~ ., data = mtcars[-(1:4), ])
)

expect_equal(colnames(extract_fit_engine(reg_fit)$evaluation_log)[2], "training_mae")
Expand All @@ -334,23 +321,21 @@ test_that('early stopping', {
ctrl$verbosity <- 0L

set.seed(233456)
expect_error(
expect_no_condition(
reg_fit <-
boost_tree(trees = 200, stop_iter = 5, mode = "regression") %>%
set_engine("xgboost", validation = .1) %>%
fit(mpg ~ ., data = mtcars[-(1:4), ]),
regex = NA
fit(mpg ~ ., data = mtcars[-(1:4), ])
)

expect_equal(extract_fit_engine(reg_fit)$niter - extract_fit_engine(reg_fit)$best_iteration, 5)
expect_true(extract_fit_engine(reg_fit)$niter < 200)

expect_error(
expect_no_condition(
reg_fit <-
boost_tree(trees = 20, mode = "regression") %>%
set_engine("xgboost", validation = .1, eval_metric = "mae") %>%
fit(mpg ~ ., data = mtcars[-(1:4), ]),
regex = NA
fit(mpg ~ ., data = mtcars[-(1:4), ])
)

expect_warning(
Expand Down Expand Up @@ -380,39 +365,39 @@ test_that('xgboost data conversion', {
mtcar_smat <- Matrix::Matrix(mtcar_mat, sparse = TRUE)
wts <- 1:32

expect_error(from_df <- parsnip:::as_xgb_data(mtcar_x, mtcars$mpg), regexp = NA)
expect_no_condition(from_df <- parsnip:::as_xgb_data(mtcar_x, mtcars$mpg))
expect_true(inherits(from_df$data, "xgb.DMatrix"))
expect_true(inherits(from_df$watchlist$training, "xgb.DMatrix"))

expect_error(from_mat <- parsnip:::as_xgb_data(mtcar_mat, mtcars$mpg), regexp = NA)
expect_no_condition(from_mat <- parsnip:::as_xgb_data(mtcar_mat, mtcars$mpg))
expect_true(inherits(from_mat$data, "xgb.DMatrix"))
expect_true(inherits(from_mat$watchlist$training, "xgb.DMatrix"))

expect_error(from_sparse <- parsnip:::as_xgb_data(mtcar_smat, mtcars$mpg), regexp = NA)
expect_no_condition(from_sparse <- parsnip:::as_xgb_data(mtcar_smat, mtcars$mpg))
expect_true(inherits(from_mat$data, "xgb.DMatrix"))
expect_true(inherits(from_mat$watchlist$training, "xgb.DMatrix"))

expect_error(from_df <- parsnip:::as_xgb_data(mtcar_x, mtcars$mpg, validation = .1), regexp = NA)
expect_no_condition(from_df <- parsnip:::as_xgb_data(mtcar_x, mtcars$mpg, validation = .1))
expect_true(inherits(from_df$data, "xgb.DMatrix"))
expect_true(inherits(from_df$watchlist$validation, "xgb.DMatrix"))
expect_true(nrow(from_df$data) > nrow(from_df$watchlist$validation))

expect_error(from_mat <- parsnip:::as_xgb_data(mtcar_mat, mtcars$mpg, validation = .1), regexp = NA)
expect_no_condition(from_mat <- parsnip:::as_xgb_data(mtcar_mat, mtcars$mpg, validation = .1))
expect_true(inherits(from_mat$data, "xgb.DMatrix"))
expect_true(inherits(from_mat$watchlist$validation, "xgb.DMatrix"))
expect_true(nrow(from_mat$data) > nrow(from_mat$watchlist$validation))

expect_error(from_sparse <- parsnip:::as_xgb_data(mtcar_smat, mtcars$mpg, validation = .1), regexp = NA)
expect_no_condition(from_sparse <- parsnip:::as_xgb_data(mtcar_smat, mtcars$mpg, validation = .1))
expect_true(inherits(from_mat$data, "xgb.DMatrix"))
expect_true(inherits(from_mat$watchlist$validation, "xgb.DMatrix"))
expect_true(nrow(from_sparse$data) > nrow(from_sparse$watchlist$validation))

# set event_level for factors

mtcars_y <- factor(mtcars$mpg < 15, levels = c(TRUE, FALSE), labels = c("low", "high"))
expect_error(from_df <- parsnip:::as_xgb_data(mtcar_x, mtcars_y), regexp = NA)
expect_no_condition(from_df <- parsnip:::as_xgb_data(mtcar_x, mtcars_y))
expect_equal(xgboost::getinfo(from_df$data, name = "label")[1:5], rep(0, 5))
expect_error(from_df <- parsnip:::as_xgb_data(mtcar_x, mtcars_y, event_level = "second"), regexp = NA)
expect_no_condition(from_df <- parsnip:::as_xgb_data(mtcar_x, mtcars_y, event_level = "second"))
expect_equal(xgboost::getinfo(from_df$data, name = "label")[1:5], rep(1, 5))

mtcars_y <- factor(mtcars$mpg < 15, levels = c(TRUE, FALSE, "na"), labels = c("low", "high", "missing"))
Expand All @@ -421,9 +406,13 @@ test_that('xgboost data conversion', {
)

# case weights added
expect_error(wted <- parsnip:::as_xgb_data(mtcar_x, mtcars$mpg, weights = wts), regexp = NA)
expect_no_condition(
wted <- parsnip:::as_xgb_data(mtcar_x, mtcars$mpg, weights = wts)
)
expect_equal(wts, xgboost::getinfo(wted$data, "weight"))
expect_error(wted_val <- parsnip:::as_xgb_data(mtcar_x, mtcars$mpg, weights = wts, validation = 1/4), regexp = NA)
expect_no_condition(
wted_val <- parsnip:::as_xgb_data(mtcar_x, mtcars$mpg, weights = wts, validation = 1/4)
)
expect_true(all(xgboost::getinfo(wted_val$data, "weight") %in% wts))
expect_null(xgboost::getinfo(wted_val$watchlist$validation, "weight"))

Expand Down Expand Up @@ -461,9 +450,13 @@ test_that('xgboost data and sparse matrices', {
expect_equal(extract_fit_engine(from_df), extract_fit_engine(from_sparse), ignore_function_env = TRUE)

# case weights added
expect_error(wted <- parsnip:::as_xgb_data(mtcar_smat, mtcars$mpg, weights = wts), regexp = NA)
expect_no_condition(
wted <- parsnip:::as_xgb_data(mtcar_smat, mtcars$mpg, weights = wts)
)
expect_equal(wts, xgboost::getinfo(wted$data, "weight"))
expect_error(wted_val <- parsnip:::as_xgb_data(mtcar_smat, mtcars$mpg, weights = wts, validation = 1/4), regexp = NA)
expect_no_condition(
wted_val <- parsnip:::as_xgb_data(mtcar_smat, mtcars$mpg, weights = wts, validation = 1/4)
)
expect_true(all(xgboost::getinfo(wted_val$data, "weight") %in% wts))
expect_null(xgboost::getinfo(wted_val$watchlist$validation, "weight"))

Expand Down
31 changes: 13 additions & 18 deletions tests/testthat/test-case-weights.R
Original file line number Diff line number Diff line change
Expand Up @@ -10,22 +10,21 @@ test_that('case weights with xy method', {
two_class_subset <- two_class_dat[wts != 0, ]
wts <- importance_weights(wts)

expect_error({
expect_no_condition({
set.seed(1)
C5_bst_wt_fit <-
boost_tree(trees = 5) %>%
set_engine("C5.0") %>%
set_mode("classification") %>%
fit(Class ~ ., data = two_class_dat, case_weights = wts)
},
regexp = NA)
})

expect_output(
print(C5_bst_wt_fit$fit$call),
"weights = weights"
)

expect_error({
expect_no_condition({
set.seed(1)
C5_bst_wt_fit <-
boost_tree(trees = 5) %>%
Expand All @@ -36,8 +35,7 @@ test_that('case weights with xy method', {
y = two_class_dat$Class,
case_weights = wts
)
},
regexp = NA)
})

expect_output(
print(C5_bst_wt_fit$fit$call),
Expand All @@ -57,21 +55,20 @@ test_that('case weights with xy method - non-standard argument names', {
two_class_subset <- two_class_dat[wts != 0, ]
wts <- importance_weights(wts)

expect_error({
expect_no_condition({
set.seed(1)
rf_wt_fit <-
rand_forest(trees = 5) %>%
set_mode("classification") %>%
fit(Class ~ ., data = two_class_dat, case_weights = wts)
},
regexp = NA)
})

# expect_output(
# print(rf_wt_fit$fit$call),
# "case\\.weights = weights"
# )

expect_error({
expect_no_condition({
set.seed(1)
rf_wt_fit <-
rand_forest(trees = 5) %>%
Expand All @@ -81,8 +78,7 @@ test_that('case weights with xy method - non-standard argument names', {
y = two_class_dat$Class,
case_weights = wts
)
},
regexp = NA)
})
})

test_that('case weights with formula method', {
Expand All @@ -97,11 +93,11 @@ test_that('case weights with formula method', {
ames_subset <- ames[wts != 0, ]
wts <- frequency_weights(wts)

expect_error(
expect_no_condition(
lm_wt_fit <-
linear_reg() %>%
fit(Sale_Price ~ Longitude + Latitude, data = ames, case_weights = wts),
regexp = NA)
fit(Sale_Price ~ Longitude + Latitude, data = ames, case_weights = wts)
)

lm_sub_fit <-
linear_reg() %>%
Expand Down Expand Up @@ -141,15 +137,14 @@ test_that('case weights with formula method that goes through `fit_xy()`', {
ames_subset <- ames[wts != 0, ]
wts <- frequency_weights(wts)

expect_error(
expect_no_condition(
lm_wt_fit <-
linear_reg() %>%
fit_xy(
x = ames[c("Longitude", "Latitude")],
y = ames$Sale_Price,
case_weights = wts
),
regexp = NA)
))

lm_sub_fit <-
linear_reg() %>%
Expand Down
10 changes: 4 additions & 6 deletions tests/testthat/test-descriptors.R
Original file line number Diff line number Diff line change
Expand Up @@ -199,17 +199,15 @@ test_that("can be temporarily overriden at evaluation time", {

test_that("system-level descriptor tests", {
skip_if_not_installed("xgboost")
expect_error(
expect_no_condition(
boost_tree(mode = "regression", mtry = .cols()) %>%
set_engine("xgboost") %>%
fit_xy(x = mtcars[, -1], y = mtcars$mpg),
NA
fit_xy(x = mtcars[, -1], y = mtcars$mpg)
)
expect_error(
expect_no_condition(
boost_tree(mode = "regression", mtry = .cols()) %>%
set_engine("xgboost") %>%
fit(mpg ~ ., data = mtcars),
NA
fit(mpg ~ ., data = mtcars)
)

})
Loading
Loading