tests/testthat/test-incidence.R

context("Incidence main function")

# setting up the data -------------------------------------------------- 
the_seed <- eval(parse(text = as.character(Sys.Date())))

# Integer incidence   -------------------------------------------------- 
set.seed(the_seed)
dat <- as.integer(sample(-3:10, 50, replace = TRUE))

# Date incidence      -------------------------------------------------- 
# note: the choice of dates here makes sure first date is 28 Dec 2015, which
# starts an iso week, so that counts will be comparable with/without iso
set.seed(the_seed)
dat <- as.integer(c(-3, sample(-3:100, 50, replace = TRUE)))
dat_dates <- as.Date("2015-12-31") + dat

test_that("construction - default, integer input", {
  

  ## USING DAILY INCIDENCE
  x <- incidence(dat)

  ## classes
  expect_is(x, "incidence")
  expect_is(x$dates, class(dat))
  expect_is(x$counts, "matrix")

  ## dimensions
  expect_equal(nrow(x$counts), length(x$dates))

  ## results
  expect_false(any(is.na(x$counts)))
  expect_equal(length(x$dates), diff(range(dat)) + 1)
  expect_equal(sum(x$counts), length(dat))
  expect_equal(sum(x$counts), x$n)
  expect_true(all(diff(x$dates) == x$interval))

  ## USING INCIDENCE PER 3 DAYS
  x <- incidence(dat, 3)

  ## String numbers can be interpreted as intervals
  expect_identical(x, incidence(dat, "3"))

  ## classes
  expect_is(x, "incidence")
  expect_is(x$dates, class(dat))
  expect_is(x$counts, "matrix")

  ## dimensions
  expect_equal(nrow(x$counts), length(x$dates))

  ## results
  expect_false(any(is.na(x$counts)))
  expect_equal(sum(x$counts), length(dat))
  expect_equal(sum(x$counts), x$n)
  expect_true(all(diff(x$dates) == x$interval))
})

test_that("construction - ISO week", {
  

  ## USING WEEKLY INCIDENCE
  inc.week    <- incidence(dat_dates, interval = 7, standard = FALSE)
  inc.isoweek <- incidence(dat_dates, interval = 7)

  ## classes
  expect_is(inc.week, "incidence")
  expect_is(inc.isoweek, "incidence")

  ## dimensions
  expect_equal(setdiff(names(inc.isoweek), names(inc.week)), "isoweeks")
  expect_equal(length(inc.isoweek$isoweeks), length(inc.isoweek$dates))
  expect_equal(nrow(inc.isoweek$counts), length(inc.isoweek$dates))

  ## results
  expect_false(any(is.na(inc.isoweek$counts)))
  expect_equal(sum(inc.isoweek$counts), length(dat))
  expect_equal(sum(inc.isoweek$counts), inc.isoweek$n)
  expect_true(all(diff(inc.isoweek$dates) == inc.isoweek$interval))
})

test_that("construction - numeric input", {
  

  ## USING DAILY INCIDENCE
  set.seed(1)
  dat_int <- sample(-3:10, 100, replace = TRUE)
  dat_num <- dat_int + 0.1

  msg <- paste0("Flooring from non-integer date caused approximations:\n",
                "Mean relative difference: 0.0228833")
  expect_warning(incidence(dat_num),
                 msg)

  x_num <- suppressWarnings(incidence(dat_num))
  x_int <- incidence(dat_int)

  ## compare outputs
  expect_equal(x_num, x_int)
  expect_is(x_num$dates, "numeric")
  expect_is(x_int$dates, "integer")
})

test_that("construction - Date input", {
  

  x         <- incidence(dat)
  x.dates   <- incidence(dat_dates)
  expect_message(x.i.trim  <- incidence(dat, first_date = 0),
                 "[0-9]+ observations outside of \\[0, [0-9]+\\] were removed."
                )
  expect_message(x.d.trim  <- incidence(dat_dates, first_date = "2016-01-01"),
                 "[0-9]+ observations outside of \\[2016-01-01, [-0-9]{10}\\] were removed."
                )
  x.7       <- incidence(dat_dates, 7L, standard = FALSE)
  x.7.iso   <- incidence(dat_dates, "week")
  x.7.week  <- incidence(dat_dates, "week", standard = FALSE)
  expect_warning(x.7.week2  <- incidence(dat_dates, "week", iso_week = FALSE),
		 "`iso_week` has been deprecated")
  # iso_week can reset standard, but is given a warning
  expect_identical(x.7.week2, x.7.week)

  ## Here, we can test if starting on a different day gives us expected results
  x.ds       <- incidence(dat_dates + 1L)
  x.7.ds     <- incidence(dat_dates + 1L, 7L, standard = FALSE)
  x.w.ds     <- incidence(dat_dates + 1L, "week", standard = FALSE)
  x.7.ds.iso <- incidence(dat_dates + 1L, 7L)
  x.w.ds.iso <- incidence(dat_dates + 1L, "week")

  ## Testing monthly input
  expect_warning(x.mo.no <- incidence(dat_dates - 28, "month", standard = FALSE),
                 "The first_date \\(2015-11-30\\) represents a day that does not occur in all months.")

  x.mo.iso <- incidence(dat_dates, "month")
  expect_equal(format(x.mo.iso$dates, "%m"), unique(format(sort(dat_dates), "%m")))
  expect_equal(format(x.mo.iso$dates, "%d"), rep("01", 5)) # all starts on first
  expect_equal(x.mo.iso$dates[[1]], as.Date("2015-12-01"))
  expect_equal(sum(x.mo.iso$counts), 51L)

  x.mo <- incidence(dat_dates, "month", standard = FALSE)
  expect_equal(format(x.mo$dates, "%m"), unique(format(sort(dat_dates), "%m"))[-5])
  expect_equal(format(x.mo$dates, "%d"), rep("28", 4)) # all starts on the 28th
  expect_equal(x.mo$dates[[1]], as.Date("2015-12-28"))
  expect_equal(sum(x.mo$counts), 51L)

  ## Testing quarterly input
  expect_warning(x.qu.no <- incidence(dat_dates - 28, "quarter", standard = FALSE),
                 "The first_date \\(2015-11-30\\) represents a day that does not occur in all months.")

  x.qu.iso <- incidence(dat_dates, "quarter")
  expect_equal(x.qu.iso$dates, as.Date(c("2015-10-01", "2016-01-01", "2016-04-01")))
  expect_equal(sum(x.qu.iso$counts), 51L)

  x.qu     <- incidence(dat_dates, "quarter", standard = FALSE)
  expect_equal(x.qu$dates, as.Date(c("2015-12-28", "2016-03-28")))
  expect_equal(sum(x.qu$counts), 51L)

  ## Testing yearly input
  dat.yr <- c(dat_dates,
              sample(dat_dates + 366, replace = TRUE),
              sample(dat_dates + 366 + 365, replace = TRUE)
             )
  x.yr.iso <- incidence(dat.yr, "year")
  x.yr     <- incidence(dat.yr, "year", standard = FALSE)
  expect_warning(x.yr.no  <- incidence(dat.yr, "year", first_date = "2016-02-29"),
                 "The first_date \\(2016-02-29\\) represents a day that does not occur in all years."
                 )
  expect_equal(get_dates(x.yr.iso), as.Date(c("2015-01-01", "2016-01-01", "2017-01-01", "2018-01-01")))
  expect_equal(get_dates(x.yr), as.Date(c("2015-12-28", "2016-12-28", "2017-12-28")))
  expect_equal(sum(x.yr$counts), sum(x.yr.iso$counts))

  ## compare outputs
  expect_equal(x$counts, x.dates$counts)
  expect_is(x$dates, "integer")
  expect_is(x.dates$dates, "Date")
  expect_equal(x.7$counts, x.7.iso$counts)
  expect_equal(x.7.iso$dates, x.7.week$dates)

  # shifting days gives the desired effect
  expect_equal(x.ds$dates[[1]], x.7.ds$dates[[1]])
  expect_equal(x.ds$dates[[1]] - 1L, x.7.ds.iso$dates[[1]])
  expect_identical(x.7.ds.iso$dates, x.w.ds.iso$dates)
  expect_failure({
    expect_identical(x.w.ds$dates, x.w.ds.iso$dates)
  })

  ## Printing will be different with text-based interval
  expect_output(print(x.7), "\\$interval: 7 days")
  expect_output(print(x.7.iso), "\\$interval: 1 week")
})

test_that("construction - POSIXct input", {
  

  ## USING DAILY INCIDENCE
  dat.pos <- as.POSIXct(dat_dates)
  x.dates <- incidence(dat_dates)
  x.pos <- incidence(dat.pos)

  ## compare outputs
  expect_equal(x.dates$counts, x.pos$counts)
  expect_is(x.dates$dates, "Date")
  expect_is(x.pos$dates, "POSIXct")
})

test_that("corner cases", {
  

  expect_error(incidence(integer(0)),
               "At least one \\(non-NA\\) date must be provided")

  expect_error(incidence(numeric(0)),
               "At least one \\(non-NA\\) date must be provided")

  expect_error(incidence(NA),
               "At least one \\(non-NA\\) date must be provided")

  expect_error(incidence(NULL),
               "dates is NULL")

  expect_error(incidence(Inf),
               "At least one \\(non-NA\\) date must be provided")

  expect_error(incidence(1, "grind"),
               "The interval 'grind' is not valid. Please supply an integer.")

  expect_error(incidence(as.Date(Sys.Date()), last_date = "core"),
               "last_date could not be converted to Date")

  expect_error(incidence(1, "week"),
               "The interval 'week' can only be used for Dates")

  expect_error(incidence(as.Date(Sys.Date()), standard = "TRUE"),
               "The argument `standard` must be either `TRUE` or `FALSE`")
  
  expect_error(incidence(sample(10), intrval = 2),
	       "intrval : interval")

  expect_error(incidence(1, were = "wolf"), "were")


  expect_warning(incidence(c(dat_dates, as.Date("1900-01-01"))),
                 "greater than 18262 days \\[1900-01-01 to"
                )
})

test_that("incidence constructor can handle missing data", {
  miss_dat <- dat
  miss_dat[5] <- NA
  expect_message(incidence(miss_dat), "1 missing observations were removed.")
})

test_that("incidence constructor can handle data out of range with groups", {
  set.seed(the_seed)
  g <- sample(letters[1:2], length(dat), replace = TRUE)
  expect_message(incidence(dat, first_date = 0, groups = g), 
                 "[0-9]+ observations outside of \\[0, [0-9]+\\] were removed."
                )
})

test_that("Expected values, no group", {
  

  expect_true(all(incidence(1:10)$counts == 1L))
  expect_true(all(incidence(sample(1:10))$counts == 1L))

  set.seed(1)
  res1 <- incidence(c(3,2,-1,1,1))
  res2 <- incidence(c(0,0,0))
  res3 <- incidence(sample(1:80, 1000, replace = TRUE))
  res4 <- incidence(as.Date("1984-01-01") + sample(1:100, 200, replace = TRUE))
  res5 <- incidence(c(3,2,-1,1,1), 2L)
  res6 <- incidence(c(0,0,0), 3L)
  res7 <- incidence(sample(1:80, 1000, replace = TRUE), 4L)
  res8 <- incidence(as.Date("1984-01-01") + sample(1:100, 200, replace = TRUE), 12L)

  expect_equal_to_reference(res1, file = "rds/incidence.res1.rds")
  expect_equal_to_reference(res2, file = "rds/incidence.res2.rds")
  expect_equal_to_reference(res3, file = "rds/incidence.res3.rds")
  expect_equal_to_reference(res4, file = "rds/incidence.res4.rds")
  expect_equal_to_reference(res5, file = "rds/incidence.res5.rds")
  expect_equal_to_reference(res6, file = "rds/incidence.res6.rds")
  expect_equal_to_reference(res7, file = "rds/incidence.res7.rds")
  expect_equal_to_reference(res8, file = "rds/incidence.res8.rds")
})

test_that("Expected values, with groups", {
  

  dat <- list(
    as.integer(c(3,2,-1,1,1)),
    as.integer(c(0,0,0)),
    as.integer(c(0,1,2,2,3,5,7))
  )

  fac <- list(
    factor(c(1,1,2,2,2)),
    factor(c('a','b','a')),
    factor(c(1, 2, 3, 3, 3, 3, 1))
  )

  res.g.1 <- incidence(dat[[1]], groups = fac[[1]])
  res.g.2 <- incidence(dat[[2]], groups = fac[[2]])
  res.g.3 <- incidence(dat[[3]], groups = fac[[3]])

  expect_equal_to_reference(res.g.1, file = "rds/res.g.1.rds")
  expect_equal_to_reference(res.g.2, file = "rds/res.g.2.rds")
  expect_equal_to_reference(res.g.3, file = "rds/res.g.3.rds")
})

test_that("user-defined group levels are preserved", {
  g <- sample(LETTERS[1:5], 100, replace = TRUE)
  g <- factor(g, levels = LETTERS[5:1])
  i <- incidence(rpois(100, 10), groups = g)
  expect_identical(group_names(i), levels(g))
  i.df <- as.data.frame(i, long = TRUE) 
  expect_identical(levels(i.df$groups), levels(g))
})

test_that("Printing returns the object", {
  

  x <- incidence(as.Date("2001-01-01"))
  y <- incidence(1:2, groups = factor(1:2))
  z <- incidence(dat_dates, interval = 7)
  expect_equal_to_reference(capture.output(print(x)),
                            file = "rds/print1.rds")
  expect_equal_to_reference(capture.output(print(y)),
                            file = "rds/print2.rds")
  expect_equal_to_reference(capture.output(print(z)),
                            file = "rds/print3.rds")
})

Try the incidence package in your browser

Any scripts or data that you put into this service are public.

incidence documentation built on Nov. 30, 2018, 4:23 p.m.