tests/testthat/test-adapt.r

In rbi.helpers: 'rbi' Helper Functions

context("Testing functions for adapting")

library(data.table)
set.seed(12124)
setDTthreads(1)

model <- system.file(package = "rbi", "PZ.bi")
example_output <- rbi::bi_read(
  system.file(package = "rbi", "example_output.nc")
)
bi <- rbi::libbi(model, nparticles = 1)
bi <- rbi::attach_data(bi, "output", example_output)
obs <- list(P_obs = data.frame(time = 0, value = 1.485121))

test_that("pMCMC adaptation works", {
  skip_on_cran()
  suppressWarnings(capture.output(
    prop_adapted <-
      adapt_proposal(bi,
        obs = obs, nsamples = 100, min = 0.5, max = 0.53,
        adapt = "both", seed = 3
      )
  ))
  prop_adapted2 <- adapt_proposal(
    prop_adapted, with = "transform-initial-to-param", min = 0.4, max = 0.5,
    adapt = "shape", seed = 5, scale = 0.5, quiet = TRUE
  )
  capture.output(part_adapted <- adapt_particles(prop_adapted, seed = 1))
  capture.output(part_adapted2 <- adapt_particles(bi, seed = 1, obs = obs))
  expect_true(part_adapted$options$nparticles > 0)
  expect_gt(length(bi_read(prop_adapted, file = "input")), 0)
  expect_gt(
    length(
      bi_read(adapt_proposal(prop_adapted, min = 0, max = 1), file = "input")
    ), 0
  )
})

test_that("warnings are given", {
  expect_warning(adapt_proposal(bi, size = TRUE, adapt = "shape"), "adapt size")
  expect_warning(
    adapt_proposal(bi, correlations = TRUE, adapt = "size"), "adapt shape"
  )
})

test_that("errors are reported", {
  expect_error(
    acceptance_rate(rbi::extract_sample(bi, 0), model = model),
    "just one sample"
  )
  expect_error(adapt_particles(bi, min = 1, max = 0), "greater")
  expect_error(adapt_proposal(bi, min = 1, max = 0), "max>min")
  expect_error(adapt_proposal(bi, adapt = "test"), "one of")
})

test_that("deprecated options are recognised", {
  expect_warning(adapt_proposal(bi, size = TRUE), "adapt")
  expect_warning(adapt_proposal(bi, correlations = TRUE), "adapt")
})