tests/testthat/test-subset.R

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

context("Subset of incidence objects")

test_that("[ operator for incidence objects", {
  skip_on_cran()

  dat <- c(1L, 8L, 2L, 9L, 10L, -3L, 4L, 9L, 4L, 3L, 10L, 3L, 6L, 5L, -2L, 9L,
           0L, -3L, 1L, 10L, 9L, 6L, 5L, 10L, 6L, 6L, 4L, 5L, 1L, -1L, 10L, 9L,
           6L, 8L, -3L, 3L, 7L, 0L, 1L, 0L, -2L, 2L, 2L, 2L, -1L, -2L, 0L, 3L,
           0L, 9L)
  # set.seed(123)
  # dat <- as.integer(sample(-3:10, 50, replace = TRUE))
  x <- incidence(dat)
  y <- incidence(dat + as.Date("2016-01-12"), 7L)
  
  z <- incidence(dat + as.Date("2016-01-12"), "epiweek")
  s <- incidence(dat + as.Date("2016-01-12"), "sunday week")
  m <- incidence(dat + as.Date("2016-01-12"), "MMWR week")

  # epiweeks and MMWR weeks start on Sunday
  expect_identical(z[1:2], s[1:2])
  expect_identical(z[], m[])

  x.sub1 <- x[c(3,5,7,8)]
  expect_equal_to_reference(x.sub1, file = "rds/x.sub1.rds")

  x.sub2 <- x[-c(5,1,2)]
  expect_equal_to_reference(x.sub2, file = "rds/x.sub2.rds")

  expect_equal(y[1:2]$weeks, y$weeks[1:2])
  expect_equal(z[1:2]$weeks, z$weeks[1:2])
  
  y.sub1 <- y[1:2]
  expect_equal_to_reference(y.sub1, file = "rds/y.sub1.rds")
})




test_that("subset for incidence objects", {
  skip_on_cran()

  dat <- c(1L, 8L, 2L, 9L, 10L, -3L, 4L, 9L, 4L, 3L, 10L, 3L, 6L, 5L, -2L, 9L,
           0L, -3L, 1L, 10L, 9L, 6L, 5L, 10L, 6L, 6L, 4L, 5L, 1L, -1L, 10L, 9L,
           6L, 8L, -3L, 3L, 7L, 0L, 1L, 0L, -2L, 2L, 2L, 2L, -1L, -2L, 0L, 3L,
           0L, 9L)
  # set.seed(123)
  # dat <- as.integer(sample(-3:10, 50, replace = TRUE))
  x <- incidence(dat)

  x.sub3 <- subset(x, from = 0)
  expect_equal_to_reference(x.sub3, file = "rds/x.sub3.rds")

  x.sub4 <- subset(x, to = 5)
  expect_equal_to_reference(x.sub4, file = "rds/x.sub4.rds")

  x.sub5 <- subset(x, from = 1, to = 4)
  expect_equal_to_reference(x.sub5, file = "rds/x.sub5.rds")

  ## round trip
  expect_identical(x, x[])

  ## corner cases
  expect_error(subset(x, from = 19), "No data retained.")
  expect_error(subset(x, to = -2319), "No data retained.")
  expect_error(subset(x, from = Inf, to = -2319), "No data retained.")
})

test_that("numeric subset works with dates ", {
  skip_on_cran()

  x <-  incidence(as.Date("2001-01-01") + 1:10, 2L)

  expect_equal(subset(x, from = 1, to = 2)$dates,
               x$dates[1:2])

  expect_equal(subset(x, from = -10, to = 2)$dates,
               x$dates[1:2])

  expect_equal(as.data.frame(subset(x, from = 0, to = 1e3)),
               as.data.frame(x))
  expect_identical(x, x[])
})


test_that("numeric subset works with dates and character strings", {
  x <-  incidence(as.Date("2001-01-01") + 1:100, "month")

  expect_equal(subset(x, from = 1, to = -1)$dates,
	       x$dates[1])

  expect_equal(subset(x, from = 1, to = 2)$dates,
               x$dates[1:2])

  expect_equal(subset(x, from = -10, to = 2)$dates,
               x$dates[1:2])


  expect_equal(subset(x, from = 5, to = 5)$dates,
	       x$dates[4])

  expect_equal(as.data.frame(subset(x, from = 0, to = 1e3)),
               as.data.frame(x))
  expect_identical(x, x[])
})

test_that("an erroneous group will give a sensible error", {
  i <- incidence(sample(1:10, 100, replace = TRUE), groups = rep(c("a", "b"), length.out = 100))
  expect_error(i[, "c"], "The following group does not exist: 'c'")
  expect_error(i[, c("grind", "core")], "The following groups do not exist: 'grind', 'core'")
})