tests/testthat/test_setter.R

In signaux-faibles/MLsegmentr: Model evaluation on data segments

context("Test setter functions")


test_data_frame <- data.frame(
  a = rep(1:3, 2),
  b = rep(1:2, each = 3),
  c = 0:5,
  d = rep(c("oui", "non"), 3),
  e = rep(c(T, F), each = 3)
)


require(tibble)
test_grid <- tibble::tribble(
  ~col_names, ~id_names, ~value_name, ~key_name,
  c("c"), c("a", "b"), "value", "key",
  c("c", "d", "e"), c("a", "b"), "value", "key",
  c("c"), c("a", "b"), "value", NULL,
  c("d", "e"), c("a", "b"), "value", NULL
)


expected <- list(
  data.frame(a = rep(1:3, 2), b = rep(1:2, each = 3), key = factor(rep("c", 6)), value = 0:5), #nolint
  data.frame(a = rep(1:3, 6), b = rep(rep(1:2, each = 3), 3), key = factor(rep(c("c", "d", "e"), each = 6)), value = c(0:5, rep(c("oui", "non"), 3), rep(c(TRUE, FALSE), each = 3)), stringsAsFactors = FALSE), #nolint
  data.frame(value = factor(0:5), a = rep(1:3, 2), b = rep(1:2, each = 3)),
  data.frame(value =  structure(c(4L, 2L, 4L, 1L, 3L, 1L), .Label = c("non_FALSE", "non_TRUE", "oui_FALSE", "oui_TRUE"), class = "factor"), a = rep(1:3, 2), b = rep(1:2, each = 3)) #nolint
  )

test_grid_error <- tibble::tribble(
  ~col_names, ~id_names, ~value_name, ~key_name,
  c("c"), c("c", "b"), "value", "key",
  c("c"), c("a"),      "value", "key",
  c("c"), 3,           "value", "key",
  3,      c("a", "b"), "value", "key",
  c("c"), c("a", "b"), NULL, "key",
  c("c"), c("a", "b"), c("value1", "value2"), "key",
  c("c"), c("a", "b"), "value", c("key1", "key2")

)

test_that("decorate_generic works as expected", {
  require(purrr)
  suppressWarnings(
    actual <- purrr::pmap(
      test_grid,
      decorate_generic,
      test_data = test_data_frame
    )
  )
  purrr::map2(actual, expected, expect_equal)

  purrr::pmap(
    test_grid_error,
    function(...) expect_error(decorate_generic(...), class = "assertError"),
    test_data = test_data_frame
  )
})