tests/testthat/test-is_tbl_mbte.R

In mkerschbaumer/mbte: Model-based trend estimation

context("is_tbl_mbte")

# generate an object, that should be recognized as a valid tbl_mbte.
gen_valid_tbl_mbte <- function(dat = raw_signals) {
  dat <- tibble::as_tibble(dat)

  # set relevant attributes
  attr(dat, "time") <- rlang::sym("time_var")
  attr(dat, "value") <- rlang::sym("value_var")
  attr(dat, "signal") <- rlang::sym("signal_var")
  attr(dat, "fits") <- rlang::sym("fits_var")

  # set class attribute
  class(dat) <- c("tbl_mbte", class(dat))

  dat
}

# tables generated by helper function should be recognized as valid
test_that("is_tbl_mbte - positive test helper", {
  tbl <- gen_valid_tbl_mbte()
  expect_true(is_tbl_mbte(tbl))
})

# cross-check, that objects created by new_tbl_mbte() are detected as valid
# `tbl_mbte`-objects
test_that("is_tbl_mbte - new_tbl_mbte()", {
  tbl <- gen_raw_tbl_mbte()
  expect_true(is_tbl_mbte(tbl))
})

test_that("is_tbl_mbte - not a tibble", {
  tbl <- as.data.frame(gen_valid_tbl_mbte())
  class(tbl) <- c("tbl_mbte", class(tbl))

  # make sure colnames haven't been modified
  expect_equal(colname_time(tbl), rlang::sym("time_var"))
  expect_equal(colname_value(tbl), rlang::sym("value_var"))
  expect_equal(colname_signal(tbl), rlang::sym("signal_var"))
  expect_equal(colname_fits(tbl), rlang::sym("fits_var"))

  # `tbl` should not be seen as a valid tbl_mbte, since a tbl_mbte-object must
  # also be a tibble, even if it inherits from `tbl_mbte`.
  expect_false(is_tibble(tbl))
  expect_false(is_tbl_mbte(tbl))
})

test_that("is_tbl_mbte - doesen't inherit from `tbl_mbte`", {
  tbl <- gen_valid_tbl_mbte()
  class(tbl) <- setdiff(class(tbl), "tbl_mbte")

  # should be of class `tbl_mbte`
  expect_false(is_tbl_mbte(tbl))
})

# Helper function to malformat a specific attribute (or column name
# specification), which is expected to contain a symbol. Assert that the
# resulting object is not seen as a `tbl_mbte`.
check_colname_malformatted <- function(colname) {
  stopifnot(purrr::is_scalar_character(colname))
  tbl <- gen_valid_tbl_mbte()

  attr(tbl, colname) <- NULL
  expect_false(is_tbl_mbte(tbl), info = "NULL as attribute")

  attr(tbl, colname) <- "abc"
  expect_false(is_tbl_mbte(tbl), info = "string as attribute")
}

test_that("is_tbl_mbte - colnames/attributes malformatted", {
  # colnames/attributes to malformat
  colname_to_test <- c("time", "value", "signal", "fits")

  purrr::walk(colname_to_test, check_colname_malformatted)
})