diff --git a/tests/figs/test-project-function/basic-example-plot.svg b/tests/figs/test-project-function/basic-example-plot.svg
index aa90f2d..bee5658 100644
--- a/tests/figs/test-project-function/basic-example-plot.svg
+++ b/tests/figs/test-project-function/basic-example-plot.svg
@@ -19,16 +19,16 @@
-
-
-
-
-
-
-
-
-
-
+
+
+
+
+
+
+
+
+
+
@@ -36,13 +36,13 @@
0
-100
-200
-300
+100
+200
+300
-
-
-
+
+
+
diff --git a/tests/testthat/#test-project.R# b/tests/testthat/#test-project.R#
deleted file mode 100644
index 3b9d26c..0000000
--- a/tests/testthat/#test-project.R#
+++ /dev/null
@@ -1,300 +0,0 @@
-context("Test project function")
-
-setup(RNGversion("3.5.3"))
-teardown({
- cur_R_version <- trimws(substr(R.version.string, 10, 16))
- RNGversion(cur_R_version)
-})
-
-
-
-
-
-test_that("Projections can be performed for a single day", {
- i <- incidence::incidence(as.Date('2020-01-23'))
- si <- c(0.2, 0.5, 0.2, 0.1)
- R0 <- 2
-
- p <- project(x = i,
- si = si,
- R = R0,
- n_sim = 2, # doesn't work with 1 in project function
- R_fix_within = TRUE,
- n_days = 1, # doing 2 days as project function currently not working with one day - will only use first day though
- model = "poisson"
- )
-
- expect_identical(get_dates(p), as.Date("2020-01-24"))
-})
-
-
-
-
-
-test_that("Projections can be performed for a single day", {
- i <- incidence::incidence(as.Date('2020-01-23'))
- si <- c(0.2, 0.5, 0.2, 0.1)
- R0 <- 2
-
- p <- project(x = i,
- si = si,
- R = R0,
- n_sim = 1, # doesn't work with 1 in project function
- R_fix_within = TRUE,
- n_days = 2, # doing 2 days as project function currently not working with one day - will only use first day though
- model = "poisson"
- )
-
- expect_identical(get_dates(p), as.Date("2020-01-24") + 0:1)
- expect_identical(ncol(p), 1L)
-})
-
-
-
-
-
-test_that("Projections can be performed for a single day and single simulation", {
- i <- incidence::incidence(as.Date('2020-01-23'))
- si <- c(0.2, 0.5, 0.2, 0.1)
- R0 <- 2
-
- p <- project(x = i,
- si = si,
- R = R0,
- n_sim = 1, # doesn't work with 1 in project function
- R_fix_within = TRUE,
- n_days = 1, # doing 2 days as project function currently not working with one day - will only use first day though
- model = "poisson"
- )
-
- expect_identical(get_dates(p), as.Date("2020-01-24"))
- expect_identical(ncol(p), 1L)
-})
-
-
-
-
-
-test_that("Test that dates start when needed", {
- skip_on_cran()
-
- ## simulate basic epicurve
- dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6)
- i <- incidence::incidence(dat)
-
-
- ## example with a function for SI
- si <- distcrete::distcrete("gamma", interval = 1L,
- shape = 1.5,
- scale = 2, w = 0)
-
- set.seed(1)
- pred_1 <- project(i, runif(100, 0.8, 1.9), si, n_days = 30)
- expect_equal(max(i$dates) + 1, min(get_dates(pred_1)))
-
-})
-
-
-
-
-
-test_that("Errors are thrown when they should", {
- expect_error(project(NULL),
- "x is not an incidence object")
-
- i <- incidence::incidence(1:10, 3)
- expect_error(project(i),
- "daily incidence needed, but interval is 3 days")
-
- i <- incidence::incidence(1:10, 1, group = letters[1:10])
- expect_error(project(i),
- "cannot use multiple groups in incidence object")
- i <- incidence::incidence(seq(Sys.Date(), by = "month", length.out = 12), "month")
- expect_error(project(i),
- "daily incidence needed, but interval is 30 days")
-
- i <- incidence::incidence(1)
- si <- distcrete::distcrete("gamma", interval = 5L,
- shape = 1.5,
- scale = 2, w = 0)
-
- expect_error(project(i, 1, si = si),
- "interval used in si is not 1 day, but 5")
- expect_error(project(i, -1, si = si),
- "R < 0 (value: -1.00)", fixed = TRUE)
- expect_error(project(i, Inf, si = si),
- "R is not a finite value", fixed = TRUE)
- expect_error(project(i, "tamere", si = si),
- "R is not numeric", fixed = TRUE)
- expect_error(project(i, R = list(1), si = si, time_change = 2),
- "`R` must be a `list` of size 2 to match 1 time changes; found 1",
- fixed = TRUE)
- expect_error(project(i, si = si, time_change = "pophip"),
- "`time_change` must be `numeric`, but is a `character`",
- fixed = TRUE)
- expect_error(project(i, si = si, time_change = 2, R = matrix(1.2)),
- "`R` must be a `vector` or a `list` if `time_change` provided; it is a `matrix, array`",
- fixed = TRUE)
-
-})
-
-
-
-
-
-test_that("Test against reference results - Poisson model", {
- skip_on_cran()
-
- ## simulate basic epicurve
- dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6)
- i <- incidence::incidence(dat)
-
-
- ## example with a function for SI
- si <- distcrete::distcrete("gamma", interval = 1L,
- shape = 1.5,
- scale = 2, w = 0)
-
- set.seed(1)
- pred_1 <- project(i, runif(100, 0.8, 1.9), si, n_days = 30)
- expect_equal_to_reference(pred_1, file = "rds/pred_1.rds", update = FALSE)
-
-
- ## time-varying R (fixed within time windows)
- set.seed(1)
- pred_2 <- project(i,
- R = c(1.5, 0.5, 2.1, .4, 1.4),
- si = si,
- n_days = 60,
- time_change = c(10, 15, 20, 30),
- n_sim = 100)
- expect_equal_to_reference(pred_2, file = "rds/pred_2.rds", update = FALSE)
-
-
- ## time-varying R, 2 periods, R is 2.1 then 0.5
- set.seed(1)
-
- pred_3 <- project(i,
- R = c(2.1, 0.5),
- si = si,
- n_days = 60,
- time_change = 40,
- n_sim = 100)
- expect_equal_to_reference(pred_3, file = "rds/pred_3.rds", update = FALSE)
-
- ## time-varying R, 2 periods, separate distributions of R for each period
- set.seed(1)
- R_period_1 <- runif(100, min = 1.1, max = 3)
- R_period_2 <- runif(100, min = 0.6, max = .9)
-
- pred_4 <- project(i,
- R = list(R_period_1, R_period_2),
- si = si,
- n_days = 60,
- time_change = 20,
- n_sim = 100)
- expect_equal_to_reference(pred_4, file = "rds/pred_4.rds", update = FALSE)
-
-})
-
-
-
-
-
-test_that("Test against reference results - NegBin model", {
- skip_on_cran()
-
- ## simulate basic epicurve
- dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6)
- i <- incidence::incidence(dat)
-
-
- ## example with a function for SI
- si <- distcrete::distcrete("gamma", interval = 1L,
- shape = 1.5,
- scale = 2, w = 0)
-
- set.seed(1)
- pred_5 <- project(i, runif(100, 0.8, 1.9), si, n_days = 30, model = "negbin")
- expect_equal_to_reference(pred_5, file = "rds/pred_5.rds", update = FALSE)
-
-
- ## time-varying R (fixed within time windows)
- set.seed(1)
- pred_6 <- project(i,
- R = c(1.5, 0.5, 2.1, .4, 1.4),
- si = si,
- n_days = 60,
- time_change = c(10, 15, 20, 30),
- n_sim = 100,
- model = "negbin")
- expect_equal_to_reference(pred_6, file = "rds/pred_6.rds", update = FALSE)
-
-
- ## time-varying R, 2 periods, R is 2.1 then 0.5
- set.seed(1)
-
- pred_7 <- project(i,
- R = c(2.1, 0.5),
- si = si,
- n_days = 60,
- time_change = 40,
- n_sim = 100,
- model = "negbin")
- expect_equal_to_reference(pred_7, file = "rds/pred_7.rds", update = FALSE)
-
- ## time-varying R, 2 periods, separate distributions of R for each period
- set.seed(1)
- R_period_1 <- runif(100, min = 1.1, max = 3)
- R_period_2 <- runif(100, min = 0.6, max = .9)
-
- par(ask = TRUE)
- for (i in 1:30)
-
- pred_8 <- project(i,
- R = list(R_period_1, R_period_2),
- si = si,
- n_days = 60,
- time_change = 20,
- n_sim = 100,
- model = "negbin")
- plot(pred_8)
- }
- expect_equal_to_reference(pred_8, file = "rds/pred_8.rds", update = FALSE)
-
-})
-
-
-
-
-
-test_that("Test R_fix_within", {
-
- ## The rationale of this test is to check that the variance of trajectories
- ## when fixing R within a given simulation is larger than when drawing
- ## systematically from the distribution. On the provided example, fixing R
- ## will lead to many more trajectories growing fast, and greater average
- ## incidence (> x10 for the last time steps).
-
- skip_on_cran()
-
- ## simulate basic epicurve
- dat <- c(0, 2, 2, 3, 3, 5, 5, 5, 6, 6, 6, 6)
- i <- incidence::incidence(dat)
-
- set.seed(1)
- x_base <- project(i,
- si = c(1, 1 , 1, 1),
- R = c(0.8, 1.2),
- n_days = 50,
- n_sim = 1000,
- R_fix_within = FALSE)
- x_fixed <- project(i,
- si = c(1, 1 , 1, 1),
- R = c(0.8, 1.2),
- n_days = 50,
- n_sim = 1000,
- R_fix_within = TRUE)
- expect_true(all(tail(rowSums(x_fixed) / rowSums(x_base), 5) > 10))
-
-})
diff --git a/tests/testthat/rds/pred_1.rds b/tests/testthat/rds/pred_1.rds
index f43bb38..6344b27 100644
Binary files a/tests/testthat/rds/pred_1.rds and b/tests/testthat/rds/pred_1.rds differ
diff --git a/tests/testthat/rds/pred_4.rds b/tests/testthat/rds/pred_4.rds
index 7c890fe..917cadf 100644
Binary files a/tests/testthat/rds/pred_4.rds and b/tests/testthat/rds/pred_4.rds differ
diff --git a/tests/testthat/rds/pred_5.rds b/tests/testthat/rds/pred_5.rds
index f37e8aa..d8c1c3c 100644
Binary files a/tests/testthat/rds/pred_5.rds and b/tests/testthat/rds/pred_5.rds differ
diff --git a/tests/testthat/rds/pred_8.rds b/tests/testthat/rds/pred_8.rds
index e99eae2..3e1f46c 100644
Binary files a/tests/testthat/rds/pred_8.rds and b/tests/testthat/rds/pred_8.rds differ
diff --git a/tests/testthat/test-accessors.R b/tests/testthat/test-accessors.R
index f78036a..9f385f8 100644
--- a/tests/testthat/test-accessors.R
+++ b/tests/testthat/test-accessors.R
@@ -1,11 +1,5 @@
context("Test accessors")
-setup(RNGversion("3.5.3"))
-teardown({
- cur_R_version <- trimws(substr(R.version.string, 10, 16))
- RNGversion(cur_R_version)
-})
-
test_that("Accessors return the right thing", {
skip_on_cran()
diff --git a/tests/testthat/test-build_projections.R b/tests/testthat/test-build_projections.R
index a69d818..4f1b4d6 100644
--- a/tests/testthat/test-build_projections.R
+++ b/tests/testthat/test-build_projections.R
@@ -1,11 +1,5 @@
context("Test build_projections")
-setup(RNGversion("3.5.3"))
-teardown({
- cur_R_version <- trimws(substr(R.version.string, 10, 16))
- RNGversion(cur_R_version)
-})
-
test_that("Test round trip", {
skip_on_cran()
diff --git a/tests/testthat/test-conversion.R b/tests/testthat/test-conversion.R
index 01f594e..ceb2aef 100644
--- a/tests/testthat/test-conversion.R
+++ b/tests/testthat/test-conversion.R
@@ -1,11 +1,5 @@
context("Test conversion")
-setup(RNGversion("3.5.3"))
-teardown({
- cur_R_version <- trimws(substr(R.version.string, 10, 16))
- RNGversion(cur_R_version)
-})
-
test_that("Test against reference results", {
skip_on_cran()
diff --git a/tests/testthat/test-cumulate.R b/tests/testthat/test-cumulate.R
index 538fcae..a968ce9 100644
--- a/tests/testthat/test-cumulate.R
+++ b/tests/testthat/test-cumulate.R
@@ -1,11 +1,5 @@
context("Test cumulative incidence")
-setup(RNGversion("3.5.3"))
-teardown({
- cur_R_version <- trimws(substr(R.version.string, 10, 16))
- RNGversion(cur_R_version)
-})
-
test_that("Test cumulate()", {
skip_on_cran()
diff --git a/tests/testthat/test-merge_add_projections.R b/tests/testthat/test-merge_add_projections.R
index ef35ad8..19855ac 100644
--- a/tests/testthat/test-merge_add_projections.R
+++ b/tests/testthat/test-merge_add_projections.R
@@ -1,12 +1,5 @@
context("Test merge_add_projections")
-setup(RNGversion("3.5.3"))
-teardown({
- cur_R_version <- trimws(substr(R.version.string, 10, 16))
- RNGversion(cur_R_version)
-})
-
-
test_that("Merging works", {
set.seed(1)
diff --git a/tests/testthat/test-merge_projections.R b/tests/testthat/test-merge_projections.R
index 90bf19c..1938116 100644
--- a/tests/testthat/test-merge_projections.R
+++ b/tests/testthat/test-merge_projections.R
@@ -1,12 +1,5 @@
context("Test merge_projections")
-setup(RNGversion("3.5.3"))
-teardown({
- cur_R_version <- trimws(substr(R.version.string, 10, 16))
- RNGversion(cur_R_version)
-})
-
-
test_that("Merging works", {
i <- incidence::incidence(as.Date('2020-01-23'))
si <- c(0.2, 0.5, 0.2, 0.1)
diff --git a/tests/testthat/test-plots.R b/tests/testthat/test-plots.R
index a58aaf0..3234c6a 100644
--- a/tests/testthat/test-plots.R
+++ b/tests/testthat/test-plots.R
@@ -1,15 +1,5 @@
context("Test project function")
-setup(RNGversion("3.5.3"))
-teardown({
- cur_R_version <- trimws(substr(R.version.string, 10, 16))
- RNGversion(cur_R_version)
-})
-
-
-
-
-
test_that("Test against reference results", {
skip_on_cran()
diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R
index aa1f5ab..6d96a8d 100644
--- a/tests/testthat/test-print.R
+++ b/tests/testthat/test-print.R
@@ -1,11 +1,5 @@
context("Test printing")
-setup(RNGversion("3.5.3"))
-teardown({
- cur_R_version <- trimws(substr(R.version.string, 10, 16))
- RNGversion(cur_R_version)
-})
-
test_that("Printing as planned", {
skip_on_cran()
diff --git a/tests/testthat/test-project.R b/tests/testthat/test-project.R
index 78e13e1..a23ffea 100644
--- a/tests/testthat/test-project.R
+++ b/tests/testthat/test-project.R
@@ -1,15 +1,5 @@
context("Test project function")
-setup(RNGversion("3.5.3"))
-teardown({
- cur_R_version <- trimws(substr(R.version.string, 10, 16))
- RNGversion(cur_R_version)
-})
-
-
-
-
-
test_that("Projections can be performed for a single day", {
i <- incidence::incidence(as.Date('2020-01-23'))
si <- c(0.2, 0.5, 0.2, 0.1)
diff --git a/tests/testthat/test-subset.R b/tests/testthat/test-subset.R
index 2f717e2..3a788dd 100644
--- a/tests/testthat/test-subset.R
+++ b/tests/testthat/test-subset.R
@@ -1,11 +1,5 @@
context("Test subset")
-setup(RNGversion("3.5.3"))
-teardown({
- cur_R_version <- trimws(substr(R.version.string, 10, 16))
- RNGversion(cur_R_version)
-})
-
test_that("Test subsetting with numeric dates inputs", {
skip_on_cran()
diff --git a/tests/testthat/test-summary.R b/tests/testthat/test-summary.R
index 0cc5e8f..34ce483 100644
--- a/tests/testthat/test-summary.R
+++ b/tests/testthat/test-summary.R
@@ -1,15 +1,5 @@
context("Test summary of projections objects")
-setup(RNGversion("3.5.3"))
-teardown({
- cur_R_version <- trimws(substr(R.version.string, 10, 16))
- RNGversion(cur_R_version)
-})
-
-
-
-
-
test_that("Testing default summary", {
i <- incidence::incidence(as.Date('2020-01-23'))
si <- c(0.2, 0.5, 0.2, 0.1)