tests/testthat/test-err_tdy.R

context("err-tdy")

## err_tdy_break_min_max_date -------------------------------------------------

test_that("'err_tdy_break_min_max_date' works with valid input", {
    expect_identical(err_tdy_break_min_max_date(break_min = "2000-01-01",
                                                break_max = "2001-01-01",
                                                unit = "year",
                                                null_ok = TRUE,
                                                equal_ok = FALSE),
                     list(break_min = as.Date("2000-01-01"),
                          break_max = as.Date("2001-01-01")))
    expect_identical(err_tdy_break_min_max_date(break_min = "2000-01-01",
                                                break_max = "2000-01-01",
                                                unit = "year",
                                                null_ok = TRUE,
                                                equal_ok = TRUE),
                     list(break_min = as.Date("2000-01-01"),
                          break_max = as.Date("2000-01-01")))
    expect_identical(err_tdy_break_min_max_date(break_min = "2000-01-01",
                                                break_max = "2001-01-01",
                                                unit = "quarter",
                                                null_ok = TRUE,
                                                equal_ok = FALSE),
                     list(break_min = as.Date("2000-01-01"),
                          break_max = as.Date("2001-01-01")))
    expect_identical(err_tdy_break_min_max_date(break_min = "2000-01-01",
                                                break_max = "2001-01-01",
                                                unit = "month",
                                                null_ok = TRUE,
                                                equal_ok = FALSE),
                     list(break_min = as.Date("2000-01-01"),
                          break_max = as.Date("2001-01-01")))
    expect_identical(err_tdy_break_min_max_date(break_min = "2000-01-01",
                                                break_max = "2001-04-01",
                                                unit = "quarter",
                                                null_ok = TRUE,
                                                equal_ok = FALSE),
                     list(break_min = as.Date("2000-01-01"),
                          break_max = as.Date("2001-04-01")))
    expect_identical(err_tdy_break_min_max_date(break_min = NULL,
                                                break_max = "2001-04-01",
                                                unit = "quarter",
                                                null_ok = TRUE,
                                                equal_ok = FALSE),
                     list(break_min = NULL,
                          break_max = as.Date("2001-04-01")))
    expect_identical(err_tdy_break_min_max_date(break_min = "2000-01-01",
                                                break_max = NULL,
                                                unit = "quarter",
                                                null_ok = TRUE,
                                                equal_ok = FALSE),
                     list(break_min = as.Date("2000-01-01"),
                          break_max = NULL))
})

test_that("'err_tdy_break_min_max_date' raises expected error with invalid input", {
    expect_error(err_tdy_break_min_max_date(break_min = NULL,
                                            break_max = "2001-01-01",
                                            unit = "year",
                                            null_ok = FALSE,
                                            equal_ok = FALSE),
                 "'break_min' is NULL")
    expect_error(err_tdy_break_min_max_date(break_min = "2001-01-01",
                                            break_max = NULL,
                                            unit = "year",
                                            null_ok = FALSE,
                                            equal_ok = FALSE),
                 "'break_max' is NULL")
    expect_error(err_tdy_break_min_max_date(break_min = NULL,
                                            break_max = NULL,
                                            unit = "year",
                                            null_ok = TRUE,
                                            equal_ok = FALSE),
                 "'break_min' and 'break_max' both NULL")
    expect_error(err_tdy_break_min_max_date(break_min = "2000-01-01",
                                            break_max = "2000-01-01",
                                            unit = "year",
                                            null_ok = TRUE,
                                            equal_ok = FALSE),
                 "'break_max' \\[2000-01-01\\] is less than or equal to 'break_min' \\[2000-01-01\\]")
})


## err_tdy_break_min_max_integer ----------------------------------------------

test_that("'err_tdy_break_min_max_integer' works with valid input", {
    expect_identical(err_tdy_break_min_max_integer(break_min = 0,
                                                   break_max = 100,
                                                   null_ok = TRUE,
                                                   equal_ok = FALSE),
                     list(break_min = 0L,
                          break_max = 100L))
    expect_identical(err_tdy_break_min_max_integer(break_min = 0,
                                                   break_max = 0,
                                                   null_ok = TRUE,
                                                   equal_ok = TRUE),
                     list(break_min = 0L,
                          break_max = 0L))
    expect_identical(err_tdy_break_min_max_integer(break_min = 0,
                                                   break_max = 400,
                                                   null_ok = TRUE,
                                                   equal_ok = FALSE),
                     list(break_min = 0L,
                          break_max = 400L))
    expect_identical(err_tdy_break_min_max_integer(break_min = 0L,
                                                   break_max = 1200L,
                                                   null_ok = TRUE,
                                                   equal_ok = FALSE),
                     list(break_min = 0L,
                          break_max = 1200L))
    expect_identical(err_tdy_break_min_max_integer(break_min = 100,
                                                   break_max = 200,
                                                   null_ok = TRUE,
                                                   equal_ok = FALSE),
                     list(break_min = 100L,
                          break_max = 200L))
    expect_identical(err_tdy_break_min_max_integer(break_min = NULL,
                                                   break_max = 400,
                                                   null_ok = TRUE,
                                                   equal_ok = FALSE),
                     list(break_min = NULL,
                          break_max = 400L))
    expect_identical(err_tdy_break_min_max_integer(break_min = 0L,
                                                   break_max = NULL,
                                                   null_ok = TRUE,
                                                   equal_ok = FALSE),
                     list(break_min = 0L,
                          break_max = NULL))
})

test_that("'err_tdy_break_min_max_integer' raises expected error with invalid input", {
    expect_error(err_tdy_break_min_max_integer(break_min = NULL,
                                               break_max = 100,
                                               null_ok = FALSE,
                                               equal_ok = FALSE),
                 "'break_min' is NULL")
    expect_error(err_tdy_break_min_max_integer(break_min = 0,
                                               break_max = NULL,
                                               null_ok = FALSE,
                                               equal_ok = FALSE),
                 "'break_max' is NULL")
    expect_error(err_tdy_break_min_max_integer(break_min = NULL,
                                               break_max = NULL,
                                               null_ok = TRUE,
                                               equal_ok = FALSE),
                 "'break_min' and 'break_max' both NULL")
    expect_error(err_tdy_break_min_max_integer(break_min = 10,
                                               break_max = 10,
                                               null_ok = TRUE,
                                               equal_ok = FALSE),
                 "'break_max' \\[10\\] is less than or equal to 'break_min' \\[10\\]")
})


## err_tdy_breaks_date_cohort -------------------------------------------------

test_that("'err_tdy_breaks_date_cohort' returns breaks with valid input", {
    expect_identical(err_tdy_breaks_date_cohort(breaks = c("2000-01-01", "2001-01-01"),
                                         open_first = FALSE),
                     as.Date(c("2000-01-01", "2001-01-01")))
    expect_identical(err_tdy_breaks_date_cohort(breaks = c("2000-02-01", "2001-02-01"),
                                         open_first = FALSE),
                     as.Date(c("2000-02-01", "2001-02-01")))
    expect_identical(err_tdy_breaks_date_cohort(breaks = character(),
                                         open_first = FALSE),
                     as.Date(character()))
    expect_identical(err_tdy_breaks_date_cohort(breaks = as.Date("2000-01-01"),
                                         open_first = TRUE),
                     as.Date("2000-01-01"))
})
    
test_that("'err_tdy_breaks_date_cohort' raises expected error with invalid input", {
    expect_error(err_tdy_breaks_date_cohort(breaks = character(),
                                     open_first = TRUE),
                 "'breaks' has length 0 but 'open_first' is TRUE")
    expect_error(err_tdy_breaks_date_cohort(breaks = "2002-01-01",
                                     open_first = FALSE),
                 "'breaks' has length 1 but 'open_first' is FALSE")
    expect_error(err_tdy_breaks_date_cohort(breaks = c("2002-01-01", "2001-01-01"),
                                     open_first = FALSE),
                 paste("'breaks' is not strictly increasing : element 1 \\[2002-01-01\\] is",
                       "greater than or equal to element 2 \\[2001-01-01\\]"))
    expect_error(err_tdy_breaks_date_cohort(breaks = c("2001-01-01", NA),
                                     open_first = FALSE),
                 "'breaks' has NAs")
    expect_error(err_tdy_breaks_date_cohort(breaks = c("2002-01-01", "2001-01-01"),
                                     open_first = FALSE),
                 paste("'breaks' is not strictly increasing : element 1 \\[2002-01-01\\] is",
                       "greater than or equal to element 2 \\[2001-01-01\\]"))
})


## err_tdy_breaks_date_period -------------------------------------------------

test_that("'err_tdy_breaks_date_period' returns breaks with valid input", {
    expect_identical(err_tdy_breaks_date_period(breaks = c("2000-01-01", "2001-01-01")),
                     as.Date(c("2000-01-01", "2001-01-01")))
    expect_identical(err_tdy_breaks_date_period(breaks = c("2000-02-01", "2001-02-01")),
                     as.Date(c("2000-02-01", "2001-02-01")))
    expect_identical(err_tdy_breaks_date_period(breaks = character()),
                     as.Date(character()))
})
    
test_that("'err_tdy_breaks_date_period' raises expected error with invalid input", {
    expect_error(err_tdy_breaks_date_period(breaks = "2002-01-01"),
                 "'breaks' has length 1")
    expect_error(err_tdy_breaks_date_period(breaks = c("2002-01-01", "2001-01-01")),
                 paste("'breaks' is not strictly increasing : element 1 \\[2002-01-01\\] is",
                       "greater than or equal to element 2 \\[2001-01-01\\]"))
    expect_error(err_tdy_breaks_date_period(breaks = c("2001-01-01", NA)),
                 "'breaks' has NAs")
    expect_error(err_tdy_breaks_date_period(breaks = c("2002-01-01", "2001-01-01")),
                 paste("'breaks' is not strictly increasing : element 1 \\[2002-01-01\\] is",
                       "greater than or equal to element 2 \\[2001-01-01\\]"))
})


## err_tdy_breaks_integer_age -------------------------------------------------

test_that("'err_tdy_breaks_integer_age' returns breaks with valid input", {
    expect_identical(err_tdy_breaks_integer_age(breaks = 0:4,
                                                open_last = FALSE),
                     0:4)
    expect_identical(err_tdy_breaks_integer_age(breaks = c(0, 5),
                                                open_last = FALSE),
                     c(0L, 5L))
    expect_identical(err_tdy_breaks_integer_age(breaks = c(0, 1),
                                                open_last = FALSE),
                     c(0L, 1L))
    expect_identical(err_tdy_breaks_integer_age(breaks = c(100, 101),
                                                open_last = FALSE),
                     c(100L, 101L))
    expect_identical(err_tdy_breaks_integer_age(breaks = integer(),
                                                open_last = FALSE),
                     integer())
    expect_identical(err_tdy_breaks_integer_age(breaks = 0,
                                                open_last = TRUE),
                     0L)
})
    
test_that("'err_tdy_breaks_integer_age' raises expected error with invalid input", {
    expect_error(err_tdy_breaks_integer_age(breaks = numeric(),
                                            open_last = TRUE),
                 "'breaks' has length 0 but 'open_last' is TRUE")
    expect_error(err_tdy_breaks_integer_age(breaks = 10,
                                            open_last = FALSE),
                 "'breaks' has length 1 but 'open_last' is FALSE")
    expect_error(err_tdy_breaks_integer_age(breaks = c(-5, 0, 1),
                                            open_last = TRUE),
                 "element 1 of 'breaks' \\[-5\\] is negative")
    expect_error(err_tdy_breaks_integer_age(breaks = c(0L, NA),
                                            open_last = FALSE),
                 "'breaks' has NAs")
    expect_error(err_tdy_breaks_integer_age(breaks = c(0L, Inf),
                                            open_last = FALSE),
                 "'breaks' has infinite values")
    expect_error(err_tdy_breaks_integer_age(breaks = c(0L, 1.1),
                                            open_last = FALSE),
                 "value '1.1' in 'breaks' not equivalent to integer")
    expect_error(err_tdy_breaks_integer_age(breaks = c(1L, 0L),
                                            open_last = FALSE),
                 "'breaks' is not strictly increasing : element 1 \\[1\\] is greater than or equal to element 2 \\[0\\]")
})


## err_tdy_breaks_integer_cohort ----------------------------------------------

test_that("'err_tdy_breaks_integer_cohort' returns breaks with valid input", {
    expect_identical(err_tdy_breaks_integer_cohort(breaks = 2000:2004,
                                                   open_first = FALSE),
                     2000:2004)
    expect_identical(err_tdy_breaks_integer_cohort(breaks = seq(1900, 2000, 5),
                                                   open_first = FALSE),
                     seq.int(1900L, 2000L, 5L))
    expect_identical(err_tdy_breaks_integer_cohort(breaks = c(0, 1),
                                                   open_first = TRUE),
                     c(0L, 1L))
    expect_identical(err_tdy_breaks_integer_cohort(breaks = integer(),
                                                   open_first = FALSE),
                     integer())
    expect_identical(err_tdy_breaks_integer_cohort(breaks = 0,
                                                   open_first = TRUE),
                     0L)
})
    

test_that("'err_tdy_breaks_integer_cohort' raises expected error with invalid input", {
    expect_error(err_tdy_breaks_integer_cohort(breaks = numeric(),
                                               open_first = NULL),
                 "'breaks' has length 0 but 'open_first' is NULL")
    expect_error(err_tdy_breaks_integer_cohort(breaks = numeric(),
                                               open_first = TRUE),
                 "'breaks' has length 0 but 'open_first' is TRUE")
    expect_error(err_tdy_breaks_integer_cohort(breaks = 10,
                                               open_first = NULL),
                 "'breaks' has length 1 but 'open_first' is NULL")
    expect_error(err_tdy_breaks_integer_cohort(breaks = 10,
                                               open_first = FALSE),
                 "'breaks' has length 1 but 'open_first' is FALSE")
})


## err_tdy_lower_upper_enumeration --------------------------------------------

test_that("'err_tdy_lower_upper_enumeration' returns list with valid input", {
    expect_identical(err_tdy_lower_upper_enumeration(lower = 0:3,
                                                     upper = 1:4),
                     list(lower = 0:3,
                          upper = 1:4))
    expect_identical(err_tdy_lower_upper_enumeration(lower = c(-100, 0),
                                                     upper = c(0, 5)),
                     list(lower = c(-100L, 0L),
                          upper = c(0L, 5L)))
    expect_identical(err_tdy_lower_upper_enumeration(lower = c(NA, 0),
                                                     upper = c(0, 1)),
                     list(lower = c(NA, 0L),
                          upper = c(0L, 1L)))
    expect_identical(err_tdy_lower_upper_enumeration(lower = 0,
                                                     upper = NA_real_),
                     list(lower = 0L,
                          upper = NA_integer_))
    expect_identical(err_tdy_lower_upper_enumeration(lower = integer(),
                                                     upper = integer()),
                     list(lower = integer(),
                          upper = integer()))
})
    
test_that("'err_tdy_lower_upper_enumeration' raises expected error with invalid input", {
    expect_error(err_tdy_lower_upper_enumeration(lower = 10,
                                                 upper = 10),
                 "element 1 of 'upper' \\[10\\] less than or equal to element 1 of 'lower' \\[10\\]")
    expect_error(err_tdy_lower_upper_enumeration(lower = c(0L, 5L),
                                                 upper = c(10L, 15L)),
                 "element 2 of 'lower' \\[5\\] less than element 1 of 'upper' \\[10\\]")
})


## err_tdy_breaks_integer_period ----------------------------------------------

test_that("'err_tdy_breaks_integer_period' returns breaks with valid input", {
    expect_identical(err_tdy_breaks_integer_period(breaks = 2000:2004),
                     2000:2004)
    expect_identical(err_tdy_breaks_integer_period(breaks = seq(1900, 2000, 5)),
                     seq.int(1900L, 2000L, 5L))
    expect_identical(err_tdy_breaks_integer_period(breaks = c(0, 1)),
                     c(0L, 1L))
    expect_identical(err_tdy_breaks_integer_period(breaks = integer()),
                     integer())
})
    
test_that("'err_tdy_breaks_integer_period' raises expected error with invalid input", {
    expect_error(err_tdy_breaks_integer_period(breaks = 10),
                 "'breaks' has length 1")
})


## err_tdy_date_scalar --------------------------------------------------------

test_that("'err_tdy_date_scalar' returns dates with valid input", {
    x <- "2001-01-01"
    ans_obtained <- err_tdy_date_scalar(x = x, name = "x")
    ans_expected <- as.Date(x)
    expect_identical(ans_obtained, ans_expected)
    x <- as.Date("2001-01-01")
    ans_obtained <- err_tdy_date_scalar(x = x, name = "x")
    ans_expected <- as.Date(x)
    expect_identical(ans_obtained, ans_expected)
    x <- "2001/1/1"
    ans_obtained <- err_tdy_date_scalar(x = x, name = "x")
    ans_expected <- as.Date(x)
    expect_identical(ans_obtained, ans_expected)
})

test_that("'err_tdy_date_scalar' raises expected error with invalid input", {
    expect_error(err_tdy_date_scalar(x = as.Date(c("2000-01-01", "2000-01-02")),
                                     name = "x"),
                 "'x' does not have length 1")
    expect_error(err_tdy_date_scalar(x = 1,
                                     name = "x"),
                 "'x' \\[\"1\"\\] not equivalent to date : 'origin' must be supplied")
    expect_error(err_tdy_date_scalar(x = "a",
                                     name = "x"),
                 "'x' \\[\"a\"\\] not equivalent to date : character string is not in a standard unambiguous format")
    expect_error(err_tdy_date_scalar(x = "a-02-01",
                                     name = "x"),
                 "'x' \\[\"a\\-02\\-01\"\\] not equivalent to date")
})


## err_tdy_date_vector --------------------------------------------------------

test_that("'err_tdy_date_vector' returns dates with valid input", {
    x <- c("2001-01-01", "2002-01-01")
    ans_obtained <- err_tdy_date_vector(x = x, name = "x")
    ans_expected <- as.Date(x)
    expect_identical(ans_obtained, ans_expected)
    x <- as.Date(c("2001-01-01", "2002-01-01"))
    ans_obtained <- err_tdy_date_vector(x = x, name = "x")
    ans_expected <- as.Date(x)
    expect_identical(ans_obtained, ans_expected)
    x <- c("2001/1/1", "2002/1/1")
    ans_obtained <- err_tdy_date_vector(x = x, name = "x")
    ans_expected <- as.Date(x)
    expect_identical(ans_obtained, ans_expected)
    x <- character()
    ans_obtained <- err_tdy_date_vector(x = x, name = "x")
    ans_expected <- as.Date(x)
    expect_identical(ans_obtained, ans_expected)
})

test_that("'err_tdy_date_vector' raises expected error with invalid input", {
    expect_error(err_tdy_date_vector(x = 1,
                                     name = "x"),
                 "'x' \\[1\\] not equivalent to dates : 'origin' must be supplied")
    expect_error(err_tdy_date_vector(x = letters,
                                     name = "x"),
                 "'x' \\[a, b, c, \\.\\.\\.\\] not equivalent to dates : character string is not in a standard unambiguous format")
    expect_error(err_tdy_date_vector(x = c("2000-01-01", "a-02-01"),
                                     name = "x"),
                 "value \"a-02-01\" in 'x' not equivalent to date")
})


## err_tdy_date_dob -----------------------------------------------------------

test_that("'err_tdy_date_dob' returns dates with valid input", {
    date <- as.Date(c("2001-01-01", "2002-01-01"))
    dob <- as.Date("2000-06-30")
    expect_identical(err_tdy_date_dob(date = date, dob = dob),
                     list(date = date,
                          dob = rep(dob, 2)))
})


## err_tdy_month --------------------------------------------------------------

test_that("'err_tdy_month' returns integer vector with valid input", {
    expect_identical(err_tdy_month(x = c(7, 2, NA, 12),
                                   name = "x"),
                     c(7L, 2L, NA, 12L))
    expect_identical(err_tdy_month(x = c("07", "02", NA, "12"),
                                   name = "x"),
                     c(7L, 2L, NA, 12L))
    expect_identical(err_tdy_month(x = c("Jul", "Feb", NA, "Dec"),
                                   name = "x"),
                     c(7L, 2L, NA, 12L))
    expect_identical(err_tdy_month(x = c("July", "February", NA, "December"),
                                   name = "x"),
                     c(7L, 2L, NA, 12L))
    expect_identical(err_tdy_month(x = NA_integer_,
                                   name = "x"),
                     NA_integer_)
    expect_identical(err_tdy_month(x = numeric(),
                                   name = "x"),
                     integer())
    expect_identical(err_tdy_month(x = character(),
                                   name = "x"),
                     integer())
})

test_that("'err_tdy_month' raises expected error with invalid input", {
    expect_error(err_tdy_month(x = "wrong",
                               name = "x"),
                 "elements of 'x' cannot be interpreted as codes or names of months")
})


## err_tdy_month_start --------------------------------------------------------

test_that("'err_tdy_month_start' returns day and month with valid input", {
    expect_identical(err_tdy_month_start("January"),
                     "Jan")
    expect_identical(err_tdy_month_start("Jan"),
                     "Jan")
    expect_identical(err_tdy_month_start("feb"),
                     "Feb")
    expect_identical(err_tdy_month_start("march"),
                     "Mar")
})

test_that("'err_tdy_month_start' raises expected error with invalid input", {
    expect_error(err_tdy_month_start(x = "wrong",
                                     name = "x"),
                 "invalid value for 'x' : \"wrong\"")
})
    

## err_tdy_integer_scalar -----------------------------------------------------

test_that("'err_tdy_integer_scalar' works with valid inputs", {
    expect_identical(err_tdy_integer_scalar(x = 1, name = "x"),
                     1L)
    expect_identical(err_tdy_integer_scalar(x = NA, name = "x"),
                     NA_integer_)
})

test_that("'err_tdy_integer_scalar' raises expected error with invalid input", {
    expect_error(err_tdy_integer_scalar(x = NULL, name = "x"),
                 "'x' is NULL")
    expect_error(err_tdy_integer_scalar(x = 0.2,
                                 name = "x"),
                 "'x' \\[0.2\\] not equivalent to integer")
    expect_error(err_tdy_integer_scalar(x = Inf,
                                 name = "x"),
                 "'x' \\[Inf\\] not equivalent to integer")
    expect_error(err_tdy_integer_scalar(x = "a",
                                 name = "x"),
                 "'x' \\[a\\] not equivalent to integer")
    expect_error(err_tdy_integer_scalar(x = character(), name = "x"),
                 "'x' does not have length 1")
})


## err_tdy_integer_vector -----------------------------------------------------

test_that("'err_tdy_integer_vector' works with valid inputs", {
    expect_identical(err_tdy_integer_vector(x = c(1, NA, 22, -1), name = "x"),
                     c(1L, NA, 22L, -1L))
    expect_identical(err_tdy_integer_vector(x = character(), name = "x"),
                     integer())
})

test_that("'err_tdy_integer_vector' raises expected error with invalid input", {
    expect_error(err_tdy_integer_vector(x = c(0.2, 3),
                                 name = "x"),
                 "value '0.2' in 'x' not equivalent to integer")
    expect_error(err_tdy_integer_vector(x = c(0, Inf),
                                 name = "x"),
                 "value 'Inf' in 'x' not equivalent to integer")
    expect_error(err_tdy_integer_vector(x = c(0, Inf, 0.1),
                                 name = "x"),
                 "value 'Inf' in 'x' not equivalent to integer")
    expect_error(err_tdy_integer_vector(x = "a",
                                 name = "x"),
                 "value 'a' in 'x' not equivalent to integer")
})


## err_tdy_many_to_one --------------------------------------------------------

test_that("'err_tdy_many_to_one' works with valid inputs", {
    x <- data.frame(a = 1:2, b = c("z", "z"))
    expect_identical(err_tdy_many_to_one(x = x,
                                         name = "x"),
                     data.frame(a = as.character(1:2), b = c("z", "z"), stringsAsFactors = FALSE))
})

test_that("'err_tdy_many_to_one' raises expected error with invalid input", {
    x <- "wrong"
    expect_error(err_tdy_many_to_one(x = x,
                                     name = "x"),
                 "'x' is not a data.frame")
    x <- data.frame(a = 1:2, b = c("z", "z"), c = 3:4)
    expect_error(err_tdy_many_to_one(x = x,
                                     name = "x"),
                 "'x' does not have 2 columns")
    x <- data.frame(a = character(), b = character())
    expect_error(err_tdy_many_to_one(x = x,
                                     name = "x"),
                 "'x' has 0 rows")
    x <- data.frame(a = 1:2, b = c(NA, "z"))
    expect_error(err_tdy_many_to_one(x = x,
                                     name = "x"),
                 "column 2 of 'x' has NAs")
    x <- data.frame(a = 1:2, b = c("y", "z"))
    expect_error(err_tdy_many_to_one(x = x,
                                     name = "x"),
                 "neither column of 'x' has duplicates, as required for many-to-one mapping")
    x <- data.frame(a = c(1, 1), b = c("y", "y"))
    expect_error(err_tdy_many_to_one(x = x,
                                     name = "x"),
                 "neither column of 'x' has entirely unique values, as required for many-to-one mapping")
})


## err_tdy_map_dim ------------------------------------------------------------

test_that("'err_tdy_map_dim' works with valid input", {
    map_dim <- c(1, 3, 2, 0)
    n_dim_self <- 4L
    n_dim_oth <- 3L
    ans_obtained <- err_tdy_map_dim(map_dim = map_dim,
                                    n_dim_self = n_dim_self,
                                    n_dim_oth = n_dim_oth)
    ans_expected <- as.integer(map_dim)
    expect_identical(ans_obtained, ans_expected)
})

test_that("'err_tdy_map_dim' works with 'n_dim_self' equal to 1", {
    map_dim <- 2
    n_dim_self <- 1L
    n_dim_oth <- 2L
    ans_obtained <- err_tdy_map_dim(map_dim = map_dim,
                                    n_dim_self = n_dim_self,
                                    n_dim_oth = n_dim_oth)
    ans_expected <- as.integer(map_dim)
    expect_identical(ans_obtained, ans_expected)
})

test_that("'err_tdy_map_dim' works with 'n_dim_oth' equal to 1", {
    map_dim <- c(0L, 1L)
    n_dim_self <- 2L
    n_dim_oth <- 1L
    ans_obtained <- err_tdy_map_dim(map_dim = map_dim,
                                    n_dim_self = n_dim_self,
                                    n_dim_oth = n_dim_oth)
    ans_expected <- as.integer(map_dim)
    expect_identical(ans_obtained, ans_expected)
})


## err_tdy_map_pos ------------------------------------------------------------

test_that("'err_tdy_map_pos' works when 'self' and 'oth' identical", {
    map_pos <- list(1:3, 1:4)
    map_dim <- 1:2
    dim_self <- 3:4
    dim_oth <- 3:4
    ans_obtained <- err_tdy_map_pos(map_pos = map_pos,
                                    map_dim = map_dim,
                                    dim_self = dim_self,
                                    dim_oth = dim_oth)
    ans_expected <- map_pos
    expect_identical(ans_obtained, ans_expected)
})

test_that("'err_tdy_map_pos' works when 'self' and 'oth' identical, apart from permutation", {
    map_pos <- list(3:1, 4:1)
    map_dim <- 2:1
    dim_self <- 3:4
    dim_oth <- 4:3
    ans_obtained <- err_tdy_map_pos(map_pos = map_pos,
                                    map_dim = map_dim,
                                    dim_self = dim_self,
                                    dim_oth = dim_oth)
    ans_expected <- map_pos
    expect_identical(ans_obtained, ans_expected)
})

test_that("'err_tdy_map_pos' works when one dimension in 'self' collapsed, and 'oth' has an extra dimension", {
    map_pos <- list(1:2, 1:3, c(0L, 0L), 1:2)
    map_dim <- c(1L, 2L, 0L, 3L)
    dim_self <- c(2L, 3L, 2L, 2L)
    dim_oth <- c(2L, 3L, 2L, 10L)
    ans_obtained <- err_tdy_map_pos(map_pos = map_pos,
                                    map_dim = map_dim,
                                    dim_self = dim_self,
                                    dim_oth = dim_oth)
    ans_expected <- map_pos
    expect_identical(ans_obtained, ans_expected)
})

test_that("'err_tdy_map_pos' coerces numeric to integer", {
    map_pos <- list(c(1, 2), c(1, 2, 3), c(0L, 0L), c(1, 2))
    map_dim <- c(1L, 2L, 0L, 3L)
    dim_self <- c(2L, 3L, 2L, 2L)
    dim_oth <- c(2L, 3L, 2L, 10L)
    ans_obtained <- err_tdy_map_pos(map_pos = map_pos,
                                    map_dim = map_dim,
                                    dim_self = dim_self,
                                    dim_oth = dim_oth)
    ans_expected <- lapply(map_pos, as.integer)
    expect_identical(ans_obtained, ans_expected)
})

test_that("'err_tdy_map_pos' works when 'self' and 'oth' both have one dimension", {
    map_pos <- list(c(1L, 0L, 2L))
    map_dim <- 1L
    dim_self <- 3L
    dim_oth <- 2L
    ans_obtained <- err_tdy_map_pos(map_pos = map_pos,
                                    map_dim = map_dim,
                                    dim_self = dim_self,
                                    dim_oth = dim_oth)
    ans_expected <- lapply(map_pos, as.integer)
    expect_identical(ans_obtained, ans_expected)
})

test_that("'err_tdy_map_pos' raises expected error when position in 'self' does not map on to valid position in 'oth'", {
    map_pos <- list(1:3, c(1L, 2L, 4L))
    map_dim <- 1:2
    dim_self <- c(3L, 3L)
    dim_oth <- c(3L, 3L)
    expect_error(err_tdy_map_pos(map_pos = map_pos,
                                 map_dim = map_dim,
                                 dim_self = dim_self,
                                 dim_oth = dim_oth),
                 "element from element 2 of 'map_pos' not found in seq_len(dim_oth[[2]]) : 4",
                 fixed = TRUE)
})

test_that("'err_tdy_map_pos' raises expected error when position in 'oth' not mapped on to by position in 'self'", {
    map_pos <- list(1:3, c(1L, 2L, 3L, 3L))
    map_dim <- 1:2
    dim_self <- c(3L, 4L)
    dim_oth <- c(3L, 4L)
    expect_error(err_tdy_map_pos(map_pos = map_pos,
                                 map_dim = map_dim,
                                 dim_self = dim_self,
                                 dim_oth = dim_oth),
                 "element from seq_len(dim_oth[[2]]) not found in element 2 of 'map_pos' : 4",
                 fixed = TRUE)
})

test_that("'err_tdy_map_pos' raises expected error when dimension of 'self' not found in 'oth' has non-zerl elements", {
    map_pos <- list(1:3, c(0L, 0L, 1L))
    map_dim <- c(1L, 0L)
    dim_self <- c(3L, 3L)
    dim_oth <- 3L
    expect_error(err_tdy_map_pos(map_pos = map_pos,
                                 map_dim = map_dim,
                                 dim_self = dim_self,
                                 dim_oth = dim_oth),
                 "dimension 2 of 'self' does not map on to 'oth', but element 2 of 'map_pos' has non-zero elements",
                 fixed = TRUE)
})


## err_tdy_non_negative_integer_scalar ----------------------------------------

test_that("'err_tdy_non_negative_integer_scalar' works with valid inputs", {
    expect_identical(err_tdy_non_negative_integer_scalar(x = 1, name = "x"),
                     1L)
    expect_identical(err_tdy_integer_scalar(x = 0L, name = "x"),
                     0L)
})

test_that("'err_tdy_non_negative_integer_scalar' raises expected error with invalid input", {
    expect_error(err_tdy_integer_scalar(x = NULL, name = "x"),
                 "'x' is NULL")
    expect_error(err_tdy_non_negative_integer_scalar(x = 0.1,
                                                 name = "x"),
                 "'x' \\[0.1\\] not equivalent to integer")
})


## err_tdy_non_negative_integer_vector ----------------------------------------

test_that("'err_tdy_non_negative_integer_vector' works with valid inputs", {
    expect_identical(err_tdy_non_negative_integer_vector(x = c(1, 2), name = "x"),
                     1:2)
    expect_identical(err_tdy_integer_vector(x = numeric(), name = "x"),
                     integer())
    expect_identical(err_tdy_integer_vector(x = 0L, name = "x"),
                     0L)
})

test_that("'err_tdy_non_negative_integer_vector' raises expected error with invalid input", {
    expect_error(err_tdy_non_negative_integer_vector(x = c(1, 0.1, 2),
                                                 name = "x"),
                 "element 2 of 'x' \\[0.1\\] not equivalent to integer")
})


## err_tdy_positive_integer_scalar --------------------------------------------

test_that("'err_tdy_positive_integer_scalar' works with valid inputs", {
    expect_identical(err_tdy_positive_integer_scalar(x = 1, name = "x"),
                     1L)
})

test_that("'err_tdy_positive_integer_scalar' raises expected error with invalid input", {
    expect_error(err_tdy_positive_integer_scalar(x = 0.1,
                                                 name = "x"),
                 "'x' \\[0.1\\] not equivalent to integer")
    expect_error(err_tdy_positive_integer_scalar(x = NULL, name = "x"),
                 "'x' is NULL")
})


## err_tdy_positive_integer_vector --------------------------------------------

test_that("'err_tdy_positive_integer_vector' works with valid inputs", {
    expect_identical(err_tdy_positive_integer_vector(x = c(1, 2), name = "x"),
                     1:2)
    expect_identical(err_tdy_integer_vector(x = numeric(), name = "x"),
                     integer())
})

test_that("'err_tdy_positive_integer_vector' raises expected error with invalid input", {
    expect_error(err_tdy_positive_integer_vector(x = c(0.1, 1.0),
                                                 name = "x"),
                 "element 1 of 'x' \\[0.1\\] not equivalent to integer")
})


## err_tdy_month_label ------------------------------------------------------

test_that("'err_tdy_month_label' works with valid inputs", {
    expect_identical(err_tdy_month_label("2020 Jan", name = "x"),
                     as.Date("2020-01-01"))
    expect_identical(err_tdy_month_label("2020Feb", name = "x"),
                     as.Date("2020-02-01"))
    expect_identical(err_tdy_month_label("2020 MAR", name = "x"),
                     as.Date("2020-03-01"))
    expect_identical(err_tdy_month_label("2020   aPr", name = "x"),
                     as.Date("2020-04-01"))
})

test_that("'err_tdy_month_label' raises expected error with invalid input", {
    expect_error(err_tdy_month_label("2020 Janu", name = "x"),
                 "invalid value for 'x' : \"2020 Janu\"")
})


## err_tdy_quarter_label ------------------------------------------------------

test_that("'err_tdy_quarter_label' works with valid inputs", {
    expect_identical(err_tdy_quarter_label("2020 Q1", name = "x"),
                     as.Date("2020-01-01"))
    expect_identical(err_tdy_quarter_label("2020Q2", name = "x"),
                     as.Date("2020-04-01"))
    expect_identical(err_tdy_quarter_label("2020 q3", name = "x"),
                     as.Date("2020-07-01"))
    expect_identical(err_tdy_quarter_label("2020   q4", name = "x"),
                     as.Date("2020-10-01"))
})

test_that("'err_tdy_quarter_label' raises expected error with invalid input", {
    expect_error(err_tdy_quarter_label("2020 Q5", name = "x"),
                 "invalid value for 'x' : \"2020 Q5\"")
})


## err_tdy_same_length --------------------------------------------------------

test_that("'err_tdy_same_length' works with valid inputs", {
    expect_identical(err_tdy_same_length(x1 = 1L, x2 = 2, name1 = "x1", name2 = "x2"),
                     list(x1 = 1L, x2 = 2))
    expect_identical(err_tdy_same_length(x1 = 1L, x2 = 1:2, name1 = "x1", name2 = "x2"),
                     list(x1 = c(1L, 1L), x2 = 1:2))
    expect_identical(err_tdy_same_length(x1 = 1:2, x2 = 2, name1 = "x1", name2 = "x2"),
                     list(x1 = 1:2, x2 = c(2, 2)))
    expect_identical(err_tdy_same_length(x1 = 1:2, x2 = 2:1, name1 = "x1", name2 = "x2"),
                     list(x1 = 1:2, x2 = 2:1))
})


## err_tdy_unit ---------------------------------------------------------------

test_that("'err_tdy_unit' works with valid inputs", {
    expect_identical(err_tdy_unit(x = NULL, name = "x"),
                     "year")
    for (val in c("year", "years",
                  "quarter", "quarters",
                  "month", "months",
                  "1 year", "1 years",
                  "33 year", "33 years"))
    expect_identical(err_tdy_unit(x = val, name = "x"),
                     val)
})

test_that("'err_tdy_unit' raises expected error with invalid input", {
    expect_error(err_tdy_unit(x = NA_character_,
                              name = "x"),
                 "'x' is NA")
    expect_error(err_tdy_unit(x = "wrong",
                              name = "x"),
                 "'x' has invalid value \\[\"wrong\"\\]")
    expect_error(err_tdy_unit(x = "1 month",
                              name = "x"),
                 "'x' has invalid value \\[\"1 month\"\\]")
    expect_error(err_tdy_unit(x = "0 year",
                              name = "x"),
                 "'x' has invalid value \\[\"0 year\"\\] : number of years less than 1")
    expect_error(err_tdy_unit(x = "-5 years",
                              name = "x"),
                 "'x' has invalid value \\[\"-5 years\"\\] : number of years less than 1")
})
johnrbryant/demcheck documentation built on Dec. 31, 2021, 11:57 a.m.