diff --git a/tests/testthat/helper-fits.R b/tests/testthat/helper-fits.R index a9ed0b5..54bc6f4 100644 --- a/tests/testthat/helper-fits.R +++ b/tests/testthat/helper-fits.R @@ -11,7 +11,7 @@ #' @param model A list of (unnamed) formulas #' @param simulated Parameter values to be used for simulation. test_fit = function(model, simulated) { - testthat::skip_if(is.null(options("test_mcp_fits")[[1]]), + testthat::skip_if(is.null(getOption("test_mcp_fits")), "This time-consuming test is only run locally before release. Set options(test_mcp_fits = TRUE) to run.") # Simulate diff --git a/tests/testthat/helper-runs.R b/tests/testthat/helper-runs.R index 8748afa..47b8973 100644 --- a/tests/testthat/helper-runs.R +++ b/tests/testthat/helper-runs.R @@ -306,6 +306,7 @@ test_pp_eval = function(fit) { # Rutine for testing a list of erroneous models test_bad = function(models, ...) { for (model in models) { + stopifnot(all(sapply(model, is.formula))) test_name = paste0(as.character(substitute(models)), ": ", paste0(model, collapse=", ")) @@ -317,9 +318,20 @@ test_bad = function(models, ...) { # Routine for testing a list of good models -test_good = function(models, ...) { +test_good = function(essential, extensive = list(), ...) { + stopifnot(is.list(essential)) + stopifnot(is.list(extensive)) + + if (is.null(getOption("test_mcp_allmodels"))) { + models = essential + } else { + models = c(essential, extensive) + } + for (model in models) { - test_name = paste0(as.character(substitute(models)), ": + stopifnot(is.list(model)) + stopifnot(all(sapply(model, is.formula))) + test_name = paste0(as.character(substitute(essential)), ": ", paste0(model, collapse=", ")) testthat::test_that(test_name, { diff --git a/tests/testthat/test-runs-bernoulli-binomial.R b/tests/testthat/test-runs-bernoulli-binomial.R index ed64e33..8cdee83 100644 --- a/tests/testthat/test-runs-bernoulli-binomial.R +++ b/tests/testthat/test-runs-bernoulli-binomial.R @@ -30,19 +30,22 @@ test_bad(bad_binomial, family = binomial()) -good_binomial = list( - list(y | trials(N) ~ 1), # one segment - list(y | trials(N) ~ 1 + x, # specified multiple times and with rel() - y | trials(N) ~ 1 ~ rel(1) + rel(x), - rel(1) ~ 0), +good_binomial_essential = list( list(y | trials(N) ~ 1, # With varying 1 + (1|id) ~ 1), list(y | trials(N) ~ 1 + ar(1)) # Simple AR(1) #list(y | trials(N) ~ 1, # 1 ~ N) # N can be both trials and slope. TO DO: Fails in this test because par_x = "x" ) +good_binomial_extensive = list( + list(y | trials(N) ~ 1), # one segment + list(y | trials(N) ~ 1 + x, # specified multiple times and with rel() + y | trials(N) ~ 1 ~ rel(1) + rel(x), + rel(1) ~ 0) +) -test_good(good_binomial, +test_good(good_binomial_essential, + good_binomial_extensive, data = data_binomial, family = binomial()) @@ -75,16 +78,19 @@ test_bad(bad_bernoulli, family = bernoulli()) -good_bernoulli = list( +good_bernoulli_essential = list( + list(y_bern ~ 1, # With varying + 1 + (1|id) ~ 1) +) +good_bernoulli_extensive = list( list(y_bern ~ 1), # one segment list(y_bern ~ 1 + x, # specified multiple times and with rel() y_bern ~ 1 ~ rel(1) + rel(x), - rel(1) ~ 0), - list(y_bern ~ 1, # With varying - 1 + (1|id) ~ 1) + rel(1) ~ 0) ) -test_good(good_bernoulli, +test_good(good_bernoulli_essential, + good_bernoulli_extensive, data = data_binomial, family = bernoulli()) diff --git a/tests/testthat/test-runs-formulas-gauss.R b/tests/testthat/test-runs-formulas-gauss.R index 935caf4..f185dbd 100644 --- a/tests/testthat/test-runs-formulas-gauss.R +++ b/tests/testthat/test-runs-formulas-gauss.R @@ -16,16 +16,18 @@ bad_y = list( test_bad(bad_y) -good_y = list( - list(y ~ 1), # Regular +good_y_essential = list( list(y ~ 1, # Explicit and implicit y and cp y ~ 1 ~ 1, rel(1) + (1|id) ~ rel(1) + x, - ~ 1), + ~ 1) +) +good_y_extensive = list( + list(y ~ 1), # Regular list(ok_y ~ 1) # decimal y ) -test_good(good_y) +test_good(good_y_essential, good_y_extensive) @@ -104,21 +106,23 @@ test_bad(bad_slopes) -good_slopes = list( - list(y ~ 0 + x), # Regular +good_slopes_essential = list( list(y ~ 0 + x, # Multiple on/off ~ 0, ~ 1 + x), + list(y ~ 0 + x + I(x^2) + I(x^3), # Test "non-linear" x + ~ 0 + exp(x) + abs(x), + ~ 0 + sin(x) + cos(x) + tan(x)) +) +good_slopes_extensive = list( + list(y ~ 0 + x), # Regular list(y ~ x, # Chained relative slopes ~ 0 + rel(x), ~ rel(x)), - list(y ~ 0 + x + I(x^2) + I(x^3), # Test "non-linear" x - ~ 0 + exp(x) + abs(x), - ~ 0 + sin(x) + cos(x) + tan(x)), list(y ~ ok_x) # alternative x ) -test_good(good_slopes, par_x = NULL) +test_good(good_slopes_essential, good_slopes_extensive, par_x = NULL) @@ -143,25 +147,28 @@ bad_cps = list( test_bad(bad_cps) -good_cps = list( - list(y ~ 0 + x, # Regular cp - 1 ~ 1), +good_cps_essential = list( list(y ~ 1, # Implicit cp ~ 1, ~ 0), list(y ~ 0, # Varying 1 + (1|id) ~ 1), + + list(y ~ 1, + 1 + (1|id) ~ 1, + 1 + (1|ok_id_integer) ~ 1, # multiple groups and alternative data + 1 + (1|ok_id_factor) ~ 1) # alternative group data +) +good_cps_extensive = list( + list(y ~ 0 + x, # Regular cp + 1 ~ 1), list(y ~ 0, # Chained varying and relative cp y ~ 1 ~ 1, rel(1) + (1|id) ~ 0, rel(1) + (1|id) ~ 0, ~ x), list(y ~ 1, - (1|id) ~ 0), # Intercept is implicit. I don't like it, but OK. - list(y ~ 1, - 1 + (1|id) ~ 1, - 1 + (1|ok_id_integer) ~ 1, # multiple groups and alternative data - 1 + (1|ok_id_factor) ~ 1) # alternative group data + (1|id) ~ 0) # Intercept is implicit. I don't like it, but OK. ) -test_good(good_cps) +test_good(good_cps_essential, good_cps_extensive) diff --git a/tests/testthat/test-runs-poisson.R b/tests/testthat/test-runs-poisson.R index 3736f2d..43d2b11 100644 --- a/tests/testthat/test-runs-poisson.R +++ b/tests/testthat/test-runs-poisson.R @@ -19,17 +19,21 @@ test_bad(bad_poisson, family = poisson()) -good_poisson = list( - list(y ~ 1), # one segment - list(y ~ 1 + x, # specified multiple times and with rel() - y ~ 1 ~ rel(1) + rel(x), - rel(1) ~ 0), +good_poisson_essential = list( list(y ~ 1, # With varying 1 + (1|id) ~ 1), list(y ~ 1 + ar(1), ~ 1 + x + ar(2, 1 + x + I(x^3))) ) -test_good(good_poisson, +good_poisson_extensive = list( + list(y ~ 1), # one segment + list(y ~ 1 + x, # specified multiple times and with rel() + y ~ 1 ~ rel(1) + rel(x), + rel(1) ~ 0) +) + +test_good(good_poisson_essential, + good_poisson_extensive, data = data_binomial, family = poisson()) diff --git a/tests/testthat/test-runs-prior.R b/tests/testthat/test-runs-prior.R index cb9aab0..dd59e08 100644 --- a/tests/testthat/test-runs-prior.R +++ b/tests/testthat/test-runs-prior.R @@ -26,29 +26,42 @@ for (prior in bad_prior) { } -good_prior = list( +good_prior_essential = list( list( # Fixed values and non-default change point int_2 = "int_1", cp_1 = "dnorm(3, 10)", x_2 = "-0.5" ), - list( # Outside the observed range allowed - cp_1 = "dunif(-100, -90)", - cp_2 = "dnorm(100, 20) T(100, 110)" - ), + list( cp_1 = "dirichlet(1)", # Dirichlet prior on change points cp_2 = "dirichlet(1)" + ) +) +good_prior_extensive = list( + list( # Changepoint outside of the observed range is allowed + cp_1 = "dunif(-100, -90)", + cp_2 = "dnorm(100, 20) T(100, 110)" ), + list( cp_1 = "dirichlet(3)", # Dirichlet prior on change points cp_2 = "dirichlet(2)" ) ) -for (prior in good_prior) { - test_name = paste0("Good priors: ", paste0(prior, collapse=", ")) +for (prior in good_prior_essential) { + test_name = paste0("Good priors (essential): ", paste0(prior, collapse=", ")) testthat::test_that(test_name, { test_runs(prior_model, prior = prior) }) } + +if (is.null(getOption("test_mcp_allmodels")) == FALSE) { + for (prior in good_prior_extensive) { + test_name = paste0("Good priors (extensive): ", paste0(prior, collapse=", ")) + testthat::test_that(test_name, { + test_runs(prior_model, prior = prior) + }) + } +} diff --git a/tests/testthat/test-runs-sigma-arma.R b/tests/testthat/test-runs-sigma-arma.R index 4d641b4..6abf312 100644 --- a/tests/testthat/test-runs-sigma-arma.R +++ b/tests/testthat/test-runs-sigma-arma.R @@ -11,21 +11,24 @@ bad_variance = list( test_bad(bad_variance) -good_variance = list( - list(y ~ 1 + sigma(1)), +good_variance_essential = list( list(y ~ 1 + sigma(x + I(x^2))), - list(y ~ 1 + sigma(1 + sin(x))), - list(y ~ 1, - ~ 0 + sigma(rel(1)), # test relative intercept - ~ x + sigma(x), - ~ 0 + sigma(rel(x))), # test relative slope list(y ~ 1, 1 + (1|id) ~ rel(1) + I(x^2) + sigma(rel(1) + x)), # Test with varying change point and more mcp stuff list(y | weights(weights_ok) ~ 1 + sigma(1 + x), # With weights ~ 0 + sigma(1 + rel(x))) ) -test_good(good_variance) +good_variance_extensive = list( + list(y ~ 1 + sigma(1)), + list(y ~ 1 + sigma(1 + sin(x))), + list(y ~ 1, + ~ 0 + sigma(rel(1)), # test relative intercept + ~ x + sigma(x), + ~ 0 + sigma(rel(x))) # test relative slope +) + +test_good(good_variance_essential, good_variance_extensive) ############# @@ -47,22 +50,25 @@ bad_arma = list( test_bad(bad_arma) -good_arma = list( - list(y ~ ar(1)), # simple - list(y ~ ar(5)), # higher order - list(y ~ ar(1, 1 + x + I(x^2) + exp(x))), # complicated regression +good_arma_essential = list( list(y ~ ar(1), ~ ar(2, 0 + x)), # change in ar list(y ~ 1, ~ 0 + ar(2)), # onset of AR - list(y ~ 1, - 1 + (1|id) ~ rel(1) + I(x^2) + ar(2, rel(1) + x)), # varying change point list(y ~ ar(1) + sigma(1 + x), - ~ ar(2, 1 + I(x^2)) + sigma(1)), # With sigma + ~ ar(2, 1 + I(x^2)) + sigma(1)) # With sigma +) + +good_arma_extensive = list( + list(y ~ ar(1)), # simple + list(y ~ ar(5)), # higher order + list(y ~ ar(1, 1 + x + I(x^2) + exp(x))), # complicated regression list(y ~ ar(1), ~ ar(2, rel(1))), # Relative to no variance. Perhaps alter this behavior so it becomes illegal? + list(y ~ 1, + 1 + (1|id) ~ rel(1) + I(x^2) + ar(2, rel(1) + x)), # varying change point list(y | weights(weights_ok) ~ 1 + ar(1), # With weights ~ 0 + ar(2, 1 + x)) ) -test_good(good_arma) +test_good(good_arma_essential, good_arma_extensive)