tests/testthat/test-condition-pr-matrix.R

In estimatr: Fast Estimators for Design-Based Inference

context("Helper - HT condition_pr_matrix")
n <- 5


test_that("Checks class", {
    # Errors appropriately
    expect_error(
      declaration_to_condition_pr_mat(rbinom(5, 1, 0.5)),
      "`ra_declaration` must be an object of class 'ra_declaration'"
    )
})

test_that("Complete randomization", {

  skip_if_not_installed("randomizr")

  prs <- rep(0.4, times = n)
  comp_ra <- randomizr::declare_ra(N = n, prob = prs[1])
  perms <- randomizr::obtain_permutation_matrix(comp_ra)
  expect_equal(
    declaration_to_condition_pr_mat(comp_ra),
    permutations_to_condition_pr_mat(perms)
  )

})

test_that("declaration to condition_pr_mat errors", {

  expect_error(
    declaration_to_condition_pr_mat(randomizr::declare_ra(N = n), 1, NULL),
    "Cannot have `condition2 == NULL`"
  )
  expect_error(
    declaration_to_condition_pr_mat(randomizr::declare_ra(N = n), NULL, 1),
    "Cannot have `condition1 == NULL`"
  )
  expect_error(
    declaration_to_condition_pr_mat(rbinom(5, 1, 0.5)),
    "`ra_declaration` must be an object of class 'ra_declaration'"
  )
})

test_that("condition args work properly", {

  # Condition args work properly
  mat01 <- declaration_to_condition_pr_mat(
    randomizr::declare_ra(N = n, prob = 0.4),
    0,
    1
  )
  mat10 <- declaration_to_condition_pr_mat(
    randomizr::declare_ra(N = n, prob = 0.4),
    1,
    0
  )

  # Diagonals are just flipped, check the names!
  # colnames(mat01)
  # colnames(mat10)
  expect_equal(mat01, mat10[rownames(mat01), colnames(mat01)])
})

test_that("Complete randomization with number of treated units not fixed", {

  #
  comp_odd_ra <- randomizr::declare_ra(N = 3, prob = 0.5)
  perms <- randomizr::obtain_permutation_matrix(comp_odd_ra)

  decl_cond_pr_mat <- declaration_to_condition_pr_mat(comp_odd_ra)

  # following passes so just use perms instead of get_perms
  # get_perms <- replicate(40000, conduct_ra(comp_odd_ra))
  # expect_true(
  #    max(permutations_to_condition_pr_mat(perms) -
  #         round(permutations_to_condition_pr_mat(get_perms), 3)) < 0.01
  # )

  expect_equal(
    decl_cond_pr_mat,
    permutations_to_condition_pr_mat(perms)
  )

})

test_that("Complete randomization with non 0.5 as remainder", {
  comp_odd_ra <- randomizr::declare_ra(N = 3, prob = 0.4)
  decl_cond_pr_mat <- declaration_to_condition_pr_mat(comp_odd_ra)

  set.seed(40)
  get_perms <- replicate(10000, randomizr::conduct_ra(comp_odd_ra))
  expect_equal(
    decl_cond_pr_mat,
    permutations_to_condition_pr_mat(get_perms),
    tolerance = 0.01
  )
})
test_that("Simple ra", {

  # Simple randomization
  prs <- rep(0.4, times = n)
  simp_ra <- randomizr::declare_ra(N = n, prob = prs[1], simple = TRUE)

  # perms <- randomizr::obtain_permutation_matrix(simp_ra)
  # Won't work because some permutations are more likely than others
  # So instead we just resample and set the tolerance
  perms <- replicate(10000, randomizr::conduct_ra(simp_ra))
  # Won't be equal because some permutations are more likely than others in
  # this case
  expect_equal(
    declaration_to_condition_pr_mat(simp_ra),
    permutations_to_condition_pr_mat(perms),
    tolerance = 0.02
  )
})
test_that("Blocked complete ra", {

  # Blocked case
  dat <- data.frame(
    bl = c("A", "B", "A", "B", "B", "B"),
    pr = c(0.5, 0.25, 0.5, 0.25, 0.25, 0.25)
  )

  bl_ra <- randomizr::declare_ra(blocks = dat$bl, block_m = c(1, 1))
  bl_perms <- randomizr::obtain_permutation_matrix(bl_ra)

  expect_equal(
    declaration_to_condition_pr_mat(bl_ra),
    permutations_to_condition_pr_mat(bl_perms)
  )
})
test_that("Blocked complete ra with remainder", {
  dat <- data.frame(
    bl = c("A", "B", "A", "B", "B", "B"),
    pr = c(0.5, 0.25, 0.5, 0.25, 0.25, 0.25)
  )

  # with remainder
  bl <- c("A", "B", "A", "A", "B", "B") # Is this used anywhere?

  bl_ra <- randomizr::declare_ra(blocks = dat$bl, prob = 0.4)
  bl_perms <- replicate(5000, randomizr::conduct_ra(bl_ra))

  expect_equal(
    declaration_to_condition_pr_mat(bl_ra),
    permutations_to_condition_pr_mat(bl_perms),
    tolerance = 0.02
  )
})
test_that("Clustered complete ra", {

  # Cluster complete case
  dat <- data.frame(
    cl = c("A", "B", "A", "C", "A", "B")
  )

  cl_ra <- randomizr::declare_ra(clusters = dat$cl, m = 1)
  cl_perms <- randomizr::obtain_permutation_matrix(cl_ra)

  expect_equal(
    declaration_to_condition_pr_mat(cl_ra),
    permutations_to_condition_pr_mat(cl_perms)
  )

  # with remainder
  cl_ra <- randomizr::declare_ra(clusters = dat$cl, prob = 0.5)
  cl_perms <- randomizr::obtain_permutation_matrix(cl_ra)

  # lapply(1:ncol(cl_perms), function(x) table(dat$cl, cl_perms[, x]))
  expect_equal(
    declaration_to_condition_pr_mat(cl_ra),
    permutations_to_condition_pr_mat(cl_perms)
  )
})

test_that("Clustered ra", {

  # Cluster simple ? Should this be simple or no? --NJF
  dat <- data.frame(
    cl = c("A", "B", "A", "C", "A", "B")
  )

  dat$prs <- 0.3
  cl_simp_ra <- randomizr::declare_ra(clusters = dat$cl, prob = dat$prs[1])
  cl_simp_perms <- randomizr::obtain_permutation_matrix(cl_simp_ra)

  cl_simp_cpm <- declaration_to_condition_pr_mat(cl_simp_ra)

  set.seed(42)
  expect_equal(
    cl_simp_cpm,
    permutations_to_condition_pr_mat(cl_simp_perms),
    tolerance = 0.1
  )

  set.seed(42)
  cl_simp_sim_perms <- replicate(10000, randomizr::conduct_ra(cl_simp_ra))

  expect_equal(
    cl_simp_cpm,
    permutations_to_condition_pr_mat(cl_simp_sim_perms),
    tolerance = 0.01
  )

})

test_that("Blocked and Clustered ra", {

  # Blocked and clustered
  dat <- data.frame(
    bl = c("A", "B", "B", "B", "A", "A", "B", "B"),
    cl = c(1, 2, 3, 3, 4, 4, 5, 5)
  )

  bl_cl_ra <- randomizr::declare_ra(clusters = dat$cl, blocks = dat$bl, block_m = c(1, 2))
  bl_cl_perms <- randomizr::obtain_permutation_matrix(bl_cl_ra)

  expect_equal(
    declaration_to_condition_pr_mat(bl_cl_ra),
    permutations_to_condition_pr_mat(bl_cl_perms)
  )
})

test_that("Blocked and clusted ra with remainder", {

  # with remainder
  dat <- data.frame(
    bl = c("A", "B", "B", "B", "A", "A", "B", "B"),
    cl = c(1, 2, 3, 3, 4, 4, 5, 5)
  )

  bl_cl_ra <- randomizr::declare_ra(clusters = dat$cl, blocks = dat$bl, prob = 0.5)
  bl_cl_perms <- randomizr::obtain_permutation_matrix(bl_cl_ra)

  expect_equal(
    declaration_to_condition_pr_mat(bl_cl_ra),
    permutations_to_condition_pr_mat(bl_cl_perms)
  )
})

test_that("Custom ra", {
  cust_perms <- cbind(c(1, 0, 1, 0), c(1, 1, 0, 0))
  cust_ra <- randomizr::declare_ra(permutation_matrix = cust_perms)

  expect_equal(
    declaration_to_condition_pr_mat(cust_ra),
    permutations_to_condition_pr_mat(cust_perms)
  )
})

test_that("Errors for things that we can't support", {

  #
  # multiple armed experiments
  mult_ra <- randomizr::declare_ra(N = 10, prob_each = c(0.2, 0.2, 0.6))
  expect_error(
    declaration_to_condition_pr_mat(mult_ra),
    "`ra_declaration` must have only two arms when passed directly"
  )

  # Permutation error
  expect_error(
    permutations_to_condition_pr_mat(matrix(c(1, 2, 2, 1), nrow = 2)),
    "Matrix of `permutations` must be comprised of only 0s and 1s"
  )

  # Not unique treatment prob for all clusters when complete randomized
  expect_error(
    gen_pr_matrix_cluster(
      c(1, 1, 2, 2),
      treat_probs = runif(4),
      simple = FALSE
    ),
    "Treatment probabilities cannot vary within blocks"
  )
})

test_that("probability not fixed within blocks", {
  bl_small <- randomizr::declare_ra(
    blocks = c(1, 1, 2, 2),
    prob = 0.4
  )
  assign(
    "probabilities_matrix",
    matrix(
      c(0.4, 0.5, 0.6, 0.7, 0.6, 0.5, 0.4, 0.3),
      ncol = 2,
      dimnames = list(NULL, c("prob_0", "prob_1"))
    ),
    bl_small
  )
  expect_error(
    declaration_to_condition_pr_mat(bl_small),
    "Treatment probabilities must be fixed within blocks for block randomized"
  )
})

test_that("N=2, m=1", {

  comp <- randomizr::declare_ra(N = 2, m = 1)
  assign(
    "probabilities_matrix",
    matrix(
      c(0.4, 0.5, 0.6, 0.5),
      ncol = 2,
      dimnames = list(NULL, c("prob_0", "prob_1"))
    ),
    comp
  )
  expect_error(
    declaration_to_condition_pr_mat(comp),
    "Treatment probabilities must be fixed for complete randomized designs"
  )

  # error in internal function
  expect_error(
    estimatr:::gen_pr_matrix_block(c(1, 2), c(1, 2)),
    "Must specify one of `t`, `p2`, or `p1`"
  )


})