tests/testthat/test-re_registration.R

In parsnip: A Common API to Modeling and Analysis Functions

# For issue #653 we want to be able to re-run the registration code as
# long as the information being registered is the same.


test_that('re-registration of mode', {
  old_val <- get_from_env("bart_modes")
  expect_no_condition(set_model_mode("bart", "classification"))
  new_val <- get_from_env("bart_modes")
  expect_equal(old_val, new_val)
})

test_that('re-registration of engine', {
  old_val <- get_from_env("bart")
  expect_no_condition(
    set_model_engine("bart", mode = "classification", eng = "dbarts")
  )
  new_val <- get_from_env("bart")
  expect_equal(old_val, new_val)
})


test_that('re-registration of package dependencies', {
  old_val <- get_from_env("bart_pkgs")
  expect_no_error(expect_no_warning(
    set_dependency("bart", "dbarts", "dbarts")
  ))
  new_val <- get_from_env("bart_pkgs")
  expect_equal(old_val, new_val)
})

test_that('re-registration of fit information', {
  old_val <- get_from_env("bart_fit")
  expect_no_condition(
    set_fit(
      model = "bart",
      eng = "dbarts",
      mode = "regression",
      value = list(
        interface = "data.frame",
        data = c(x = "x.train", y = "y.train"),
        protect = c("x", "y"),
        func = c(pkg = "dbarts", fun = "bart"),
        defaults = list(verbose = FALSE, keeptrees = TRUE, keepcall = FALSE)
      )
    )
  )
  new_val <- get_from_env("bart_fit")
  expect_equal(old_val, new_val)

  # Fail if newly registered data is different than existing
  # `verbose` option is different here
  expect_snapshot(
    error = TRUE,
    set_fit(
      model = "bart",
      eng = "dbarts",
      mode = "regression",
      value = list(
        interface = "data.frame",
        data = c(x = "x.train", y = "y.train"),
        protect = c("x", "y"),
        func = c(pkg = "dbarts", fun = "bart"),
        defaults = list(verbose = TRUE, keeptrees = TRUE, keepcall = FALSE)
      )
    )
  )
})

test_that('re-registration of encoding information', {
  old_val <- get_from_env("bart_encoding")
  expect_no_condition(
    set_encoding(
      model = "bart",
      eng = "dbarts",
      mode = "regression",
      options = list(
        predictor_indicators = "none",
        compute_intercept = FALSE,
        remove_intercept = FALSE,
        allow_sparse_x = FALSE
      )
    )
  )
  new_val <- get_from_env("bart_encoding")
  expect_equal(old_val, new_val)

  # Fail if newly registered data is different than existing
  # `compute_intercept` option is different here
  expect_snapshot(
    error = TRUE,
    set_encoding(
      model = "bart",
      eng = "dbarts",
      mode = "regression",
      options = list(
        predictor_indicators = "none",
        compute_intercept = TRUE,
        remove_intercept = FALSE,
        allow_sparse_x = FALSE
      )
    )
  )
})


test_that('re-registration of prediction information', {
  old_val <- get_from_env("bart_predict")
  expect_no_condition(
    set_pred(
      model = "bart",
      eng = "dbarts",
      mode = "regression",
      type = "numeric",
      value = list(
        pre = NULL,
        post = NULL,
        func = c(pkg = "parsnip", fun = "dbart_predict_calc"),
        args =
          list(
            obj = quote(object),
            new_data =  quote(new_data),
            type = "numeric"
          )
      )
    )
  )
  new_val <- get_from_env("bart_predict")
  expect_equal(old_val, new_val)

  # Fail if newly registered data is different than existing
  # `type` option is different here
  expect_snapshot(
    error = TRUE,
    set_pred(
      model = "bart",
      eng = "dbarts",
      mode = "regression",
      type = "numeric",
      value = list(
        pre = NULL,
        post = NULL,
        func = c(pkg = "parsnip", fun = "dbart_predict_calc"),
        args =
          list(
            obj = quote(object),
            new_data =  quote(new_data),
            type = "tuba"
          )
      )
    )
  )
})