tests/testthat/test-initialization.R

In jaatha: Simulation-Based Maximum Likelihood Parameter Estimation

context("Initialization")

test_that("determining block per par works", {
  expect_equal(determine_bpp(2, 1), 1)
  expect_equal(determine_bpp(2, 2), 2)
  expect_equal(determine_bpp(2, 3), 2)
  expect_equal(determine_bpp(2, 4), 2)
  expect_equal(determine_bpp(2, 5), 3)
  expect_equal(determine_bpp(2, 9), 5)
  
  expect_equal(determine_bpp(3, 1), 1)
  expect_equal(determine_bpp(3, 2), 2)
  expect_equal(determine_bpp(3, 3), 2)
  expect_equal(determine_bpp(3, 4), 2)
  expect_equal(determine_bpp(3, 5), 2)
  expect_equal(determine_bpp(3, 9), 3)
})


test_that("creation of initial blocks works", {
  par_ranges <- par_ranges_class$new(matrix(1:4, 2, 2))
  expect_equal(1, length(create_initial_blocks(par_ranges, 1)))
  expect_equal(4, length(create_initial_blocks(par_ranges, 2)))
  expect_equal(6, length(create_initial_blocks(par_ranges, 3)))
  expect_equal(8, length(create_initial_blocks(par_ranges, 4)))
  par_ranges <- par_ranges_class$new(matrix(1:6, 3, 2))
  expect_equal(1, length(create_initial_blocks(par_ranges, 1)))
  expect_equal(6, length(create_initial_blocks(par_ranges, 2)))
  expect_equal(9, length(create_initial_blocks(par_ranges, 3)))
  expect_equal(12, length(create_initial_blocks(par_ranges, 4)))
})


test_that("a complete initial search works", {
  model <- create_test_model()
  data <- create_test_data(model)
  
  sim_cache <- create_sim_cache()
  par <- do_initial_search(model, data, 1, sim = 20, cores = 1, sim_cache)
  expect_that(par, is_a("matrix"))
  expect_equal(dim(par), c(1, model$get_par_number()))
  expect_true(all(par >= 0 & par <= 1))
  
  sim_cache <- create_sim_cache()
  par <- do_initial_search(model, data, 3, sim = 20, cores = 1, sim_cache)
  expect_that(par, is_a("matrix"))
  expect_equal(dim(par), c(3, model$get_par_number()))
  expect_true(all(par >= 0 & par <= 1))
  
  sim_cache <- create_sim_cache()
  par <- do_initial_search(model, data, 4, sim = 20, cores = 1, sim_cache)
  expect_that(par, is_a("matrix"))
  expect_equal(dim(par), c(4, model$get_par_number()))
  expect_true(all(par >= 0 & par <= 1))
})


test_that("zoom-in search works", {
  model <- create_test_model()
  data <- create_test_data(model)
  
  sim_cache <- create_sim_cache()
  par <- do_zoom_in_search(model, data, 1, sim = 20, cores = 1, sim_cache, 0.05)
  expect_that(par, is_a("matrix"))
  expect_equal(dim(par), c(1, model$get_par_number()))
  expect_true(all(par >= 0 & par <= 1))
  
  sim_cache <- create_sim_cache()
  par <- do_zoom_in_search(model, data, 2, sim = 20, cores = 1, sim_cache, 0.1)
  expect_that(par, is_a("matrix"))
  expect_equal(dim(par), c(2, model$get_par_number()))
  expect_true(all(par >= 0 & par <= 1))
  
  sim_cache <- create_sim_cache()
  par <- do_zoom_in_search(model, data, 3, sim = 20, cores = 1, sim_cache, 0.2)
  expect_that(par, is_a("matrix"))
  expect_equal(dim(par), c(3, model$get_par_number()))
  expect_true(all(par >= 0 & par <= 1))
})


test_that("the initialization supports one-parameter models", {
  model <- create_jaatha_model(function(x) rpois(10, x),
                               par_ranges = matrix(c(0.1, 10), 1, 2),
                               sum_stats = list(stat_identity(), stat_sum()),
                               test = FALSE)
  data <- create_test_data(model)
  sim_cache <- create_sim_cache()
  
  for (method in c("zoom-in", "initial-search", "random", "middle")) {
    par <- get_start_pos(model, data, 2, 20, method, cores = 1, 
                         sim_cache = sim_cache, block_width = 0.05)
    expect_that(par, is_a("matrix"))
    expect_equal(dim(par), c(2, 1))
  }
})


test_that("getting the start positions works", {
  model <- create_test_model()
  data <- create_test_data(model)
  
  # middle
  sim_cache <- create_sim_cache()
  expect_equal(get_start_pos(model, data, 1, 20, "middle", 1, sim_cache),
               matrix(0.5, 1, model$get_par_number()))
  expect_equal(get_start_pos(model, data, 2, 20, "middle", 1, sim_cache),
               matrix(0.5, 2, model$get_par_number()))
  expect_equal(get_start_pos(model, data, 3, 20, "middle", 1, sim_cache),
               matrix(0.5, 3, model$get_par_number()))
  
  # random
  pos <- get_start_pos(model, data, 1, 20, "random", 1, sim_cache)
  expect_equal(dim(pos), c(1, 2))
  expect_equal(length(unique(pos)), 2)
  expect_true(all(pos >= 0 & pos <= 1))
  
  pos <- get_start_pos(model, data, 2, 20, "random", 1, sim_cache)
  expect_equal(dim(pos), c(2, 2))
  expect_equal(length(unique(pos)), 4)
  expect_true(all(pos >= 0 & pos <= 1))
  
  pos <- get_start_pos(model, data, 3, 20, "random", 1, sim_cache)
  expect_equal(dim(pos), c(3, 2))
  expect_equal(length(unique(pos)), 6)
  expect_true(all(pos >= 0 & pos <= 1))
  
  
  # initial search
  sim_cache <- create_sim_cache()
  pos <- get_start_pos(model, data, 1, 20, "initial-search", 1, sim_cache, 0.05)
  expect_that(pos, is_a("matrix"))
  expect_true(all(pos >= 0 & pos <= 1))
  
  # zoom-in
  sim_cache <- create_sim_cache()
  pos <- get_start_pos(model, data, 1, 20, "zoom-in", 1, sim_cache, 0.05)
  expect_that(pos, is_a("matrix"))
  expect_true(all(pos >= 0 & pos <= 1))
  
  # errors
  sim_cache <- create_sim_cache()
  expect_error(get_start_pos(model, data, 1, 20, "1", 1, sim_cache, 0.05))
  expect_error(get_start_pos(model, data, 1, 20, 1, 1, sim_cache, 0.1))
})


test_that("zoom-in search works when there are simulation errors", {
  model <-   create_jaatha_model(function(x) stop("NO!"),
                                 par_ranges = matrix(c(0.1, 0.1, 10, 10), 2, 2),
                                 sum_stats = list(stat_identity(), stat_sum()),
                                 test = FALSE)
  
  data <- create_test_data(create_test_model())
  sim_cache <- create_sim_cache()
  expect_warning(
    start_pos <- get_start_pos(model, data, 2, 20, "zoom-in", 
                               1, sim_cache, 0.05)
  )
  expect_equal(start_pos, matrix(.5, 2, 2))
})