tests/testthat/test-nomial_types.R

In recipes: Preprocessing and Feature Engineering Steps for Modeling

library(recipes)
library(testthat)

# ----------------------------------------------------------------

skip_if_not_installed("modeldata")
data("Sacramento", package = "modeldata")

Sacramento_chr <-
  Sacramento |>
  mutate(across(where(is.factor), as.character))

Sacramento_fac <-
  Sacramento |>
  mutate(type = as.character(type))

Sacramento_all_fac <-
  Sacramento

# ----------------------------------------------------------------

test_that("factors all the way down", {
  tr <-
    Sacramento_all_fac |>
    slice(1:500)

  te <-
    Sacramento_all_fac |>
    slice(501:932)

  rec <-
    recipe(type ~ ., data = tr) |>
    prep(training = tr)

  expect_silent(check_nominal_type(te, rec$orig_lvls))
})

test_that("factors all the way down with skipping", {
  tr <-
    Sacramento_all_fac |>
    slice(1:500)

  te <-
    Sacramento_all_fac |>
    slice(501:932) |>
    select(-type)

  rec <-
    recipe(type ~ ., data = tr) |>
    prep(training = tr)

  expect_silent(check_nominal_type(te, rec$orig_lvls))
})

# ----------------------------------------------------------------

test_that("mixed nominal data", {
  tr <-
    Sacramento_fac |>
    slice(1:500)
  te <-
    Sacramento_fac |>
    slice(501:932)

  rec <-
    recipe(type ~ ., data = tr) |>
    prep(training = tr)

  expect_silent(check_nominal_type(te, rec$orig_lvls))
})

test_that("mixed nominal data with skipping", {
  tr <-
    Sacramento_fac |>
    slice(1:500)
  te <-
    Sacramento_fac |>
    slice(501:932) |>
    select(-type)

  rec <-
    recipe(type ~ ., data = tr) |>
    prep(training = tr)

  expect_silent(check_nominal_type(te, rec$orig_lvls))
})

# ----------------------------------------------------------------

test_that("no factors", {
  tr <-
    Sacramento_chr |>
    slice(1:500)
  te <-
    Sacramento_chr |>
    slice(501:932)

  rec <-
    recipe(type ~ ., data = tr) |>
    prep(training = tr)

  expect_silent(check_nominal_type(te, rec$orig_lvls))
})

test_that("no factors with skipping", {
  tr <-
    Sacramento_chr |>
    slice(1:500)
  te <-
    Sacramento_chr |>
    slice(501:932) |>
    select(-type)

  rec <-
    recipe(type ~ ., data = tr) |>
    prep(training = tr)

  expect_silent(check_nominal_type(te, rec$orig_lvls))
})

# ----------------------------------------------------------------

test_that("missing factors", {
  tr <-
    Sacramento_fac |>
    slice(1:500)
  te <-
    Sacramento_chr |>
    slice(501:932)

  rec <-
    recipe(type ~ ., data = tr) |>
    prep(training = tr)

  expect_snapshot(check_nominal_type(te, rec$orig_lvls))
})

test_that("missing single factor", {
  tr <-
    Sacramento_fac |>
    select(city) |>
    slice(1:500)
  te <-
    Sacramento_chr |>
    select(city) |>
    slice(501:932)

  rec <-
    recipe(~., data = tr) |>
    prep(training = tr)

  expect_snapshot(check_nominal_type(te, rec$orig_lvls))
})

test_that("missing factors with skipping", {
  tr <-
    Sacramento_fac |>
    slice(1:500)
  te <-
    Sacramento_chr |>
    slice(501:932) |>
    select(-type)

  rec <-
    recipe(type ~ ., data = tr) |>
    prep(training = tr)

  expect_snapshot(check_nominal_type(te, rec$orig_lvls))
  expect_snapshot(
    res <- bake(rec, te |> mutate(city = as.character(city)))
  )
})