tests/testthat/test-samplers.R

In lucas-castillo/SampleR: Tools To Compare Human Performance To Sampling Algorithms

test_that("mcmc works for 1d distributions", {
  target <- distr::Norm(0,3)
  pd_func <- make_distr_pdf(target)
  set.seed(1)
  mcmc_results <- sampler_mcmc(pd_func, start = 0, iterations=10, sigma_prop = 1)
  expect_is(mcmc_results, "list")
  expect_is(mcmc_results[[1]], "matrix")
  expect_equal(length(mcmc_results[[1]]), 10)
})

test_that("mcmc works for 2d distributions", {
  pd_func <- function(x, log=FALSE){return(mvtnorm::dmvnorm(x, mean = c(1,2), sigma = diag(2) * 3, log = log))}
  set.seed(1)
  mcmc_results <- sampler_mcmc(pd_func, start = c(0,0), iterations=10, sigma_prop = diag(2))
  expect_is(mcmc_results, "list")
  expect_is(mcmc_results[[1]], "matrix")
  expect_equal(length(mcmc_results[[1]]), 20)
})


test_that("mc3 works for 1d distributions", {
  target <- distr::Norm(0,3)
  pd_func <- make_distr_pdf(target)
  set.seed(1)
  mc3_results <- sampler_mc3(pd_func, start = 0, iterations=10, sigma_prop = 1)
  expect_is(mc3_results, "list")
  expect_is(mc3_results[[1]], "array")
  expect_equal(length(mc3_results[[1]][,,1]), 10)
})

test_that("mc3 works for 2d distributions", {
  pd_func <- function(x, log=FALSE){return(mvtnorm::dmvnorm(x, mean = c(1,2), sigma = diag(2) * 3, log = log))}
  set.seed(1)
  mc3_results <- sampler_mc3(pd_func, start = c(0,0), iterations=10, sigma_prop = diag(2))
  expect_is(mc3_results, "list")
  expect_is(mc3_results[[1]], "array")
  expect_equal(length(mc3_results[[1]][,,1]), 20)
})


test_that("hmc works for 1d distributions", {
  target <- distr::Norm(0,3)
  pd_func <- make_distr_pdf(target)
  set.seed(1)
  hmc_results <- sampler_hmc(pd_func, epsilon = 1, L = 10, start = 0, iterations = 10)
  expect_is(hmc_results, "list")
  expect_is(hmc_results[[1]], "matrix")
  expect_equal(length(hmc_results[[1]]), 10)
})

test_that("hmc works for 2d distributions", {
  pd_func <- function(x, log=FALSE){return(mvtnorm::dmvnorm(x, mean = c(1,2), sigma = diag(2) * 3, log = log))}
  set.seed(1)
  hmc_results <- sampler_hmc(pd_func, epsilon = 1, L = 10, start = c(0,0), iterations = 10)
  expect_is(hmc_results, "list")
  expect_is(hmc_results[[1]], "array")
  expect_equal(length(hmc_results[[1]]), 20)
})

test_that("nuts works for 1d distributions", {
  target <- distr::Norm(0,3)
  pd_func <- make_distr_pdf(target)
  set.seed(1)
  nuts_results <- sampler_nuts(pd_func, start = 0, iterations = 10, epsilon = 1)
  expect_is(nuts_results, "matrix")
  expect_equal(length(nuts_results), 10)
})

test_that("nuts works for 2d distributions", {
  pd_func <- function(x, log=FALSE){return(mvtnorm::dmvnorm(x, mean = c(1,2), sigma = diag(2) * 3, log = log))}
  set.seed(1)
  nuts_results <- sampler_nuts(pd_func, start = c(0,0), iterations = 10, epsilon = 1)
  expect_is(nuts_results, "matrix")
  expect_equal(length(nuts_results), 20)
})