Nothing
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")
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.