disable verbosity for failing chains

DESCRIPTION

@@ -2,7 +2,7 @@ Type: Package
 Package: EpiNow2
 Title: Estimate Real-Time Case Counts and Time-Varying
     Epidemiological Parameters
-Version: 1.3.6.9001
+Version: 1.3.6.9002
 Authors@R: 
     c(person(given = "Sam",
              family = "Abbott",

NEWS.md

@@ -23,6 +23,7 @@ This release is in development. For a stable release install 1.3.5 from CRAN.
 * A small bug has been fixed where the seeding time was too long. When a single delay is used this shortens the seeding time by one day and when more delays are used it shortens the seeding time by n days where n is the number of delays used e.g. for two parametric delays it's two days. By @sbfnk in #413 and reviewed by @seabbs.
 * Some tuning was done to speed up the renewal model. By @sbfnk in #416 and reviewed by @seabbs.
 * An approximation of the negative binomial by the Poisson at low levels of overdispersion was disabled as it led to parameter identification issues. By @sbfnk in #432 and reviewed by @seabbs.
+* Reduced verbosity of tests. By @sbfnk in #433 and reviewed by @seabbs.
 
 # EpiNow2 1.3.5
 

R/estimate_infections.R

@@ -324,13 +324,12 @@ estimate_infections <- function(reported_cases,
 
   # Initialise fitting by using a previous fit or fitting to cumulative cases
   if (!is.null(args$init_fit)) {
-    if (!inherits(args$init_fit, "stanfit")) {
-      if (args$init_fit %in% "cumulative") {
-        args$init_fit <- init_cumulative_fit(args,
-          warmup = 50, samples = 50,
-          id = id, verbose = FALSE
-        )
-      }
+    if (!inherits(args$init_fit, "stanfit") &&
+          args$init_fit %in% "cumulative") {
+      args$init_fit <- init_cumulative_fit(args,
+        warmup = 50, samples = 50,
+        id = id, verbose = FALSE
+      )
     }
     args$init <- extract_inits(args$init_fit,
       current_inits = args$init,
@@ -543,7 +542,7 @@ fit_model_with_nuts <- function(args, future = FALSE, max_execution_time = Inf,
       )
     }
 
-    if (is.null(fit) || length(names(fit)) == 0) {
+    if (is.null(fit) || !is.array(fit)) {
       return(NULL)
     } else {
       return(fit)
@@ -659,15 +658,13 @@ fit_model_with_vb <- function(args, future = FALSE, id = "stan") {
   }
 
   if (is.null(fit)) {
-    if (is.null(fit)) {
-      futile.logger::flog.error(
-        "%s: Fitting failed - try increasing stan_args$trials or inspecting",
-        " the model input",
-        id,
-        name = "EpiNow2.epinow.estimate_infections.fit"
-      )
-      rlang::abort("Variational Inference failed due to: ", error)
-    }
+    futile.logger::flog.error(
+      "%s: Fitting failed - try increasing stan_args$trials or inspecting",
+      " the model input",
+      id,
+      name = "EpiNow2.epinow.estimate_infections.fit"
+    )
+    rlang::abort("Variational Inference failed due to: ", error)
   }
   return(fit)
 }

tests/testthat/test-estimate_infections.R

@@ -81,8 +81,16 @@ test_that("estimate_infections successfully returns estimates using a random wal
 
 test_that("estimate_infections fails as expected when given a very short timeout", {
   skip_on_cran()
-  expect_error(default_estimate_infections(reported_cases, add_stan = list(future = TRUE, max_execution_time = 1)))
-  expect_error(default_estimate_infections(reported_cases, add_stan = list(future = FALSE, max_execution_time = 1)))
+  expect_error(output <- capture.output(suppressMessages(
+    out <- default_estimate_infections(
+      reported_cases,
+      add_stan = list(future = TRUE, max_execution_time = 1)
+  ))), "all chains failed")
+  expect_error(output <- capture.output(suppressMessages(
+    out <- default_estimate_infections(
+      reported_cases,
+      add_stan = list(future = FALSE, max_execution_time = 1)
+  ))), "timed out")
 })
 
 

tests/testthat/test-estimate_secondary.R

@@ -54,7 +54,7 @@ prev <- estimate_secondary(cases[1:100],
     week_effect = FALSE,
     scale = list(mean = 0.4, sd = 0.1)
   ),
-  verbose = TRUE
+  verbose = FALSE
 )
 
 # extract posterior parameters of interest

tests/testthat/test-regional_epinow.R

@@ -51,8 +51,8 @@ test_that("regional_epinow produces expected output when run with default settin
 })
 
 test_that("regional_epinow runs without error when given a very short timeout", {
-  expect_error(
-    regional_epinow(
+  output <- capture.output(suppressMessages(
+    out <- regional_epinow(
       reported_cases = cases,
       generation_time = generation_time_opts(generation_time),
       delays = delay_opts(reporting_delay),
@@ -62,11 +62,11 @@ test_that("regional_epinow runs without error when given a very short timeout",
         control = list(adapt_delta = 0.8),
         max_execution_time = 1
       ), logs = NULL, verbose = FALSE
-    ),
-    NA
-  )
-  expect_error(
-    regional_epinow(
+    )
+  ))
+  expect_true(all(vapply(out$regional, function(x) !is.null(x$error), TRUE)))
+  output <- capture.output(suppressMessages(
+    out <- regional_epinow(
       reported_cases = cases,
       generation_time = generation_time_opts(generation_time),
       delays = delay_opts(reporting_delay),
@@ -76,9 +76,9 @@ test_that("regional_epinow runs without error when given a very short timeout",
         control = list(adapt_delta = 0.8),
         max_execution_time = 1, future = TRUE
       ), logs = NULL, verbose = FALSE
-    ),
-    NA
-  )
+    )
+  ))
+  expect_true(all(vapply(out$regional, function(x) !is.null(x$error), TRUE)))
 })