tests for Brulee engines

DESCRIPTION

@@ -15,6 +15,7 @@ Suggests:
     baguette,
     bonsai,
     BradleyTerry2,
+    brulee,
     butcher,
     C50,
     censored,

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)
+

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
+}

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)
+
+})
+

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)
+
+})

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")
+})
+

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)
+
+})