tests/testthat/test-estimate_truncation.R

In epiforecasts/EpiNow2: Estimate Real-Time Case Counts and Time-Varying Epidemiological Parameters

# Setup for testing -------------------------------------------------------
skip_on_cran()
futile.logger::flog.threshold("FATAL")

# set number of cores to use
old_opts <- options()
options(mc.cores = ifelse(interactive(), 4, 1))

test_that("estimate_truncation can return values from simulated data and plot
           them", {
  # fit model to example data
  est <- estimate_truncation(example_truncated,
    verbose = FALSE, chains = 2, iter = 1000, warmup = 250
  )
  expect_equal(
    names(est),
    c("dist", "obs", "last_obs", "cmf", "data", "fit")
  )
  expect_s3_class(est$dist, "dist_spec")
  expect_error(plot(est), NA)
})

test_that("estimate_truncation can return values from simulated data with the
           cmdstanr backend", {
  # fit model to example data
  skip_on_os("windows")
  output <- capture.output(suppressMessages(suppressWarnings(
    est <- estimate_truncation(example_truncated,
      verbose = FALSE, chains = 2, iter = 1000, warmup = 250,
      stan = stan_opts(backend = "cmdstanr")
  ))))
  expect_equal(
    names(est),
    c("dist", "obs", "last_obs", "cmf", "data", "fit")
  )
  expect_s3_class(est$dist, "dist_spec")
  expect_error(plot(est), NA)
})

test_that("estimate_truncation works with filter_leading_zeros set", {
  skip_on_os("windows")
  # Modify the first three rows of the first dataset to have zero cases
  # and fit the model with filter_leading_zeros = TRUE. This should
  # be the same as fitting the model to the original dataset because the
  # earlier dataset is corrected to be the same as the final dataset.
  modified_data <- data.table::copy(example_truncated)
  modified_data[[1]][1:3, confirm := 0]
  modified_data_fit <- estimate_truncation(
    modified_data,
    verbose = FALSE, chains = 2, iter = 1000, warmup = 250,
    filter_leading_zeros = TRUE
  )
  # fit model to original dataset
  original_data_fit <- estimate_truncation(
    example_truncated,
    verbose = FALSE, chains = 2, iter = 1000, warmup = 250
  )
  expect_named(
    modified_data_fit,
    c("dist", "obs", "last_obs", "cmf", "data", "fit")
  )
  # Compare the results of the two fits
  expect_equal(
    original_data_fit$dist$dist,
    modified_data_fit$dist$dist
  )
  expect_equal(
    original_data_fit$data$obs_dist,
    modified_data_fit$data$obs_dist
  )
})

test_that("estimate_truncation works with zero_threshold set", {
  skip_on_os("windows")
  # fit model to a modified version of example_data with zero leading cases
  # but with filter_leading_zeros = TRUE
  modified_data <- example_truncated
  modified_data <- purrr::map(modified_data, function(x) x[sample(1:10, 6), confirm := 0])
  out <- estimate_truncation(modified_data,
                             verbose = FALSE, chains = 2, iter = 1000, warmup = 250,
                             zero_threshold = 1
  )
  expect_named(out, c("dist", "obs", "last_obs", "cmf", "data", "fit"))
  expect_s3_class(out$dist, "dist_spec")
})

test_that("deprecated arguments are recognised", {
  expect_error(estimate_truncation(example_truncated,
    verbose = FALSE, trunc_max = 10
  ), "deprecated")
  expect_error(estimate_truncation(example_truncated,
    verbose = FALSE, max_truncation = 10
  ), "deprecated")
  expect_error(estimate_truncation(example_truncated,
    verbose = FALSE, trunc_dist = "lognormal"
  ), "deprecated")
  expect_deprecated(
    estimate_truncation(obs = example_truncated,
      verbose = FALSE
    )
  )
})

options(old_opts)