From 6f2f94cd8799510d74cb78dc601dbf7d03a0cc99 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Wed, 13 Sep 2023 21:44:08 +0100 Subject: [PATCH 01/29] Move tests to dedicated script --- tests/testthat/tests-sim.r | 31 ------------------------------- 1 file changed, 31 deletions(-) delete mode 100644 tests/testthat/tests-sim.r diff --git a/tests/testthat/tests-sim.r b/tests/testthat/tests-sim.r deleted file mode 100644 index 05b7b813..00000000 --- a/tests/testthat/tests-sim.r +++ /dev/null @@ -1,31 +0,0 @@ -test_that("Simulators output epichains objects", { - expect_s3_class( - simulate_tree( - nchains = 10, - offspring_dist = "pois", - lambda = 2, - statistic = "size", - stat_max = 10 - ), - "epichains" - ) - expect_s3_class( - simulate_tree_from_pop( - pop = 100, - offspring_dist = "nbinom", - offspring_mean = 0.5, - offspring_disp = 1.1, - serials_dist = function(x) 3 - ), - "epichains" - ) - expect_s3_class( - simulate_summary( - nchains = 10, - offspring_dist = "pois", - lambda = 2, - stat_max = 10 - ), - "epichains" - ) -}) From a463f1962d37b5ec0d677fcf13536621738916b2 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Wed, 13 Sep 2023 21:50:28 +0100 Subject: [PATCH 02/29] Add test for checks --- tests/testthat/test-checks.R | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) create mode 100644 tests/testthat/test-checks.R diff --git a/tests/testthat/test-checks.R b/tests/testthat/test-checks.R new file mode 100644 index 00000000..fde23d57 --- /dev/null +++ b/tests/testthat/test-checks.R @@ -0,0 +1,18 @@ +test_that("Checks work", { + expect_error( + check_offspring_valid(1), + "character string" + ) + expect_error( + check_offspring_func_valid("rrpois"), + "does not exist" + ) + expect_error( + check_serial_valid("a"), + "must be a function" + ) + expect_error( + check_nchains_valid(1.1), + "less than" + ) +}) From 39ccbb2b11a4b1922e410459151a1d8f3ded2432 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Wed, 13 Sep 2023 21:51:30 +0100 Subject: [PATCH 03/29] Add test for simulation functions --- tests/testthat/tests-simulate.R | 326 ++++++++++++++++++++++++++++++++ 1 file changed, 326 insertions(+) create mode 100644 tests/testthat/tests-simulate.R diff --git a/tests/testthat/tests-simulate.R b/tests/testthat/tests-simulate.R new file mode 100644 index 00000000..dcf8449c --- /dev/null +++ b/tests/testthat/tests-simulate.R @@ -0,0 +1,326 @@ +# Define global variables and options +set.seed(12) +serial_func <- function(n) { + rlnorm(n, meanlog = 0.58, sdlog = 1.58) +} + +test_that("Simulators return epichains objects", { + expect_s3_class( + simulate_tree( + nchains = 10, + offspring_dist = "pois", + lambda = 2, + statistic = "size", + stat_max = 10 + ), + "epichains" + ) + expect_s3_class( + simulate_tree_from_pop( + pop = 100, + offspring_dist = "nbinom", + offspring_mean = 0.5, + offspring_disp = 1.1, + serials_dist = function(x) 3 + ), + "epichains" + ) + expect_s3_class( + simulate_summary( + nchains = 10, + offspring_dist = "pois", + lambda = 2, + stat_max = 10 + ), + "epichains" + ) +}) + +test_that("Simulators work", { + expect_length( + simulate_summary( + nchains = 2, + statistic = "size", + offspring_dist = "pois", + lambda = 0.5 + ), + 2 + ) + expect_gte( + nrow( + simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + ), + 2 + ) + expect_gte( + nrow( + simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + ), + 1 + ) +}) + +test_that("simulate_tree throws errors", { + expect_error( + simulate_tree( + nchains = 2, + offspring_dist = "s", + statistic = "length", + lambda = 0.9 + ), + "does not exist" + ) + expect_error( + simulate_tree( + nchains = 2, + offspring_dist = "lnorm", + statistic = "length", + meanlog = 0.9, + sdlog = 0.9 + ), + "must return integers" + ) + expect_error( + simulate_tree( + nchains = 2, + offspring_dist = s, + statistic = "length", + meanlog = 0.9, + sdlog = 0.9 + ), + "not found" + ) + expect_error( + simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "size", + lambda = 0.9, + serials_dist = c(1, 2) + ), + "must be a function" + ) + expect_error( + simulate_tree( + nchains = 2, + offspring_dist = c(1, 2), + statistic = "length", + lambda = 0.9 + ), + "character string" + ) + expect_error( + simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "size", + lambda = 0.9, + tf = 5 + ), + "must be specified" + ) +}) + +test_that("simulate_summary throws errors", { + expect_error( + simulate_summary( + nchains = 2, + offspring_dist = "s", + statistic = "length", + lambda = 0.9 + ), + "does not exist" + ) + expect_error( + simulate_summary( + nchains = 2, + offspring_dist = "lnorm", + statistic = "length", + meanlog = 0.9, + sdlog = 0.9 + ), + "must return integers" + ) + expect_error( + simulate_summary( + nchains = 2, + offspring_dist = s, + statistic = "length", + meanlog = 0.9, + sdlog = 0.9 + ), + "not found" + ) + expect_error( + simulate_summary( + nchains = 2, + offspring_dist = c(1, 2), + statistic = "length", + lambda = 0.9 + ), + "character string" + ) +}) + +test_that("simulate_tree_from_pop throws errors", { +expect_error( + simulate_tree_from_pop( + pop = 100, + offspring_dist = "binom", + offspring_mean = 0.5, + serials_dist = serial_func + ), + "should be one of" +) + expect_error( + simulate_tree_from_pop( + pop = 100, + offspring_dist = "nbinom", + offspring_mean = 0.5, + offspring_disp = 0.9, + serials_dist = serial_func + ), + "> 1" + ) + expect_error( + simulate_tree_from_pop( + pop = 100, + offspring_dist = p, + offspring_mean = 0.5, + offspring_disp = 0.9, + serials_dist = serial_func + ), + "not found" + ) +}) + +test_that("simulate_tree_from_pop throws warnings", { + expect_warning( + simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 3, + offspring_disp = 1, + serials_dist = serial_func + ), + "not used for poisson offspring" + ) +}) + +test_that("simulate_tree is numerically correct", { + expect_equal( + summary( + simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + )$chains_ran, + 2 + ) + expect_equal( + summary( + simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + )$unique_ancestors, + 2 + ) + expect_equal( + summary( + simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + )$max_generation, + 3 + ) +}) + +test_that("simulate_summary is numerically correct", { + expect_equal( + summary( + simulate_summary( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + )$max_chain_stat, + 3 + ) + expect_equal( + summary( + simulate_summary( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + )$min_chain_stat, + 1 + ) +}) + +test_that("simulate_tree_from_pop is numerically correct", { + expect_equal( + summary( + simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + )$unique_ancestors, + 0 + ) + expect_equal( + summary( + simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + )$max_time, + 0 + ) + expect_equal( + summary( + simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + )$max_generation, + 1 + ) + expect_equal( + summary( + simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + )$chains_ran, + NULL + ) +}) From 267b9959a44e8bf54b2d71a4cbefebf5bb7d358f Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Wed, 13 Sep 2023 22:02:57 +0100 Subject: [PATCH 04/29] Clean up the tests --- tests/testthat/tests-simulate.R | 138 ++++++++++++-------------------- 1 file changed, 51 insertions(+), 87 deletions(-) diff --git a/tests/testthat/tests-simulate.R b/tests/testthat/tests-simulate.R index dcf8449c..7d4e2f54 100644 --- a/tests/testthat/tests-simulate.R +++ b/tests/testthat/tests-simulate.R @@ -1,4 +1,4 @@ -# Define global variables and options +# Define global variables and options for simulations set.seed(12) serial_func <- function(n) { rlnorm(n, meanlog = 0.58, sdlog = 1.58) @@ -79,7 +79,7 @@ test_that("simulate_tree throws errors", { lambda = 0.9 ), "does not exist" - ) + ) expect_error( simulate_tree( nchains = 2, @@ -89,7 +89,7 @@ test_that("simulate_tree throws errors", { sdlog = 0.9 ), "must return integers" - ) + ) expect_error( simulate_tree( nchains = 2, @@ -107,16 +107,16 @@ test_that("simulate_tree throws errors", { statistic = "size", lambda = 0.9, serials_dist = c(1, 2) - ), - "must be a function" - ) + ), + "must be a function" + ) expect_error( simulate_tree( nchains = 2, offspring_dist = c(1, 2), statistic = "length", lambda = 0.9 - ), + ), "character string" ) expect_error( @@ -173,15 +173,15 @@ test_that("simulate_summary throws errors", { }) test_that("simulate_tree_from_pop throws errors", { -expect_error( - simulate_tree_from_pop( - pop = 100, - offspring_dist = "binom", - offspring_mean = 0.5, - serials_dist = serial_func - ), - "should be one of" -) + expect_error( + simulate_tree_from_pop( + pop = 100, + offspring_dist = "binom", + offspring_mean = 0.5, + serials_dist = serial_func + ), + "should be one of" + ) expect_error( simulate_tree_from_pop( pop = 100, @@ -218,109 +218,73 @@ test_that("simulate_tree_from_pop throws warnings", { }) test_that("simulate_tree is numerically correct", { - expect_equal( - summary( - simulate_tree( - nchains = 2, - offspring_dist = "pois", - statistic = "length", - lambda = 0.9 - ) - )$chains_ran, - 2 - ) - expect_equal( - summary( - simulate_tree( + set.seed(12) + tree_sim_summary <- summary( + simulate_tree( nchains = 2, offspring_dist = "pois", statistic = "length", lambda = 0.9 ) - )$unique_ancestors, + ) + expect_equal( + tree_sim_summary$chains_ran, 2 ) expect_equal( - summary( - simulate_tree( - nchains = 2, - offspring_dist = "pois", - statistic = "length", - lambda = 0.9 - ) - )$max_generation, + tree_sim_summary$unique_ancestors, + 2 + ) + expect_equal( + tree_sim_summary$max_generation, 3 ) }) test_that("simulate_summary is numerically correct", { + set.seed(12) + chain_summary_sim <- summary( + simulate_summary( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + ) expect_equal( - summary( - simulate_summary( - nchains = 2, - offspring_dist = "pois", - statistic = "length", - lambda = 0.9 - ) - )$max_chain_stat, + chain_summary_sim$max_chain_stat, 3 ) expect_equal( - summary( - simulate_summary( - nchains = 2, - offspring_dist = "pois", - statistic = "length", - lambda = 0.9 - ) - )$min_chain_stat, + chain_summary_sim$min_chain_stat, 1 ) }) test_that("simulate_tree_from_pop is numerically correct", { + set.seed(12) + susc_outbreak_summary <- summary( + simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + ) expect_equal( - summary( - simulate_tree_from_pop( - pop = 100, - offspring_dist = "pois", - offspring_mean = 0.9, - serials_dist = serial_func - ) - )$unique_ancestors, + susc_outbreak_summary$unique_ancestors, 0 ) expect_equal( - summary( - simulate_tree_from_pop( - pop = 100, - offspring_dist = "pois", - offspring_mean = 0.9, - serials_dist = serial_func - ) - )$max_time, + susc_outbreak_summary$max_time, 0 ) expect_equal( - summary( - simulate_tree_from_pop( - pop = 100, - offspring_dist = "pois", - offspring_mean = 0.9, - serials_dist = serial_func - ) - )$max_generation, + susc_outbreak_summary$max_generation, 1 ) expect_equal( - summary( - simulate_tree_from_pop( - pop = 100, - offspring_dist = "pois", - offspring_mean = 0.9, - serials_dist = serial_func - ) - )$chains_ran, + susc_outbreak_summary$chains_ran, NULL ) }) From 042388c15ac20bd68b6c56225005ac9cafa10c0f Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Wed, 13 Sep 2023 22:05:34 +0100 Subject: [PATCH 05/29] Generate likelihood doc file --- man/likelihood.Rd | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/man/likelihood.Rd b/man/likelihood.Rd index 6c69b974..213a62f6 100644 --- a/man/likelihood.Rd +++ b/man/likelihood.Rd @@ -54,9 +54,9 @@ contributions will be returned rather than the sum/product.} If \code{log = TRUE} \itemize{ \item A joint log-likelihood (sum of individual log-likelihoods), if -\code{individual == FALSE} (default) and \code{obs_prob = 1} (default), or +\code{individual == FALSE} (default) and \code{obs_prob == 1} (default), or \item A list of individual log-likelihoods, if \code{individual == TRUE} and -\code{obs_prob = 1} (default), or +\code{obs_prob == 1} (default), or \item A list of individual log-likelihoods (same length as \code{nsim_obs}), if \code{individual == TRUE} and \code{0 <= obs_prob < 1}, or \item A vector of joint log-likelihoods (same length as \code{nsim_obs}), if From 98dd76a1fd46f9bf6328dd27fad30bb1093ec99b Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Thu, 14 Sep 2023 19:06:28 +0100 Subject: [PATCH 06/29] Use expect_identical instead of expect_equal --- tests/testthat/tests-simulate.R | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/tests/testthat/tests-simulate.R b/tests/testthat/tests-simulate.R index 7d4e2f54..f83c1534 100644 --- a/tests/testthat/tests-simulate.R +++ b/tests/testthat/tests-simulate.R @@ -227,15 +227,15 @@ test_that("simulate_tree is numerically correct", { lambda = 0.9 ) ) - expect_equal( + expect_identical( tree_sim_summary$chains_ran, 2 ) - expect_equal( + expect_identical( tree_sim_summary$unique_ancestors, 2 ) - expect_equal( + expect_identical( tree_sim_summary$max_generation, 3 ) @@ -251,11 +251,11 @@ test_that("simulate_summary is numerically correct", { lambda = 0.9 ) ) - expect_equal( + expect_identical( chain_summary_sim$max_chain_stat, 3 ) - expect_equal( + expect_identical( chain_summary_sim$min_chain_stat, 1 ) @@ -271,15 +271,15 @@ test_that("simulate_tree_from_pop is numerically correct", { serials_dist = serial_func ) ) - expect_equal( + expect_identical( susc_outbreak_summary$unique_ancestors, 0 ) - expect_equal( + expect_identical( susc_outbreak_summary$max_time, 0 ) - expect_equal( + expect_identical( susc_outbreak_summary$max_generation, 1 ) From bbab69d65f314208e10db18c501953f76d20b920 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Thu, 14 Sep 2023 19:06:54 +0100 Subject: [PATCH 07/29] Use expect_null instead of expect_equal --- tests/testthat/tests-simulate.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/tests-simulate.R b/tests/testthat/tests-simulate.R index f83c1534..e590e09e 100644 --- a/tests/testthat/tests-simulate.R +++ b/tests/testthat/tests-simulate.R @@ -283,7 +283,7 @@ test_that("simulate_tree_from_pop is numerically correct", { susc_outbreak_summary$max_generation, 1 ) - expect_equal( + expect_null(susc_outbreak_summary$chains_ran) susc_outbreak_summary$chains_ran, NULL ) From fbc65ac7e0ea9808d5ef6c2f7da9ae76bf87ac81 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Thu, 14 Sep 2023 19:07:08 +0100 Subject: [PATCH 08/29] Fix expected data types --- tests/testthat/tests-simulate.R | 19 ++++++++----------- 1 file changed, 8 insertions(+), 11 deletions(-) diff --git a/tests/testthat/tests-simulate.R b/tests/testthat/tests-simulate.R index e590e09e..bd29f7d5 100644 --- a/tests/testthat/tests-simulate.R +++ b/tests/testthat/tests-simulate.R @@ -229,15 +229,15 @@ test_that("simulate_tree is numerically correct", { ) expect_identical( tree_sim_summary$chains_ran, - 2 + 2.00 ) expect_identical( tree_sim_summary$unique_ancestors, - 2 + 2L ) expect_identical( tree_sim_summary$max_generation, - 3 + 3L ) }) @@ -253,11 +253,11 @@ test_that("simulate_summary is numerically correct", { ) expect_identical( chain_summary_sim$max_chain_stat, - 3 + 3.00 ) expect_identical( chain_summary_sim$min_chain_stat, - 1 + 1.00 ) }) @@ -273,18 +273,15 @@ test_that("simulate_tree_from_pop is numerically correct", { ) expect_identical( susc_outbreak_summary$unique_ancestors, - 0 + 0L ) expect_identical( susc_outbreak_summary$max_time, - 0 + 0.00 ) expect_identical( susc_outbreak_summary$max_generation, - 1 + 1L ) expect_null(susc_outbreak_summary$chains_ran) - susc_outbreak_summary$chains_ran, - NULL - ) }) From e40fd81d11e4265a12714e6cfd2b2bda1ce977cb Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Thu, 14 Sep 2023 20:10:13 +0100 Subject: [PATCH 09/29] Add tests for utils.R --- tests/testthat/test-utils.R | 120 ++++++++++++++++++++++++++++++++++++ 1 file changed, 120 insertions(+) create mode 100644 tests/testthat/test-utils.R diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R new file mode 100644 index 00000000..c271e47d --- /dev/null +++ b/tests/testthat/test-utils.R @@ -0,0 +1,120 @@ +test_that("Reparametrized distributions work", { + expect_length( + rnbinom_mean_disp( + n = 5, + mn = 4, + disp = 2 + ), + 5 + ) +}) + +test_that("Log-probabilities work", { + expect_length( + complementary_logprob(x = 0), + 1 + ) + expect_length( + complementary_logprob(x = -Inf), + 1 + ) + expect_length( + complementary_logprob(x = -0.1), + 1 + ) +}) + +test_that("Chain lengths sampler works", { + expect_length( + rgen_length( + n = 1, + x = c(1, 2, 3), + prob = 0.3 + ), + 3 + ) +}) + +test_that("Chain sizes sampler works", { + expect_length( + rbinom_size( + n = 1, + x = c(1, 2, 3), + prob = 0.3 + ), + 3 + ) +}) + +test_that("Reparametrized distributions are numerically correct", { + set.seed(12) + expect_identical( + rnbinom_mean_disp( + n = 5, + mn = 4, + disp = 2 + ), + c(0, 2, 5, 2, 3) + ) +}) + +test_that("Log-probabilities are numerically correct", { + expect_identical( + complementary_logprob(x = 0), + -Inf + ) + expect_identical( + complementary_logprob(x = -Inf), + 0 + ) + expect_lt( + complementary_logprob(x = -0.1), + 0 + ) +}) + +test_that("Chain lengths sampler is numerically correct", { + set.seed(12) + expect_identical( + rgen_length( + n = 1, + x = c(1, 2, 3), + prob = 0.3 + ), + c(8, 9, 10) + ) +}) + +test_that("Chain sizes sampler is numerically correct", { + set.seed(12) + expect_identical( + rbinom_size( + n = 1, + x = c(1, 2, 3), + prob = 0.3 + ), + c(1, 2, 3) + ) +}) + +test_that("Reparametrized distributions throw warnings", { + expect_warning( + rnbinom_mean_disp( + n = 5, + mn = 4, + disp = 0.9 + ), + "NAs produced" + ) +}) + +test_that("Log-probabilities throw warnings", { + expect_warning( + complementary_logprob(0.1), + "NaNs produced" + ) + expect_warning( + complementary_logprob(Inf), + "NaNs produced" + ) +}) From c9ed2ec0aa53142905f5d112b67550dc2ccd2491 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Thu, 14 Sep 2023 23:19:34 +0100 Subject: [PATCH 10/29] Add tests for epichains classes and methods --- tests/testthat/_snaps/epichains.md | 138 +++++++++++++++++++ tests/testthat/test-epichains.R | 206 +++++++++++++++++++++++++++++ 2 files changed, 344 insertions(+) create mode 100644 tests/testthat/_snaps/epichains.md create mode 100644 tests/testthat/test-epichains.R diff --git a/tests/testthat/_snaps/epichains.md b/tests/testthat/_snaps/epichains.md new file mode 100644 index 00000000..c31d1707 --- /dev/null +++ b/tests/testthat/_snaps/epichains.md @@ -0,0 +1,138 @@ +# print.epichains works for simulate_summary output + + Code + epichains_summary + Output + `epichains` object + + [1] 1 Inf Inf Inf Inf 1 2 Inf 1 1 + + Simulated chain sizes: + + Max: 2 + Min: 1 + +# print.epichains works for simulate_tree output + + Code + epichains_tree + Output + `epichains` object + + < tree head (from first known ancestor) > + + chain_id sim_id ancestor generation + 11 1 2 1 2 + 13 2 2 1 2 + 18 3 2 1 2 + 19 4 2 1 2 + 22 6 2 1 2 + 23 8 2 1 2 + + < tree tail > + + chain_id sim_id ancestor generation + 41 2 17 6 3 + 85 6 17 6 4 + 42 2 18 6 3 + 86 6 18 7 4 + 87 6 19 7 4 + 88 6 20 7 4 + Chains simulated: 10 + Number of ancestors (known): 9 + Number of generations: 5 + Use `as.data.frame()` to view the full output in the console. + +--- + + Code + epichains_tree2 + Output + `epichains` object + + < tree head (from first known ancestor) > + + chain_id sim_id ancestor generation time + 11 1 2 1 2 3 + 13 2 2 1 2 3 + 16 3 2 1 2 3 + 17 4 2 1 2 3 + 18 5 2 1 2 3 + 19 6 2 1 2 3 + + < tree tail > + + chain_id sim_id ancestor generation time + 116 7 20 9 4 9 + 128 8 20 9 4 9 + 117 7 21 9 4 9 + 129 8 21 9 4 9 + 130 8 22 9 4 9 + 131 8 23 9 4 9 + Chains simulated: 10 + Number of ancestors (known): 9 + Number of generations: 4 + Use `as.data.frame()` to view the full output in the console. + +# head and tail methods work + + Code + head(epichains_tree) + Output + < tree head (from first known ancestor) > + + chain_id sim_id ancestor generation + 11 1 2 1 2 + 13 2 2 1 2 + 18 3 2 1 2 + 19 4 2 1 2 + 22 6 2 1 2 + 23 8 2 1 2 + +--- + + Code + head(epichains_tree2) + Output + < tree head (from first known ancestor) > + + chain_id sim_id ancestor generation time + 11 1 2 1 2 3 + 13 2 2 1 2 3 + 16 3 2 1 2 3 + 17 4 2 1 2 3 + 18 5 2 1 2 3 + 19 6 2 1 2 3 + +--- + + Code + tail(epichains_tree) + Output + + < tree tail > + + chain_id sim_id ancestor generation + 41 2 17 6 3 + 85 6 17 6 4 + 42 2 18 6 3 + 86 6 18 7 4 + 87 6 19 7 4 + 88 6 20 7 4 + +--- + + Code + tail(epichains_tree2) + Output + + < tree tail > + + chain_id sim_id ancestor generation time + 116 7 20 9 4 9 + 128 8 20 9 4 9 + 117 7 21 9 4 9 + 129 8 21 9 4 9 + 130 8 22 9 4 9 + 131 8 23 9 4 9 + diff --git a/tests/testthat/test-epichains.R b/tests/testthat/test-epichains.R new file mode 100644 index 00000000..624151ae --- /dev/null +++ b/tests/testthat/test-epichains.R @@ -0,0 +1,206 @@ +set.seed(12) +epichains_summary <- simulate_summary( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + lambda = 2 +) +epichains_tree <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + lambda = 2 +) +epichains_tree2 <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + serials_dist = function(x) 3, + lambda = 2 +) + +aggreg_by_gen <- aggregate( + epichains_tree, + grouping_var = "generation" +) +aggreg_by_time <- aggregate( + epichains_tree2, + grouping_var = "time" +) + +aggreg_by_both <- aggregate( + epichains_tree2, + grouping_var = "both" +) + +set.seed(11223) +epichains_summary_all_infs <- simulate_summary( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + lambda = 3 +) + +test_that("print.epichains works for simulate_summary output", { + expect_snapshot(epichains_summary) +}) + +test_that("print.epichains works for simulate_tree output", { + expect_snapshot(epichains_tree) +}) + +test_that("print.epichains works for simulate_tree output", { + expect_snapshot(epichains_tree2) +}) + +test_that("summary.epichains works as expected", { + expect_named( + summary(epichains_summary), + c( + "chain_ran", + "max_chain_stat", + "min_chain_stat" + ) + ) + expect_named( + summary(epichains_tree2), + c( + "chains_ran", + "max_time", + "unique_ancestors", + "max_generation" + ) + ) + expect_named( + summary(epichains_tree2), + c( + "chains_ran", + "max_time", + "unique_ancestors", + "max_generation" + ) + ) + expect_true( + is.infinite( + summary(epichains_summary_all_infs)$min_chain_stat + ) + ) + expect_true( + is.infinite( + summary(epichains_summary_all_infs)$max_chain_stat + ) + ) +}) + +test_that("validate_epichains works", { + expect_invisible( + validate_epichains(epichains_summary) + ) + expect_invisible( + validate_epichains(epichains_tree) + ) + expect_invisible( + validate_epichains(epichains_tree2) + ) +}) + +test_that("is_chains_tree works", { + expect_true( + is_chains_tree(epichains_tree) + ) + expect_true( + is_chains_tree(epichains_tree2) + ) + expect_false( + is_chains_tree(epichains_summary) + ) +}) + +test_that("is_chains_summary works", { + expect_true( + is_chains_tree(epichains_tree) + ) + expect_true( + is_chains_tree(epichains_tree2) + ) + expect_false( + is_chains_tree(epichains_summary) + ) +}) + +test_that("is_epichains_aggregate_df works", { + expect_true( + is_epichains_aggregate_df(aggreg_by_gen) + ) + expect_true( + is_epichains_aggregate_df(aggreg_by_time) + ) + expect_true( + is_epichains_aggregate_df(aggreg_by_both) + ) + expect_false( + is_epichains_aggregate_df(epichains_tree) + ) +}) + +test_that("validate_epichains throws errors", { + expect_error( + validate_epichains(mtcars), + "must have an epichains class" + ) +}) + +test_that("head and tail methods work", { + expect_snapshot(head(epichains_tree)) + expect_snapshot(head(epichains_tree2)) + expect_snapshot(tail(epichains_tree)) + expect_snapshot(tail(epichains_tree2)) +}) + +test_that("aggregate method work", { + expect_named( + aggreg_by_gen, + c("generation", "cases") + ) + expect_named( + aggreg_by_time, + c("time", "cases") + ) + expect_identical( + as.vector( + vapply(aggreg_by_both, names, FUN.VALUE = character(2)) + ), + c("time", "cases", "generation", "cases") + ) + expect_s3_class( + aggreg_by_gen, + "epichains_aggregate_df" + ) + expect_s3_class( + aggreg_by_time, + "epichains_aggregate_df" + ) + expect_s3_class( + aggreg_by_both, + "epichains_aggregate_df" + ) + expect_error( + aggregate(epichains_summary), + "attribute" + ) +}) + +test_that("aggregate method is numerically correct", { + expect_identical( + aggreg_by_gen$cases, + c(10L, 17L, 38L, 38L, 12L) + ) + expect_identical( + aggreg_by_time$cases, + c(10L, 21L, 48L, 60L) + ) +}) From 3584b3bfd976fbf40412b13c0e3dc767fd4e8b9c Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Thu, 14 Sep 2023 23:19:47 +0100 Subject: [PATCH 11/29] Add tests for the helper functions --- tests/testthat/_snaps/helpers.md | 22 ++++++++++ tests/testthat/test-helpers.R | 69 +++++++++++++++++++++++++++++++- 2 files changed, 90 insertions(+), 1 deletion(-) create mode 100644 tests/testthat/_snaps/helpers.md diff --git a/tests/testthat/_snaps/helpers.md b/tests/testthat/_snaps/helpers.md new file mode 100644 index 00000000..538123be --- /dev/null +++ b/tests/testthat/_snaps/helpers.md @@ -0,0 +1,22 @@ +# get_offspring_func works correctly + + Code + body(pois_offspring_func) + Output + { + truncdist::rtrunc(n, spec = "pois", lambda = mean_offspring * + susc/pop, b = susc) + } + +--- + + Code + body(nbinom_offspring_func) + Output + { + new_mn <- mean_offspring * susc/pop + size <- new_mn/(disp_offspring - 1) + truncdist::rtrunc(n, spec = "nbinom", b = susc, mu = new_mn, + size = size) + } + diff --git a/tests/testthat/test-helpers.R b/tests/testthat/test-helpers.R index 1fbc99d3..9c7b3417 100644 --- a/tests/testthat/test-helpers.R +++ b/tests/testthat/test-helpers.R @@ -1,4 +1,4 @@ -test_that("Helper functions work correctly", { +test_that("construct_offspring_ll_name works correctly", { expect_identical( construct_offspring_ll_name( offspring_dist = "pois", @@ -7,3 +7,70 @@ test_that("Helper functions work correctly", { "pois_size_ll" ) }) + +test_that("update_chain_stat works correctly", { + stat_latest <- 1 + n_offspring <- 2 + expect_identical( + update_chain_stat( + stat_type = "size", + stat_latest = stat_latest, + n_offspring = n_offspring + ), + stat_latest + n_offspring + ) + expect_identical( + update_chain_stat( + stat_type = "length", + stat_latest = stat_latest, + n_offspring = n_offspring + ), + stat_latest + pmin(1, n_offspring) + ) +}) + +test_that("get_offspring_func works correctly", { + pois_offspring_func <- get_offspring_func( + offspring_dist = "pois", + n = n, + susc = susc, + pop = pop, + mean_offspring = mean_offspring, + disp_offspring = disp_offspring + ) + expect_snapshot(body(pois_offspring_func)) + nbinom_offspring_func <- get_offspring_func( + offspring_dist = "nbinom", + n = n, + susc = susc, + pop = pop, + mean_offspring = mean_offspring, + disp_offspring = disp_offspring + ) + expect_snapshot(body(nbinom_offspring_func)) +}) + +test_that("get_offspring_func throws errors", { + expect_error( + get_offspring_func( + offspring_dist = "ss", + n = n, + susc = susc, + pop = pop, + mean_offspring = mean_offspring, + disp_offspring = disp_offspring + ), + "must either be" + ) +}) + +test_that("get_statistic_func works correctly", { + expect_identical( + get_statistic_func(chain_statistic = "size"), + rbinom_size + ) + expect_identical( + get_statistic_func(chain_statistic = "length"), + rgen_length + ) +}) From c3943268586e4da088cc0409419f6cacc211104c Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Thu, 14 Sep 2023 23:20:02 +0100 Subject: [PATCH 12/29] Linting --- tests/testthat/test-utils.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index c271e47d..4118e7cb 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -4,7 +4,7 @@ test_that("Reparametrized distributions work", { n = 5, mn = 4, disp = 2 - ), + ), 5 ) }) @@ -53,7 +53,7 @@ test_that("Reparametrized distributions are numerically correct", { n = 5, mn = 4, disp = 2 - ), + ), c(0, 2, 5, 2, 3) ) }) From 29a7395b34384d8c4fbf56b6c88f3435909ab3d9 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Thu, 14 Sep 2023 23:20:23 +0100 Subject: [PATCH 13/29] Add more tests for the simulation functions --- tests/testthat/tests-simulate.R | 23 +++++++++++++++++++++++ 1 file changed, 23 insertions(+) diff --git a/tests/testthat/tests-simulate.R b/tests/testthat/tests-simulate.R index bd29f7d5..ab3f2219 100644 --- a/tests/testthat/tests-simulate.R +++ b/tests/testthat/tests-simulate.R @@ -68,6 +68,19 @@ test_that("Simulators work", { ), 1 ) + expect_true( + all( + simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + serials_dist = function(x) 3, + lambda = 2, + tf = 5 + )$time < 5 + ) + ) }) test_that("simulate_tree throws errors", { @@ -173,6 +186,7 @@ test_that("simulate_summary throws errors", { }) test_that("simulate_tree_from_pop throws errors", { + set.seed(123) expect_error( simulate_tree_from_pop( pop = 100, @@ -202,6 +216,15 @@ test_that("simulate_tree_from_pop throws errors", { ), "not found" ) + expect_error( + simulate_tree_from_pop( + pop = 100, + offspring_dist = "nbinom", + offspring_mean = 0.5, + serials_dist = serial_func + ), + "must be specified" + ) }) test_that("simulate_tree_from_pop throws warnings", { From d68b62a1290f1cc488e23359f930beac61b1ab4d Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Fri, 15 Sep 2023 12:17:54 +0100 Subject: [PATCH 14/29] Replace snapshot test of returned functions with a check for the required argument specification --- tests/testthat/_snaps/helpers.md | 22 ---------------------- tests/testthat/test-helpers.R | 18 ++++++++++++++++-- 2 files changed, 16 insertions(+), 24 deletions(-) delete mode 100644 tests/testthat/_snaps/helpers.md diff --git a/tests/testthat/_snaps/helpers.md b/tests/testthat/_snaps/helpers.md deleted file mode 100644 index 538123be..00000000 --- a/tests/testthat/_snaps/helpers.md +++ /dev/null @@ -1,22 +0,0 @@ -# get_offspring_func works correctly - - Code - body(pois_offspring_func) - Output - { - truncdist::rtrunc(n, spec = "pois", lambda = mean_offspring * - susc/pop, b = susc) - } - ---- - - Code - body(nbinom_offspring_func) - Output - { - new_mn <- mean_offspring * susc/pop - size <- new_mn/(disp_offspring - 1) - truncdist::rtrunc(n, spec = "nbinom", b = susc, mu = new_mn, - size = size) - } - diff --git a/tests/testthat/test-helpers.R b/tests/testthat/test-helpers.R index 9c7b3417..02501d58 100644 --- a/tests/testthat/test-helpers.R +++ b/tests/testthat/test-helpers.R @@ -38,7 +38,14 @@ test_that("get_offspring_func works correctly", { mean_offspring = mean_offspring, disp_offspring = disp_offspring ) - expect_snapshot(body(pois_offspring_func)) + expect_true( + any( + grepl( + "spec = \"pois\"", + deparse(body(pois_offspring_func)) + ) + ) + ) nbinom_offspring_func <- get_offspring_func( offspring_dist = "nbinom", n = n, @@ -47,7 +54,14 @@ test_that("get_offspring_func works correctly", { mean_offspring = mean_offspring, disp_offspring = disp_offspring ) - expect_snapshot(body(nbinom_offspring_func)) + expect_true( + any( + grepl( + "spec = \"nbinom\"", + deparse(body(nbinom_offspring_func)) + ) + ) + ) }) test_that("get_offspring_func throws errors", { From 020c7d455d2d8145faf99fca10ac61e11a0b14a8 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Fri, 15 Sep 2023 14:27:37 +0100 Subject: [PATCH 15/29] Reinstate the snapshot tests of functions returning functions --- tests/testthat/_snaps/helpers.md | 22 ++++++++++++++++++++++ tests/testthat/test-helpers.R | 22 ++++++++++++++++++++++ 2 files changed, 44 insertions(+) create mode 100644 tests/testthat/_snaps/helpers.md diff --git a/tests/testthat/_snaps/helpers.md b/tests/testthat/_snaps/helpers.md new file mode 100644 index 00000000..83e69e93 --- /dev/null +++ b/tests/testthat/_snaps/helpers.md @@ -0,0 +1,22 @@ +# get_statistic_func snapshots look right + + Code + body(pois_offspring_func) + Output + { + truncdist::rtrunc(n, spec = "pois", lambda = mean_offspring * + susc/pop, b = susc) + } + +--- + + Code + body(nbinom_offspring_func) + Output + { + new_mn <- mean_offspring * susc/pop + size <- new_mn/(disp_offspring - 1) + truncdist::rtrunc(n, spec = "nbinom", b = susc, mu = new_mn, + size = size) + } + diff --git a/tests/testthat/test-helpers.R b/tests/testthat/test-helpers.R index 02501d58..35fa89bb 100644 --- a/tests/testthat/test-helpers.R +++ b/tests/testthat/test-helpers.R @@ -64,6 +64,28 @@ test_that("get_offspring_func works correctly", { ) }) +test_that("get_statistic_func snapshots look right", { + pois_offspring_func <- get_offspring_func( + offspring_dist = "pois", + n = n, + susc = susc, + pop = pop, + mean_offspring = mean_offspring, + disp_offspring = disp_offspring + ) + expect_snapshot(body(pois_offspring_func)) + + nbinom_offspring_func <- get_offspring_func( + offspring_dist = "nbinom", + n = n, + susc = susc, + pop = pop, + mean_offspring = mean_offspring, + disp_offspring = disp_offspring + ) + expect_snapshot(body(nbinom_offspring_func)) +}) + test_that("get_offspring_func throws errors", { expect_error( get_offspring_func( From 67eb4d22eca0e3412d56ef05241dc80e569bec13 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Fri, 15 Sep 2023 14:29:59 +0100 Subject: [PATCH 16/29] Move simulations within tests to top of script --- tests/testthat/tests-simulate.R | 115 ++++++++++++++------------------ 1 file changed, 51 insertions(+), 64 deletions(-) diff --git a/tests/testthat/tests-simulate.R b/tests/testthat/tests-simulate.R index ab3f2219..330722a3 100644 --- a/tests/testthat/tests-simulate.R +++ b/tests/testthat/tests-simulate.R @@ -4,34 +4,55 @@ serial_func <- function(n) { rlnorm(n, meanlog = 0.58, sdlog = 1.58) } +# simulate_tree() +tree_sim_raw <- simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 +) + +tree_sim_summary <- summary(tree_sim_raw) + +# simulate_summary() +chain_summary_raw <- simulate_summary( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 +) + +chain_summary_sim <- summary(chain_summary_raw) + +# simulate_tree_from_pop() +susc_outbreak_raw <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func +) + +susc_outbreak_raw2 <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "nbinom", + offspring_mean = 1, + offspring_disp = 1.1, + serials_dist = serial_func +) + +susc_outbreak_summary <- summary(susc_outbreak_raw) + test_that("Simulators return epichains objects", { expect_s3_class( - simulate_tree( - nchains = 10, - offspring_dist = "pois", - lambda = 2, - statistic = "size", - stat_max = 10 - ), + tree_sim_raw, "epichains" ) expect_s3_class( - simulate_tree_from_pop( - pop = 100, - offspring_dist = "nbinom", - offspring_mean = 0.5, - offspring_disp = 1.1, - serials_dist = function(x) 3 - ), + susc_outbreak_raw, "epichains" ) expect_s3_class( - simulate_summary( - nchains = 10, - offspring_dist = "pois", - lambda = 2, - stat_max = 10 - ), + chain_summary_raw, "epichains" ) }) @@ -47,25 +68,14 @@ test_that("Simulators work", { 2 ) expect_gte( - nrow( - simulate_tree( - nchains = 2, - offspring_dist = "pois", - statistic = "length", - lambda = 0.9 - ) - ), - 2 + nrow(tree_sim_raw), + 2) + expect_gte( + nrow(susc_outbreak_raw), + 1 ) expect_gte( - nrow( - simulate_tree_from_pop( - pop = 100, - offspring_dist = "pois", - offspring_mean = 0.9, - serials_dist = serial_func - ) - ), + nrow(susc_outbreak_raw2), 1 ) expect_true( @@ -241,15 +251,6 @@ test_that("simulate_tree_from_pop throws warnings", { }) test_that("simulate_tree is numerically correct", { - set.seed(12) - tree_sim_summary <- summary( - simulate_tree( - nchains = 2, - offspring_dist = "pois", - statistic = "length", - lambda = 0.9 - ) - ) expect_identical( tree_sim_summary$chains_ran, 2.00 @@ -265,15 +266,6 @@ test_that("simulate_tree is numerically correct", { }) test_that("simulate_summary is numerically correct", { - set.seed(12) - chain_summary_sim <- summary( - simulate_summary( - nchains = 2, - offspring_dist = "pois", - statistic = "length", - lambda = 0.9 - ) - ) expect_identical( chain_summary_sim$max_chain_stat, 3.00 @@ -282,18 +274,13 @@ test_that("simulate_summary is numerically correct", { chain_summary_sim$min_chain_stat, 1.00 ) + expect_identical( + as.vector(chain_summary_raw), + c(2.00, 1.00) + ) }) test_that("simulate_tree_from_pop is numerically correct", { - set.seed(12) - susc_outbreak_summary <- summary( - simulate_tree_from_pop( - pop = 100, - offspring_dist = "pois", - offspring_mean = 0.9, - serials_dist = serial_func - ) - ) expect_identical( susc_outbreak_summary$unique_ancestors, 0L From 0b42272be087dfa552bec62e960eb34ad8d30f55 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Fri, 15 Sep 2023 14:30:35 +0100 Subject: [PATCH 17/29] Add tests for simulated outcomes --- tests/testthat/tests-simulate.R | 34 ++++++++++++++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) diff --git a/tests/testthat/tests-simulate.R b/tests/testthat/tests-simulate.R index 330722a3..11bfb1df 100644 --- a/tests/testthat/tests-simulate.R +++ b/tests/testthat/tests-simulate.R @@ -263,12 +263,28 @@ test_that("simulate_tree is numerically correct", { tree_sim_summary$max_generation, 3L ) + expect_identical( + tree_sim_raw$chain_id, + c(1L, 2L, 2L, 2L, 2L, 2L, 2L) + ) + expect_identical( + tree_sim_raw$sim_id, + c(1, 1, 2, 3, 4, 5, 6) + ) + expect_identical( + tree_sim_raw$ancestor, + c(NA, NA, 1, 1, 2, 2, 2) + ) + expect_identical( + tree_sim_raw$generation, + c(1L, 1L, 2L, 2L, 3L, 3L, 3L) + ) }) test_that("simulate_summary is numerically correct", { expect_identical( chain_summary_sim$max_chain_stat, - 3.00 + 2.00 ) expect_identical( chain_summary_sim$min_chain_stat, @@ -294,4 +310,20 @@ test_that("simulate_tree_from_pop is numerically correct", { 1L ) expect_null(susc_outbreak_summary$chains_ran) + expect_identical( + susc_outbreak_raw$sim_id, + 1L + ) + expect_identical( + susc_outbreak_raw$ancestor, + NA_integer_ + ) + expect_identical( + susc_outbreak_raw$generation, + 1L + ) + expect_identical( + susc_outbreak_raw$time, + 0.00 + ) }) From aa4579d4329c9f4a12c1d671fb55e4538519a3d6 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Fri, 15 Sep 2023 15:06:09 +0100 Subject: [PATCH 18/29] Add fix=TRUE to fix the pattern to be matched --- tests/testthat/test-helpers.R | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-helpers.R b/tests/testthat/test-helpers.R index 35fa89bb..c968ada5 100644 --- a/tests/testthat/test-helpers.R +++ b/tests/testthat/test-helpers.R @@ -42,10 +42,11 @@ test_that("get_offspring_func works correctly", { any( grepl( "spec = \"pois\"", - deparse(body(pois_offspring_func)) - ) + deparse(body(pois_offspring_func)), + fixed = TRUE ) ) + ) nbinom_offspring_func <- get_offspring_func( offspring_dist = "nbinom", n = n, @@ -58,7 +59,8 @@ test_that("get_offspring_func works correctly", { any( grepl( "spec = \"nbinom\"", - deparse(body(nbinom_offspring_func)) + deparse(body(nbinom_offspring_func)), + fixed = TRUE ) ) ) From f9a32a0808870afa8b71a3608866f10e59c859ee Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Fri, 15 Sep 2023 15:06:42 +0100 Subject: [PATCH 19/29] Fix comment tags --- tests/testthat/tests-simulate.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/tests/testthat/tests-simulate.R b/tests/testthat/tests-simulate.R index 11bfb1df..e93777f2 100644 --- a/tests/testthat/tests-simulate.R +++ b/tests/testthat/tests-simulate.R @@ -1,10 +1,10 @@ -# Define global variables and options for simulations +#' Define global variables and options for simulations set.seed(12) serial_func <- function(n) { rlnorm(n, meanlog = 0.58, sdlog = 1.58) } -# simulate_tree() +#' simulate_tree() tree_sim_raw <- simulate_tree( nchains = 2, offspring_dist = "pois", @@ -14,7 +14,7 @@ tree_sim_raw <- simulate_tree( tree_sim_summary <- summary(tree_sim_raw) -# simulate_summary() +#' simulate_summary() chain_summary_raw <- simulate_summary( nchains = 2, offspring_dist = "pois", @@ -24,7 +24,7 @@ chain_summary_raw <- simulate_summary( chain_summary_sim <- summary(chain_summary_raw) -# simulate_tree_from_pop() +#' simulate_tree_from_pop() susc_outbreak_raw <- simulate_tree_from_pop( pop = 100, offspring_dist = "pois", From 5e60ed9db92275f8b58aa40eafa249c08de31297 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Fri, 15 Sep 2023 15:06:49 +0100 Subject: [PATCH 20/29] Lint --- tests/testthat/tests-simulate.R | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/tests/testthat/tests-simulate.R b/tests/testthat/tests-simulate.R index e93777f2..1e36baaf 100644 --- a/tests/testthat/tests-simulate.R +++ b/tests/testthat/tests-simulate.R @@ -69,7 +69,8 @@ test_that("Simulators work", { ) expect_gte( nrow(tree_sim_raw), - 2) + 2 + ) expect_gte( nrow(susc_outbreak_raw), 1 @@ -273,7 +274,7 @@ test_that("simulate_tree is numerically correct", { ) expect_identical( tree_sim_raw$ancestor, - c(NA, NA, 1, 1, 2, 2, 2) + c(NA, NA, 1, 1, 2, 2, 2) ) expect_identical( tree_sim_raw$generation, From d6f43239743eb271bf32852f57429ff42be24fc2 Mon Sep 17 00:00:00 2001 From: James Azam Date: Mon, 18 Sep 2023 09:42:15 +0100 Subject: [PATCH 21/29] Remove snapshot tests --- tests/testthat/_snaps/helpers.md | 22 ---------------------- tests/testthat/test-helpers.R | 22 ---------------------- 2 files changed, 44 deletions(-) delete mode 100644 tests/testthat/_snaps/helpers.md diff --git a/tests/testthat/_snaps/helpers.md b/tests/testthat/_snaps/helpers.md deleted file mode 100644 index 83e69e93..00000000 --- a/tests/testthat/_snaps/helpers.md +++ /dev/null @@ -1,22 +0,0 @@ -# get_statistic_func snapshots look right - - Code - body(pois_offspring_func) - Output - { - truncdist::rtrunc(n, spec = "pois", lambda = mean_offspring * - susc/pop, b = susc) - } - ---- - - Code - body(nbinom_offspring_func) - Output - { - new_mn <- mean_offspring * susc/pop - size <- new_mn/(disp_offspring - 1) - truncdist::rtrunc(n, spec = "nbinom", b = susc, mu = new_mn, - size = size) - } - diff --git a/tests/testthat/test-helpers.R b/tests/testthat/test-helpers.R index c968ada5..fe68e27e 100644 --- a/tests/testthat/test-helpers.R +++ b/tests/testthat/test-helpers.R @@ -66,28 +66,6 @@ test_that("get_offspring_func works correctly", { ) }) -test_that("get_statistic_func snapshots look right", { - pois_offspring_func <- get_offspring_func( - offspring_dist = "pois", - n = n, - susc = susc, - pop = pop, - mean_offspring = mean_offspring, - disp_offspring = disp_offspring - ) - expect_snapshot(body(pois_offspring_func)) - - nbinom_offspring_func <- get_offspring_func( - offspring_dist = "nbinom", - n = n, - susc = susc, - pop = pop, - mean_offspring = mean_offspring, - disp_offspring = disp_offspring - ) - expect_snapshot(body(nbinom_offspring_func)) -}) - test_that("get_offspring_func throws errors", { expect_error( get_offspring_func( From 45b22e8fe3c1b005b8b3f89cfaf2a21d426ab941 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Mon, 18 Sep 2023 18:02:34 +0100 Subject: [PATCH 22/29] Remove tests for the get_offspring_func() helper --- tests/testthat/test-helpers.R | 51 ----------------------------------- 1 file changed, 51 deletions(-) diff --git a/tests/testthat/test-helpers.R b/tests/testthat/test-helpers.R index fe68e27e..28d66f0b 100644 --- a/tests/testthat/test-helpers.R +++ b/tests/testthat/test-helpers.R @@ -29,57 +29,6 @@ test_that("update_chain_stat works correctly", { ) }) -test_that("get_offspring_func works correctly", { - pois_offspring_func <- get_offspring_func( - offspring_dist = "pois", - n = n, - susc = susc, - pop = pop, - mean_offspring = mean_offspring, - disp_offspring = disp_offspring - ) - expect_true( - any( - grepl( - "spec = \"pois\"", - deparse(body(pois_offspring_func)), - fixed = TRUE - ) - ) - ) - nbinom_offspring_func <- get_offspring_func( - offspring_dist = "nbinom", - n = n, - susc = susc, - pop = pop, - mean_offspring = mean_offspring, - disp_offspring = disp_offspring - ) - expect_true( - any( - grepl( - "spec = \"nbinom\"", - deparse(body(nbinom_offspring_func)), - fixed = TRUE - ) - ) - ) -}) - -test_that("get_offspring_func throws errors", { - expect_error( - get_offspring_func( - offspring_dist = "ss", - n = n, - susc = susc, - pop = pop, - mean_offspring = mean_offspring, - disp_offspring = disp_offspring - ), - "must either be" - ) -}) - test_that("get_statistic_func works correctly", { expect_identical( get_statistic_func(chain_statistic = "size"), From fdf45f8e37304fe1fa7b323903227b51ce09c87d Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Tue, 19 Sep 2023 16:45:40 +0100 Subject: [PATCH 23/29] Restructure tests-epichains by moving simulations into individual contexts --- tests/testthat/_snaps/epichains.md | 190 ++++++---- tests/testthat/test-epichains.R | 551 +++++++++++++++++++++++------ 2 files changed, 565 insertions(+), 176 deletions(-) diff --git a/tests/testthat/_snaps/epichains.md b/tests/testthat/_snaps/epichains.md index c31d1707..66a761ec 100644 --- a/tests/testthat/_snaps/epichains.md +++ b/tests/testthat/_snaps/epichains.md @@ -1,52 +1,77 @@ -# print.epichains works for simulate_summary output +# print.epichains works for simulation functions Code - epichains_summary + susc_outbreak_raw Output - `epichains` object + `epichains` object + + < tree head (from first known ancestor) > - [1] 1 Inf Inf Inf Inf 1 2 Inf 1 1 + [1] sim_id ancestor generation time + <0 rows> (or 0-length row.names) - Simulated chain sizes: + < tree tail > - Max: 2 - Min: 1 + sim_id ancestor generation time + 1 1 NA 1 0 + Number of ancestors (known): 0 + Number of generations: 1 + Use `as.data.frame()` to view the full output in the console. -# print.epichains works for simulate_tree output +--- Code - epichains_tree + susc_outbreak_raw2 Output `epichains` object < tree head (from first known ancestor) > - chain_id sim_id ancestor generation - 11 1 2 1 2 - 13 2 2 1 2 - 18 3 2 1 2 - 19 4 2 1 2 - 22 6 2 1 2 - 23 8 2 1 2 + sim_id ancestor generation time + 2 2 1 2 21.5834705 + 3 3 1 2 0.3939008 + 4 4 2 3 21.6595273 < tree tail > - chain_id sim_id ancestor generation - 41 2 17 6 3 - 85 6 17 6 4 - 42 2 18 6 3 - 86 6 18 7 4 - 87 6 19 7 4 - 88 6 20 7 4 - Chains simulated: 10 - Number of ancestors (known): 9 - Number of generations: 5 + sim_id ancestor generation time + 1 1 NA 1 0.0000000 + 2 2 1 2 21.5834705 + 3 3 1 2 0.3939008 + 4 4 2 3 21.6595273 + Number of ancestors (known): 2 + Number of generations: 3 Use `as.data.frame()` to view the full output in the console. --- Code - epichains_tree2 + tree_sim_raw + Output + `epichains` object + + < tree head (from first known ancestor) > + + chain_id sim_id ancestor generation + 3 1 2 1 2 + 4 1 3 1 2 + + < tree tail > + + chain_id sim_id ancestor generation + 1 1 1 NA 1 + 2 2 1 NA 1 + 3 1 2 1 2 + 4 1 3 1 2 + Chains simulated: 2 + Number of ancestors (known): 1 + Number of generations: 2 + Use `as.data.frame()` to view the full output in the console. + +--- + + Code + tree_sim_raw2 Output `epichains` object @@ -55,84 +80,125 @@ chain_id sim_id ancestor generation time 11 1 2 1 2 3 13 2 2 1 2 3 - 16 3 2 1 2 3 + 15 3 2 1 2 3 17 4 2 1 2 3 - 18 5 2 1 2 3 19 6 2 1 2 3 + 20 7 2 1 2 3 < tree tail > chain_id sim_id ancestor generation time - 116 7 20 9 4 9 - 128 8 20 9 4 9 - 117 7 21 9 4 9 - 129 8 21 9 4 9 - 130 8 22 9 4 9 - 131 8 23 9 4 9 + 92 9 19 8 4 9 + 109 6 19 8 5 12 + 93 9 20 9 4 9 + 110 6 20 9 5 12 + 94 9 21 9 4 9 + 111 6 21 9 5 12 Chains simulated: 10 Number of ancestors (known): 9 - Number of generations: 4 + Number of generations: 5 Use `as.data.frame()` to view the full output in the console. # head and tail methods work Code - head(epichains_tree) + head(susc_outbreak_raw) Output < tree head (from first known ancestor) > - chain_id sim_id ancestor generation - 11 1 2 1 2 - 13 2 2 1 2 - 18 3 2 1 2 - 19 4 2 1 2 - 22 6 2 1 2 - 23 8 2 1 2 + [1] sim_id ancestor generation time + <0 rows> (or 0-length row.names) --- Code - head(epichains_tree2) + head(susc_outbreak_raw2) + Output + < tree head (from first known ancestor) > + + sim_id ancestor generation time + 2 2 1 2 21.5834705 + 3 3 1 2 0.3939008 + 4 4 2 3 21.6595273 + +--- + + Code + head(tree_sim_raw) + Output + < tree head (from first known ancestor) > + + chain_id sim_id ancestor generation + 3 1 2 1 2 + 4 1 3 1 2 + +--- + + Code + head(tree_sim_raw2) Output < tree head (from first known ancestor) > chain_id sim_id ancestor generation time 11 1 2 1 2 3 13 2 2 1 2 3 - 16 3 2 1 2 3 + 15 3 2 1 2 3 17 4 2 1 2 3 - 18 5 2 1 2 3 19 6 2 1 2 3 + 20 7 2 1 2 3 + +--- + + Code + tail(susc_outbreak_raw) + Output + + < tree tail > + + sim_id ancestor generation time + 1 1 NA 1 0 + +--- + + Code + tail(susc_outbreak_raw2) + Output + + < tree tail > + + sim_id ancestor generation time + 1 1 NA 1 0.0000000 + 2 2 1 2 21.5834705 + 3 3 1 2 0.3939008 + 4 4 2 3 21.6595273 --- Code - tail(epichains_tree) + tail(tree_sim_raw) Output < tree tail > - chain_id sim_id ancestor generation - 41 2 17 6 3 - 85 6 17 6 4 - 42 2 18 6 3 - 86 6 18 7 4 - 87 6 19 7 4 - 88 6 20 7 4 + chain_id sim_id ancestor generation + 1 1 1 NA 1 + 2 2 1 NA 1 + 3 1 2 1 2 + 4 1 3 1 2 --- Code - tail(epichains_tree2) + tail(tree_sim_raw2) Output < tree tail > chain_id sim_id ancestor generation time - 116 7 20 9 4 9 - 128 8 20 9 4 9 - 117 7 21 9 4 9 - 129 8 21 9 4 9 - 130 8 22 9 4 9 - 131 8 23 9 4 9 + 92 9 19 8 4 9 + 109 6 19 8 5 12 + 93 9 20 9 4 9 + 110 6 20 9 5 12 + 94 9 21 9 4 9 + 111 6 21 9 5 12 diff --git a/tests/testthat/test-epichains.R b/tests/testthat/test-epichains.R index 624151ae..3ad1c810 100644 --- a/tests/testthat/test-epichains.R +++ b/tests/testthat/test-epichains.R @@ -1,73 +1,189 @@ -set.seed(12) -epichains_summary <- simulate_summary( - nchains = 10, - statistic = "size", - offspring_dist = "pois", - stat_max = 10, - lambda = 2 -) -epichains_tree <- simulate_tree( - nchains = 10, - statistic = "size", - offspring_dist = "pois", - stat_max = 10, - lambda = 2 -) -epichains_tree2 <- simulate_tree( - nchains = 10, - statistic = "size", - offspring_dist = "pois", - stat_max = 10, - serials_dist = function(x) 3, - lambda = 2 -) +#' Define global variables and options for simulations +serial_func <- function(n) { + rlnorm(n, meanlog = 0.58, sdlog = 1.58) +} -aggreg_by_gen <- aggregate( - epichains_tree, - grouping_var = "generation" -) -aggreg_by_time <- aggregate( - epichains_tree2, - grouping_var = "time" -) - -aggreg_by_both <- aggregate( - epichains_tree2, - grouping_var = "both" -) - -set.seed(11223) -epichains_summary_all_infs <- simulate_summary( - nchains = 10, - statistic = "size", - offspring_dist = "pois", - stat_max = 10, - lambda = 3 -) - -test_that("print.epichains works for simulate_summary output", { - expect_snapshot(epichains_summary) -}) - -test_that("print.epichains works for simulate_tree output", { - expect_snapshot(epichains_tree) +test_that("Simulators return epichains objects", { + set.seed(12) + #' Simulate an outbreak from a susceptible population (pois) + susc_outbreak_raw <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + #' Simulate an outbreak from a susceptible population (nbinom) + susc_outbreak_raw2 <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "nbinom", + offspring_mean = 1, + offspring_disp = 1.1, + serials_dist = serial_func + ) + #' Simulate a tree of infections without serials + tree_sim_raw <- simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Simulate a tree of infections with serials + tree_sim_raw2 <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + serials_dist = function(x) 3, + lambda = 2 + ) + #' Simulate chain statistics + chain_summary_raw <- simulate_summary( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Expectations + expect_s3_class( + tree_sim_raw, + "epichains" + ) + expect_s3_class( + tree_sim_raw2, + "epichains" + ) + expect_s3_class( + susc_outbreak_raw, + "epichains" + ) + expect_s3_class( + susc_outbreak_raw2, + "epichains" + ) + expect_s3_class( + chain_summary_raw, + "epichains" + ) }) -test_that("print.epichains works for simulate_tree output", { - expect_snapshot(epichains_tree2) +test_that("print.epichains works for simulation functions", { + set.seed(12) + #' Simulate an outbreak from a susceptible population (pois) + susc_outbreak_raw <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + #' Simulate an outbreak from a susceptible population (nbinom) + susc_outbreak_raw2 <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "nbinom", + offspring_mean = 1, + offspring_disp = 1.1, + serials_dist = serial_func + ) + #' Simulate a tree of infections without serials + tree_sim_raw <- simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Simulate a tree of infections with serials + tree_sim_raw2 <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + serials_dist = function(x) 3, + lambda = 2 + ) + #' Simulate chain statistics + chain_summary_raw <- simulate_summary( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Expectations + expect_snapshot(susc_outbreak_raw) + expect_snapshot(susc_outbreak_raw2) + expect_snapshot(tree_sim_raw) + expect_snapshot(tree_sim_raw2) + expect_snapshot(chain_summary_raw) }) test_that("summary.epichains works as expected", { + set.seed(12) + #' Simulate an outbreak from a susceptible population (pois) + susc_outbreak_raw <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + #' Simulate an outbreak from a susceptible population (nbinom) + susc_outbreak_raw2 <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "nbinom", + offspring_mean = 1, + offspring_disp = 1.1, + serials_dist = serial_func + ) + #' Simulate a tree of infections without serials + tree_sim_raw <- simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Simulate a tree of infections with serials + tree_sim_raw2 <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + serials_dist = function(x) 3, + lambda = 2 + ) + #' Simulate chain statistics + chain_summary_raw <- simulate_summary( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Simulate case where all the chain statistics are Inf + set.seed(11223) + epichains_summary_all_infs <- simulate_summary( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + lambda = 3 + ) + #' Expectations expect_named( - summary(epichains_summary), + summary(tree_sim_raw), c( - "chain_ran", - "max_chain_stat", - "min_chain_stat" + "chains_ran", + "max_time", + "unique_ancestors", + "max_generation" + ) + ) + expect_named( + summary(tree_sim_raw2), + c( + "chains_ran", + "max_time", + "unique_ancestors", + "max_generation" ) ) expect_named( - summary(epichains_tree2), + summary(susc_outbreak_raw), c( "chains_ran", "max_time", @@ -76,7 +192,7 @@ test_that("summary.epichains works as expected", { ) ) expect_named( - summary(epichains_tree2), + summary(susc_outbreak_raw2), c( "chains_ran", "max_time", @@ -84,6 +200,14 @@ test_that("summary.epichains works as expected", { "max_generation" ) ) + expect_named( + summary(chain_summary_raw), + c( + "chain_ran", + "max_chain_stat", + "min_chain_stat" + ) + ) expect_true( is.infinite( summary(epichains_summary_all_infs)$min_chain_stat @@ -97,42 +221,208 @@ test_that("summary.epichains works as expected", { }) test_that("validate_epichains works", { + set.seed(12) + #' Simulate an outbreak from a susceptible population (pois) + susc_outbreak_raw <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + #' Simulate an outbreak from a susceptible population (nbinom) + susc_outbreak_raw2 <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "nbinom", + offspring_mean = 1, + offspring_disp = 1.1, + serials_dist = serial_func + ) + #' Simulate a tree of infections without serials + tree_sim_raw <- simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Simulate a tree of infections with serials + tree_sim_raw2 <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + serials_dist = function(x) 3, + lambda = 2 + ) + #' Simulate chain statistics + chain_summary_raw <- simulate_summary( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Expectations + expect_invisible( + validate_epichains(susc_outbreak_raw) + ) + expect_invisible( + validate_epichains(susc_outbreak_raw2) + ) expect_invisible( - validate_epichains(epichains_summary) + validate_epichains(tree_sim_raw) ) expect_invisible( - validate_epichains(epichains_tree) + validate_epichains(tree_sim_raw2) ) expect_invisible( - validate_epichains(epichains_tree2) + validate_epichains(chain_summary_raw) + ) + expect_error( + validate_epichains(mtcars), + "must have an epichains class" ) }) test_that("is_chains_tree works", { + set.seed(12) + #' Simulate an outbreak from a susceptible population + susc_outbreak_raw <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + #' Simulate an outbreak from a susceptible population (nbinom) + susc_outbreak_raw2 <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "nbinom", + offspring_mean = 1, + offspring_disp = 1.1, + serials_dist = serial_func + ) + #' Simulate a tree of infections without serials + tree_sim_raw <- simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Simulate a tree of infections with serials + tree_sim_raw2 <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + serials_dist = function(x) 3, + lambda = 2 + ) + #' Simulate chain statistics + chain_summary_raw <- simulate_summary( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Expectations expect_true( - is_chains_tree(epichains_tree) + is_chains_tree(susc_outbreak_raw) ) expect_true( - is_chains_tree(epichains_tree2) + is_chains_tree(susc_outbreak_raw2) + ) + expect_true( + is_chains_tree(tree_sim_raw) + ) + expect_true( + is_chains_tree(tree_sim_raw2) ) expect_false( - is_chains_tree(epichains_summary) + is_chains_tree(chain_summary_raw) ) }) test_that("is_chains_summary works", { - expect_true( - is_chains_tree(epichains_tree) + set.seed(12) + #' Simulate an outbreak from a susceptible population + susc_outbreak_raw <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + #' Simulate an outbreak from a susceptible population (nbinom) + susc_outbreak_raw2 <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "nbinom", + offspring_mean = 1, + offspring_disp = 1.1, + serials_dist = serial_func + ) + #' Simulate a tree of infections without serials + tree_sim_raw <- simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Simulate a tree of infections with serials + tree_sim_raw2 <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + serials_dist = function(x) 3, + lambda = 2 ) + #' Simulate chain statistics + chain_summary_raw <- simulate_summary( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Expectations expect_true( - is_chains_tree(epichains_tree2) + is_chains_summary(chain_summary_raw) + ) + expect_false( + is_chains_summary(susc_outbreak_raw) + ) + expect_false( + is_chains_summary(susc_outbreak_raw2) + ) + expect_false( + is_chains_summary(tree_sim_raw) ) expect_false( - is_chains_tree(epichains_summary) + is_chains_summary(tree_sim_raw2) ) }) -test_that("is_epichains_aggregate_df works", { +test_that("aggregate.epichains method returns correct objects", { + set.seed(12) + #' Simulate a tree of infections with serials + tree_sim_raw2 <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + serials_dist = function(x) 3, + lambda = 2 + ) + #' Create aggregates + aggreg_by_gen <- aggregate( + tree_sim_raw2, + grouping_var = "generation" + ) + aggreg_by_time <- aggregate( + tree_sim_raw2, + grouping_var = "time" + ) + aggreg_by_both <- aggregate( + tree_sim_raw2, + grouping_var = "both" + ) + #' Expectations for class inheritance expect_true( is_epichains_aggregate_df(aggreg_by_gen) ) @@ -142,65 +432,98 @@ test_that("is_epichains_aggregate_df works", { expect_true( is_epichains_aggregate_df(aggreg_by_both) ) - expect_false( - is_epichains_aggregate_df(epichains_tree) - ) -}) - -test_that("validate_epichains throws errors", { - expect_error( - validate_epichains(mtcars), - "must have an epichains class" - ) -}) - -test_that("head and tail methods work", { - expect_snapshot(head(epichains_tree)) - expect_snapshot(head(epichains_tree2)) - expect_snapshot(tail(epichains_tree)) - expect_snapshot(tail(epichains_tree2)) -}) - -test_that("aggregate method work", { - expect_named( - aggreg_by_gen, - c("generation", "cases") - ) - expect_named( - aggreg_by_time, - c("time", "cases") - ) - expect_identical( - as.vector( - vapply(aggreg_by_both, names, FUN.VALUE = character(2)) - ), - c("time", "cases", "generation", "cases") - ) + #' Expectations for class inheritance expect_s3_class( aggreg_by_gen, - "epichains_aggregate_df" + "data.frame" ) expect_s3_class( aggreg_by_time, - "epichains_aggregate_df" + "data.frame" ) expect_s3_class( aggreg_by_both, - "epichains_aggregate_df" - ) - expect_error( - aggregate(epichains_summary), - "attribute" + "list" ) }) test_that("aggregate method is numerically correct", { + set.seed(12) + #' Simulate a tree of infections without serials + tree_sim_raw <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + lambda = 2 + ) + #' Simulate a tree of infections with serials + tree_sim_raw2 <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + serials_dist = function(x) 3, + lambda = 2 + ) + #' Create aggregates + aggreg_by_gen <- aggregate( + tree_sim_raw, + grouping_var = "generation" + ) + aggreg_by_time <- aggregate( + tree_sim_raw2, + grouping_var = "time" + ) expect_identical( aggreg_by_gen$cases, - c(10L, 17L, 38L, 38L, 12L) + c(10L, 12L, 19L, 26L, 14L) ) expect_identical( aggreg_by_time$cases, - c(10L, 21L, 48L, 60L) + c(10L, 17L, 38L, 38L, 12L) + ) +}) + +test_that("head and tail methods work", { + set.seed(12) + #' Simulate an outbreak from a susceptible population + susc_outbreak_raw <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + #' Simulate an outbreak from a susceptible population (nbinom) + susc_outbreak_raw2 <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "nbinom", + offspring_mean = 1, + offspring_disp = 1.1, + serials_dist = serial_func + ) + #' Simulate a tree of infections without serials + tree_sim_raw <- simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Simulate a tree of infections with serials + tree_sim_raw2 <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + serials_dist = function(x) 3, + lambda = 2 ) + expect_snapshot(head(susc_outbreak_raw)) + expect_snapshot(head(susc_outbreak_raw2)) + expect_snapshot(head(tree_sim_raw)) + expect_snapshot(head(tree_sim_raw2)) + expect_snapshot(tail(susc_outbreak_raw)) + expect_snapshot(tail(susc_outbreak_raw2)) + expect_snapshot(tail(tree_sim_raw)) + expect_snapshot(tail(tree_sim_raw2)) }) From 395641d11344a540a34a0cb926d406894e61f21f Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Tue, 19 Sep 2023 17:39:29 +0100 Subject: [PATCH 24/29] Restructure test-simulate by moving simulations into individual contexts --- tests/testthat/tests-simulate.R | 149 ++++++++++++++++++-------------- 1 file changed, 85 insertions(+), 64 deletions(-) diff --git a/tests/testthat/tests-simulate.R b/tests/testthat/tests-simulate.R index 1e36baaf..768be755 100644 --- a/tests/testthat/tests-simulate.R +++ b/tests/testthat/tests-simulate.R @@ -1,76 +1,61 @@ #' Define global variables and options for simulations -set.seed(12) serial_func <- function(n) { rlnorm(n, meanlog = 0.58, sdlog = 1.58) } -#' simulate_tree() -tree_sim_raw <- simulate_tree( - nchains = 2, - offspring_dist = "pois", - statistic = "length", - lambda = 0.9 -) - -tree_sim_summary <- summary(tree_sim_raw) - -#' simulate_summary() -chain_summary_raw <- simulate_summary( - nchains = 2, - offspring_dist = "pois", - statistic = "length", - lambda = 0.9 -) - -chain_summary_sim <- summary(chain_summary_raw) - -#' simulate_tree_from_pop() -susc_outbreak_raw <- simulate_tree_from_pop( - pop = 100, - offspring_dist = "pois", - offspring_mean = 0.9, - serials_dist = serial_func -) - -susc_outbreak_raw2 <- simulate_tree_from_pop( - pop = 100, - offspring_dist = "nbinom", - offspring_mean = 1, - offspring_disp = 1.1, - serials_dist = serial_func -) - -susc_outbreak_summary <- summary(susc_outbreak_raw) - -test_that("Simulators return epichains objects", { - expect_s3_class( - tree_sim_raw, - "epichains" - ) - expect_s3_class( - susc_outbreak_raw, - "epichains" - ) - expect_s3_class( - chain_summary_raw, - "epichains" - ) -}) - test_that("Simulators work", { + set.seed(12) + #' Simulate an outbreak from a susceptible population (pois) + susc_outbreak_raw <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + #' Simulate an outbreak from a susceptible population (nbinom) + susc_outbreak_raw2 <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "nbinom", + offspring_mean = 1, + offspring_disp = 1.1, + serials_dist = serial_func + ) + #' Simulate a tree of infections without serials + tree_sim_raw <- simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Simulate a tree of infections with serials + tree_sim_raw2 <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + serials_dist = function(x) 3, + lambda = 2 + ) + #' Simulate chain statistics + chain_summary_raw <- simulate_summary( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Expectations expect_length( - simulate_summary( - nchains = 2, - statistic = "size", - offspring_dist = "pois", - lambda = 0.5 - ), + chain_summary_raw, 2 ) expect_gte( nrow(tree_sim_raw), 2 ) + expect_gte( + nrow(tree_sim_raw2), + 2 + ) expect_gte( nrow(susc_outbreak_raw), 1 @@ -197,7 +182,6 @@ test_that("simulate_summary throws errors", { }) test_that("simulate_tree_from_pop throws errors", { - set.seed(123) expect_error( simulate_tree_from_pop( pop = 100, @@ -252,6 +236,17 @@ test_that("simulate_tree_from_pop throws warnings", { }) test_that("simulate_tree is numerically correct", { + set.seed(12) + #' Simulate a tree of infections without serials + tree_sim_raw <- simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' summarise the results + tree_sim_summary <- summary(tree_sim_raw) + #' Expectations expect_identical( tree_sim_summary$chains_ran, 2.00 @@ -283,21 +278,47 @@ test_that("simulate_tree is numerically correct", { }) test_that("simulate_summary is numerically correct", { + set.seed(12) + #' Simulate chain statistics + chain_summary_raw <- simulate_summary( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Summarise the results + chain_summary_summaries <- summary(chain_summary_raw) + #' Expectations expect_identical( - chain_summary_sim$max_chain_stat, + chain_summary_summaries$chain_ran, 2.00 ) expect_identical( - chain_summary_sim$min_chain_stat, + chain_summary_summaries$max_chain_stat, + 3.00 + ) + expect_identical( + chain_summary_summaries$min_chain_stat, 1.00 ) expect_identical( as.vector(chain_summary_raw), - c(2.00, 1.00) + c(1.00, 3.00) ) }) test_that("simulate_tree_from_pop is numerically correct", { + set.seed(12) + #' Simulate an outbreak from a susceptible population + susc_outbreak_raw <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + #' Summarise the results + susc_outbreak_summary <- summary(susc_outbreak_raw) + #' Expectations expect_identical( susc_outbreak_summary$unique_ancestors, 0L From e90b97266963e3aeb7ce7d85f5731875cce0aa3e Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Tue, 19 Sep 2023 17:42:00 +0100 Subject: [PATCH 25/29] Rename file --- tests/testthat/{tests-simulate.R => test-simulate.R} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename tests/testthat/{tests-simulate.R => test-simulate.R} (100%) diff --git a/tests/testthat/tests-simulate.R b/tests/testthat/test-simulate.R similarity index 100% rename from tests/testthat/tests-simulate.R rename to tests/testthat/test-simulate.R From d6aaa799e8f55388c9b7dbe4733d06e86b7205e0 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Tue, 19 Sep 2023 17:44:38 +0100 Subject: [PATCH 26/29] Linting --- tests/testthat/test-epichains.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-epichains.R b/tests/testthat/test-epichains.R index 3ad1c810..e842cd83 100644 --- a/tests/testthat/test-epichains.R +++ b/tests/testthat/test-epichains.R @@ -154,7 +154,7 @@ test_that("summary.epichains works as expected", { statistic = "length", lambda = 0.9 ) - #' Simulate case where all the chain statistics are Inf + #' Simulate case where all the chain statistics are Inf set.seed(11223) epichains_summary_all_infs <- simulate_summary( nchains = 10, @@ -277,8 +277,8 @@ test_that("validate_epichains works", { validate_epichains(chain_summary_raw) ) expect_error( - validate_epichains(mtcars), - "must have an epichains class" + validate_epichains(mtcars), + "must have an epichains class" ) }) From 537ceabdd233d2169135e3d6b76a8cca68eed734 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Tue, 19 Sep 2023 17:44:54 +0100 Subject: [PATCH 27/29] Linting --- tests/testthat/test-simulate.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-simulate.R b/tests/testthat/test-simulate.R index 768be755..4f454712 100644 --- a/tests/testthat/test-simulate.R +++ b/tests/testthat/test-simulate.R @@ -43,7 +43,7 @@ test_that("Simulators work", { statistic = "length", lambda = 0.9 ) - #' Expectations + #' Expectations expect_length( chain_summary_raw, 2 @@ -290,7 +290,7 @@ test_that("simulate_summary is numerically correct", { chain_summary_summaries <- summary(chain_summary_raw) #' Expectations expect_identical( - chain_summary_summaries$chain_ran, + chain_summary_summaries$chain_ran, 2.00 ) expect_identical( From 01c5ef90b8f62cc2433a0e244f0541fa27fbc2d6 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Tue, 19 Sep 2023 18:15:49 +0100 Subject: [PATCH 28/29] Add tests for the class of the head and tail methods --- tests/testthat/test-epichains.R | 70 ++++++++++++++++++++++++++++++++- 1 file changed, 69 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-epichains.R b/tests/testthat/test-epichains.R index e842cd83..98f58523 100644 --- a/tests/testthat/test-epichains.R +++ b/tests/testthat/test-epichains.R @@ -485,7 +485,7 @@ test_that("aggregate method is numerically correct", { ) }) -test_that("head and tail methods work", { +test_that("head and tail print output as expected", { set.seed(12) #' Simulate an outbreak from a susceptible population susc_outbreak_raw <- simulate_tree_from_pop( @@ -527,3 +527,71 @@ test_that("head and tail methods work", { expect_snapshot(tail(tree_sim_raw)) expect_snapshot(tail(tree_sim_raw2)) }) + +test_that("head and tail return data.frames", { + set.seed(12) + #' Simulate an outbreak from a susceptible population + susc_outbreak_raw <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "pois", + offspring_mean = 0.9, + serials_dist = serial_func + ) + #' Simulate an outbreak from a susceptible population (nbinom) + susc_outbreak_raw2 <- simulate_tree_from_pop( + pop = 100, + offspring_dist = "nbinom", + offspring_mean = 1, + offspring_disp = 1.1, + serials_dist = serial_func + ) + #' Simulate a tree of infections without serials + tree_sim_raw <- simulate_tree( + nchains = 2, + offspring_dist = "pois", + statistic = "length", + lambda = 0.9 + ) + #' Simulate a tree of infections with serials + tree_sim_raw2 <- simulate_tree( + nchains = 10, + statistic = "size", + offspring_dist = "pois", + stat_max = 10, + serials_dist = function(x) 3, + lambda = 2 + ) + #' Expectations + expect_s3_class( + head(susc_outbreak_raw), + "data.frame" + ) + expect_s3_class( + head(susc_outbreak_raw2), + "data.frame" + ) + expect_s3_class( + head(tree_sim_raw), + "data.frame" + ) + expect_s3_class( + head(tree_sim_raw2), + "data.frame" + ) + expect_s3_class( + tail(susc_outbreak_raw), + "data.frame" + ) + expect_s3_class( + tail(susc_outbreak_raw2), + "data.frame" + ) + expect_s3_class( + tail(tree_sim_raw), + "data.frame" + ) + expect_s3_class( + tail(tree_sim_raw2), + "data.frame" + ) +}) From 356a44cd2d0003985953017d12896078ad6e09d0 Mon Sep 17 00:00:00 2001 From: jamesaazam Date: Tue, 19 Sep 2023 18:16:02 +0100 Subject: [PATCH 29/29] Re-generate snaps --- tests/testthat/_snaps/epichains.md | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) diff --git a/tests/testthat/_snaps/epichains.md b/tests/testthat/_snaps/epichains.md index 66a761ec..bb23c3c1 100644 --- a/tests/testthat/_snaps/epichains.md +++ b/tests/testthat/_snaps/epichains.md @@ -99,7 +99,21 @@ Number of generations: 5 Use `as.data.frame()` to view the full output in the console. -# head and tail methods work +--- + + Code + chain_summary_raw + Output + `epichains` object + + [1] 4 1 + + Simulated chain lengths: + + Max: 4 + Min: 1 + +# head and tail print output as expected Code head(susc_outbreak_raw)