tests/testthat/test-ei_summary_random.R

In eiballots: Ballot-Level Microdata and Summaries for Ecological Inference (Florida 2000)

# tests/testthat/test-ei_summary_random.R
# Tests for ei_summary_random().
# All tests use synthetic data passed via the `data` argument.

# ----------------------------------------------------------------------------
# Helper (same as test-ei_summary.R)
# ----------------------------------------------------------------------------

make_test_data <- function(n = 300, seed = 42) {
  set.seed(seed)
  data.frame(
    COUNTY   = "Lee",
    PRECINCT = sample(paste0("P", 1:5), n, replace = TRUE),
    PRE      = sample(c("R", "D", "O", "A"), n, replace = TRUE,
                      prob = c(0.50, 0.40, 0.05, 0.05)),
    USS      = sample(c("R", "D", "O", "A", NA), n, replace = TRUE,
                      prob = c(0.40, 0.33, 0.04, 0.04, 0.19)),
    HOS3     = sample(c("Bau", "Duf", "BauDuf", "BerDuf", "A"), n,
                      replace = TRUE, prob = c(0.25, 0.25, 0.25, 0.20, 0.05)),
    D21      = sample(c("Y", "N", "A", NA), n, replace = TRUE,
                      prob = c(0.42, 0.35, 0.05, 0.18)),
    stringsAsFactors = FALSE
  )
}


# ----------------------------------------------------------------------------
# Basic structure
# ----------------------------------------------------------------------------

test_that("ei_summary_random() returns an ei_summary object", {
  obj <- ei_summary_random("PRE", data = make_test_data(), seed = 1)
  expect_s3_class(obj, "ei_summary")
})

test_that("ei_summary_random() has meta$random element", {
  obj <- ei_summary_random("PRE", data = make_test_data(), seed = 1)
  expect_true(!is.null(obj$meta$random))
  expect_named(obj$meta$random,
               c("method", "n_units", "unit_sizes", "seed",
                 "n_units_arg", "unit_size_arg", "size_range_arg"))
})

test_that("meta$random$seed matches the seed argument", {
  obj <- ei_summary_random("PRE", data = make_test_data(), seed = 99)
  expect_equal(obj$meta$random$seed, 99)
})

test_that("unit_sizes sum to n_voters", {
  obj <- ei_summary_random(c("PRE", "USS"), data = make_test_data(), seed = 1)
  expect_equal(sum(obj$meta$random$unit_sizes), obj$meta$n_voters)
})

test_that("precinct ids in result use zero-padded unit labels", {
  obj <- ei_summary_random("PRE", data = make_test_data(), seed = 1)
  expect_true(all(grepl("^rnd_unit_", obj$meta$precinct_info$precinct_id)))
})

# ----------------------------------------------------------------------------
# Default behaviour (same number of units as real precincts)
# ----------------------------------------------------------------------------

test_that("default: same number of units as real precincts", {
  d    <- make_test_data()
  real <- ei_summary("PRE", data = d)
  rnd  <- ei_summary_random("PRE", data = d, seed = 1)
  expect_equal(rnd$meta$n_precincts, real$meta$n_precincts)
})

test_that("default: total voters preserved", {
  d    <- make_test_data()
  real <- ei_summary("PRE", data = d)
  rnd  <- ei_summary_random("PRE", data = d, seed = 1)
  expect_equal(rnd$meta$n_voters, real$meta$n_voters)
})

test_that("default: vote totals are the same as real (only grouping changes)", {
  d    <- make_test_data()
  real <- ei_summary("PRE", data = d)
  rnd  <- ei_summary_random("PRE", data = d, seed = 1)
  opt_cols <- setdiff(names(real$margins$PRE),
                      c("precinct_id", "county_id", "n_voters"))
  for (opt in opt_cols) {
    expect_equal(sum(rnd$margins$PRE[[opt]]),
                 sum(real$margins$PRE[[opt]]),
                 label = sprintf("total votes for option '%s'", opt))
  }
})


# ----------------------------------------------------------------------------
# Reproducibility
# ----------------------------------------------------------------------------

test_that("same seed produces identical results", {
  d    <- make_test_data()
  obj1 <- ei_summary_random("PRE", data = d, seed = 7)
  obj2 <- ei_summary_random("PRE", data = d, seed = 7)
  expect_identical(obj1$margins$PRE, obj2$margins$PRE)
})

test_that("different seeds produce different groupings", {
  d    <- make_test_data(n = 1000, seed = 42)
  obj1 <- ei_summary_random("PRE", data = d, n_units = 10, seed = 1)
  obj2 <- ei_summary_random("PRE", data = d, n_units = 10, seed = 2)
  # With 10 units and 1000 voters, different seeds should give different sizes
  expect_false(identical(obj1$margins$PRE$n_voters,
                         obj2$margins$PRE$n_voters))
})


# ----------------------------------------------------------------------------
# n_units argument
# ----------------------------------------------------------------------------

test_that("n_units controls the number of random units", {
  obj <- ei_summary_random("PRE", data = make_test_data(),
                            n_units = 3, seed = 1)
  expect_equal(obj$meta$n_precincts, 3L)
  expect_equal(obj$meta$random$n_units, 3L)
})

test_that("n_units = 1 puts all voters in one unit", {
  obj <- ei_summary_random("PRE", data = make_test_data(),
                            n_units = 1, seed = 1)
  expect_equal(obj$meta$n_precincts, 1L)
  expect_equal(nrow(obj$margins$PRE), 1L)
})


# ----------------------------------------------------------------------------
# unit_size argument
# ----------------------------------------------------------------------------

test_that("unit_size controls size of each unit", {
  d   <- make_test_data()
  obj <- ei_summary_random("PRE", data = d, unit_size = 50, seed = 1)
  # All units except possibly the last should have size 50
  sizes <- obj$meta$random$unit_sizes
  expect_true(all(sizes[-length(sizes)] == 50L))
})

test_that("unit_size: sizes sum to n_voters", {
  obj <- ei_summary_random("PRE", data = make_test_data(),
                            unit_size = 60, seed = 1)
  expect_equal(sum(obj$meta$random$unit_sizes), obj$meta$n_voters)
})

test_that("unit_size takes precedence over n_units with a warning", {
  expect_warning(
    obj <- ei_summary_random("PRE", data = make_test_data(),
                              unit_size = 50, n_units = 10, seed = 1),
    regexp = "'n_units' ignored"
  )
  sizes <- obj$meta$random$unit_sizes
  expect_true(all(sizes[-length(sizes)] == 50L))
})

test_that("unit_size takes precedence over size_range with a warning", {
  expect_warning(
    obj <- ei_summary_random("PRE", data = make_test_data(),
                              unit_size = 50, size_range = c(30, 80),
                              seed = 1),
    regexp = "'size_range' ignored"
  )
  sizes <- obj$meta$random$unit_sizes
  expect_true(all(sizes[-length(sizes)] == 50L))
})


# ----------------------------------------------------------------------------
# size_range argument
# ----------------------------------------------------------------------------

test_that("size_range: all unit sizes within bounds (except possible residual)", {
  d   <- make_test_data()
  obj <- ei_summary_random("PRE", data = d,
                            size_range = c(20, 80), seed = 1)
  sizes <- obj$meta$random$unit_sizes
  # All but the last (residual) must be within range
  if (length(sizes) > 1L)
    expect_true(all(sizes[-length(sizes)] >= 20L &
                      sizes[-length(sizes)] <= 80L))
})

test_that("size_range: sizes sum to n_voters", {
  obj <- ei_summary_random("PRE", data = make_test_data(),
                            size_range = c(20, 80), seed = 1)
  expect_equal(sum(obj$meta$random$unit_sizes), obj$meta$n_voters)
})

test_that("size_range + n_units: correct number of units created", {
  obj <- ei_summary_random("PRE", data = make_test_data(),
                            n_units = 4, size_range = c(20, 100),
                            seed = 1)
  expect_equal(obj$meta$n_precincts, 4L)
})


# ----------------------------------------------------------------------------
# Compatibility with ei_summary methods
# ----------------------------------------------------------------------------

test_that("ei_summary_random() output works with to_eipack()", {
  obj  <- ei_summary_random(c("PRE", "USS"), data = make_test_data(),
                             seed = 1)
  wide <- to_eipack(obj)
  expect_s3_class(wide$margins, "data.frame")
  expect_true(any(grepl("^PRE_",  names(wide$margins))))
  expect_true(any(grepl("^USS_",  names(wide$margins))))
})

test_that("ei_summary_random() output works with subset_elections()", {
  obj3 <- ei_summary_random(c("PRE", "USS", "HOS3"),
                             data = make_test_data(), seed = 1)
  obj2 <- subset_elections(obj3, c("PRE", "USS"))
  expect_equal(obj2$meta$elections, c("PRE", "USS"))
  expect_equal(length(dim(obj2$joint_precinct)), 3L)
})

test_that("ei_summary_random() single race has NULL joint objects", {
  obj <- ei_summary_random("PRE", data = make_test_data(), seed = 1)
  expect_null(obj$joint_precinct)
  expect_null(obj$joint_total)
})

test_that("ei_summary_random() vote totals match ei_summary() totals", {
  d    <- make_test_data()
  real <- ei_summary(c("PRE", "USS"), data = d)
  rnd  <- ei_summary_random(c("PRE", "USS"), data = d, seed = 1)
  for (e in c("PRE", "USS")) {
    opt_cols <- setdiff(names(real$margins[[e]]),
                        c("precinct_id", "county_id", "n_voters"))
    for (opt in opt_cols) {
      expect_equal(
        sum(rnd$margins[[e]][[opt]]),
        sum(real$margins[[e]][[opt]]),
        label = sprintf("%s option '%s': random vs real total", e, opt)
      )
    }
  }
})


# ----------------------------------------------------------------------------
# Error handling
# ----------------------------------------------------------------------------

test_that("ei_summary_random() errors on unknown race code", {
  expect_error(
    ei_summary_random("ZZZNOPE", data = make_test_data()),
    regexp = "not found in catalog"
  )
})

test_that("ei_summary_random() errors when n_units > N", {
  expect_error(
    ei_summary_random("PRE", data = make_test_data(), n_units = 9999),
    regexp = "n_units"
  )
})

test_that("ei_summary_random() errors when unit_size > N", {
  expect_error(
    ei_summary_random("PRE", data = make_test_data(), unit_size = 9999),
    regexp = "unit_size"
  )
})

test_that("ei_summary_random() errors on malformed size_range", {
  expect_error(
    ei_summary_random("PRE", data = make_test_data(),
                      size_range = c(100, 10)),
    regexp = "size_range"
  )
})