tests/testthat/test-check-functions.R

In ONSdigital/Bayesian-demographic-accounts: Bayesian Demographic Accounts

## check_account --------------------------------------------------------------

test_that("'check_account' returns TRUE with valid account", {
    population <- fake_classif_vars(n_time = 4L)
    population$time <- population$time - 1L
    population <- unique(population[-match("cohort", names(population))])
    births <- fake_classif_vars()
    births <- births[births$age == 1, , drop = FALSE]
    deaths <- fake_classif_vars()
    immigration <- fake_classif_vars()
    emigration <- fake_classif_vars()
    internal_in <- fake_classif_vars()
    internal_out <- fake_classif_vars()
    population$count <- 100
    births$count <- 50
    is_upper <- with(deaths, age == time - cohort - 1)
    is_max_age <- with(deaths, age == max(age))
    deaths$count <- with(deaths, ifelse(is_upper & is_max_age, 101, 1))
    immigration$count <- 5
    emigration$count <- 4
    account <- list(population = population,
                    births = births,
                    deaths = deaths,
                    immigration = immigration,
                    emigration = emigration)
    expect_true(check_account(account))
})

test_that("'check_account' raises correct eror when data frame invalid", {
    population <- fake_classif_vars(n_time = 4L)
    population$time <- population$time - 1L
    population <- unique(population[-match("cohort", names(population))])
    births <- fake_classif_vars()
    births <- births[births$age == 1, , drop = FALSE]
    deaths <- fake_classif_vars()
    immigration <- fake_classif_vars()
    emigration <- fake_classif_vars()
    internal_in <- fake_classif_vars()
    internal_out <- fake_classif_vars()
    population$count <- 100
    births$count <- 50
    is_upper <- with(deaths, age == time - cohort - 1)
    is_max_age <- with(deaths, age == max(age))
    deaths$count <- with(deaths, ifelse(is_upper & is_max_age, 101, 1))
    immigration$count <- 5
    emigration$count <- 4
    emigration$count[1] <- NA
    account <- list(population = population,
                    births = births,
                    deaths = deaths,
                    immigration = immigration,
                    emigration = emigration)
    expect_error(check_account(account),
                 "problem with 'account' :")
})


## 'check_arg_dm' ----------------------------------------------------------

test_that("'check_arg_dm' returns TRUE when 'arg' is valid data frame", {
    data <- fake_classif_vars()
    data$count <- 1L
    ratio <- data.frame(age = 0:2, ratio = c(1.1, 3, 0))
    expect_true(check_arg_dm(arg = ratio,
                             nm_arg = "ratio",
                             data = data,
                             neg_ok = FALSE,
                             zero_ok = TRUE))
})

test_that("'check_arg_dm' returns TRUE when 'arg' is valid numeric scalar", {
    ratio <- 0
    expect_true(check_arg_dm(arg = ratio,
                             nm_arg = "ratio",
                             data = data,
                             neg_ok = FALSE,
                             zero_ok = TRUE))
})

test_that("'check_arg_dm' returns expected error 'arg' is not a data frame or a numeric vector", {
    ratio <- "wrong"
    expect_error(check_arg_dm(arg = ratio,
                              nm_arg = "ratio",
                              data = data,
                              neg_ok = FALSE,
                              zero_ok = TRUE),
                 "'ratio' has class 'character'")
})


## 'check_arg_dm_df' ----------------------------------------------------------

test_that("'check_arg_dm_df' returns TRUE when 'arg' is valid", {
    data <- fake_classif_vars()
    data$count <- 1L
    ratio <- data.frame(sex = c("Female", "Male", "Other"), ratio = c(1.1, 0, 0.4))
    expect_true(check_arg_dm_df(arg = ratio,
                                nm_arg = "ratio",
                                data = data,
                                neg_ok = FALSE,
                                zero_ok = TRUE))
})

test_that("'check_arg_dm_df' throws correct error when 'arg' does not have variable called 'nm_arg'", {
    data <- fake_classif_vars()
    data$count <- 1L
    ratio <- data.frame(sex = c("Female", "Male", "Other"), wrong = c(1.1, 0, 0.4))
    expect_error(check_arg_dm_df(arg = ratio,
                                nm_arg = "ratio",
                                data = data,
                                neg_ok = FALSE,
                                zero_ok = TRUE),
                 "'ratio' does not have a variable called 'ratio'")
})

test_that("'check_arg_dm_df' throws correct error when 'nm_arg' in names of 'data'", {
    data <- fake_classif_vars()
    data$count <- 1L
    age <- data.frame(sex = c("Female", "Male", "Other"), age = c(1.1, 0, 0.4))
    expect_error(check_arg_dm_df(arg = age,
                                nm_arg = "age",
                                data = data,
                                neg_ok = FALSE,
                                zero_ok = TRUE),
                 "argument 'age' has the same name as a variable in 'data'")
})

test_that("'check_arg_dm_df' throws correct error when 'arg' has variable not in 'data'", {
    data <- fake_classif_vars()
    data$count <- 1L
    ratio <- data.frame(region = c("A", "B", "C"), ratio = c(1.1, 0, 0.4))
    expect_error(check_arg_dm_df(arg = ratio,
                                 nm_arg = "ratio",
                                 data = data,
                                 neg_ok = FALSE,
                                 zero_ok = TRUE),
                 "'ratio' has a variable \\[region\\] not found in 'data'")
})

test_that("'check_arg_dm_df' throws correct error when 'data' has row that does not map on to 'arg'", {
    data <- fake_classif_vars()
    data$count <- 1L
    ratio <- data.frame(age = 0:1, ratio = c(1.1, 0))
    expect_error(check_arg_dm_df(arg = ratio,
                                 nm_arg = "ratio",
                                 data = data,
                                 neg_ok = FALSE,
                                 zero_ok = TRUE),
                 "row of 'data' with classifying variables 1997, Female, 2000, 2 does not have corresponding row in 'ratio'")
})

test_that("'check_arg_dm_df' throws correct error when 'arg' has an NA where corresponding row in 'data' does not", {
    data <- fake_classif_vars()
    data$count <- 1L
    ratio <- data.frame(age = 0:2, ratio = c(1.1, NA, 0))
    expect_error(check_arg_dm_df(arg = ratio,
                                 nm_arg = "ratio",
                                 data = data,
                                 neg_ok = FALSE,
                                 zero_ok = TRUE),
                 paste("row of 'data' with classifying variables 1998, Female, 2000, 1 has non-NA value for 'count'",
                       "but corresponding row in 'ratio' has NA value for 'ratio'"))
})

test_that("'check_arg_dm_df' throws correct error when 'arg' has an negative values", {
    data <- fake_classif_vars()
    data$count <- 1L
    disp <- data.frame(age = 0:2, disp = c(1.1, 3, -1))
    expect_error(check_arg_dm_df(arg = disp,
                                 nm_arg = "disp",
                                 data = data,
                                 neg_ok = FALSE,
                                 zero_ok = TRUE),
                 "'disp' variable in 'disp' has negative values")
})

test_that("'check_arg_dm_df' throws correct error when 'arg' has zeros", {
    data <- fake_classif_vars()
    data$count <- 1L
    disp <- data.frame(age = 0:2, disp = c(1.1, 3, 0))
    expect_error(check_arg_dm_df(arg = disp,
                                 nm_arg = "disp",
                                 data = data,
                                 neg_ok = FALSE,
                                 zero_ok = FALSE),
                 "'disp' variable in 'disp' has zeros")
})



## 'check_arg_dm_num' ---------------------------------------------------------

test_that("'check_arg_dm_num' returns TRUE when 'arg' is valid", {
    expect_true(check_arg_dm_num(0.5,
                                 nm_arg = "x",
                                 neg_ok = FALSE,
                                 zero_ok = FALSE))
    expect_true(check_arg_dm_num(-0.5,
                                 nm_arg = "x",
                                 neg_ok = TRUE,
                                 zero_ok = FALSE))
    expect_true(check_arg_dm_num(0,
                                 nm_arg = "x",
                                 neg_ok = TRUE,
                                 zero_ok = TRUE))
})

test_that("'check_arg_dm_num' throws correct error when 'arg' is invalid", {
    expect_error(check_arg_dm_num(c(0.5, 0.1),
                                  nm_arg = "x",
                                  neg_ok = FALSE,
                                  zero_ok = FALSE),
                 "'x' does not have length 1")
    expect_error(check_arg_dm_num(NA_real_,
                                  nm_arg = "x",
                                  neg_ok = FALSE,
                                  zero_ok = FALSE),
                 "'x' is NA")
    expect_error(check_arg_dm_num(-1,
                                  nm_arg = "x",
                                  neg_ok = FALSE,
                                  zero_ok = FALSE),
                 "'x' is negative")
    expect_error(check_arg_dm_num(0,
                                  nm_arg = "x",
                                  neg_ok = FALSE,
                                  zero_ok = FALSE),
                 "'x' equals 0")
})


## 'check_classif_vars_complete' -----------------------------------------------

test_that("'check_classif_vars_valid' returns TRUE when classif_vars valid", {
    classif_vars <- fake_classif_vars()
    expect_true(check_classif_vars_complete(classif_vars = classif_vars,
                                            nm_obj = "deaths",
                                            no_min_age = FALSE))
})


test_that("'check_classif_vars_valid' throws expected error when 'age' does not have minimum 0", {
    classif_vars <- expand.grid(list(sex = c("Female", "Male"),
                                     time = 2000:2001,
                                     age = 1:3),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    expect_error(check_classif_vars_complete(classif_vars = classif_vars,
                                             nm_obj = "deaths",
                                             no_min_age = FALSE),
                 "minimum value for 'age' \\[1\\] in 'deaths' is not zero")
})

test_that("'check_classif_vars_complete' does not throw error when 'age' does not have minimum 0, but 'no_min_age' is TRUE", {
    classif_vars <- expand.grid(list(time = 2000:2001,
                               age = 1:3),
                          stringsAsFactors = FALSE,
                          KEEP.OUT.ATTRS = FALSE)
    expect_true(check_classif_vars_complete(classif_vars = classif_vars,
                                         nm_obj = "births",
                                         no_min_age = TRUE))
})

test_that("'check_classif_vars_complete' throws expected error when classifying variable missing intermediate values", {
    classif_vars <- expand.grid(list(sex = c("Female", "Male"),
                                     time = c(2000, 2002),
                                     age = 0:2),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    expect_error(check_classif_vars_complete(classif_vars = classif_vars,
                                             nm_obj = "deaths",
                                             no_min_age = FALSE),
                 "'time' variable in 'deaths' missing intermediate value \\[2001\\]")
})

test_that("'check_classif_vars_complete' throws expected error when missing some combinations of classifying variables - no cohort", {
    classif_vars <- expand.grid(list(sex = c("Female", "Male"),
                                     time = 2000:2001,
                                     age = 0:2),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    classif_vars <- classif_vars[-2,]
    expect_error(check_classif_vars_complete(classif_vars,
                                             nm_obj = "population",
                                             no_min_age = FALSE),
                 "'population' does not include all possible combinations of classification variables")
})

test_that("'check_classif_vars_complete' throws expected error when missing some combinations of classifying variables - has cohort", {
    classif_vars <- fake_classif_vars()
    classif_vars <- classif_vars[-2,]
    expect_error(check_classif_vars_complete(classif_vars,
                                             nm_obj = "deaths",
                                             no_min_age = FALSE),
                 "'deaths' does not include all possible combinations of classification variables")
})


## 'check_classif_vars_consistent_levels' -------------------------------------

test_that("'check_classif_vars_consistent_levels' returns TRUE when levels consistent - rates", {
    classif_vars_births <- expand.grid(age = 1:2,
                                       time = 2000:2002,
                                       gender = c("F", "M", "D"),
                                       region = c("a", "b"),
                                       KEEP.OUT.ATTRS = FALSE)
    classif_vars_deaths <- expand.grid(age = 0:3,
                                       time = 2000:2002,
                                       gender = c("F", "M", "D"),
                                       region = c("a", "b"),
                                       KEEP.OUT.ATTRS = FALSE)
    classif_vars_all <- list(classif_vars_births,
                             classif_vars_deaths)
    classif_vars_template <- classif_vars_deaths
    nms_obj_all <- c("births", "deaths")
    absent_ok <- FALSE
    ignore_age_cohort <- "births"
    omit_first_time <- character()
    expect_true(check_classif_vars_consistent_levels(classif_vars_all = classif_vars_all,
                                                     nms_obj_all = nms_obj_all,
                                                     classif_vars_template = classif_vars_template,
                                                     absent_ok = absent_ok,
                                                     ignore_age_cohort = ignore_age_cohort,
                                                     omit_first_time = omit_first_time))
})

test_that("'check_classif_vars_consistent_levels' returns TRUE when levels consistent - data models", {
    classif_vars_popn <- fake_classif_vars_popn()
    classif_vars_births <- fake_classif_vars()
    classif_vars_births <- classif_vars_births[classif_vars_births$age == 1L, , ]
    classif_vars_deaths <- fake_classif_vars()
    classif_vars_all <- list(classif_vars_popn,
                             classif_vars_births,
                             classif_vars_deaths)
    classif_vars_template <- classif_vars_deaths
    nms_obj_all <- c("reg_popn", "reg_births", "reg_deaths")
    absent_ok <- TRUE
    ignore_age_cohort <- "reg_births"
    omit_first_time <- "reg_popn"
    expect_true(check_classif_vars_consistent_levels(classif_vars_all = classif_vars_all,
                                                     nms_obj_all = nms_obj_all,
                                                     classif_vars_template = classif_vars_template,
                                                     absent_ok = absent_ok,
                                                     ignore_age_cohort = ignore_age_cohort,
                                                     omit_first_time = omit_first_time))
})

test_that("'check_classif_vars_consistent_levels' returns TRUE when levels consistent - account", {
    classif_vars_popn <- fake_classif_vars_popn()
    classif_vars_births <- fake_classif_vars()
    classif_vars_births <- classif_vars_births[classif_vars_births$age == 1L, , ]
    classif_vars_deaths <- fake_classif_vars()
    classif_vars_all <- list(classif_vars_popn,
                             classif_vars_births,
                             classif_vars_deaths)
    classif_vars_template <- classif_vars_deaths
    nms_obj_all <- c("population", "births", "deaths")
    absent_ok <- FALSE
    ignore_age_cohort <- "births"
    omit_first_time <- "population"
    expect_true(check_classif_vars_consistent_levels(classif_vars_all = classif_vars_all,
                                                     nms_obj_all = nms_obj_all,
                                                     classif_vars_template = classif_vars_template,
                                                     absent_ok = absent_ok,
                                                     ignore_age_cohort = ignore_age_cohort,
                                                     omit_first_time = omit_first_time))
})

test_that("'check_classif_vars_consistent_levels' raises correct error with unexpected value", {
    classif_vars_births <- fake_classif_vars()
    classif_vars_births <- classif_vars_births[classif_vars_births$age == 1L, , ]
    classif_vars_births[1, "time"] <- 4000
    classif_vars_deaths <- fake_classif_vars()
    classif_vars_all <- list(classif_vars_births,
                             classif_vars_deaths)
    classif_vars_template <- classif_vars_deaths
    nms_obj_all <- c("births", "deaths")
    absent_ok <- FALSE
    ignore_age_cohort <- "births"
    omit_first_time <- character()
    expect_error(check_classif_vars_consistent_levels(classif_vars_all = classif_vars_all,
                                                     nms_obj_all = nms_obj_all,
                                                     classif_vars_template = classif_vars_template,
                                                     absent_ok = absent_ok,
                                                     ignore_age_cohort = ignore_age_cohort,
                                                     omit_first_time = omit_first_time),
                 "variable 'time' in 'births' has unexpected value \\[4000\\]")
})

test_that("'check_classif_vars_consistent_levels' raises correct error with absent value", {
    classif_vars_births <- fake_classif_vars()
    classif_vars_births <- classif_vars_births[classif_vars_births$age == 1L, , ]
    classif_vars_births <- classif_vars_births[classif_vars_births$sex == "Female", ]
    classif_vars_deaths <- fake_classif_vars()
    classif_vars_all <- list(classif_vars_births,
                             classif_vars_deaths)
    classif_vars_template <- classif_vars_deaths
    nms_obj_all <- c("births", "deaths")
    absent_ok <- FALSE
    ignore_age_cohort <- "births"
    omit_first_time <- character()
    expect_error(check_classif_vars_consistent_levels(classif_vars_all = classif_vars_all,
                                                     nms_obj_all = nms_obj_all,
                                                     classif_vars_template = classif_vars_template,
                                                     absent_ok = absent_ok,
                                                     ignore_age_cohort = ignore_age_cohort,
                                                     omit_first_time = omit_first_time),
                 "variable 'sex' in 'births' does not have value 'Male'")
})


## 'check_classif_vars_consistent_names' --------------------------------------

test_that("'check_classif_vars_consistent_names' returns TRUE when names valid - rates", {
    nms_classif_all <- list(c("age", "time"),
                            c("age", "sex", "time"),
                            c("age", "sex", "time"),
                            c("age", "sex", "time"))
    nms_obj_all <- c("births", "deaths", "immigration", "emigration")
    nms_classif_template <- c("age", "time", "sex")
    no_cohort  <- nms_obj_all
    no_sexgender <- "births"
    expect_true(check_classif_vars_consistent_names(nms_classif_all = nms_classif_all,
                                                    nms_obj_all = nms_obj_all,
                                                    nms_classif_template = nms_classif_template,
                                                    no_cohort = no_cohort,
                                                    no_sexgender = no_sexgender))
})

test_that("'check_classif_vars_consistent_names' returns TRUE when names valid - data models", {
    nms_classif_all <- list(c("age", "time", "cohort", "region", "sex"),
                            c("age", "sex", "cohort", "region", "time"),
                            c("cohort", "age", "sex", "time", "region"),
                            c("age", "sex", "cohort", "time", "region"),
                            c("age", "sex", "time", "region"))
    nms_obj_all <- c("births", "deaths", "immigration", "emigration", "population")
    nms_classif_template <- c("age", "time", "sex", "region", "cohort")
    no_cohort  <- "population"
    no_sexgender <- character()
    expect_true(check_classif_vars_consistent_names(nms_classif_all = nms_classif_all,
                                                    nms_obj_all = nms_obj_all,
                                                    nms_classif_template = nms_classif_template,
                                                    no_cohort = no_cohort,
                                                    no_sexgender = no_sexgender))
})

test_that("'check_classif_vars_consistent_names' returns TRUE when names valid - account", {
    nms_classif_all <- list(c("age", "time", "cohort", "gender"),
                            c("age", "gender", "cohort",  "time"),
                            c("cohort", "age", "gender", "time"),
                            c("age", "gender", "cohort", "time"),
                            c("age", "gender", "time"))
    nms_obj_all <- c("births", "deaths", "immigration", "emigration", "population")
    nms_classif_template <- c("age", "time", "gender", "cohort")
    no_cohort  <- "population"
    no_sexgender <- character()
    expect_true(check_classif_vars_consistent_names(nms_classif_all = nms_classif_all,
                                                    nms_obj_all = nms_obj_all,
                                                    nms_classif_template = nms_classif_template,
                                                    no_cohort = no_cohort,
                                                    no_sexgender = no_sexgender))
})

test_that("'check_classif_vars_consistent_names' throws expected error when names invalid", {
    nms_classif_all <- list(c("age", "time", "cohort", "gender"),
                            c("age", "gender", "cohort",  "time"),
                            c("cohort", "age", "gender", "wrong"),
                            c("age", "gender", "cohort", "time"),
                            c("age", "gender", "time"))
    nms_obj_all <- c("births", "deaths", "immigration", "emigration", "population")
    nms_classif_template <- c("age", "time", "gender", "cohort")
    no_cohort  <- "population"
    no_sexgender <- character()
    expect_error(check_classif_vars_consistent_names(nms_classif_all = nms_classif_all,
                                                    nms_obj_all = nms_obj_all,
                                                    nms_classif_template = nms_classif_template,
                                                    no_cohort = no_cohort,
                                                    no_sexgender = no_sexgender),
                 "'immigration' has classification variables cohort, age, gender, wrong : expected variables age, time, gender, cohort")
})


## 'check_classif_vars_valid' -------------------------------------------------

test_that("'check_classif_vars_valid' returns TRUE when inputs valid - no region", {
    classif_vars <- fake_classif_vars()
    expect_true(check_classif_vars_valid(classif_vars = classif_vars,
                                         nm_obj = "deaths"))
})

test_that("'check_classif_vars_valid' returns TRUE when inputs valid - has region", {
    classif_vars <- fake_classif_vars(n_region = 2L)
    expect_true(check_classif_vars_valid(classif_vars = classif_vars,
                                         nm_obj = "deaths"))
})

test_that("'check_classif_vars_valid' throws expected error when 'nm_obj' has NAs", {
    classif_vars <- expand.grid(list(sex = c("Female", "Male"),
                                     time = 2001:2000,
                                     age = 0:3),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    classif_vars$time[[2]] <- NA
    expect_error(check_classif_vars_valid(classif_vars = classif_vars,
                                          nm_obj = "deaths"),
                 "'time' variable in 'deaths' has NAs")
})

test_that("'check_classif_vars_valid' throws expected error when 'nm_obj' has duplicated classif vars", {
    classif_vars <- expand.grid(list(sex = c("Female", "Male"),
                                     time = 2001:2000,
                                     age = 0:3),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    classif_vars <- rbind(classif_vars, classif_vars[2, ])
    expect_error(check_classif_vars_valid(classif_vars = classif_vars,
                                          nm_obj = "deaths"),
                 sprintf("'deaths' has more than one row with values : %s",
                         paste(classif_vars[2, ], collapse = ", ")))
})

test_that("'check_classif_vars_valid' throws expected error when 'nm_obj' has non-numeric classif column", {
    classif_vars <- expand.grid(list(sex = c("Female", "Male"),
                                     time = as.character(2001:2000),
                                     age = 0:3),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    expect_error(check_classif_vars_valid(classif_vars = classif_vars,
                                          nm_obj = "deaths"),
                 "'time' variable in 'deaths' is non-numeric")
})

test_that("'check_classif_vars_valid' throws expected error when 'nm_obj' has non-integer classif column", {
    classif_vars <- expand.grid(list(sex = c("Female", "Male"),
                                     time = c(2001.1, 2000),
                                     age = 0:3),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    expect_error(check_classif_vars_valid(classif_vars = classif_vars,
                                          nm_obj = "deaths"),
                 "'time' variable in 'deaths' has non-integer values")
})


## 'check_consistent_account_rates --------------------------------------------

test_that("'check_consistent_account_rates' returns TRUE with valid account and rates", {
    ## account
    population <- fake_classif_vars(n_time = 4L)
    population$time <- population$time - 1L
    population <- unique(population[-match("cohort", names(population))])
    births <- fake_classif_vars()
    births <- births[births$age == 1, , drop = FALSE]
    deaths <- fake_classif_vars()
    immigration <- fake_classif_vars()
    emigration <- fake_classif_vars()
    population$count <- 100
    births$count <- 50
    is_upper <- with(deaths, age == time - cohort - 1)
    is_max_age <- with(deaths, age == max(age))
    deaths$count <- with(deaths, ifelse(is_upper & is_max_age, 101, 1))
    immigration$count <- 5
    emigration$count <- 4
    account <- list(population = population,
                    births = births,
                    deaths = deaths,
                    immigration = immigration,
                    emigration = emigration)
    ## rates
    births <- expand.grid(time = 2000:2002,
                          age = 1,
                          KEEP.OUT.ATTRS = FALSE)
    births$rate <- 0.1
    deaths <- expand.grid(time = 2000:2002,
                          sex = c("Female", "Male"),
                          age = 0:2,
                          KEEP.OUT.ATTRS = FALSE)
    deaths$rate <- 0.2
    rates <- list(deaths = deaths,
                  births = births,
                  immigration = deaths,
                  emigration = deaths)
    ## comparison
    expect_true(check_consistent_account_rates(account = account,
                                               rates = rates))
})

test_that("'check_consistent_account_rates' throws correct error when account and rates have different series", {
    ## account
    population <- fake_classif_vars(n_time = 4L)
    population$time <- population$time - 1L
    population <- unique(population[-match("cohort", names(population))])
    births <- fake_classif_vars()
    births <- births[births$age == 1, , drop = FALSE]
    deaths <- fake_classif_vars()
    immigration <- fake_classif_vars()
    emigration <- fake_classif_vars()
    population$count <- 100
    births$count <- 50
    is_upper <- with(deaths, age == time - cohort - 1)
    is_max_age <- with(deaths, age == max(age))
    deaths$count <- with(deaths, ifelse(is_upper & is_max_age, 101, 1))
    immigration$count <- 5
    emigration$count <- 4
    account <- list(population = population,
                    births = births,
                    deaths = deaths,
                    immigration = immigration,
                    emigration = emigration)
    ## rates
    births <- expand.grid(time = 2000:2002,
                          age = 1,
                          KEEP.OUT.ATTRS = FALSE)
    births$rate <- 0.1
    deaths <- expand.grid(time = 2000:2002,
                          sex = c("Female", "Male"),
                          age = 0:2,
                          KEEP.OUT.ATTRS = FALSE)
    deaths$rate <- 0.2
    rates <- list(deaths = deaths,
                  births = births,
                  emigration = deaths)
    ## comparison
    expect_error(check_consistent_account_rates(account = account,
                                                rates = rates),
                 paste("series in 'account' \\[population, births, deaths,",
                       "immigration, emigration\\] inconsistent with",
                       "series in 'rates' \\[deaths, births, emigration\\]"))                 
})

test_that("'check_consistent_account_rates' throws correct error when account and rates have different classification variables", {
    ## account
    population <- fake_classif_vars(n_time = 4L, n_region = 2)
    population$time <- population$time - 1L
    population <- unique(population[-match("cohort", names(population))])
    births <- fake_classif_vars(n_region = 2)
    births <- births[births$age == 1, , drop = FALSE]
    deaths <- fake_classif_vars(n_region = 2)
    immigration <- fake_classif_vars(n_region = 2)
    emigration <- fake_classif_vars(n_region = 2)
    population$count <- 100
    births$count <- 50
    is_upper <- with(deaths, age == time - cohort - 1)
    is_max_age <- with(deaths, age == max(age))
    deaths$count <- with(deaths, ifelse(is_upper & is_max_age, 101, 1))
    immigration$count <- 5
    emigration$count <- 4
    account <- list(population = population,
                    births = births,
                    deaths = deaths,
                    immigration = immigration,
                    emigration = emigration)
    ## rates
    births <- expand.grid(time = 2000:2002,
                          age = 1,
                          KEEP.OUT.ATTRS = FALSE)
    births$rate <- 0.1
    deaths <- expand.grid(time = 2000:2002,
                          sex = c("Female", "Male"),
                          age = 0:2,
                          KEEP.OUT.ATTRS = FALSE)
    deaths$rate <- 0.2
    rates <- list(deaths = deaths,
                  births = births,
                  immigration = deaths,
                  emigration = deaths)
    ## comparison
    expect_error(check_consistent_account_rates(account = account,
                                                rates = rates),
                 paste("names of classification variables",
                       "\\[cohort, sex, time, age, region\\] for",
                       "series 'deaths' in 'account' not consistent with names of",
                       "classification variables \\[time, sex, age\\]",
                       "for series 'deaths' in 'rates'"))
})

test_that("'check_consistent_account_rates' throws correct error when account and rates have different levels - rates missing level", {
    ## account
    population <- fake_classif_vars(n_time = 4L, n_age = 4)
    population$time <- population$time - 1L
    population <- unique(population[-match("cohort", names(population))])
    births <- fake_classif_vars()
    births <- births[births$age == 1, , drop = FALSE]
    deaths <- fake_classif_vars(n_age = 4)
    immigration <- fake_classif_vars(n_age = 4)
    emigration <- fake_classif_vars(n_age = 4)
    population$count <- 100
    births$count <- 50
    is_upper <- with(deaths, age == time - cohort - 1)
    is_max_age <- with(deaths, age == max(age))
    deaths$count <- with(deaths, ifelse(is_upper & is_max_age, 101, 1))
    immigration$count <- 5
    emigration$count <- 4
    account <- list(population = population,
                    births = births,
                    deaths = deaths,
                    immigration = immigration,
                    emigration = emigration)
    ## rates
    births <- expand.grid(time = 2000:2002,
                          age = 1,
                          KEEP.OUT.ATTRS = FALSE)
    births$rate <- 0.1
    deaths <- expand.grid(time = 2000:2002,
                          sex = c("Female", "Male"),
                          age = 0:2,
                          KEEP.OUT.ATTRS = FALSE)
    deaths$rate <- 0.2
    rates <- list(deaths = deaths,
                  births = births,
                  immigration = deaths,
                  emigration = deaths)
    ## comparison
    expect_error(check_consistent_account_rates(account = account,
                                                rates = rates),
                 paste("'age' variable for series 'deaths' in 'account'",
                       "has value \\[3\\] not found in 'age' variable for series",
                       "'deaths' in 'rates'"))
})

test_that("'check_consistent_account_rates' throws correct error when account and rates have different levels - account missing level", {
    ## account
    population <- fake_classif_vars(n_time = 4L)
    population$time <- population$time - 1L
    population <- unique(population[-match("cohort", names(population))])
    births <- fake_classif_vars()
    births <- births[births$age == 1, , drop = FALSE]
    deaths <- fake_classif_vars()
    immigration <- fake_classif_vars()
    emigration <- fake_classif_vars()
    population$count <- 100
    births$count <- 50
    is_upper <- with(deaths, age == time - cohort - 1)
    is_max_age <- with(deaths, age == max(age))
    deaths$count <- with(deaths, ifelse(is_upper & is_max_age, 101, 1))
    immigration$count <- 5
    emigration$count <- 4
    account <- list(population = population,
                    births = births,
                    deaths = deaths,
                    immigration = immigration,
                    emigration = emigration)
    ## rates
    births <- expand.grid(time = 2000:2002,
                          age = 1,
                          KEEP.OUT.ATTRS = FALSE)
    births$rate <- 0.1
    deaths <- expand.grid(time = 2000:2002,
                          sex = c("Female", "Male"),
                          age = 0:3,
                          KEEP.OUT.ATTRS = FALSE)
    deaths$rate <- 0.2
    rates <- list(deaths = deaths,
                  births = births,
                  immigration = deaths,
                  emigration = deaths)
    ## comparison
    expect_error(check_consistent_account_rates(account = account,
                                                rates = rates),
                 paste("'age' variable for series 'deaths' in 'rates'",
                       "has value \\[3\\] not found in 'age' variable for series",
                       "'deaths' in 'account'"))
})


## 'check_consistent_rates_data_models ----------------------------------------

test_that("'check_consistent_rates_data_models' returns TRUE with valid rates and data models", {
    ## rates
    classif_vars <- expand.grid(list(sex = c("Female", "Male"),
                                     time = 2002:2000,
                                     age = 0:2),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    deaths <- classif_vars
    deaths$rate <- 3
    immigration1 <- classif_vars
    immigration1$rate <- 3
    emigration1 <- classif_vars
    emigration1$rate <- 0.2
    immigration2 <- immigration1
    emigration2 <- emigration1
    births <- expand.grid(list(time = 2002:2000,
                               age = 1),
                          stringsAsFactors = FALSE,
                          KEEP.OUT.ATTRS = FALSE)
    births$rate <- 0.2
    rates <- list(deaths = deaths,
                  births = births,
                  immigration1 = immigration1,
                  emigration1 = emigration1,
                  immigration2 = immigration2,
                  emigration2 = emigration2)
    ## data models
    reg_popn <- fake_classif_vars_popn()
    reg_popn$count <- 10
    mod_popn <- dm_poibin(data = reg_popn,
                          prob = 0.95,
                          nm_series = "population")
    reg_births <- fake_classif_vars()
    reg_births <- reg_births[reg_births$age == 1L, , drop = FALSE]
    reg_births$count <- 1
    mod_births <- dm_exact(data = reg_births,
                           nm_series = "births")
    reg_deaths <- fake_classif_vars()
    reg_deaths$count <- 2
    mod_deaths <- dm_exact(data = reg_deaths,
                           nm_series = "deaths")
    data_models <- list(mod_popn, mod_births, mod_deaths)
    ## comparison
    expect_true(check_consistent_rates_data_models(rates = rates,
                                                   data_models = data_models))
})


test_that("'check_consistent_rates_data_models' throws correct error when names of series inconsistent", {
    ## rates
    classif_vars <- expand.grid(list(sex = c("Female", "Male"),
                                     time = 2002:2000,
                                     age = 0:2),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    deaths <- classif_vars
    deaths$rate <- 3
    immigration1 <- classif_vars
    immigration1$rate <- 3
    emigration1 <- classif_vars
    emigration1$rate <- 0.2
    immigration2 <- immigration1
    emigration2 <- emigration1
    births <- expand.grid(list(time = 2002:2000,
                               age = 1),
                          stringsAsFactors = FALSE,
                          KEEP.OUT.ATTRS = FALSE)
    births$rate <- 0.2
    rates <- list(deaths = deaths,
                  births = births,
                  immigration1 = immigration1,
                  emigration1 = emigration1,
                  immigration2 = immigration2,
                  emigration2 = emigration2)
    ## data models
    reg_popn <- fake_classif_vars_popn()
    reg_popn$count <- 10
    mod_popn <- dm_poibin(data = reg_popn,
                          prob = 0.95,
                          nm_series = "population")
    reg_births <- fake_classif_vars()
    reg_births <- reg_births[reg_births$age == 1L, , drop = FALSE]
    reg_births$count <- 1
    mod_births <- dm_exact(data = reg_births,
                           nm_series = "births")
    reg_deaths <- fake_classif_vars()
    reg_deaths$count <- 2
    mod_deaths <- dm_exact(data = reg_deaths,
                           nm_series = "deaths")
    data_models <- list(mod_popn, mod_births, mod_deaths)
    reg_immigration <- fake_classif_vars()
    reg_immigration$count <- 2
    mod_immigration <- dm_poibin(data = reg_immigration,
                                 prob = 0.9,
                                 nm_series = "immigration")
    data_models <- list(mod_popn, mod_births, mod_deaths, mod_immigration)
    ## comparison
    expect_error(check_consistent_rates_data_models(rates = rates,
                                                    data_models = data_models),
                 "'data_models' has model for series \\[immigration\\] not found in 'rates'")
})


test_that("'check_consistent_rates_data_models' throws expected error when names of variables inconsistent", {
    ## rates
    classif_vars <- expand.grid(list(sex = c("Female", "Male"),
                                     time = 2002:2000,
                                     age = 0:2,
                                     region = 1:2),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    deaths <- classif_vars
    deaths$rate <- 3
    immigration1 <- classif_vars
    immigration1$rate <- 3
    emigration1 <- classif_vars
    emigration1$rate <- 0.2
    immigration2 <- immigration1
    emigration2 <- emigration1
    births <- expand.grid(list(time = 2002:2000,
                               age = 1,
                               region = 1:2),
                          stringsAsFactors = FALSE,
                          KEEP.OUT.ATTRS = FALSE)
    births$rate <- 0.2
    rates <- list(deaths = deaths,
                  births = births,
                  immigration1 = immigration1,
                  emigration1 = emigration1,
                  immigration2 = immigration2,
                  emigration2 = emigration2)
    ## data models
    reg_popn <- fake_classif_vars_popn()
    reg_popn$count <- 10
    mod_popn <- dm_poibin(data = reg_popn,
                          prob = 0.95,
                          nm_series = "population")
    reg_births <- fake_classif_vars()
    reg_births <- reg_births[reg_births$age == 1L, , drop = FALSE]
    reg_births$count <- 1
    mod_births <- dm_exact(data = reg_births,
                           nm_series = "births")
    reg_deaths <- fake_classif_vars()
    reg_deaths$count <- 2
    mod_deaths <- dm_exact(data = reg_deaths,
                           nm_series = "deaths")
    data_models <- list(mod_popn, mod_births, mod_deaths)
    ## comparison
    expect_error(check_consistent_rates_data_models(rates = rates,
                                                    data_models = data_models),
                 paste("names of classification variables \\[cohort, sex, time, age\\] for data model",
                       "for dataset 'reg_births' and series 'births' in 'data_models'",
                       "not consistent with names of classification variables",
                       "\\[time, age, region\\] for series 'births' in 'rates'"))
})

test_that("'check_consistent_rates_data_models' throws expected error when levels of variables inconsistent", {
    ## account
    ## rates
    classif_vars <- expand.grid(list(sex = c("Female", "Male"),
                                     time = 2001:2000,
                                     age = 0:2),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    deaths <- classif_vars
    deaths$rate <- 3
    immigration1 <- classif_vars
    immigration1$rate <- 3
    emigration1 <- classif_vars
    emigration1$rate <- 0.2
    immigration2 <- immigration1
    emigration2 <- emigration1
    births <- expand.grid(list(time = 2001:2000,
                               age = 1),
                          stringsAsFactors = FALSE,
                          KEEP.OUT.ATTRS = FALSE)
    births$rate <- 0.2
    rates <- list(deaths = deaths,
                  births = births,
                  immigration1 = immigration1,
                  emigration1 = emigration1,
                  immigration2 = immigration2,
                  emigration2 = emigration2)
    ## data models
    reg_popn <- fake_classif_vars_popn()
    reg_popn$count <- 10
    mod_popn <- dm_poibin(data = reg_popn,
                          prob = 0.95,
                          nm_series = "population")
    reg_births <- fake_classif_vars()
    reg_births <- reg_births[reg_births$age == 1L, , drop = FALSE]
    reg_births$count <- 1
    mod_births <- dm_exact(data = reg_births,
                           nm_series = "births")
    reg_deaths <- fake_classif_vars()
    reg_deaths$count <- 2
    mod_deaths <- dm_exact(data = reg_deaths,
                           nm_series = "deaths")
    data_models <- list(mod_popn, mod_births, mod_deaths)
    ## comparison
    expect_error(check_consistent_rates_data_models(rates = rates,
                                                    data_models = data_models),
                 paste("'time' variable from data model for dataset 'reg_births'",
                       "and series 'births' in 'data_models'",
                       "has value \\[2002\\] not found in 'time' variable",
                       "from series 'births' in 'rates'"))
})


## 'check_data_dm' ------------------------------------------------------------

test_that("'check_data_dm' returns TRUE with valid data - is_popn is FALSE", {
    data_no_region <- fake_classif_vars()
    data_no_region$count <- c(NA, seq_len(nrow(data_no_region) - 1))
    expect_true(check_data_dm(data_no_region, is_popn = FALSE))
    data_with_region <- fake_classif_vars(n_region = 2)
    data_with_region$count <- c(NA, seq_len(nrow(data_with_region) - 1))
    expect_true(check_data_dm(data_with_region, is_popn = FALSE))
})

test_that("'check_data_dm' returns TRUE with valid data - is_popn is TRUE", {
    data_no_region <- fake_classif_vars_popn()
    data_no_region$count <- c(NA, seq_len(nrow(data_no_region) - 1))
    expect_true(check_data_dm(data_no_region, is_popn = TRUE))
    data_with_region <- fake_classif_vars_popn(n_region = 2)
    data_with_region$count <- c(NA, seq_len(nrow(data_with_region) - 1))
    expect_true(check_data_dm(data_with_region, is_popn = TRUE))
})

test_that("'check_data_dm' throws an error when 'data' is not a data frame", {
    expect_error(check_data_dm(NULL,
                               is_popn = FALSE),
                 "'data' has class \"NULL\"")
})

test_that("'check_data_dm' throws an error when 'data' does not have all the required colnames", {
    data <- fake_classif_vars(n_region = 2)
    data$count <- c(NA, seq_len(nrow(data) - 1))
    expect_error(check_data_dm(data[-match("count", names(data))],
                               is_popn = FALSE))
    expect_error(check_data_dm(data[-match("age", names(data))],
                               is_popn = FALSE))
})

test_that("'check_data_dm' has exactly one variable called 'sex' or 'gender'", {
    data <- fake_classif_vars(n_region = 2)
    data$count <- c(NA, seq_len(nrow(data) - 1))
    data <- data[-match("sex", names(data))]
    expect_error(check_data_dm(data, is_popn = FALSE))
    data$sex <- rep(c("F", "M"), each = nrow(data) / 2)
    data$gender <- rep(c("F", "M", "N"), nrow(data) / 3)
    expect_error(check_data_dm(data, is_popn = FALSE))
})    

test_that("'check_data_dm' throws an error when 'data' has unexpected colnames", {
    data <- fake_classif_vars(n_region = 2)
    data$count <- c(NA, seq_len(nrow(data) - 1))
    data$wrong <- NA
    expect_error(check_data_dm(data, is_popn = FALSE))
    names(data)[length(data)] <- NA
    expect_error(check_data_dm(data, is_popn = FALSE))
    names(data)[length(data)] <- ""
    expect_error(check_data_dm(data, is_popn = FALSE))
})

test_that("'check_data_dm' throws an error when classification variables have NA", {
    data <- fake_classif_vars(n_region = 2)
    data$count <- c(NA, seq_len(nrow(data) - 1))
    data$region[[10]] <- NA
    expect_error(check_data_dm(data, is_popn = FALSE))
})

test_that("'check_data_dm' throws an error when classification variables have duplicated rows", {
    data <- fake_classif_vars(n_region = 2)
    data$count <- c(NA, seq_len(nrow(data) - 1))
    data <- rbind(data, data[12, ])
    expect_error(check_data_dm(data, is_popn = FALSE))
})

test_that("'check_data_dm' throws an error when count variable is not non-negative whole number", {
    data <- fake_classif_vars(n_region = 2)
    data$count <- c("a", seq_len(nrow(data) - 1))
    expect_error(check_data_dm(data, is_popn = FALSE))
    data$count <- c(1.1, seq_len(nrow(data) - 1))
    expect_error(check_data_dm(data, is_popn = FALSE))
    data$count <- c(-1, seq_len(nrow(data) - 1))
    expect_error(check_data_dm(data, is_popn = FALSE))
})


## 'check_data_exact' ---------------------------------------------------------

test_that("'check_data_exact' returns TRUE with valid data - is_births is TRUE", {
    data <- fake_classif_vars(n_region = 2)
    data <- data[data$age == 1, , drop = FALSE]
    data$count <- seq_len(nrow(data))
    expect_true(check_data_exact(data = data, is_births = TRUE))
})


test_that("'check_data_exact' returns TRUE with valid data - is_births is FALSE", {
    data <- fake_classif_vars(n_region = 2)
    data$count <- seq_len(nrow(data))
    expect_true(check_data_exact(data = data, is_births = FALSE))
})

test_that("'check_data_exact' throws correct error when combination of classification variables missing", {
    data <- fake_classif_vars(n_region = 2)
    data$count <- seq_len(nrow(data))
    data <- data[-10,]
    expect_error(check_data_exact(data, is_births = FALSE),
                 "'data' does not include all possible combinations of classification variables")
})


## 'check_data_models' ---------------------------------------------------------

test_that("'check_data_models' returns TRUE when 'data_models' is valid", {
    reg_popn <- fake_classif_vars_popn(n_region = 2)
    reg_popn$count <- seq_len(nrow(reg_popn))
    mod_popn <- dm_poibin(data = reg_popn,
                          prob = 0.95,
                          nm_series = "population")
    reg_births <- fake_classif_vars(n_region = 3)
    reg_births$count <- 1L
    mod_births <- dm_exact(data = reg_births,
                           nm_series = "births")
    reg_deaths <- fake_classif_vars(n_region = 3)
    reg_deaths$count <- seq_len(nrow(reg_deaths))
    mod_deaths <- dm_exact(data = reg_deaths,
                           nm_series = "deaths")
    data_models <- list(mod_popn, mod_births, mod_deaths)
    expect_true(check_data_models(data_models))
    expect_true(check_data_models(list()))
})

test_that("'check_data_models' raises correct error when 'data_models' has element not of class 'data_model'", {
    data_models <- list(population = 1L)
    expect_error(check_data_models(data_models),
                 "'data_models' has element with class \"integer\"")
})

test_that("'check_data_models' raises correct error when two elements of 'data_models' refer to same dataset", {
    reg_popn <- fake_classif_vars_popn(n_region = 2)
    reg_popn$count <- seq_len(nrow(reg_popn))
    mod_popn <- dm_poibin(data = reg_popn,
                          prob = 0.95,
                          nm_series = "population")
    reg_births <- fake_classif_vars(n_region = 3)
    reg_births$count <- 1L
    mod_births <- dm_exact(data = reg_births,
                           nm_series = "births")
    reg_deaths <- fake_classif_vars(n_region = 3)
    reg_deaths$count <- seq_len(nrow(reg_deaths))
    mod_deaths <- dm_exact(data = reg_deaths,
                           nm_series = "deaths")
    data_models <- list(mod_popn, mod_births, mod_deaths, mod_popn)
    expect_error(check_data_models(data_models),
                 "two models in 'data_models' refer to the same dataset : 'reg_popn'")
})

test_that("'check_data_models' raises correct error when incorrect number of birth or death models", {
    reg_popn <- fake_classif_vars_popn(n_region = 2)
    reg_popn$count <- seq_len(nrow(reg_popn))
    mod_popn <- dm_poibin(data = reg_popn,
                          prob = 0.95,
                          nm_series = "population")
    reg_births <- fake_classif_vars(n_region = 3)
    reg_births$count <- 1L
    mod_births <- dm_exact(data = reg_births,
                            nm_series = "births")
    mod_births1 <- dm_exact(data = reg_births,
                            nm_series = "births",
                            nm_data = "d1")
    mod_births2 <- dm_exact(data = reg_births,
                            nm_series = "births",
                            nm_data = "d2")
    reg_deaths <- fake_classif_vars(n_region = 3)
    reg_deaths$count <- seq_len(nrow(reg_deaths))
    mod_deaths <- dm_exact(data = reg_deaths,
                           nm_series = "deaths")
    expect_error(check_data_models(list(mod_popn, mod_births)),
                 "'data_models' does not have a model for deaths")
    expect_error(check_data_models(list(mod_popn, mod_deaths)),
                 "'data_models' does not have a model for births")
    expect_error(check_data_models(list(mod_popn, mod_births1, mod_births2, mod_deaths)),
                 "'data_models' has two or more models for births")
})


## 'check_disp_dm' ----------------------------------------------------------

test_that("'check_disp_dm' returns TRUE when 'disp' is valid data frame", {
    data <- fake_classif_vars()
    data$count <- 1L
    disp <- data.frame(age = 0:2, disp = c(1.1, 3, 0.001))
    expect_true(check_disp_dm(disp = disp,
                              data = data))
})

    
## 'check_dominant' ------------------------------------------------------------

test_that("'check_dominant' returns true when 'dominant' is valid", {
    expect_true(check_dominant("female"))
})

test_that("'check_dominant' throws an error when 'dominant' is non-character", {
    expect_error(check_dominant(5),
                 "'dominant' is non-character")
})

test_that("'check_dominant' throws an error when 'dominant' does not have length 1", {
    expect_error(check_dominant(c("female", "male")),
                 "'dominant' does not have length 1")
})

test_that("'check_dominant' throws an error when 'dominant' is NA", {
    expect_error(check_dominant(NA_character_),
                 "'dominant' is NA")
})

test_that("'check_dominant' throws an error when 'dominant' is blank", {
    expect_error(check_dominant(""),
                 "'dominant' is blank")
})


## check_identities -----------------------------------------------------------

test_that("'check_identities' returns TRUE with internally consistent account", {
    population <- fake_classif_vars(n_time = 4L)
    population$time <- population$time - 1L
    population <- unique(population[-match("cohort", names(population))])
    births <- fake_classif_vars()
    births <- births[births$age == 1, , drop = FALSE]
    deaths <- fake_classif_vars()
    immigration <- fake_classif_vars()
    emigration <- fake_classif_vars()
    internal_in <- fake_classif_vars()
    internal_out <- fake_classif_vars()
    population$count <- 100
    births$count <- 50
    is_upper <- with(deaths, age == time - cohort - 1)
    is_max_age <- with(deaths, age == max(age))
    deaths$count <- with(deaths, ifelse(is_upper & is_max_age, 101, 1))
    immigration$count <- 5
    emigration$count <- 4
    account <- list(population = population,
                    births = births,
                    deaths = deaths,
                    immigration = immigration,
                    emigration = emigration)
    expect_true(check_identities(account))
})

test_that("'check_identities' raises a worning (not error) when account inconsistent", {
    population <- fake_classif_vars(n_time = 4L)
    population$time <- population$time - 1L
    population <- unique(population[-match("cohort", names(population))])
    births <- fake_classif_vars()
    births <- births[births$age == 1, , drop = FALSE]
    deaths <- fake_classif_vars()
    immigration <- fake_classif_vars()
    emigration <- fake_classif_vars()
    internal_in <- fake_classif_vars()
    internal_out <- fake_classif_vars()
    population$count <- 100 + 1 ## inconsistent
    births$count <- 50
    is_upper <- with(deaths, age == time - cohort - 1)
    is_max_age <- with(deaths, age == max(age))
    deaths$count <- with(deaths, ifelse(is_upper & is_max_age, 101, 1))
    immigration$count <- 5
    emigration$count <- 4
    account <- list(population = population,
                    births = births,
                    deaths = deaths,
                    immigration = immigration,
                    emigration = emigration)
    expect_warning(check_identities(account),
                   "accounting identities not satisfied")
})


## 'check_is_births_deaths' ---------------------------------------------------

test_that("'check_is_births_deaths' returns true when 'x' is births", {
    data <- fake_classif_vars(n_region = 2)
    data$count <- seq_len(nrow(data))
    x <- dm_exact(data = data,
                  nm_series = "births")
    expect_true(check_is_births_deaths(x))
})

test_that("'check_is_births_deaths' raises error when 'x' is not births or deaths", {
    data <- fake_classif_vars(n_region = 2)
    data$count <- seq_len(nrow(data))
    x <- dm_exact(data = data,
                  nm_series = "births") ## 'dm_exact' only accepts "births" and "deaths"
    x$nm_series <- "population"
    expect_error(check_is_births_deaths(x),
                 "data model has class 'dm_exact' but series is 'population'")
})


## 'check_is_not_births_deaths' -----------------------------------------------

test_that("'check_is_not_births_deaths' returns true when 'x' is not births", {
    data <- fake_classif_vars(n_region = 2)
    data$count <- seq_len(nrow(data))
    x <- dm_poibin(data = data,
                   prob = 0.98,
                   nm_series = "immigration1")
    expect_true(check_is_not_births_deaths(x))
})

test_that("'check_is_not_births_deaths' raises error when 'x' is births or deaths", {
    data <- fake_classif_vars(n_region = 2)
    data$count <- seq_len(nrow(data))
    x <- dm_poibin(data = data,
                   prob = 0.95,
                   nm_series = "births")
    expect_error(check_is_not_births_deaths(x),
                 "data model has class 'dm_poibin' but series is 'births'")
})


## 'check_measure_var_valid' --------------------------------------------------

test_that("'check_measure_var_valid' returns TRUE when 'var' is valid - numeric", {
    expect_true(check_measure_var_valid_num(var = 1:5 + 0.1,
                                            nm_var = "rate",
                                            nm_obj = "births",
                                            na_ok = FALSE,
                                            frac_ok = TRUE))
})

test_that("'check_measure_var_valid' returns TRUE when 'var' is valid - list", {
    expect_true(check_measure_var_valid(var = list(1:5 + 0.1,
                                                   2:6 + 0.2),
                                        nm_var = "rate",
                                        nm_obj = "births",
                                        na_ok = FALSE,
                                        frac_ok = TRUE))
})

test_that("'check_measure_var_valid' throws correct error when 'var' is not numeric or list", {
    expect_error(check_measure_var_valid(var = NULL,
                                         nm_var = "count",
                                         nm_obj = "births",
                                         na_ok = FALSE,
                                         frac_ok = FALSE),
                 "'count' variable in 'births' is not numeric or list")
})


## 'check_measure_var_valid_list' ----------------------------------------------

test_that("'check_measure_var_valid_list' returns TRUE when 'var' is valid - 'rate'", {
    expect_true(check_measure_var_valid_list(var = list(1:5 + 0.1,
                                                        2:6 + 0.2),
                                            nm_var = "rate",
                                            nm_obj = "births",
                                            na_ok = FALSE,
                                            frac_ok = TRUE))
})

test_that("'check_measure_var_valid_list' returns TRUE when 'var' is valid - 'account'", {
    expect_true(check_measure_var_valid_list(var = list(1:5,
                                                        5:1),
                                             nm_var = "count",
                                             nm_obj = "population",
                                             na_ok = FALSE,
                                             frac_ok = FALSE))
})

test_that("'check_measure_var_valid_list' throws correct error when 'var' has non-numeric elements", {
    expect_error(check_measure_var_valid_list(var = list(c(0.1, "a"),
                                                         c(0.2, 0.1)),
                                              nm_var = "rate",
                                              nm_obj = "births",
                                              na_ok = FALSE,
                                              frac_ok = TRUE),
                 "'rate' variable in 'births' has non-numeric elements")
})

test_that("'check_measure_var_valid_list' throws correct error when elements of 'var' have different lengths", {
    expect_error(check_measure_var_valid_list(var = list(c(0.1, 0.2, 0.1),
                                                         c(0.2, 0.1)),
                                              nm_var = "rate",
                                              nm_obj = "births",
                                              na_ok = FALSE,
                                              frac_ok = TRUE),
                 "elements of 'rate' variable in 'births' have different lengths")
})

test_that("'check_measure_var_valid_list' throws correct error when 'var' has NAs", {
    expect_error(check_measure_var_valid_list(var = list(c(0.1, NA),
                                                         c(0.2, 0.1)),
                                              nm_var = "rate",
                                              nm_obj = "births",
                                              na_ok = FALSE,
                                              frac_ok = TRUE),
                 "'rate' variable in 'births' has elements with NAs")
})


test_that("'check_measure_var_valid_list' throws correct error when 'var' is negative", {
    expect_error(check_measure_var_valid_list(var = list(-0.1, 0.1),
                                              nm_var = "rate",
                                              nm_obj = "births",
                                              na_ok = FALSE,
                                              frac_ok = TRUE),
                 "'rate' variable in 'births' has elements with negative values")
})

test_that("'check_measure_var_valid_list' throws correct error when 'var' has non-integer values", {
    expect_error(check_measure_var_valid_list(var = list(0.1, 1L),
                                              nm_var = "count",
                                              nm_obj = "births",
                                              na_ok = FALSE,
                                              frac_ok = FALSE),
                 "'count' variable in 'births' has elements with non-integer values")
})


## 'check_measure_var_valid_num' ----------------------------------------------

test_that("'check_measure_var_valid_num' returns TRUE when 'var' is valid - 'rate'", {
    expect_true(check_measure_var_valid_num(var = 1:5 + 0.1,
                                            nm_var = "rate",
                                            nm_obj = "births",
                                            na_ok = FALSE,
                                            frac_ok = TRUE))
})

test_that("'check_measure_var_valid_num' returns TRUE when 'var' is valid - 'data'", {
    expect_true(check_measure_var_valid_num(var = c(1:5, NA),
                                            nm_var = "count",
                                            nm_obj = "census",
                                            na_ok = TRUE,
                                            frac_ok = FALSE))
})

test_that("'check_measure_var_valid_num' returns TRUE when 'var' is valid - 'account'", {
    expect_true(check_measure_var_valid_num(var = 1:5,
                                            nm_var = "count",
                                            nm_obj = "population",
                                            na_ok = FALSE,
                                            frac_ok = FALSE))
})

test_that("'check_measure_var_valid_num' throws correct error when 'var' has NAs", {
    expect_error(check_measure_var_valid_num(var = c(0.1, NA),
                                             nm_var = "rate",
                                             nm_obj = "births",
                                             na_ok = FALSE,
                                             frac_ok = TRUE),
                 "'rate' variable in 'births' has NAs")
})

test_that("'check_measure_var_valid_num' throws correct error when 'var' is negative", {
    expect_error(check_measure_var_valid_num(var = -0.1,
                                             nm_var = "rate",
                                             nm_obj = "births",
                                             na_ok = FALSE,
                                             frac_ok = TRUE),
                 "'rate' variable in 'births' has negative values")
})

test_that("'check_measure_var_valid_num' throws correct error when 'var' has non-integer values", {
    expect_error(check_measure_var_valid_num(var = 0.1,
                                             nm_var = "count",
                                             nm_obj = "births",
                                             na_ok = FALSE,
                                             frac_ok = FALSE),
                 "'count' variable in 'births' has non-integer values")
})

## 'check_n_particle' ---------------------------------------------------------

test_that("'check_n_particle' returns TRUE when 'n_particle' is valid", {
    expect_true(check_n_particle(1000))
})

test_that("'check_n_particle' throws correct error when 'n_particle' is invalid", {
    expect_error(check_n_particle("a"),
                 "'n_particle' is non-numeric")
    expect_error(check_n_particle(c(8, 8)),
                 "'n_particle' does not have length 1")
    expect_error(check_n_particle(NA_real_),
                 "'n_particle' is NA")
    expect_error(check_n_particle(0.3),
                 "'n_particle' is not an integer")
    expect_error(check_n_particle(0),
                 "'n_particle' is less than 1")
})


## 'check_n_thin' ---------------------------------------------------------

test_that("'check_n_thin' returns TRUE when 'n_thin' is valid", {
    expect_true(check_n_thin(1))
})

test_that("'check_n_thin' throws correct error when 'n_thin' is invalid", {
    expect_error(check_n_thin("a"),
                 "'n_thin' is non-numeric")
    expect_error(check_n_thin(c(8, 8)),
                 "'n_thin' does not have length 1")
    expect_error(check_n_thin(NA_real_),
                 "'n_thin' is NA")
    expect_error(check_n_thin(0.3),
                 "'n_thin' is not an integer")
    expect_error(check_n_thin(0),
                 "'n_thin' is less than 1")
})


## 'check_n_thread' ---------------------------------------------------------

test_that("'check_n_thread' returns TRUE when 'n_thread' is valid", {
    expect_true(check_n_thread(NULL))
})

test_that("'check_n_thread' throws correct error when 'n_thread' is invalid", {
    expect_warning(check_n_thread(1),
                   "'n_thread' is currently ignored")
})
                

## 'check_names_df_valid' -----------------------------------------------------

test_that("'check_names_df_valid' returns TRUE when inputs valid", {
    ## population counts
    expect_true(check_names_df_valid(nms_vars = c("age", "sex", "time", "count"),
                                     nm_obj = "population",
                                     incl_cohort = FALSE,
                                     incl_sexgender = TRUE,
                                     incl_region = FALSE,
                                     nm_measure_var = "count"))
    ## birth rates
    expect_true(check_names_df_valid(nms_vars = c("age", "cohort", "region", "time", "rate"),
                                     nm_obj = "births",
                                     incl_cohort = TRUE,
                                     incl_sexgender = FALSE,
                                     incl_region = TRUE,
                                     nm_measure_var = "rate"))
    ## immigration data
    expect_true(check_names_df_valid(nms_vars = c("age", "cohort", "time", "count", "gender"),
                                     nm_obj = "reg_im",
                                     incl_cohort = TRUE,
                                     incl_sexgender = TRUE,
                                     incl_region = FALSE,
                                     nm_measure_var = "count"))
})

test_that("'check_names_df_valid' throws correct error when inputs invalid", {
    ## population counts
    expect_error(check_names_df_valid(nms_vars = c("age", "sex", "time", "rate"),
                                      nm_obj = "population",
                                      incl_cohort = FALSE,
                                      incl_sexgender = TRUE,
                                      incl_region = FALSE,
                                      nm_measure_var = "count"),
                 "'population' variables \\[age, sex, time, rate\\] incomplete or invalid")
    ## birth rates
    expect_error(check_names_df_valid(nms_vars = c("age", "region", "time", "rate"),
                                      nm_obj = "births",
                                      incl_cohort = TRUE,
                                      incl_sexgender = FALSE,
                                      incl_region = TRUE,
                                      nm_measure_var = "rate"),
                 "'births' variables \\[age, region, time, rate\\] incomplete or invalid")
    ## immigration data
    expect_error(check_names_df_valid(nms_vars = c("age", "cohort", "time", "count"),
                                      nm_obj = "reg_im",
                                      incl_cohort = TRUE,
                                      incl_sexgender = TRUE,
                                      incl_region = FALSE,
                                      nm_measure_var = "count"),
                 "'reg_im' variables \\[age, cohort, time, count\\] incomplete or invalid")
})


## 'check_names_series_valid' --------------------------------------------------------

test_that("'check_names_series_valid' returns TRUE when inputs valid", {
    ## rates
    expect_true(check_names_series_valid(names = c("births",
                                                   "deaths",
                                                   "immigration1",
                                                   "emigration1",
                                                   "immigration2",
                                                   "emigration2"),
                                         nm_obj = "rates",
                                         incl_popn = FALSE,
                                         incl_stock = FALSE,
                                         subset_ok = FALSE))
    ## data models
    expect_true(check_names_series_valid(names = c("stock",
                                                   "deaths",
                                                   "births",
                                                   "immigration1",
                                                   "immigration2",
                                                   "emigration2",
                                                   "internal_out"),
                                         nm_obj = "data_models",
                                         incl_popn = FALSE,
                                         incl_stock = TRUE,
                                         subset_ok = TRUE))
    ## account
    expect_true(check_names_series_valid(names = c("population",
                                                   "births",
                                                   "deaths",
                                                   "immigration",
                                                   "emigration",
                                                   "internal_in",
                                                   "internal_out"),
                                         nm_obj = "account",
                                         incl_popn = TRUE,
                                         incl_stock = FALSE,
                                         subset_ok = FALSE))
})

test_that("'check_names_series_valid' throws correct error when inputs invalid", {
    ## rates
    expect_error(check_names_series_valid(names = c("population",
                                                    "births",
                                                    "deaths",
                                                    "immigration1",
                                                    "emigration1",
                                                    "immigration2",
                                                    "emigration2"),
                                          nm_obj = "rates",
                                          incl_popn = FALSE,
                                          incl_stock = FALSE,
                                          subset_ok = FALSE),
                 paste("'rates' series names \\[population, births, deaths,",
                       "immigration1, emigration1, immigration2, emigration2\\]",
                       "incomplete or invalid"))
    ## data models
    expect_error(check_names_series_valid(names = c("stock",
                                                    "deaths",
                                                    "births",
                                                    "immigration",
                                                    "immigration2",
                                                    "emigration2",
                                                    "internal_out"),
                                          nm_obj = "data_models",
                                          incl_popn = FALSE,
                                          incl_stock = TRUE,
                                          subset_ok = TRUE),
                 paste("'data_models' series names \\[stock, deaths, births,",
                       "immigration, immigration2, emigration2, internal_out\\]",
                       "incomplete or invalid"))
    ## account
    expect_error(check_names_series_valid(names = c("population",
                                                    "stock",
                                                    "births",
                                                    "deaths",
                                                    "immigration",
                                                    "emigration",
                                                    "internal_in",
                                                    "internal_out"),
                                          nm_obj = "account",
                                          incl_popn = TRUE,
                                          incl_stock = FALSE,
                                          subset_ok = FALSE),
                 paste("'account' series names \\[population, stock, births, deaths,",
                       "immigration, emigration, internal_in, internal_out\\]",
                       "incomplete or invalid"))
})


## 'check_names_valid' --------------------------------------------------------

test_that("'check_names_valid' throws expected error when 'nm_obj' does not have names", {
    expect_error(check_names_valid(names = NULL, nm_obj = "x"),
                 "'x' does not have names")
})

test_that("'check_names_valid' throws expected error when names have NA", {
    expect_error(check_names_valid(names = c("a", NA), nm_obj = "x"),
                 "names for 'x' have NAs")
})

test_that("'check_names_valid' throws expected error when names have blanks", {
    expect_error(check_names_valid(names = c("a", ""), nm_obj = "x"),
                 "names for 'x' have blanks")
})

test_that("'check_names_valid' throws expected error when names have duplicates", {
    expect_error(check_names_valid(c("a", "a"), nm_obj = "x"),
                 "names for 'x' have duplicates")
})


## 'check_nm_data' ------------------------------------------------------------

test_that("'check_nm_data' returns TRUE when 'nm_data' is valid", {
    expect_true(check_nm_data("reg_popn"))
})

test_that("'check_nm_data' throws an error when 'nm_data' is non-character", {
    expect_error(check_nm_data(5),
                 "'nm_data' is non-character")
})

test_that("'check_nm_data' throws an error when 'nm_data' does not have length 1", {
    expect_error(check_nm_data(c("reg_births", "reg_births")),
                 "'nm_data' does not have length 1")
})

test_that("'check_nm_data' throws an error when 'nm_data' is NA", {
    expect_error(check_nm_data(NA_character_),
                 "'nm_data' is NA")
})

test_that("'check_nm_data' throws an error when 'nm_data' is blank", {
    expect_error(check_nm_data(""),
                 "'nm_data' is blank")
})


## 'check_nm_series' ---------------------------------------------------------------

test_that("'check_nm_series' returns TRUE when 'nm_series' is valid - 'region' not in names", {
    names_data <- c("cohort", "age", "sex", "time", "count")
    expect_true(check_nm_series("population", names_data = names_data))
})

test_that("'check_nm_series' returns TRUE when 'nm_series' is valid - 'region' in names", {
    names_data <- c("cohort", "age", "sex", "time", "region", "count")
    expect_true(check_nm_series("internal_in", names_data = names_data))
})

test_that("'check_nm_series' throws an error when 'nm_series' is non-character", {
    names_data <- c("cohort", "age", "sex", "time", "count")
    expect_error(check_nm_series(5, names_data = names_data),
                 "'nm_series' is non-character")
})

test_that("'check_nm_series' throws an error when 'nm_series' is non-character", {
    names_data <- c("cohort", "age", "sex", "time", "count")
    expect_error(check_nm_series(5, names_data = names_data),
                 "'nm_series' is non-character")
})

test_that("'check_nm_series' throws an error when 'nm_series' does not have length 1", {
    names_data <- c("cohort", "age", "sex", "time", "count")
    expect_error(check_nm_series(c("births", "births"), names_data = names_data),
                 "'nm_series' does not have length 1")
})

test_that("'check_nm_series' throws an error when 'nm_series' is NA", {
    names_data <- c("cohort", "age", "sex", "time", "count")
    expect_error(check_nm_series(NA_character_, names_data = names_data),
                 "'nm_series' is NA")
})

test_that("'check_nm_series' throws an error when 'nm_series' is invalid", {
    names_data <- c("cohort", "age", "sex", "time", "count")
    expect_error(check_nm_series("", names_data = names_data),
                 "'nm_series' has invalid value \\[\"\"\\]")
})

test_that("'check_nm_series' throws an error when 'nm_series' is invalid", {
    names_data <- c("cohort", "age", "sex", "time", "count")
    expect_error(check_nm_series("wrong", names_data = names_data),
                 "'nm_series' has invalid value \\[\"wrong\"\\]")
})

test_that("'check_nm_series' throws an error when 'nm_series' is invalid", {
    names_data <- c("cohort", "age", "sex", "time", "count")
    expect_error(check_nm_series("internal_in", names_data = names_data),
                 "'nm_series' has invalid value \\[\"internal_in\"\\]")
})


## 'check_prob' ---------------------------------------------------------------

test_that("'check_prob' returns TRUE when 'prob' is valid", {
    expect_true(check_prob(0.8))
})

test_that("'check_prob' throws correct error when 'prob' is invalid", {
    expect_error(check_prob("a"),
                 "'prob' is non-numeric")
    expect_error(check_prob(c(0.8, 0.8)),
                 "'prob' does not have length 1")
    expect_error(check_prob(NA_real_),
                 "'prob' is NA")
    expect_error(check_prob(0),
                 "'prob' is less than or equal to 0")
    expect_error(check_prob(1),
                 "'prob' is greater than or equal to 1")
})


## 'check_rates' ---------------------------------------------------

test_that("'check_rates' returns TRUE with vald rates - no region", {
    classif_vars <- expand.grid(list(sex = c("Female", "Male"),
                                     time = 2001:2000,
                                     age = 0:3),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    deaths <- classif_vars
    deaths$rate <- 3
    immigration1 <- classif_vars
    immigration1$rate <- 3
    emigration1 <- classif_vars
    emigration1$rate <- 0.2
    immigration2 <- immigration1
    emigration2 <- emigration1
    births <- expand.grid(list(time = 2001:2000,
                               age = 1:2),
                          stringsAsFactors = FALSE,
                          KEEP.OUT.ATTRS = FALSE)
    births$rate <- 0.2
    rates <- list(deaths = deaths,
                  births = births,
                  immigration1 = immigration1,
                  emigration1 = emigration1,
                  immigration2 = immigration2,
                  emigration2 = emigration2)
    expect_true(check_rates(rates))
})

test_that("'check_rates' returns TRUE with vald rates - with region", {
    classif_vars <- expand.grid(list(region = 1:3,
                                     sex = c("Female", "Male"),
                                     time = 2001:2000,
                                     age = 0:3),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    deaths <- classif_vars
    deaths$rate <- 3
    immigration1 <- classif_vars
    immigration1$rate <- 3
    emigration1 <- classif_vars
    emigration1$rate <- 0.2
    immigration2 <- immigration1
    emigration2 <- emigration1
    internal_in <- immigration1
    internal_out <- emigration1
    births <- expand.grid(list(time = 2001:2000,
                               region = 1:3,
                               age = 1:2),
                          stringsAsFactors = FALSE,
                          KEEP.OUT.ATTRS = FALSE)
    births$rate <- 0.2
    rates <- list(deaths = deaths,
                  births = births,
                  internal_in = internal_in,
                  internal_out = internal_out,
                  immigration1 = immigration1,
                  emigration1 = emigration1,
                  immigration2 = immigration2,
                  emigration2 = emigration2)
    expect_true(check_rates(rates))
})

test_that("'check_rates' throws expected error when colnames are duplicated", {
    classif_vars <- expand.grid(list(region = 1:3,
                                     sex = c("Female", "Male"),
                                     time = 2001:2000,
                                     age = 0:3),
                                stringsAsFactors = FALSE,
                                KEEP.OUT.ATTRS = FALSE)
    deaths <- classif_vars
    deaths$rate <- 3
    immigration1 <- classif_vars
    immigration1$rate <- 3
    emigration1 <- classif_vars
    emigration1$rate <- 0.2
    immigration2 <- immigration1
    emigration2 <- emigration1
    internal_in <- immigration1
    internal_out <- emigration1
    births <- expand.grid(list(time = 2001:2000,
                               region = 1:3,
                               age = 1:2),
                          stringsAsFactors = FALSE,
                          KEEP.OUT.ATTRS = FALSE)
    births$rate <- 0.2
    births$wrong <- 1
    names(births)[length(births)] <- "time"
    rates <- list(deaths = deaths,
                  births = births,
                  internal_in = internal_in,
                  internal_out = internal_out,
                  immigration1 = immigration1,
                  emigration1 = emigration1,
                  immigration2 = immigration2,
                  emigration2 = emigration2)
    expect_error(check_rates(rates),
                 "problem with 'rates' :")
})


## 'check_ratio_dm' ----------------------------------------------------------

test_that("'check_ratio_dm' returns TRUE when 'ratio' is valid data frame", {
    data <- fake_classif_vars()
    data$count <- 1L
    ratio <- data.frame(age = 0:2, ratio = c(1.1, 3, 0))
    expect_true(check_ratio_dm(ratio = ratio,
                               data = data))
})


## 'check_region_iff_internal' ------------------------------------------------

test_that("'check_region_iff_internal' returns TRUE when 'region' and 'internal_in' both present", {
    expect_true(check_region_iff_internal(nms_vars = c("age", "sex", "cohort", "region", "time"),
                                          nms_series = c("births", "deaths", "immigration", "emigration",
                                                         "internal_in", "internal_out")))
})

test_that("'check_region_iff_internal' returns TRUE when 'region' and 'internal_in' both absent", {
    expect_true(check_region_iff_internal(nms_vars = c("age", "sex", "cohort", "time"),
                                          nms_series = c("births", "deaths", "immigration", "emigration")))
})

test_that("'check_region_iff_internal' raises expected error when 'region' present and 'internal_in' absent", {
    expect_error(check_region_iff_internal(nms_vars = c("age", "sex", "cohort", "region", "time"),
                                           nms_series = c("births", "deaths", "immigration", "emigration")),
                 "have 'region' variable but do not have series 'internal_in' and 'internal_out'")
})

test_that("'check_region_iff_internal' raises expected error when 'region' absent and 'internal_in' both present", {
    expect_error(check_region_iff_internal(nms_vars = c("age", "sex", "cohort", "time"),
                                           nms_series = c("births", "deaths", "immigration", "emigration",
                                                          "internal_in", "internal_out")),
                 "have series 'internal_in' and 'internal_out' but do not have 'region' variable")
})


## 'check_threshold' ---------------------------------------------------------------

test_that("'check_threshold' returns TRUE when 'threshold' is valid", {
    expect_true(check_threshold(0.5))
    expect_true(check_threshold(0))
    expect_true(check_threshold(1))
})

test_that("'check_threshold' throws correct error when 'threshold' is invalid", {
    expect_error(check_threshold("a"),
                 "'threshold' is non-numeric")
    expect_error(check_threshold(c(0.8, 0.8)),
                 "'threshold' does not have length 1")
    expect_error(check_threshold(NA_real_),
                 "'threshold' is NA")
    expect_error(check_threshold(-1),
                 "'threshold' is negative")
    expect_error(check_threshold(1.1),
                 "'threshold' is greater than 1")
})