tests/testthat/test-proposal.r

In rbi.helpers: 'rbi' Helper Functions

context("Testing generating multivariate proposals")

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

model_str <- "
model test {
  const no_a = 2
  const no_b = 3
  dim a(no_a)
  dim b(no_b)

  obs M[a]

  state N[a] (has_input = 0)
  noise e[a, b]
  param m[a, b]
  param p

  sub parameter {
    m[0,0] ~ beta()
    m[0,1] ~ gamma()
    m[0,2] ~ gaussian(mean = 1)
    m[1,b] ~ truncated_gaussian(mean = 1, lower = m[0,b])
    p ~ uniform(lower = 0, upper = 1)
  }

  sub initial {
    N[a] <- 1
  }

  sub transition {
    e[a, b] ~ gaussian(mean = m[a,b])
    N[a] <- N[a] + e[a, 0] +
       e[a, 1]
  }

  sub observation {
    inline x = m
    M[a] ~ gaussian(mean = N[a])
  }
}
"

model <- rbi::bi_model(lines = stringi::stri_split_lines(model_str)[[1]])
bi <- rbi::libbi(model, dims = list(a = c("first", "second")))
test_output <- Map(
  function(x) {
    if (is.data.frame(x)) x$value <- abs(rnorm(nrow(x)))
    x
  },
  list(
    e = data.frame(
      expand.grid(time = 0:1, a = c("first", "second"), b = 0:2, np = 0:1)
    ),
    N = data.frame(
      expand.grid(time = 0:1, a = c("first", "second"), np = 0:1)
    ),
    m = data.frame(expand.grid(a = c("first", "second"), b = 0:2, np = 0:1)),
    p = data.frame(np = 0:1),
    close = 0,
    loglikelihood = data.frame(np = 0:1),
    logprior = data.frame(np = 0:1)
  )
)
bi <- rbi::attach_data(bi, "output", test_output)
test_that("multivariate proposals can be generated with multiple parameters", {
  skip_on_cran()

  updated_model <- update_proposal(model)
  bi$model <- updated_model

  expect_gt(length(get_mvn_params(bi)), 0)
  expect_gt(length(get_mvn_params(bi, fix = 0)), 0)
})

test_that("multivariate proposals can be generated with one parameter", {

  skip_on_cran()

  updated_model <- update_proposal(model)
  bi$model <- updated_model

  bi$model <- rbi::fix(bi$model, m = 0)
  test_output$m <- NULL
  test_output$p$value <- 1 ## no variation
  bi <- rbi::attach_data(bi, "output", test_output)
  expect_gt(length(get_mvn_params(bi)), 0)

  test_output$p$value <- 1 ## no variation
  expect_gt(length(get_mvn_params(bi)), 0)
})

test_that("multivariate proposals can be generated if covariance is 0", {

  skip_on_cran()

  updated_model <- update_proposal(model)
  bi$model <- updated_model

  test_output$m$value <- 1
  test_output$p$value <- 1
  bi <- rbi::attach_data(bi, "output", test_output)

  expect_gt(length(get_mvn_params(bi)), 0)
})

test_that("errors are reported", {
  expect_error(update_proposal(3), "must be a")
})