diff --git a/DESCRIPTION b/DESCRIPTION index 1de9d49a..2569d935 100644 --- a/DESCRIPTION +++ b/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 = "rich.fitzjohn@gmail.com"), person("Wes", "Hinsley", role = "aut"), diff --git a/R/model.R b/R/model.R index c0111b8a..80123b7e 100644 --- a/R/model.R +++ b/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) } diff --git a/tests/testthat/_snaps/sample-manual.md b/tests/testthat/_snaps/sample-manual.md index 43d29471..f3b4c1b4 100644 --- a/tests/testthat/_snaps/sample-manual.md +++ b/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 '' + i Created + i 50 steps x 2 chains + i This is a restart + x No chains complete + diff --git a/tests/testthat/test-combine.R b/tests/testthat/test-combine.R index 913ff6e8..89ec6ac3 100644 --- a/tests/testthat/test-combine.R +++ b/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))) }) diff --git a/tests/testthat/test-example.R b/tests/testthat/test-example.R index e8b5dd96..07e67509 100644 --- a/tests/testthat/test-example.R +++ b/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) +}) diff --git a/tests/testthat/test-model.R b/tests/testthat/test-model.R index 337d6364..6338c6ab 100644 --- a/tests/testthat/test-model.R +++ b/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, "", + 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, "", + 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) +}) diff --git a/tests/testthat/test-sample-manual.R b/tests/testthat/test-sample-manual.R index 6fae9d68..9f1aa5d0 100644 --- a/tests/testthat/test-sample-manual.R +++ b/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")