tests/testthat/test-model-simulation.R

In coala: A Framework for Coalescent Simulation

context("Model Simulation")

test_that("basic models can be simulated", {
  expect_error(simulate(model_theta_tau(), pars = 1))
  expect_error(simulate(model_theta_tau(), pars = 1:3))
  expect_error(simulate(model_theta_tau(), pars = c(2, 50)))
  sum_stats <- simulate(model_theta_tau(), pars = c(1, 5))
  expect_true(is.list(sum_stats))
  expect_false(is.null(sum_stats$jsfs))
  expect_true(sum(sum_stats$jsfs) > 0)
})


test_that("parallel simulations are reproducible", {
  skip_on_os("windows")
  model <- coal_model(10) + feat_mutation(5) + sumstat_seg_sites() +
    locus_single(10) + locus_single(10) + locus_single(10) + locus_single(10)

  res <- simulate(model, seed = 215, cores = 2)
  expect_false(identical(res[[1]], res[[2]]))

  res2 <- simulate(model, seed = 215, cores = 2)
  expect_equal(res, res2)

  res3 <- simulate(model, seed = 215, cores = 1)
  expect_equal(res, res3)

  set.seed(215)
  res4 <- simulate(model, cores = 2)
  expect_equal(res, res4)
})


test_that("models with multiple loci groups can be simulated", {
  model <- model_theta_tau() + locus_averaged(2, 100) + sumstat_seg_sites()
  sum_stats <- simulate(model, pars = c(1, 5))
  expect_equal(length(sum_stats$seg_sites), get_locus_number(model))
})


test_that("model without ranged parameters can be simualted", {
  model <- coal_model(5, 1) + feat_mutation(5) + sumstat_sfs("sfs")
  stat <- simulate(model)
  expect_false(is.null(stat$sfs))
})


test_that("models with priors can be simulated", {
  model <- coal_model(5, 1) +
    feat_mutation(5) +
    feat_recombination(par_prior("r", stats::rbinom(1, 3, .5))) +
    sumstat_sfs("sfs")
  stats <- simulate(model)
  expect_equal(names(stats$pars), "r")
  expect_true(all(stats$pars %in% 0:3))
})


test_that("priors are sampled for every repetition", {
  model <- coal_model(5, 1) +
    feat_mutation(par_prior("theta", stats::rexp(1))) +
    sumstat_sfs("sfs")
  stats <- simulate(model, nsim = 2)
  expect_true(stats[[1]]$pars != stats[[2]]$pars)

  skip_on_os("windows")
  stats <- simulate(model, nsim = 2, cores = 2, seed = 17)
  expect_true(stats[[1]]$pars != stats[[2]]$pars)
})


test_that("simulating with more than one repetition works", {
  sim <- simulate(model_theta_tau(), 2, seed = 17, pars = c(1, 5))
  expect_that(sim, is_a("list"))
  expect_equal(length(sim), 2)
  expect_equal(sim[[1]]$pars, c(tau = 1, theta = 5))
  expect_equal(sim[[2]]$pars, c(tau = 1, theta = 5))
})