tests/testthat/test-bootstrap.R

In incidence: Compute, Handle, Plot and Model Incidence of Dated Events

context("Bootstrapping incidence")

set.seed(1)
dates <- as.integer(sample(-3:100, 50, replace = TRUE))
DATES <- as.Date("2016-09-20") + dates
groups <- sample(c("toto", "tata"), 50, replace = TRUE)


test_that("Bootstrap needs an incidence object", {
  expect_error(bootstrap(DATES), "x is not an incidence object")
})

test_that("estimate_peak needs an incidence object", {
  expect_error(estimate_peak(DATES), "x is not an incidence object")
})

test_that("Bootstrap incidence with groups", {
  skip_on_cran()

  x <- incidence(DATES, 3, groups = groups)
  y <- bootstrap(x)
  z <- bootstrap(x, TRUE)
  expect_identical(colSums(x$counts), colSums(y$counts))
  expect_identical(colSums(x$counts), colSums(z$counts))
  expect_identical(colnames(x$counts), colnames(y$counts))
  expect_identical(colnames(x$counts), colnames(z$counts))
  expect_identical(x$interval, y$interval)
  expect_identical(x$interval, z$interval)

})


context("Mountain Climbing")

test_that("find_peak can find the peak", {
  skip_on_cran()


  x <- incidence(DATES, 3, groups = groups)
 
  expect_error(find_peak(1:10), "x is not an incidence object")
  expect_message(p1 <- find_peak(x), "'x' is stratified by groups\npooling groups before finding peaks")
  expect_length(p1, 1L)
  expect_named(find_peak(x, pool = FALSE), c("tata", "toto"))
})


test_that("estimate_peak can roughly estimate it", {
  x <- incidence(DATES, 3, groups = groups)
  y <- incidence(dates, 3)
  expect_message(e1 <- estimate_peak(x), "'x' is stratified by groups\npooling groups before finding peaks")
  e2 <- estimate_peak(y)
  expect_named(e1, c("observed", "estimated", "ci", "peaks"))
  expect_named(e2, c("observed", "estimated", "ci", "peaks"))
  ## The observed is identical to find_peak
  expect_identical(e1$observed, find_peak(pool(x)))
  expect_identical(e2$observed, find_peak(pool(y)))
  ## The number of peaks defaults to 100
  expect_length(e1$peaks, 100)
  expect_length(e2$peaks, 100)
  ## The observed falls within the confidence interval
  expect_gt(as.integer(e1$observed), as.integer(e1$ci[1]))
  expect_lt(as.integer(e1$observed), as.integer(e1$ci[2]))
  expect_gt(as.integer(e2$observed), as.integer(e2$ci[1]))
  expect_lt(as.integer(e2$observed), as.integer(e2$ci[2]))
})