tests/testthat/test.sampling.R

In lsasim: Functions to Facilitate the Simulation of Large Scale Assessment Data

context("Sampling alternatives on cluster_gen")

cluster_gen_wrap <- function(samp, clab = NULL, rlab = NULL, seed = 9674731) {
  set.seed(seed)
  enn <- list(3, rep(20, 3))
  ENN <- list(6, seq(30, 80, 10))
  cluster_gen(
    enn, ENN, cluster_labels = clab, resp_labels = rlab,
    calc_weights = TRUE, sampling_method = samp, verbose = FALSE
  )
}

data_default <- cluster_gen_wrap("mixed")
data_sch_stu <- cluster_gen_wrap("mixed", "school", "student")
data_sch_stu_pps <- cluster_gen_wrap("PPS", "school", "student")
data_sch_stu_srs <- cluster_gen_wrap("SRS", "school", "student")
data_skl_elv_mix <- cluster_gen_wrap("mixed", "skole", "elev")
data_skl_elv_srs <- cluster_gen_wrap("SRS", "skole", "elev")
data_skl_elv_pps <- cluster_gen_wrap("PPS", "skole", "elev")

extract_weights <- function(data) {
  w_cols <- c("school.weight", "within.school.weight", "final.student.weight")
  out <- list(
    vapply(data[["school"]], function(x) x[[w_cols[1]]], numeric(20)),
    vapply(data[["school"]], function(x) x[[w_cols[2]]], numeric(20)),
    vapply(data[["school"]], function(x) x[[w_cols[3]]], numeric(20))
  )
  out
}

test_that("Sampling weights are the expected", {
  expect_equal(extract_weights(data_default), extract_weights(data_sch_stu))
  expect_equal(extract_weights(data_default), extract_weights(data_sch_stu_pps))
  expect_false(
    identical(extract_weights(data_default), extract_weights(data_sch_stu_srs))
  )
  expect_equal(
    extract_weights(data_skl_elv_mix), extract_weights(data_skl_elv_srs)
  )
  expect_false(
    identical(extract_weights(data_skl_elv_mix), extract_weights(data_sch_stu_pps))
  )
})