tests/testthat/test.clusterSamples.R

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

context("Basic cluster sampling")
wrap_cluster_gen <- function(...) {
  cluster_gen(..., family = "gaussian", verbose = FALSE)
}

# Basic argument handling =====================================================
test_that("Basic argument handling generates data", {
  df01 <- wrap_cluster_gen(1:2)
  df02 <- wrap_cluster_gen(2:4)
  df03 <- wrap_cluster_gen(2:4, cluster_labels = LETTERS[1:2])
  df04 <- wrap_cluster_gen(2:3, resp_labels = LETTERS[1:2])
  df05 <- wrap_cluster_gen(2:4,
    cluster_labels = LETTERS[1:2],
    resp_labels = LETTERS[3:5]
  )
  df06 <- wrap_cluster_gen(2:3, n_X = 1)
  df07 <- wrap_cluster_gen(2:3, n_X = 1, n_W = 1)
  df08 <- wrap_cluster_gen(2:3, n_X = 2:3, n_W = 3)
  df09 <- wrap_cluster_gen(2:3, n_X = 0, n_W = list(5, 2))
  df10 <- wrap_cluster_gen(rep(10, 3),
    c_mean = list(c(1, 10), c(1e2, 1e3)), n_X = 2
  )
  df11 <- wrap_cluster_gen(2:4,
    separate_questionnaires = FALSE,
    c_mean = c(1, 10), n_X = 2
  )
  df12 <- wrap_cluster_gen(2:4, collapse = "partial")
  df13 <- wrap_cluster_gen(2:4, collapse = "full")
  df14 <- wrap_cluster_gen(2:4,
    collapse = "full",
    separate_questionnaires = FALSE
  )

  expect_output(str(df01), "List of 1")
  expect_output(str(df02), "List of 2")
  expect_equal(names(df03), LETTERS[1:2])
  expect_equal(df04$school[[1]]$uniqueID[1], "A1_school1")
  expect_equal(df05$B[[3]]$uniqueID[4], "D4_B3_A1")
  expect_equal(
    as.vector(sapply(
      df06$school,
      function(c) sapply(c[1:3], class)
    )),
    rep(c("integer", "numeric", "factor"), 2)
  )
  expect_equal(as.vector(sapply(df07$school, function(c) sapply(c, class))),
               rep(c("integer", "numeric", "factor",
                   rep("numeric", "numeric", 3), "character"), 2))
  expect_equal(as.vector(sapply(df08$school, function(c) sapply(c, class))),
               rep(c("integer", rep("numeric", 2), rep("factor", 3),
                     rep("numeric", 3), "character"), 2))
  expect_output(str(df09$school[[1]]$q1), "Factor w/ 5 levels")
  expect_output(str(df09$school[[1]]$q2), "Factor w/ 2 levels")
  expect_output(str(df09$school[[2]]$q1), "Factor w/ 5 levels")
  expect_output(str(df09$school[[2]]$q2), "Factor w/ 2 levels")
  expect_equivalent(sapply(df10, function(x) apply(x[[1]][2:3], 2, mean))[, 1],
                    c(1, 10), tolerance = .5)
  expect_equivalent(sapply(df10, function(x) apply(x[[2]][2:3], 2, mean))[, 1],
                    c(1, 10), tolerance = .5)
  expect_equivalent(sapply(df10, function(x) apply(x[[1]][2:3], 2, mean))[, 2],
                    c(1e2, 1e3), tolerance = .5)
  expect_equivalent(sapply(df10, function(x) apply(x[[2]][2:3], 2, mean))[, 2],
                    c(1e2, 1e3), tolerance = .5)
  expect_output(str(df11), "List of 6")
  expect_output(str(df12), "List of 2")
  expect_output(str(df13), "24 obs.")
  expect_output(str(df14), "24 obs.")
})

# Errors are caught ===========================================================
test_that("Errors are caught", {
  expect_error(cluster_gen(1))
  expect_error(cluster_gen(2:4, separate_questionnaires = FALSE, n_X = 1:2))
  expect_error(cluster_gen(2:4, separate_questionnaires = FALSE, n_W = 1:2))
  expect_error(cluster_gen(2:4, cluster_labels = "a"))
  expect_warning(cluster_gen(2:4, separate_quest = FALSE, collapse = "partial",
                             verbose = FALSE))
})

# uniqueIDs are correct =======================================================
test_that("uniqueIDs are correct", {
  wrap_cluster_gen_2 <- function(..., coll = "full", return_all = FALSE,
                                 verb = FALSE) {
    data <- cluster_gen(..., n_X = 0, n_W = 1, family = "gaussian",
                        verbose = verb, collapse = coll)
    if (!return_all) data <- data[, 6]
    return(data)  # corresponds to the bottom level's uniqueID
  }
  scheme1 <- list(1, 2, c(1, 2), c(3, 2, 3))
  scheme2 <- list(2, c(3, 2), c(1, 1, 2, 3, 2), rep(2, 9))

  df1 <- wrap_cluster_gen_2(2:4)
  df2 <- wrap_cluster_gen_2(2:4, separate_questionnaires = FALSE)
  df3 <- wrap_cluster_gen_2(scheme1)
  df4 <- wrap_cluster_gen_2(scheme1, separate_questionnaires = FALSE)
  df6 <- wrap_cluster_gen_2(scheme2)
  df7 <- wrap_cluster_gen_2(scheme2, separate_questionnaires = FALSE)
  df8 <- wrap_cluster_gen(c(2, 3, 4), n_X = 1, n_W = 1, c_mean = 10,
                          cluster_labels = c("school", "class"),
                          resp_labels = c("teacher", "student"),
                          separate_questionnaires = FALSE)
  expect_equal(df1,
    c("student1_class1_school1", "student2_class1_school1",
      "student3_class1_school1", "student4_class1_school1",
      "student1_class1_school2", "student2_class1_school2",
      "student3_class1_school2", "student4_class1_school2",
      "student1_class2_school1", "student2_class2_school1",
      "student3_class2_school1", "student4_class2_school1",
      "student1_class2_school2", "student2_class2_school2",
      "student3_class2_school2", "student4_class2_school2",
      "student1_class3_school1", "student2_class3_school1",
      "student3_class3_school1", "student4_class3_school1",
      "student1_class3_school2", "student2_class3_school2",
      "student3_class3_school2", "student4_class3_school2")
  )
  expect_equal(df2,
    c("student1_class1_school1", "student2_class1_school1",
     "student3_class1_school1", "student4_class1_school1",
     "student1_class2_school1", "student2_class2_school1",
     "student3_class2_school1", "student4_class2_school1",
     "student1_class3_school1", "student2_class3_school1",
     "student3_class3_school1", "student4_class3_school1",
     "student1_class1_school2", "student2_class1_school2",
     "student3_class1_school2", "student4_class1_school2",
     "student1_class2_school2", "student2_class2_school2",
     "student3_class2_school2", "student4_class2_school2",
     "student1_class3_school2", "student2_class3_school2",
     "student3_class3_school2", "student4_class3_school2")
  )
  expect_equal(df3,
    c("student1_class1_school1_state1", "student2_class1_school1_state1",
    "student3_class1_school1_state1", "student1_class1_school2_state1",
    "student2_class1_school2_state1", "student1_class2_school2_state1",
    "student2_class2_school2_state1", "student3_class2_school2_state1")
  )
  expect_equal(df4,
    c("student1_class1_school1_state1", "student2_class1_school1_state1",
    "student3_class1_school1_state1", "student1_class1_school2_state1",
    "student2_class1_school2_state1", "student1_class2_school2_state1",
    "student2_class2_school2_state1", "student3_class2_school2_state1")
  )
  expect_equal(df6,
    c("student1_class1_school1_state1", "student2_class1_school1_state1",
    "student1_class1_school1_state2", "student2_class1_school1_state2",
    "student1_class1_school2_state1", "student2_class1_school2_state1",
    "student1_class1_school2_state2", "student2_class1_school2_state2",
    "student1_class1_school3_state1", "student2_class1_school3_state1",
    "student1_class2_school1_state2", "student2_class2_school1_state2",
    "student1_class2_school2_state2", "student2_class2_school2_state2",
    "student1_class2_school3_state1", "student2_class2_school3_state1",
    "student1_class3_school1_state2", "student2_class3_school1_state2")
  )
  expect_equal(df7,
    c("student1_class1_school1_state1", "student2_class1_school1_state1",
    "student1_class1_school2_state1", "student2_class1_school2_state1",
    "student1_class1_school3_state1", "student2_class1_school3_state1",
    "student1_class2_school3_state1", "student2_class2_school3_state1",
    "student1_class1_school1_state2", "student2_class1_school1_state2",
    "student1_class2_school1_state2", "student2_class2_school1_state2",
    "student1_class3_school1_state2", "student2_class3_school1_state2",
    "student1_class1_school2_state2", "student2_class1_school2_state2",
    "student1_class2_school2_state2", "student2_class2_school2_state2")
  )
})

# Named n vector ==============================================================
test_that("Named vectors are working properly", {
  df1 <- cluster_gen(n       = c("land" = 1, "skole" = 3, "klasse" = 2),
                     verbose = FALSE,
                     collapse = "full")
  df2 <- cluster_gen(n       = list("pais" = 1, "cidade" = 4,
                                    "escola" = 1:4, "estudante" = rep(1, 10)),
                    verbose = FALSE,
                    collapse = "full")
  expect_equal(df1$uniqueID, c("klasse1_skole1_land1", "klasse2_skole1_land1",
                               "klasse1_skole2_land1", "klasse2_skole2_land1",
                               "klasse1_skole3_land1", "klasse2_skole3_land1"))
  expect_equal(df2$uniqueID, c("estudante1_escola1_cidade1_pais1",
    "estudante1_escola1_cidade2_pais1", "estudante1_escola1_cidade3_pais1",
    "estudante1_escola1_cidade4_pais1", "estudante1_escola2_cidade2_pais1",
    "estudante1_escola2_cidade3_pais1", "estudante1_escola2_cidade4_pais1",
    "estudante1_escola3_cidade3_pais1", "estudante1_escola3_cidade4_pais1",
    "estudante1_escola4_cidade4_pais1"))
})

# Different means =============================================================
test_that("Different means are working", {
  wrap_c_gen_mu <- function(...) {
    cluster_gen(..., n_X = 2, n_W = 0, family = "gaussian",
                verbose = FALSE, calc_weights = FALSE)
  }
  df1 <- wrap_c_gen_mu(c(2, 1000))
  df2 <- wrap_c_gen_mu(c(2, 1000), c_mean = 10)
  df3 <- wrap_c_gen_mu(c(2, 1000), c_mean = c(10, 100))
  df4 <- wrap_c_gen_mu(c(2, 1000), c_mean = list(list(c(10, 100), c(20, 200))))
  df5 <- wrap_c_gen_mu(n      = c(school = 2, class = 3, student = 1000),
                      c_mean = list(
                          school = list(c(10, 100), c(20, 200)),
                          class  = list(c(30, 300), c(40, 400), c(50, 500),
                                        c(60, 600), c(70, 700), c(80, 800))
                          )
                      )
  mean_Xs <- function(x) colMeans(x[2:3])
  expect_equivalent(sapply(df1$school, mean_Xs)[, 1], c(0, 0), tol = .5)
  expect_equivalent(sapply(df1$school, mean_Xs)[, 2], c(0, 0), tol = .5)
  expect_equivalent(sapply(df2$school, mean_Xs)[, 1], c(10, 10), tol = .5)
  expect_equivalent(sapply(df2$school, mean_Xs)[, 2], c(10, 10), tol = .5)
  expect_equivalent(sapply(df3$school, mean_Xs)[, 1], c(10, 100), tol = .5)
  expect_equivalent(sapply(df3$school, mean_Xs)[, 2], c(10, 100), tol = .5)
  expect_equivalent(sapply(df4$school, mean_Xs)[, 1], c(10, 100), tol = .5)
  expect_equivalent(sapply(df4$school, mean_Xs)[, 2], c(20, 200), tol = .5)
  expect_equivalent(sapply(df5$school, mean_Xs)[, 1], c(10, 100), tol = .5)
  expect_equivalent(sapply(df5$school, mean_Xs)[, 2], c(20, 200), tol = .5)
  expect_equivalent(sapply(df5$class, mean_Xs)[, 1], c(30, 300), tol = .5)
  expect_equivalent(sapply(df5$class, mean_Xs)[, 2], c(40, 400), tol = .5)
  expect_equivalent(sapply(df5$class, mean_Xs)[, 3], c(50, 500), tol = .5)
  expect_equivalent(sapply(df5$class, mean_Xs)[, 4], c(60, 600), tol = .5)
  expect_equivalent(sapply(df5$class, mean_Xs)[, 5], c(70, 700), tol = .5)
  expect_equivalent(sapply(df5$class, mean_Xs)[, 6], c(80, 800), tol = .5)
})

# Sampling weights =============================================================
context("Sampling weights")
calc_weights <- function(data_list) {
  w <- sapply(data_list, function(x) colSums(x[4:6]))
  w_sum <- rowSums(w)
  w_1_i <- w_sum[1]
  n_i_w_ij <- w_sum[3]
  out <- c(w_1_i, n_i_w_ij)
  return(out)
}

# Example from PISA manual tables ==============================================
test_that("Weights and labels from PISA examples are correct", {
  wrap_cl_gen <- function(n, N, meth = "SRS", sum_pop = sapply(N, sum),
                          sep = FALSE, verbose = FALSE, ...) {
    data <- cluster_gen(
      n                       = n,
      N                       = N,
      sum_pop                 = sum_pop,
      n_X                     = 1,
      n_W                     = 1,
      sampling_method         = meth,
      separate_questionnaires = sep,
      verbose                 = verbose,
      ...
    )
    if (verbose) print(data)
    return(data)
  }
  ex_3.3 <- wrap_cl_gen(n = c(school = 4, student = 10),
                        N = c(        10,           40))
  ex_3.4 <- wrap_cl_gen(
    n = list(school =  4, student = c(10, 10, 10,  10)),
    N = list(school = 10,
             student = c(15, 30, 40, 100, 10, 20, 25, 35, 45, 80))
  )
  ex_3.5 <- wrap_cl_gen(
    n = list(school =  4, student = c(10, 10, 10,  10)),
    N = list(school = 10,
             student = c(10, 15, 20, 25, 30, 35, 40, 45, 80, 100))
  )
  ex_3.6 <- wrap_cl_gen(
    n = list(school = 4, student = c(10, 10, 10,  10)),
    N = list(school = 10,
             student = c(40, 45, 80, 100, 10, 15, 20, 25, 30, 35))
  )
  ex_3.7 <- wrap_cl_gen(
    n = list(school =  4, student = c(10, 10, 10,  10)),
    N = list(school = 10,
             student = c(20, 40, 80, 100, 10, 15, 25, 30, 35, 45)), "PPS"
  )
  expect_equivalent(calc_weights(ex_3.3), c(2.5 * 10 * 4, 400))
  expect_equivalent(calc_weights(ex_3.4), c(2.5 * 10 * 4, 462.5))
  expect_equivalent(calc_weights(ex_3.5), c(2.5 * 10 * 4, 175))
  expect_equivalent(calc_weights(ex_3.6), c(2.5 * 10 * 4, 662.5))
  expect_equivalent(calc_weights(ex_3.7), c(9.75 * 10, 400))

  weight_names <- c("school.weight", "final.student.weight")
  expect_equal(names(calc_weights(ex_3.3)), weight_names)
  expect_equal(names(calc_weights(ex_3.4)), weight_names)
  expect_equal(names(calc_weights(ex_3.5)), weight_names)
  expect_equal(names(calc_weights(ex_3.6)), weight_names)
  expect_equal(names(calc_weights(ex_3.7)), weight_names)
})

# Custom weight tests ==========================================================
wrap_cluster_gen <- function(n, N, meth = "SRS", sum_pop = sapply(N, sum),
                               sep = FALSE, verb = FALSE, print = FALSE, ...) {
    data <- cluster_gen(n                       = n,
                        N                       = N,
                        sum_pop                 = sum_pop,
                        n_X                     = 1,
                        n_W                     = 1,
                        sampling_method         = meth,
                        separate_questionnaires = sep,
                        verbose                 = verb,
                        ...)
    if (print) print(data)
    return(data)
}
test_that("Sampling weights are correct", {
  ex1 <- wrap_cluster_gen(n = c(1, 2, 3), N = c(10, 100, 600))
  ex2 <- wrap_cluster_gen(n = list(school = 4, student = c(10, 5, 2, 3)),
                          N = list(school = 10, students = rep(100, 10)),
                          meth = "PPS")
  ex3 <- wrap_cluster_gen(n = list(school = 4, student = c(10, 5, 2, 3)),
                          N = list(school = 10, students = rep(100, 10)),
                          meth = "PPS")
  expect_equivalent(calc_weights(ex1)["class.weight"] / 3, 100 * 10)
  expect_equivalent(calc_weights(ex2)["final.student.weight"], 100 * 10)
  expect_equivalent(calc_weights(ex3)["school.weight"], 2.5 * (10 + 5 + 2 + 3))
})

# Exploring different sampling methods =========================================
n1 <- list(cnt = 1, sch = 3, cls = c(2, 1, 3), stu = rep(2, 6))
N1 <- list(cnt = 1, sch = 5, cls = 8:4, stu = rep(8, sum(8:4)))
ex4 <- wrap_cluster_gen(n1, N1, meth = "SRS", sep = TRUE)
ex5 <- wrap_cluster_gen(n1, N1, meth = "PPS", sep = TRUE)
ex6 <- wrap_cluster_gen(n1, N1, meth = c("PPS", "SRS", "PPS"), sep = TRUE)
n2 <- list(1, 3, c(2, 1, 3), rep(2, 6))
N2 <- list(1, 5, 8:4, rep(8, sum(8:4)))
ex7 <- wrap_cluster_gen(n2, N2, meth = "mixed", sep = TRUE,
                        cluster_labels = c("state", "school", "class"),
                        resp_labels = c("governor", "principal", "student"))
test_that("Weights are correct for different sampling methods", {
  expect_equivalent(calc_weights(ex4$cnt)["cnt.weight"], 1 * 3)
  expect_equivalent(calc_weights(ex4$sch)["sch.weight"], (5 / 3) * 6)
  expect_equivalent(calc_weights(ex4$cls)["cls.weight"], 5 * 2 * 6)
  expect_equivalent(calc_weights(ex5$cnt)["final.sch.weight"], 5)
  expect_equivalent(calc_weights(ex5$sch)["final.cls.weight"], sum(8:4))
  expect_equivalent(calc_weights(ex5$cls)["final.stu.weight"],
                    sum(rep(8, sum(8:4))))
  expect_equivalent(calc_weights(ex6$cnt)["final.sch.weight"], 5)
  expect_equivalent(calc_weights(ex6$sch)["sch.weight"], (5 / 3) * 6)
  expect_equivalent(calc_weights(ex6$cls)["final.stu.weight"],
                    sum(rep(8, sum(8:4))))
  expect_equivalent(calc_weights(ex7$state)["state.weight"], 1 * 3)
  expect_equivalent(calc_weights(ex7$school)["final.principal.weight"], sum(8:4))
  expect_equivalent(calc_weights(ex7$class)["class.weight"], 5 * 2 * 6)
})

# Script for testing with Leslie ===============================================
test_that("Examples worked on with Leslie have correct weights", {
  wrap_cluster_gen <- function(..., verb = FALSE) {
    suppressWarnings(cluster_gen(..., n_X = 1, n_W = 1, verbose = verb))
  }
  lr1 <- wrap_cluster_gen(n = c(school = 2, student = 10))
  lr2 <- wrap_cluster_gen(n = c(school = 2, class = 1, student =  5),
                          N = c(school = 5, class = 2, student = 10))
  lr3 <- wrap_cluster_gen(n = list(state = 2,
                                   school  = c(2, 3),
                                   student = c(10, 20, 6, 9, 12)),
                          N = list(state = 10,
                                   school  = c(20, 3, rep(1, 8)),
                                   student = c(20, 30, 1:18, rep(12, 3), 1:8)))
  expect_equal(
    object = sapply(seq_along(lr1$school),
                    function (x) sum(lr1$school[[x]]["final.student.weight"])),
    expected = rep(10, 2)
  )
  expect_equal(
    object = sapply(seq_along(lr2$school),
                    function (x) sum(lr2$school[[x]]["final.class.weight"])),
    expected = rep(5, 2)
  )
  expect_equal(
    object = sapply(seq_along(lr2$class),
                    function (x) sum(lr2$class[[x]]["final.student.weight"])),
    expected = rep(50, 2)
  )
  expect_equal(
    object = sapply(seq_along(lr3$state),
                    function (x) sum(lr3$state[[x]]["state.weight"])),
    expected = 5 * c(2, 3)
  )
  expect_equal(
    object = sapply(seq_along(lr3$school),
                    function (x) sum(lr3$school[[x]]["final.student.weight"])),
    expected = rep(58.6, 5)
  )
})

# Ranges for n and N ==========================================================
context("Cluster sampling with ranged number of elements")
check_cluster_structure <- function(n, FUN = "length") {
  set.seed(1234)
  n_list <- convert_vector_to_list(n)
  structure <- draw_cluster_structure(n_list, output="text")
  func <- match.fun(FUN)
  structure_out <- func(structure)
  return(structure_out)
}
n <- c(city = 2, school = 2, class = 3, student = 4)
n2 <- list(city = 2, school = 2, class = 3, student = ranges(10, 50))
n3 <- list(city = 2, school = 2, class = ranges(1, 3), stu = ranges(10, 50))
n4 <- list(city = 2, school = 2, class = ranges(1, 3), student = 20)
n5 <- list(city = 2, school = ranges(5, 8), class = ranges(1, 3), stu = 20)
n6 <- list(2, ranges(1, 3), ranges(2, 5), ranges(1, 5), ranges(5, 100))

test_that("Random levels work", {
  expect_equal(check_cluster_structure(n), 18)
  expect_equal(check_cluster_structure(n2), 18)
  expect_equal(check_cluster_structure(n3), 13)
  expect_equal(check_cluster_structure(n4), 11)
  expect_equal(check_cluster_structure(n5), 40)
  expect_equal(check_cluster_structure(n6), 37)
})

test_that("Random level-generated data generates questionnaires", {
  set.seed(1234); df2 <- cluster_gen(n2, verbose = FALSE, separate = FALSE)
  set.seed(1234); df3 <- cluster_gen(n3, verbose = FALSE)
  set.seed(1234); df4 <- cluster_gen(n4, verbose = FALSE)
  set.seed(7646); df5 <- cluster_gen(n5, verbose = FALSE)
  set.seed(7646); df6 <- cluster_gen(n6, verbose = FALSE)
  expect_output(str(df2), "List of 12")
  expect_output(str(df3$school), "List of 4")
  expect_output(str(df3$class), "List of 7")
  expect_output(str(df4$school), "List of 4")
  expect_output(str(df5$city), "List of 2")
  expect_output(str(df5$school), "List of 13")
  expect_output(str(df6$state), "List of 2")
  expect_output(str(df6$city), "List of 3")
  expect_output(str(df6$school), "List of 8")
  expect_output(str(df6$class), "List of 17")
})

test_that("Combinations of ranges for n and N are treated correctly", {
  wrap_cluster_gen_3 <- function(n, N, ...) {
    suppressWarnings(
      cluster_gen(n       = n,
                  N       = N,
                  n_X     = 1,
                  n_W     = 0,
                  verbose = FALSE)
    )
  }
  # Templates for n and N
  n_combos_2 <- list(
    n_vect_nn = c(4, 5),
    n_list_nr = list(4,            ranges(5, 10)),
    n_list_rn = list(ranges(1, 5), 5),
    n_list_rr = list(ranges(1, 5), ranges(5, 10))
  )
  n_combos_3 <- list(
    n_vect_nnn = c(4, 3, 5),
    n_list_nnr = list(4,            3,            ranges(5, 10)),
    n_list_nrn = list(4,            ranges(1, 3), 5),
    n_list_nrr = list(4,            ranges(2, 3), ranges(5, 10)),
    n_list_rnn = list(ranges(1, 5), 3,            5),
    n_list_rnr = list(ranges(1, 5), 3,            ranges(5, 10)),
    n_list_rrn = list(ranges(1, 5), ranges(2, 3), 5),
    n_list_rrr = list(ranges(1, 5), ranges(2, 3), ranges(5, 10))
  )
  N_combos_2 <- list(
    N_nn = list(10,            rep(10, 10)),
    N_nr = list(10,            ranges(10, 20)),
    N_rn = list(ranges(5, 10), ranges(10, 20))
  )
  N_combos_3 <- list(
    N_nnr = list(10,           3,            ranges(10, 30)),
    N_nrn = list(10,           ranges(1, 3), 10),
    N_nrr = list(10,           ranges(1, 3), ranges(10, 30)),
    N_rnn = list(ranges(1, 5), 3,            10),
    N_rnr = list(ranges(1, 5), 3,            ranges(10, 30)),
    N_rrn = list(ranges(1, 5), ranges(1, 3), 10),
    N_rrr = list(ranges(1, 5), ranges(1, 3), ranges(10, 30))
  )

  # Data combining templates
  data <- list()
  for (n in names(n_combos_2)) {
    for (N in names(N_combos_2)) {
      name <- paste(n, N, sep=",")
      data[[name]] <- wrap_cluster_gen_3(n_combos_2[[n]], N_combos_2[[N]])
    }
  }
  for (n in names(n_combos_3)) {
    for (N in names(N_combos_3)) {
      name <- paste(n, N, sep=",")
      data[[name]] <- wrap_cluster_gen_3(n_combos_3[[n]], N_combos_3[[N]])
    }
  }

  expect_length(data, 68)
})

test_that("N cannot be smaller than n", {
  N7 <- list(ranges(1, 5), ranges(2, 5), ranges(5, 10))
  n7 <- list(ranges(2, 4), 6, ranges(5, 15))
  set.seed(212128)
  expect_warning(df7 <- cluster_gen(n7, N = N7, verbose = FALSE))
  expect_warning(df8 <- cluster_gen(n = 2:4, N = 1:3, verbose = FALSE))
  expect_warning(df9 <- cluster_gen(n = list(2, 3:4, ranges(3, 9)),
                                    N = list(1, 2, 1:2), verbose = FALSE))
  expect_output(str(df7), "List of 2")
  expect_output(str(df8), "List of 2")
  expect_output(str(df9), "List of 2")
})

test_that("n cannor be larger than N", {
  n7 <- list(school = ranges(5, 10), student = ranges(10, 20))
  N7 <- c(150, 40)
  set.seed(683)
  expect_output(str(cluster_gen(n7, N7, verbose = FALSE)), "List of 7")
})

# Replicate weights ===========================================================
context("Replicate weights")
test_that("Replication weights are correct", {
  set.seed(230)
  df <- cluster_gen(c(sch = 4, stu = 10), n_X = 3, n_W = 1, verb = FALSE)
  df2 <- cluster_gen(c(4, 2, 50), N = 2, n_X = 3, n_W = 1, verb = FALSE)
  expect_equivalent(
    unlist(calc_replicate_weights(df, "Jackknife")),
    c(0.1583, 0.25863, -0.6291, 0.22373, 0.37991, 0.22653, 0.46595, 0.12253,
     -0.21558, 0.21949, 0.007635, 0.19926, 0.22443, 0.35964, 0.57823, 0.29161,
      0.55662, 0.380, -0.22718, 0.24207, -0.062089, 0.34626, -0.058133,
      0.38484),
    tolerance = .001
  )
  expect_equivalent(
    unlist(calc_replicate_weights(df, "BRR")),
    c(0.1583, 0.26948, -0.6291,
      0.25458, 0.37991, 0.26840, 0.46595, 0.087336, -0.21558, 0.18462, 0.007635,
      0.11830, 0.22443, 0.42200, 0.57823, 0.19830, 0.55662, 0.19854, -0.22718,
      0.18062, -0.062089, 0.15298, -0.058133, 0.39506),
    tolerance = .001
  )
  expect_equivalent(
    unlist(calc_replicate_weights(df, "BRR Fay")), c(0.1583, 0.37924, -0.6291,
      0.37981, 0.37991, 0.35083, 0.46595, 0.11388, -0.21558, 0.17835, 0.007635,
      0.061061, 0.22443, 0.31347, 0.57823, 0.26680, 0.55662, 0.27788, -0.22718,
      0.15690, -0.062089, 0.16565, -0.058133, 0.43946),
    tolerance = .001
  )
  expect_equivalent(
    unlist(calc_replicate_weights(df2, "Jackknife")),
    c(-0.91682, 0.58524, -0.75526, 0.62202, 0.078651, 0.18152, -0.60683, 1.0304,
      -0.61887, 0.28214, 0.14648, 0.097626, 0.34393, 0.81689, -0.3518, 0.69058,
      -0.18448, 1.0098, -0.97671, 0.54090, 0.089031, 0.33646, 0.31780, 0.24962,
      0.14199, 0.160, -0.17590, 0.15325, -0.14977, 0.15775, 0.016379, 0.13521,
      -0.039737, 0.15934, -0.083488, 0.14985, -0.0065551, 0.12376, 0.14174,
      0.12627, -0.11362, 0.12734, -0.088833, 0.15358, 0.055686, 0.13908,
      -0.038120, 0.1048, 0.00044528, 0.14973, -0.083442, 0.16180, -0.073915,
      0.16425, -0.22734, 0.13211, 0.12983, 0.1326, 0.057065, 0.15071, -0.12838,
      0.13798, -0.10214, 0.13505, -0.13884, 0.13237, 0.071190, 0.14779,
      -0.048908, 0.12694, -0.082624, 0.12896),
    tolerance = .001
  )
  expect_equivalent(
    unlist(calc_replicate_weights(df2, "BRR")),
    c(-0.91682, 0.58524, -0.75526, 0.62202, 0.078651, 0.18152, -0.60683, 1.0304,
      -0.61887, 0.28214, 0.14648, 0.097626, 0.34393, 0.81689, -0.3518, 0.69058,
      -0.18448, 1.0098, -0.97671, 0.54090, 0.089031, 0.33646, 0.31780, 0.24962,
      0.14199, 0.17590, -0.17590, 0.16296, -0.14977, 0.18931, 0.016379, 0.1367,
      -0.039737, 0.14701, -0.083488, 0.11212, -0.0065551, 0.1253, 0.14174,
      0.097715, -0.11362, 0.11582, -0.088833, 0.14864, 0.055686, 0.13105,
      -0.038120, 0.11423, 0.00044528, 0.175, -0.083442, 0.18967, -0.073915,
      0.18524, -0.22734, 0.15204, 0.12983, 0.16000, 0.057065, 0.18171, -0.12838,
      0.16736, -0.10214, 0.19531, -0.13884, 0.13627, 0.071190, 0.1124,
      -0.048908, 0.11426, -0.082624, 0.10313),
    tolerance = .001
  )
  expect_equivalent(
    unlist(calc_replicate_weights(df2, "BRR Fay")),
    c(-0.91682, 0.58524, -0.75526, 0.62202, 0.078651, 0.18152, -0.60683, 1.0304,
      -0.61887, 0.28214, 0.14648, 0.097626, 0.34393, 0.81689, -0.3518, 0.69058,
      -0.18448, 1.0098, -0.97671, 0.54090, 0.089031, 0.33646, 0.31780, 0.24962,
      0.14199, 0.14960, -0.17590, 0.15219, -0.14977, 0.13998, 0.016379, 0.13424,
      -0.039737, 0.14775, -0.083488, 0.10442, -0.0065551, 0.16460, 0.14174,
      0.14578, -0.11362, 0.12667, -0.088833, 0.13911, 0.055686, 0.13834,
      -0.038120, 0.10972, 0.00044528, 0.17486, -0.083442, 0.18864, -0.073915,
      0.18789, -0.22734, 0.11231, 0.12983, 0.15832, 0.057065, 0.18278, -0.12838,
      0.1378, -0.10214, 0.1269, -0.13884, 0.12953, 0.071190, 0.14217, -0.048908,
      0.12724, -0.082624, 0.097933),
    tolerance = .001
  )
  # Tests shown to Eugene on 4/sep/2019
  set.seed(1127)
  w <- cluster_gen(N = c(school = 3, class = 2, student = 10),
                   n = c(school = 2, class = 2, student = 5), verbose = FALSE)
  x <- cluster_gen(N = list(school = 2, class = c(2, 3),
                            student = c(6, 7, 3, 2, 9)),
                   n = list(school = 2, class = c(1, 2),
                            student = c(2, 2, 2)), verbose = FALSE)
  y <- cluster_gen(c(4, 2, 50), N = 2, n_X = 3, n_W = 1, verbose = FALSE)
  z <- cluster_gen(n = c(sch = 20, stu = 5),
                   N = c(sch = 1e2, stu = 20),
                   n_X = 3, n_W = 1,
                   print_pop_structure = FALSE, verbose = FALSE)
  expect_equivalent(mean(unlist(calc_replicate_weights(w, "Jackknife"))), 0.2, .1)
  expect_equivalent(mean(unlist(calc_replicate_weights(w, "BRR"))), 0.2, .1)
  expect_equivalent(mean(unlist(calc_replicate_weights(w, "BRR Fay"))), 0.2, .1)
  expect_equal(mean(unlist(calc_replicate_weights(x, "Jackknife"))), NaN)
  expect_equal(mean(unlist(calc_replicate_weights(x, "BRR"))), 0.4, .1)
  expect_equivalent(mean(unlist(calc_replicate_weights(x, "BRR Fay"))), 0.4, .1)
  expect_equivalent(mean(unlist(calc_replicate_weights(y, "Jackknife"))), 0.1, .1)
  expect_equivalent(mean(unlist(calc_replicate_weights(y, "BRR"))), 0.1, .1)
  expect_equivalent(mean(unlist(calc_replicate_weights(y, "BRR Fay"))), 0.1, .1)
  expect_equivalent(mean(unlist(calc_replicate_weights(z, "Jackknife"))), 0.2, .1)
  expect_equivalent(mean(unlist(calc_replicate_weights(z, "BRR"))), 0.2, .1)
  expect_equivalent(mean(unlist(calc_replicate_weights(z, "BRR Fay"))), 0.2, .1)
})

# Intraclass correlations =====================================================
context("Intraclass correlations")
reps <- 100
rep_stats <- matrix(nrow = reps, ncol = 14)
retrieved <- vector()
bias <- vector()
for (r in seq_len(reps)) {
  rho <- runif(1)
  df <- cluster_gen(c(rpois(1, 10), rpois(1, 100)), n_X = 2, n_W = 0,
                    rho = rho,
                    sigma = rpois(1, 10),
                    verbose = FALSE)
  df_stats <- anova(df, FALSE)
  rep_stats[r, ] <- unlist(df_stats)
  bias <- append(bias, rep_stats[r, 9] - rho)
}
colnames(rep_stats) <- names(unlist(df_stats))
test_that("Observed rho is an unbiased estimator", {
  expect_equivalent(mean(bias), 0, tol = .1)
})
test_that("Rho changes as expected", {
  rho <- c(.9, .3, .2)
  set.seed(8141221)
  df <- cluster_gen(c(40, 100), n_X = 3, n_W = 0, rho = rho, verbose = FALSE)
  df_stats <- anova(df, FALSE)
  expect_equivalent(
    unlist(df_stats$population_estimates)[c(3, 7, 11)], rho, tol = .1
  )
})
test_that("Rho works for dataframes with three or more levels", {
  set.seed(9621)
  df <- cluster_gen(c(5, 4, 50), rho = .7, verbose = FALSE)
  df_stats <- anova(df, FALSE)
  expect_equivalent(mean(unlist(df_stats$school$population_estimates)[c(3, 7)]),
                    .52,
                    tol = .1)
  expect_equivalent(unlist(df_stats$class$population_estimates)[3],
                    .68,
                    tol = .1)
  set.seed(6485)
  df2 <- cluster_gen(c(10, 20, 50), rho = c(.7, .2), verbose = FALSE)
  df2_stats <- anova(df2, FALSE)
  expect_equivalent(unlist(df2_stats$school$population_estimates)[c(3, 7)],
                    c(.7, .2),
                    tol = .1)
  expect_equivalent(unlist(df2_stats$class$population_estimates)[c(3, 7)],
                    c(.7, .2),
                    tol = .1)
  set.seed(893961)
  df3 <- cluster_gen(c(25, 15, 50), rho = list(.4, .9), verbose = FALSE)
  df3_stats <- anova(df3, FALSE)
  expect_equivalent(unlist(df3_stats$school$population_estimates)[c(3, 7)],
                    c(.4, .4),
                    tol = .1)
  expect_equivalent(unlist(df3_stats$class$population_estimates)[c(3, 7)],
                    c(.9, .9),
                    tol = .1)
  # set.seed(977753)
  set.seed(9775)
  df4 <- cluster_gen(
    n = c(10, 20, 50),
    rho = list(.4, c(.1, .2, .3)),
    n_X = list(2, 3),
    verbose = FALSE
  )
  df4_stats <- anova(df4, FALSE)
  expect_equivalent(unlist(df4_stats$school$population_estimates)[c(3, 7)],
                    c(.4, .4),
                    tol = .2)
  expect_equivalent(unlist(df4_stats$class$population_estimates)[c(3, 7, 11)],
                    c(.1, .2, .3),
                    tol = .1)
})

test_that("c_mean and rho work together", {
  rho <- .3
  df <- cluster_gen(n = c(20, 200), n_X = 1, n_W = 0,
                    rho = rho, c_mean = 5, verbose = FALSE)
  expect_equivalent(summary(df, print = "none")$school$y_bar, 5, .1)
  expect_equivalent(
    anova(df, print = FALSE)$population_estimates$q1[3], rho, .1
  )
  rho <- .5
  df <- cluster_gen(n = c(50, 500), n_X = 1, n_W = 0,
                    rho = rho,
                    c_mean = list(as.list(seq(1, 4, length.out = 50))),
                    verbose = FALSE)
  expect_equivalent(
    anova(df, FALSE)$population_estimates$q1[3], rho, .1
  )
})

test_that("Rho behaves properly with sigma and c_mean", {
  expect_error(
    cluster_gen(
      n = c(40, 100), n_X = 1, n_W = 0,
      sigma = list(as.list(1:40)),
      rho = .5,
      verbose = FALSE
    )
  )
  set.seed(9624063)
  df2 <- cluster_gen(
    n = c(5, 40, 100), n_X = 1, n_W = 0,
    sigma = list(5, 10),
    verbose = FALSE
  )
  df3 <- cluster_gen(
    n = c(5, 40, 100), n_X = 1, n_W = 0,
    c_mean = list(1, 7),
    sigma = list(3, 9),
    verbose = FALSE
  )
  expect_equivalent(
    anova(df2, print=FALSE)$school$sample_statistics[1], 25, 1
  )
  expect_equivalent(
    anova(df2, print=FALSE)$class$sample_statistics[1], 100, 1
  )
  expect_equivalent(
    anova(df3, print=FALSE)$school$sample_statistics[1], 9, 1
  )
  expect_equivalent(
    anova(df3, print=FALSE)$class$sample_statistics[1], 64, 1
  )
  anova(df3, print=FALSE)
})

test_that("Rho is retrieved when c_mean is provided and sigma2 is missing", {
  n_classes <- 150
  c_mean_narrow <- list(as.list(seq(10, 12, length = n_classes)))
  c_mean_wide <- list(as.list(seq(10, 50, length = n_classes)))
  df_narrow <- cluster_gen(
    n = c(n_classes, 50), n_X = 1, n_W = 0, rho = .2, verbose = FALSE,
    c_mean = c_mean_narrow
  )
  df_wide <- cluster_gen(
    n = c(n_classes, 50), n_X = 1, n_W = 0, rho = .2, verbose = FALSE,
    c_mean = c_mean_wide
  )
  df_narrow_tog <- cluster_gen(
    n = c(n_classes, 50), n_X = 1, n_W = 0, rho = .2, verbose = FALSE,
    separate_questionnaires = FALSE,
    c_mean = unlist(c_mean_narrow)
  )
  df_wide_tog <- cluster_gen(
    n = c(n_classes, 50), n_X = 1, n_W = 0, rho = .2, verbose = FALSE,
    separate_questionnaires = FALSE,
    c_mean = unlist(c_mean_wide)
  )
  expect_equivalent(
    object = anova(df_narrow, print = FALSE)$population$q1["rho_hat.q1"],
    expected = .2,
    tol = .1
  )
  expect_equivalent(
    object = anova(df_wide, print = FALSE)$population$q1["rho_hat.q1"],
    expected = .2,
    tol = .1
  )
  expect_equivalent(
    object = anova(df_narrow_tog, print = FALSE)$pop$q1["rho_hat.q1"],
    expected = .2,
    tol = .1
  )
  expect_equivalent(
    object = anova(df_wide, print = FALSE)$pop$q1["rho_hat.q1"],
    expected = .2,
    tol = .1
  )
})

test_that("Rho works for together questionnaires", {
  set.seed(278074)
  df1 <- cluster_gen(c(50, 20), rho = .8, n_X = 1, verbose = FALSE,
                    separate_questionnaires = FALSE)
  df2 <- cluster_gen(
    n = c(5, 40, 100), n_X = 2, n_W = 0,
    c_mean = c(1, 7),
    rho = c(.2, .8),
    verbose = FALSE,
    separate_questionnaires = FALSE
  )
  df3 <- cluster_gen(
    n = c(5, 40, 100), n_X = 2, n_W = 0,
    sigma = c(5, 10),
    rho = .5,
    verbose = FALSE,
    separate_questionnaires = FALSE
  )
  df4 <- cluster_gen(
    n = c(5, 40, 100), n_X = 2, n_W = 0,
    sigma = c(3, 9),
    rho = c(.2, .8),
    verbose = FALSE,
    separate_questionnaires = FALSE
  )
  expect_equivalent(anova(df1, print=F)$pop$q1["rho_hat.q1"], .8, .1)
  expect_equivalent(anova(df2, print=F)$pop$q1["rho_hat.q1"], .2, .1)
  expect_equivalent(anova(df2, print=F)$pop$q2["rho_hat.q2"], .8, .1)
  expect_equivalent(
    summary(df2, print="none")$class$y_bar, c(1, 7), .1
  )
  expect_equivalent(anova(df3, print=F)$pop$q1["rho_hat.q1"], .5, .1)
  expect_equivalent(anova(df3, print=F)$pop$q2["rho_hat.q2"], .5, .1)
  expect_equivalent(anova(df3, print=F)$pop$q1["sigma2_hat.q1"], 25, .1)
  expect_equivalent(anova(df3, print=F)$pop$q2["sigma2_hat.q2"], 100, 1)
  expect_equivalent(anova(df4, print=F)$pop$q1["rho_hat.q1"], .2, .1)
  expect_equivalent(anova(df4, print=F)$pop$q2["rho_hat.q2"], .8, .1)
  expect_equivalent(anova(df4, print=F)$pop$q1["sigma2_hat.q1"], 9, .1)
  expect_equivalent(anova(df4, print=F)$pop$q2["sigma2_hat.q2"], 81, .1)
})

# Adding cor_matrix and cat_prop to cluster_gen ===============================
context("Passing cor_matrix and cat_prop from cluster_gen to questionnaire_gen")
cl_gen_cor <- function(n, mx, nX = 0, nW = 0, sep = TRUE) {
  cluster_gen(
    n, n_X = nX, n_W = nW, cor_matrix = mx,
    verbose = FALSE, separate_questionnaires = sep
  )
}
test_that("Correlation matrix is correctly parsed in 2-level structures", {
  ## Setting up datasets ------------------------------------------------------
  cor_mx <- matrix(c(1, .8, .8, 1), 2)
  set.seed(33602732)
  dfXX <- cl_gen_cor(c(4, 100), cor_mx, 2)
  dfXW <- cl_gen_cor(c(4, 100), cor_mx, 1, 1)
  dfWW <- cl_gen_cor(c(4, 100), cor_mx, 0, 2)
  dfXXt <- cl_gen_cor(c(4, 100), cor_mx, 2, 0, FALSE)

  ## Testing output -----------------------------------------------------------
  expect_equivalent(
    object    = lapply(dfXX$school, function(x) cor(x[, c("q1", "q2")])),
    expected  = replicate(4, list(cor_mx)),
    tolerance = .1
  )
  expect_equivalent(
    object    = with(dfXW$school[[1]], polycor::polychor(q1, q2)),
    expected  = cor_mx[1, 2],
    tolerance = .1
  )
  expect_equivalent(
    object    = with(dfXW$school[[3]], polycor::polychor(q1, q2)),
    expected  = cor_mx[1, 2],
    tolerance = .1
  )
  expect_equivalent(
    object    = with(dfWW$school[[1]], polycor::polychor(q1, q2)),
    expected  = cor_mx[1, 2],
    tolerance = .1
  )
  expect_equivalent(
    object    = lapply(dfXXt, function(x) cor(x[, c("q1", "q2")])),
    expected  = replicate(4, list(cor_mx)),
    tolerance = .1
  )
})
test_that("Correlation matrix works for structures with 3+ levels", {
  ## Generating data ----------------------------------------------------------
  cor_mx_schools <- matrix(c(1, .6, .3, .6, 1, -.4, .3, -.4, 1), 3)
  cor_mx_classes <- matrix(c(1, -.9, -.9, 1), 2)
  cor_mx <- list(school = cor_mx_schools, class = cor_mx_classes)
  set.seed(6400492)
  df3 <- cl_gen_cor(c(2, 200, 100), cor_mx, list(3, 2))

  ## Testing output -----------------------------------------------------------
  expect_equivalent(
    object    = lapply(df3$school, function(x) cor(x[, c("q1", "q2", "q3")])),
    expected  = list(cor_mx$school, cor_mx$school),
    tolerance = .1
  )
  expect_equivalent(
    object    = lapply(df3$class, function(x) cor(x[, c("q1", "q2")])),
    expected  = replicate(400, list(cor_mx$class)),
    tolerance = .1
  )
})
test_that("cor_matrix is customizable between elements at the same level", {
  ## Generating data ----------------------------------------------------------
  cor_mx_school1 <- matrix(c(1, -.9, -.9, 1), 2)
  cor_mx_school2 <- matrix(c(1, .4, .4, 1), 2)
  cor_mx <- list(school = list(cor_mx_school1, cor_mx_school2))
  df_sep <- cl_gen_cor(c(2, 200), cor_mx, 2)
  df_tog <- cl_gen_cor(c(2, 200), cor_mx, 2, 0, FALSE)

  ## Testing output -----------------------------------------------------------
  expect_equivalent(
    object = lapply(df_sep$school, function(x) cor(x[, c("q1", "q2")])),
    expected = cor_mx$school,
    tolerance = .5
  )
  expect_equivalent(
    object = lapply(df_tog, function(x) cor(x[, c("q1", "q2")])),
    expected = cor_mx$school,
    tolerance = .5
  )
})

# Passing cat_prop ============================================================
context("Passing cat_prop to cluster_gen")
wrap_cluster_gen_cat <- function(n, cat, sep = TRUE) {
  cluster_gen(n, cat_prop = cat, separate_questionnaires = sep, verbose = FALSE)
}
test_that("cat_prop is parsed correctly: unique props for all structures", {
  set.seed(288497)
  propX <- list(1)
  propW <- list(c(.5, .8, 1))
  propXW <- list(1, c(.3, 1))
  propXX <- list(1, 1)
  propWW <- list(c(.7, 1), c(.2, .3, .7, .9, 1))
  propXXWW <- list(1, 1, c(.5, 1), c(.25, .75, 1))
  nXW <- c(1, 100)
  dfXsep <- wrap_cluster_gen_cat(nXW, propX)
  dfWsep <- wrap_cluster_gen_cat(nXW, propW)
  dfXWsep <- wrap_cluster_gen_cat(nXW, propXW)
  dfXXsep <- wrap_cluster_gen_cat(nXW, propXX)
  dfWWsep <- wrap_cluster_gen_cat(nXW, propWW)
  dfXXWWsep <- wrap_cluster_gen_cat(nXW, propXXWW)
  dfXtog <- wrap_cluster_gen_cat(nXW, propX, FALSE)
  dfWtog <- wrap_cluster_gen_cat(nXW, propW, FALSE)
  dfXWtog <- wrap_cluster_gen_cat(nXW, propXW, FALSE)
  dfXXtog <- wrap_cluster_gen_cat(nXW, propXX, FALSE)
  dfWWtog <- wrap_cluster_gen_cat(nXW, propWW, FALSE)
  dfXXWWtog <- wrap_cluster_gen_cat(nXW, propXXWW, FALSE)
  expect_equivalent(
    object = sapply(dfXsep$school[[1]], class),
    expected = c("integer", "numeric", rep("numeric", 3), "character")
  )
  expect_equivalent(
    object = sapply(dfXtog$school1, class),
    expected = c("integer", "numeric", rep("numeric", 3), "character")
  )
  expect_equivalent(
    object = sapply(dfWsep$school[[1]], class),
    expected = c("integer", "factor", rep("numeric", 3), "character")
  )
  expect_equivalent(
    object = sapply(dfWtog$school1, class),
    expected = c("integer", "factor", rep("numeric", 3), "character")
  )
  expect_equivalent(
    object = sapply(dfXWsep$school[[1]], class),
    expected = c("integer", "numeric", "factor", rep("numeric", 3), "character")
  )
  expect_equivalent(
    object = sapply(dfXWtog$school1, class),
    expected = c("integer", "numeric", "factor", rep("numeric", 3), "character")
  )
  expect_equivalent(
    object = sapply(dfWWsep$school[[1]], class),
    expected = c("integer", "factor", "factor", rep("numeric", 3), "character")
  )
  expect_equivalent(
    object = sapply(dfWWtog$school1, class),
    expected = c("integer", "factor", "factor", rep("numeric", 3), "character")
  )
  expect_equivalent(
    object = sapply(dfXXWWsep$school[[1]], class),
    expected = c("integer", "numeric", "numeric", "factor", "factor",
      rep("numeric", 3), "character")
  )
  expect_equivalent(
    object = sapply(dfXXWWtog$school1, class),
    expected = c("integer", "numeric", "numeric", "factor", "factor",
      rep("numeric", 3), "character")
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfWsep$school[[1]]["q1"]))),
    expected = unlist(propW),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfXWsep$school[[1]]["q2"]))),
    expected = unlist(propXW[[2]]),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfWWsep$school[[1]]["q1"]))),
    expected = unlist(propWW[[1]]),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfWWsep$school[[1]]["q2"]))),
    expected = unlist(propWW[[2]]),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfXXWWsep$school[[1]]["q3"]))),
    expected = unlist(propXXWW[[3]]),
    tol = .1
  )
    expect_equivalent(
    object = cumsum(prop.table(table(dfXXWWsep$school[[1]]["q4"]))),
    expected = unlist(propXXWW[[4]]),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfWtog$school1["q1"]))),
    expected = unlist(propW),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfXWtog$school1["q2"]))),
    expected = unlist(propXW[[2]]),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfWWtog$school1["q1"]))),
    expected = unlist(propWW[[1]]),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfWWtog$school1["q2"]))),
    expected = unlist(propWW[[2]]),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfXXWWtog$school1["q3"]))),
    expected = unlist(propXXWW[[3]]),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfXXWWtog$school1["q4"]))),
    expected = unlist(propXXWW[[4]]),
    tol = .1
  )
})
test_that("cat_prop is parsed correctly: individual props for each level", {
  set.seed(879752)
  nXW <- c(1, 30, 100)
  propXXWW <- list(list(1, 1, c(.5, 1)), list(1, c(.25, .75, 1), c(.9, 1)))
  dfXXWWsep <- wrap_cluster_gen_cat(nXW, propXXWW)
  dfXXWWtog <- wrap_cluster_gen_cat(nXW, propXXWW, FALSE)
  expect_equivalent(
    object = cumsum(prop.table(table(dfXXWWsep$school[[1]]["q3"]))),
    expected = unlist(propXXWW[[1]][[3]]),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfXXWWsep$class[[1]]["q2"]))),
    expected = unlist(propXXWW[[2]][[2]]),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfXXWWsep$class[[1]]["q3"]))),
    expected = unlist(propXXWW[[2]][[3]]),
    tol = .1
  )
})
test_that("cat_prop is parsed correctly: individual props within a level", {
  set.seed(87975)
  nXW <- c(2, 100)
  propXXWW <- list(list(list(c(.9, 1)), list(c(.1, 1))))
  dfXXWWsep <- wrap_cluster_gen_cat(nXW, propXXWW)
  dfXXWWtog <- wrap_cluster_gen_cat(nXW, propXXWW, FALSE)
  expect_equivalent(
    object = cumsum(prop.table(table(dfXXWWsep$school[[1]]["q1"]))),
    expected = unlist(propXXWW[[1]][[1]][[1]]),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfXXWWsep$school[[2]]["q1"]))),
    expected = unlist(propXXWW[[1]][[2]][[1]]),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfXXWWtog$school1["q1"]))),
    expected = unlist(propXXWW[[1]][[1]][[1]]),
    tol = .1
  )
  expect_equivalent(
    object = cumsum(prop.table(table(dfXXWWtog$school2["q1"]))),
    expected = unlist(propXXWW[[1]][[2]][[1]]),
    tol = .1
  )
})

# n_W as list of lists =========================================================
context("Complex n_W")
test_that("Special cases of n_W work as expected", {
  n3 <- c(school = 3, class = 2, student = 5)
  cluster_gen_2 <- function(...) {
      cluster_gen(
        ..., verbose = FALSE, calc_weights = FALSE, family = "gaussian"
      )
  }
  df3 <- cluster_gen_2(n3, n_X = 0, n_W = list(list(3, 4, 4), list(2, 5)))
  for (i in seq_len(3)) {
    expect_equivalent(
      object = sapply(df3$school[[i]][, 2:4], function(x) max(levels(x))),
      expected = c("3", "4", "4")
    )
  }
  for (i in seq_len(6)) {
    expect_equivalent(
      object = sapply(df3$class[[i]][, 2:3], function(x) max(levels(x))),
      expected = c("2", "5")
    )
  }
})