diff --git a/DESCRIPTION b/DESCRIPTION index c643204..eb6752e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -15,6 +15,7 @@ Suggests: baguette, bonsai, BradleyTerry2, + brulee, butcher, C50, censored, diff --git a/tests/testthat/helper-data.R b/tests/testthat/helper-data.R new file mode 100644 index 0000000..7844307 --- /dev/null +++ b/tests/testthat/helper-data.R @@ -0,0 +1,31 @@ +library(modeldata) +library(rsample) + +set.seed(392) +binary_tr <- sim_logistic(200, ~ .1 + 2 * A - 3 * B + 1 * A *B, corr = .7) +binary_rs <- vfold_cv(binary_tr) +binary_te <- sim_logistic(2, ~ .1 + 2 * A - 3 * B + 1 * A *B, corr = .7) + +### + +set.seed(392) +three_class_tr <- + sim_multinomial( + 500, + ~ -0.5 + 0.6 * abs(A), + ~ ifelse(A > 0 & B > 0, 1.0 + 0.2 * A / B, - 2), + ~ -0.6 * A + 0.50 * B - A * B) +three_class_rs <- vfold_cv(three_class_tr) +three_class_te <- + sim_multinomial( + 2, + ~ -0.5 + 0.6 * abs(A), + ~ ifelse(A > 0 & B > 0, 1.0 + 0.2 * A / B, - 2), + ~ -0.6 * A + 0.50 * B - A * B) + +### + +num_tr <- sim_regression(200) +num_rs <- vfold_cv(num_tr) +num_te <- sim_regression(2) + diff --git a/tests/testthat/helper-objects.R b/tests/testthat/helper-objects.R index 52db341..1434d9e 100644 --- a/tests/testthat/helper-objects.R +++ b/tests/testthat/helper-objects.R @@ -29,3 +29,15 @@ spark_not_installed <- function() { } need_install } + +# ------------------------------------------------------------------------------ + +is_torch_working <- function() { + res <- try(torch::torch_tensor(1), silent = TRUE) + if (inherits(res, "try-error")) { + ret <- FALSE + } else { + ret <- TRUE + } + ret +} diff --git a/tests/testthat/test-brulee-linear.R b/tests/testthat/test-brulee-linear.R new file mode 100644 index 0000000..20250c0 --- /dev/null +++ b/tests/testthat/test-brulee-linear.R @@ -0,0 +1,43 @@ +test_that("linear regression via brulee", { + skip_if_not_installed("torch") + skip_if_not(any(get_from_env("linear_reg")$engine == "brulee")) + skip_if_not(is_torch_working()) + + set.seed(2832) + ols_fit <- + linear_reg() %>% + set_engine("brulee", epochs = 2) %>% + fit(outcome ~ ., data = num_tr) + expect_s3_class(ols_fit, c("_brulee_linear_reg", "model_fit")) + ols_pred <- predict(ols_fit, num_te) + expect_true(inherits(ols_pred, "data.frame")) + expect_true(nrow(ols_pred) == 2) + expect_named(ols_pred, ".pred") + + # ------------------------------------------------------------------------------ + + lr_spec <- + linear_reg(penalty = tune(), mixture = tune()) %>% + set_engine("brulee", epochs = tune(), learn_rate = tune(), stop_iter = tune()) %>% + set_mode("regression") + + lr_param <- + lr_spec %>% + extract_parameter_set_dials() %>% + update( + epochs = epochs(c(1, 10)) + ) + + set.seed(487) + lr_res <- + lr_spec %>% + tune_grid( + outcome ~ ., + num_rs, + grid = 2, + param_info = lr_param) + + expect_true(nrow(collect_notes(lr_res)) == 0) + +}) + diff --git a/tests/testthat/test-brulee-logistic.R b/tests/testthat/test-brulee-logistic.R new file mode 100644 index 0000000..301b638 --- /dev/null +++ b/tests/testthat/test-brulee-logistic.R @@ -0,0 +1,50 @@ +test_that("logistic regression via brulee", { + skip_if_not_installed("torch") + skip_if_not(any(get_from_env("logistic_reg")$engine == "brulee")) + skip_if_not(is_torch_working()) + + set.seed(2832) + glm_fit <- + logistic_reg() %>% + set_engine("brulee", epochs = 2, class_weights = 1/2) %>% + fit(class ~ ., data = binary_tr) + expect_s3_class(glm_fit, c("_brulee_logistic_reg", "model_fit")) + + glm_class_pred <- predict(glm_fit, binary_te, type = "class") + expect_true(inherits(glm_class_pred, "data.frame")) + expect_true(nrow(glm_class_pred) == 2) + expect_named(glm_class_pred, ".pred_class") + + glm_prob_pred <- predict(glm_fit, binary_te, type = "prob") + expect_true(inherits(glm_prob_pred, "data.frame")) + expect_true(nrow(glm_prob_pred) == 2) + expect_named(glm_prob_pred, c(".pred_one", ".pred_two")) + + + # ------------------------------------------------------------------------------ + + lr_spec <- + logistic_reg(penalty = tune(), mixture = tune()) %>% + set_engine("brulee", epochs = tune(), learn_rate = tune(), + stop_iter = tune(), class_weights = tune()) %>% + set_mode("classification") + + lr_param <- + lr_spec %>% + extract_parameter_set_dials() %>% + update( + epochs = epochs(c(1, 10)) + ) + + set.seed(473) + lr_res <- + lr_spec %>% + tune_grid( + class ~ ., + binary_rs, + grid = 2, + param_info = lr_param) + + expect_true(nrow(collect_notes(lr_res)) == 0) + +}) diff --git a/tests/testthat/test-brulee-mlp.R b/tests/testthat/test-brulee-mlp.R new file mode 100644 index 0000000..b04c25a --- /dev/null +++ b/tests/testthat/test-brulee-mlp.R @@ -0,0 +1,146 @@ +test_that("classification neural network via brulee", { + skip_if_not_installed("torch") + skip_if_not(any(get_from_env("mlp")$engine == "brulee")) + skip_if_not(is_torch_working()) + + set.seed(232) + nnet_fit <- + mlp(hidden_units = 2, learn_rate = 0.01, epochs = 2) %>% + set_engine("brulee", class_weights = 1/2) %>% + set_mode("classification") %>% + fit(class ~ ., data = three_class_tr) + expect_s3_class(nnet_fit, c("_brulee_mlp", "model_fit")) + + nnet_class_pred <- predict(nnet_fit, three_class_te, type = "class") + expect_true(inherits(nnet_class_pred, "data.frame")) + expect_true(nrow(nnet_class_pred) == 2) + expect_named(nnet_class_pred, ".pred_class") + + nnet_prob_pred <- predict(nnet_fit, three_class_te, type = "prob") + expect_true(inherits(nnet_prob_pred, "data.frame")) + expect_true(nrow(nnet_prob_pred) == 2) + expect_named(nnet_prob_pred, c(".pred_one", ".pred_two", ".pred_three")) + +}) + +test_that("regression neural network via brulee", { + skip_if_not_installed("torch") + skip_if_not(any(get_from_env("mlp")$engine == "brulee")) + skip_if_not(is_torch_working()) + + set.seed(2832) + nnet_fit <- + mlp(hidden_units = 2, learn_rate = 0.01, epochs = 2) %>% + set_engine("brulee") %>% + set_mode("regression") %>% + fit(outcome ~ ., data = num_tr) + expect_s3_class(nnet_fit, c("_brulee_mlp", "model_fit")) + + nnet_class_pred <- predict(nnet_fit, num_te) + expect_true(inherits(nnet_class_pred, "data.frame")) + expect_true(nrow(nnet_class_pred) == 2) + expect_named(nnet_class_pred, ".pred") + + # ------------------------------------------------------------------------------ + + nnet_spec <- + mlp(hidden_units = tune(), learn_rate = tune(), epochs = tune(), + penalty = tune(), activation = tune()) %>% + set_engine("brulee", stop_iter = tune()) %>% + set_mode("regression") + + nnet_param <- + nnet_spec %>% + extract_parameter_set_dials() %>% + update( + hidden_units = hidden_units(c(2, 5)), + epochs = epochs(c(1, 10)) + ) + + set.seed(682) + nnet_res <- + nnet_spec %>% + tune_grid( + outcome ~ ., + num_rs, + grid = 2, + param_info = nnet_param) + + expect_true(nrow(collect_notes(nnet_res)) == 0) +}) + + +test_that("classification neural network (2 hidden layers) via brulee", { + skip_if_not_installed("torch") + skip_if_not(any(get_from_env("mlp")$engine == "brulee_two_layer")) + skip_if_not(is_torch_working()) + + set.seed(28132) + nnet_fit <- + mlp(hidden_units = 2, learn_rate = 0.01, epochs = 2) %>% + set_engine("brulee_two_layer", class_weights = 1/2, hidden_units_2 = 3, + activation_2 = "elu") %>% + set_mode("classification") %>% + fit(class ~ ., data = three_class_tr) + expect_s3_class(nnet_fit, c("_brulee_two_layer_mlp", "model_fit")) + + nnet_class_pred <- predict(nnet_fit, three_class_te, type = "class") + expect_true(inherits(nnet_class_pred, "data.frame")) + expect_true(nrow(nnet_class_pred) == 2) + expect_named(nnet_class_pred, ".pred_class") + + nnet_prob_pred <- predict(nnet_fit, three_class_te, type = "prob") + expect_true(inherits(nnet_prob_pred, "data.frame")) + expect_true(nrow(nnet_prob_pred) == 2) + expect_named(nnet_prob_pred, c(".pred_one", ".pred_two", ".pred_three")) + + # ------------------------------------------------------------------------------ + + nnet_spec <- + mlp(hidden_units = tune(), learn_rate = tune(), epochs = tune(), + penalty = tune(), activation = tune()) %>% + set_engine("brulee_two_layer", class_weights = tune(), + hidden_units_2 = tune(), + activation_2 = tune()) %>% + set_mode("classification") + + nnet_param <- + nnet_spec %>% + extract_parameter_set_dials() %>% + update( + hidden_units = hidden_units(c(2, 5)), + hidden_units_2 = hidden_units_2(c(2, 5)), + epochs = epochs(c(1, 10)) + ) + + set.seed(28132) + nnet_res <- + nnet_spec %>% + tune_grid( + class ~ ., + binary_rs, + grid = 2, + param_info = nnet_param) + expect_true(nrow(collect_notes(nnet_res)) == 0) + +}) + +test_that("regression neural network (2 hidden layers) via brulee", { + skip_if_not_installed("torch") + skip_if_not(any(get_from_env("mlp")$engine == "brulee_two_layer")) + skip_if_not(is_torch_working()) + + set.seed(2832) + nnet_fit <- + mlp(hidden_units = 2, learn_rate = 0.01, epochs = 2) %>% + set_engine("brulee_two_layer", hidden_units_2 = 3, activation_2 = "elu") %>% + set_mode("regression") %>% + fit(outcome ~ ., data = num_tr) + expect_s3_class(nnet_fit, c("_brulee_two_layer_mlp", "model_fit")) + + nnet_class_pred <- predict(nnet_fit, num_te) + expect_true(inherits(nnet_class_pred, "data.frame")) + expect_true(nrow(nnet_class_pred) == 2) + expect_named(nnet_class_pred, ".pred") +}) + diff --git a/tests/testthat/test-brulee-multinom.R b/tests/testthat/test-brulee-multinom.R new file mode 100644 index 0000000..288597d --- /dev/null +++ b/tests/testthat/test-brulee-multinom.R @@ -0,0 +1,50 @@ +test_that("multinomial regression via brulee", { + skip_if_not_installed("torch") + skip_if_not(any(get_from_env("multinom_reg")$engine == "brulee")) + skip_if_not(is_torch_working()) + + set.seed(2832) + mnl_fit <- + multinom_reg() %>% + set_engine("brulee", epochs = 2, class_weights = 1/2) %>% + fit(class ~ ., data = three_class_tr) + expect_s3_class(mnl_fit, c("_brulee_multinom_reg", "model_fit")) + + mnl_class_pred <- predict(mnl_fit, three_class_te, type = "class") + expect_true(inherits(mnl_class_pred, "data.frame")) + expect_true(nrow(mnl_class_pred) == 2) + expect_named(mnl_class_pred, ".pred_class") + + mnl_prob_pred <- predict(mnl_fit, three_class_te, type = "prob") + expect_true(inherits(mnl_prob_pred, "data.frame")) + expect_true(nrow(mnl_prob_pred) == 2) + expect_named(mnl_prob_pred, c(".pred_one", ".pred_two", ".pred_three")) + + + # ------------------------------------------------------------------------------ + + mnl_spec <- + multinom_reg(penalty = tune(), mixture = tune()) %>% + set_engine("brulee", epochs = tune(), learn_rate = tune(), + stop_iter = tune(), class_weights = tune()) %>% + set_mode("classification") + + mnl_param <- + mnl_spec %>% + extract_parameter_set_dials() %>% + update( + epochs = epochs(c(1, 10)) + ) + + set.seed(217) + mnl_res <- + mnl_spec %>% + tune_grid( + class ~ ., + three_class_rs, + grid = 2, + param_info = mnl_param) + + expect_true(nrow(collect_notes(mnl_res)) == 0) + +})