Merge pull request #128 from mrc-ide/mrc-6110

Fix coverage holes

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: monty
 Title: Monte Carlo Models
-Version: 0.3.16
+Version: 0.3.17
 Authors@R: c(person("Rich", "FitzJohn", role = c("aut", "cre"),
                     email = "[email protected]"),
              person("Wes", "Hinsley", role = "aut"),

R/model.R

@@ -686,4 +686,5 @@ print.monty_model_properties <- function(x, ...) {
   if (any(unset)) {
     cli::cli_alert_info("Unset: {squote(names(x)[unset])}")
   }
+  invisible(x)
 }

tests/testthat/_snaps/sample-manual.md

@@ -9,3 +9,15 @@
       i 100 steps x 2 chains
       x No chains complete
 
+# can print information about a continued sample
+
+    Code
+      monty_sample_manual_info(path)
+    Message
+      
+      -- Manual monty sampling at '<PATH>'
+      i Created <DATE>
+      i 50 steps x 2 chains
+      i This is a restart
+      x No chains complete
+

tests/testthat/test-combine.R

@@ -18,11 +18,14 @@ test_that("can combine a model with direct_sample and one without", {
     parameters = "x",
     density = function(x) dexp(x, log = TRUE)))
   ab <- a + b
+  ba <- b + a
   expect_equal(ab$properties, a$properties)
+  expect_equal(ba$properties, a$properties)
 
-  r1 <- monty_rng_create(seed = 42)
-  r2 <- monty_rng_create(seed = 42)
-  expect_equal(ab$direct_sample(r1), a$direct_sample(r2))
+  expect_equal(ab$direct_sample(monty_rng_create(seed = 42)),
+               a$direct_sample(monty_rng_create(seed = 42)))
+  expect_equal(ba$direct_sample(monty_rng_create(seed = 42)),
+               a$direct_sample(monty_rng_create(seed = 42)))
 })
 
 

tests/testthat/test-example.R

@@ -3,3 +3,15 @@ test_that("error if unexpected example used", {
     monty_example("unknown"),
     "'name' must be one of")
 })
+
+
+test_that("can use banana", {
+  m <- monty_example("banana")
+  r1 <- monty_rng_create(seed = 1, n_streams = 1)
+  r2 <- monty_rng_create(seed = 1, n_streams = 2)
+  x1 <- m$direct_sample(r1)
+  x2 <- m$direct_sample(r2)
+  expect_null(dim(x1))
+  expect_equal(dim(x2), c(2, 2))
+  expect_equal(unname(x2[, 1]), x1)
+})

tests/testthat/test-model.R

@@ -256,3 +256,30 @@ test_that("can print information about simple models", {
   expect_match(res$messages, "can be directly sampled from",
                fixed = TRUE, all = FALSE)
 })
+
+
+test_that("can print information about model properties", {
+  p <- monty_model_properties()
+  res <- evaluate_promise(withVisible(print(p)))
+  expect_equal(res$result, list(value = p, visible = FALSE))
+  expect_match(res$messages, "<monty_model_properties>",
+               fixed = TRUE, all = FALSE)
+  expect_false(any(grepl("is_stochastic:", res$messages)))
+  expect_match(res$messages, "Unset:",
+               fixed = TRUE, all = FALSE)
+})
+
+
+test_that("can print information about model properties that are set", {
+  p <- monty_model_properties(is_stochastic = TRUE, has_observer = TRUE)
+  res <- evaluate_promise(withVisible(print(p)))
+  expect_equal(res$result, list(value = p, visible = FALSE))
+  expect_match(res$messages, "<monty_model_properties>",
+               fixed = TRUE, all = FALSE)
+  expect_match(res$messages, "is_stochastic:",
+               fixed = TRUE, all = FALSE)
+  expect_match(res$messages, "has_observer:",
+               fixed = TRUE, all = FALSE)
+  expect_match(res$messages, "Unset:",
+               fixed = TRUE, all = FALSE)
+})

tests/testthat/test-sample-manual.R

@@ -146,6 +146,19 @@ test_that("can print information about a manual sample", {
 })
 
 
+test_that("can print information about a continued sample", {
+  model <- ex_simple_gamma1()
+  sampler <- monty_sampler_random_walk(vcv = diag(1) * 0.01)
+  base <- monty_sample(model, sampler, 100, n_chains = 2, restartable = TRUE)
+
+  path <- withr::local_tempdir()
+  monty_sample_manual_prepare_continue(base, 50, path)
+  expect_snapshot(
+    monty_sample_manual_info(path),
+    transform = scrub_manual_info)
+})
+
+
 test_that("can print information about chain completeness", {
   expect_message(sample_manual_info_chain(c(TRUE, TRUE)),
                  "All chains complete")