tests/testthat/test-dualframe.R

In fieldopt: Area-Frame and Dual-Frame Survey Design under Real Field Cost

domains <- data.frame(domain = c("a", "ab", "b"), size = c(8000, 1500, 500), mean = c(5, 40, 60), sd = c(6, 30, 50))

test_that("dual-frame allocation optimises theta and respects the target", {
  opt <- dual_frame_allocation(domains, cost_a = 200, cost_b = 40, budget = 1e5)
  expect_s3_class(opt, "fieldopt_dual_frame")
  expect_lte(opt$cost, 1e5)
  for (t in c(0, 0.5, 1)) {
    fixed <- dual_frame_allocation(domains, cost_a = 200, cost_b = 40, theta = t, budget = 1e5)
    expect_lte(opt$variance, fixed$variance + 1e-6)
  }
  scr <- dual_frame_allocation(domains, cost_a = 200, cost_b = 40, theta = "screening", budget = 1e5)
  expect_equal(scr$theta, 0)
  expect_equal(opt$total, sum(domains$size * domains$mean))
  cv <- dual_frame_allocation(domains, cost_a = 200, cost_b = 40, target_cv = 0.05)
  expect_lte(cv$cv, 0.05 + 1e-6)
  expect_gt(cv$cv, 0.045)
  expect_equal(cv$overlap_a, cv$n_a * 1500 / 9500)
  deff <- dual_frame_allocation(domains, cost_a = 200, cost_b = 40, deff_a = 2, target_cv = 0.05)
  expect_gt(deff$cost, cv$cost)
  expect_error(dual_frame_allocation(domains, 200, 40), "exactly one")
  expect_error(dual_frame_allocation(domains[-1, ], 200, 40, budget = 1), "rows")
  expect_error(dual_frame_allocation(domains, 200, 40, theta = 2, budget = 1e5), "theta")
  expect_message(print(opt), "optimised")
})

test_that("two-stage allocation follows Cochran", {
  a <- two_stage_allocation(5000, 20, 4, 25, c1 = 300, c2 = 20, budget = 1e5)
  expect_s3_class(a, "fieldopt_two_stage")
  expect_equal(a$m_optimal, sqrt(300 * 25 / (20 * (4 - 25 / 20))), tolerance = 1e-9)
  expect_equal(a$m, 12)
  expect_lte(a$cost, 1e5)
  b <- two_stage_allocation(5000, 20, 4, 25, c1 = 300, c2 = 20, target_cv = 0.03, mean = 12)
  expect_lte(b$cv, 0.03)
  expect_gt(b$cv, 0.028)
  v <- two_stage_allocation(5000, 20, 4, 25, c1 = 300, c2 = 20, target_variance = b$variance_total)
  expect_lte(abs(v$n - b$n), 1)
  expect_error(two_stage_allocation(5000, 20, 4, 25, 300, 20, target_cv = 0.1), "mean")
  expect_error(two_stage_allocation(5000, 20, 4, 25, 300, 20), "exactly one")
  expect_message(print(b), "Two-stage")
})