tests/testthat/test-class_inheritance.R

In BWAM/stayCALM: Stay Calm when Applying a Consolidated Assessment Listing Methodology (CALM)

context("Class Inheritance")


test_that("inherit() returns NAs when expected", {
  expect_equal(inherit(c(20, NA, NA, 10, NA)),
               c(20, 20, 20, 10, 10))
  expect_equal(inherit(c(NA, 20, NA, 10, NA)),
               c(NA, 20, 20, 10, 10))
  expect_equal(inherit(c(NA, NA, NA, 10, NA)),
               c(NA, NA, NA, 10, 10))
  expect_equal(inherit(c(NA, NA, NA, NA, NA)),
               c(NA, NA, NA, NA, NA))
})


test_that("class_variants() returns expected vectors", {
  class.vec <- c("D", "C", "B", "A")

  expect_equal(class_variants(class.vec, ""), class.vec)
  expect_equal(class_variants(class.vec, c("", "(T)")),
               c("D", "D(T)", "C", "C(T)", "B", "B(T)",
                 "A", "A(T)"))
  expect_equal(class_variants(class.vec, c("", "(T)", "(TS)")),
               c("D", "D(T)", "D(TS)",
                 "C", "C(T)", "C(TS)",
                 "B", "B(T)", "B(TS)",
                 "A", "A(T)", "A(TS)"))
})

test_that("class_variants() returns errors for presence of NA and duplicates in vectors", {
  expect_error(class_variants(c("D", NA), ""))
  expect_error(class_variants("D", c("", "(T)", NA)))
  expect_error(class_variants(c("D", "D"), c("", "(T)", "(TS)")))
  expect_error(class_variants(c("D", "C", "D"), c("", "(T)", "(TS)")))
  expect_error(class_variants(c("D", "C"), c("", "(T)", "(T)")))
  expect_error(class_variants(c("D", "C"), c("", "(T)", "")))
})

levels.vec <- c("D", "C", "B",
                "A", "A-Special",
                "AA", "AA-Special")

test.df <- tibble::tibble(
  param = c("TP"),
  class_col = c("D", "AA"),
  threshold = c(20, 10)
)

test_that("class_inheritance() returns expected warnings and errors", {

  expect_warning(class_inheritance(.data = dplyr::mutate(test.df, threshold = as.list(threshold)),
                                   param,
                                   .class_col = class_col,
                                   .levels_vec = levels.vec),
                 "list columns cannot be inherited")

  expect_error(class_inheritance(.data = test.df,
                                 param,
                                 .class_col = class_col,
                                 .levels_vec = c("D", "D")))
})

test_that("class_inheritance() returns expected data frame", {

  answer_test.df <- tibble::tibble(
    param = c("TP"),
    class_col = factor(levels.vec,
                       levels = levels.vec,
                       ordered = TRUE),
    threshold = c(20, 20, 20, 20, 20, 10, 10)
  )

  expect_equal(class_inheritance(.data = test.df,
                                 param,
                                 .class_col = class_col,
                                 .levels_vec = levels.vec),
               answer_test.df)
})