Merge pull request #157 from lindeloev/v0.3.3

Skip dev-only tests on CI (including CRAN)

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

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, {

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())
 

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)

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())

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)
+    })
+  }
+}

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)