test-rand_pvals.R
In optrefine: Optimally Refine Strata

test_that("List returned with all expected components", {
  set.seed(11)
  samp_rows <- sample(1:nrow(rhc_X), 100)
  X <- rhc_X[samp_rows, sample(1:ncol(rhc_X), 10)]
  z <- rhc_X[samp_rows, "z"]
  ps <- prop_strat(X = X, z = z, nstrata = 2)
  pvals <- rand_pvals(ps, options = list(nrand = 100))
  expect_setequal(names(pvals), c("pvals", "obs_details", "rand_details"))
  expect_setequal(names(pvals$pvals$base),
                  c("obj", "max", "avg", "smds"))
  expect_setequal(names(pvals$obs_details$base),
                  c("obj", "max", "smds"))
  expect_setequal(names(pvals$rand_details$base),
                  c("obj", "max", "smds"))
  expect_null(pvals$pvals$refined)
  expect_null(pvals$obs_details$refined)
  expect_null(pvals$rand_details$refined)
  expect_equal(length(pvals$pvals$base$smds), 11)
  expect_equal(length(pvals$obs_details$base$smds), 11)
  expect_equal(dim(pvals$rand_details$base$smds), c(100, 11))
})


test_that("Criterion argument works as expected", {
  set.seed(13)
  samp_rows <- sample(1:nrow(rhc_X), 150)
  X <- rhc_X[samp_rows, sample(1:ncol(rhc_X), 10)]
  z <- rhc_X[samp_rows, "z"]
  ps <- prop_strat(X = X, z = z, nstrata = 2)
  ref <- refine(ps)
  pvals <- rand_pvals(ref, options = list(criterion = "sum", nrand = 10))
  expect_equal(pvals$rand_details$refined$obj, rowMeans(pvals$rand_details$refined$smds))
})


test_that("incl_base arguments work as expected", {
  set.seed(17)
  samp_rows <- sample(1:nrow(rhc_X), 300)
  X <- rhc_X[samp_rows, sample(1:ncol(rhc_X), 3)]
  z <- rhc_X[samp_rows, "z"]
  ref <- refine(X = X, z = z)
  pvals <- rand_pvals(z = ref$z, X = ref$X, base_strata = ref$base_strata,
                      refined_strata = ref$refined_strata, options = list(incl_base = FALSE, nrand = 10))
  expect_null(pvals$pvals$base)
})


test_that("Pvals calculated properly", {
  set.seed(23)
  samp_rows <- sample(1:nrow(rhc_X), 200)
  X <- rhc_X[samp_rows, sample(1:ncol(rhc_X), 5)]
  z <- rhc_X[samp_rows, "z"]
  ps <- prop_strat(X = X, z = z, nstrata = 2)
  ref <- refine(ps)
  pvals <- rand_pvals(ref, options = list(nrand = 100))
  expect_equal(pvals$pvals$base$max,
               mean(pvals$rand_details$base$max > pvals$obs_details$base$max))
  expect_equal(pvals$pvals$base$avg,
               mean(rowMeans(pvals$rand_details$base$smds) > mean(pvals$obs_details$base$smds)))
  expect_equal(as.numeric(pvals$pvals$base$smds[5]),
               mean(pvals$rand_details$base$smds[, 5] > pvals$obs_details$base$smds[5]))
  expect_equal(pvals$pvals$refined$max,
               mean(pvals$rand_details$refined$max > pvals$obs_details$refined$max))
  expect_equal(pvals$pvals$refined$avg,
               mean(rowMeans(pvals$rand_details$refined$smds) > mean(pvals$obs_details$refined$smds)))
  expect_equal(as.numeric(pvals$pvals$refined$smds[3]),
               mean(pvals$rand_details$refined$smds[, 3] > pvals$obs_details$refined$smds[3]))
})


test_that("Sum obj for pvals calculated properly", {
  set.seed(27)
  samp_rows <- sample(1:nrow(rhc_X), 200)
  X <- rhc_X[samp_rows, sample(1:ncol(rhc_X), 5)]
  z <- rhc_X[samp_rows, "z"]
  ps <- prop_strat(X = X, z = z, nstrata = 2)
  ref <- refine(ps, options = list(criterion = "sum"))
  pvals <- rand_pvals(ref, options = list(nrand = 100, criterion = "sum"))
  expect_equal(pvals$obs_details$refined$obj,
               mean(pvals$obs_details$refined$smds))
  expect_equal(pvals$obs_details$refined$obj,
               ref$details$valueIP)
  expect_equal(pvals$rand_details$refined$obj,
               rowMeans(pvals$rand_details$refined$smds))
})


test_that("Max obj for pvals calculated properly", {
  set.seed(29)
  samp_rows <- sample(1:nrow(rhc_X), 200)
  X <- rhc_X[samp_rows, sample(1:ncol(rhc_X), 5)]
  z <- rhc_X[samp_rows, "z"]
  ref <- refine(z = z, X = X, strata = rep(1, length(z)), options = list(criterion = "max"))
  pvals <- rand_pvals(ref, options = list(nrand = 100, criterion = "max"))
  expect_equal(pvals$obs_details$refined$obj,
               pvals$obs_details$refined$max)
  expect_equal(pvals$obs_details$refined$obj,
               ref$details$valueIP)
  expect_equal(pvals$rand_details$refined$obj,
               pvals$rand_details$refined$max)
})


test_that("Combo obj for pvals calculated properly", {
  set.seed(31)
  samp_rows <- sample(1:nrow(rhc_X), 200)
  X <- rhc_X[samp_rows, sample(1:ncol(rhc_X), 5)]
  z <- rhc_X[samp_rows, "z"]
  ref <- refine(z = z, X = X, strata = rep(1, length(z)), options = list(criterion = "combo", wMax = 3))
  pvals <- rand_pvals(ref, options = list(nrand = 100, criterion = "combo", wMax = 3))
  expect_equal(pvals$obs_details$refined$obj,
               (sum(pvals$obs_details$refined$smds * 2) + 3 * pvals$obs_details$refined$max) / 13)
  expect_equal(pvals$obs_details$refined$obj,
               ref$details$valueIP)
  expect_equal(pvals$rand_details$refined$obj,
               (rowSums(pvals$rand_details$refined$smds * 2) + 3 * pvals$rand_details$refined$max) / 13)

})


test_that("Table has correct dimensions and column and row names", {
  set.seed(27)
  samp_rows <- sample(1:nrow(rhc_X), 100)
  X <- rhc_X[samp_rows, sample(1:ncol(rhc_X), 5)]
  z <- rhc_X[samp_rows, "z"]
  ps <- prop_strat(X = X, z = z, nstrata = 2)
  ref <- refine(ps)
  pvals <- rand_pvals(ref, options = list(nrand = 100))
  tab1 <- table_rand_pvals(ref, options = list(rand_pvals = pvals))
  expect_equal(dim(tab1), c(9, 8))
  expect_false(is.null(colnames(tab1)))
  expect_false(is.null(rownames(tab1)))
  expect_true(all(is.na(tab1[1, 1:4])))
})


test_that("Incl_base works properly for table", {
  set.seed(22)
  samp_rows <- sample(1:nrow(rhc_X), 100)
  X <- rhc_X[samp_rows, sample(1:ncol(rhc_X), 5)]
  z <- rhc_X[samp_rows, "z"]
  ps <- prop_strat(X = X, z = z, nstrata = 2)
  ref <- refine(ps)
  pvals <- rand_pvals(ref, options = list(nrand = 100, criterion = "max"))
  tab1 <- table_rand_pvals(ref, options = list(rand_pvals = pvals))
  tab2 <- table_rand_pvals(ref, options = list(incl_base = FALSE, rand_pvals = pvals))
  expect_equal(dim(tab2), c(9, 4))
  expect_equal(tab1[, 5:8], tab2)
})


test_that("Criterion and wMax options work for table", {
  set.seed(22)
  samp_rows <- sample(1:nrow(rhc_X), 100)
  X <- rhc_X[samp_rows, sample(1:ncol(rhc_X), 5)]
  z <- rhc_X[samp_rows, "z"]
  ps <- prop_strat(X = X, z = z, nstrata = 2)
  tab1 <- table_rand_pvals(z = ps$z, X = ps$X, base_strata = ps$base_strata,
                           options = list(criterion = "combo", wMax = 10, nrand = 10))
  expect_equal(dim(tab1), c(9, 4))
  expect_equal(tab1[4, 2], 0.1527478, tolerance = 10e-5)
})



test_that("Incl_base works properly for table", {
  set.seed(22)
  samp_rows <- sample(1:nrow(rhc_X), 100)
  X <- rhc_X[samp_rows, sample(1:ncol(rhc_X), 5)]
  z <- rhc_X[samp_rows, "z"]
  ps <- prop_strat(X = X, z = z, nstrata = 2)
  tab1 <- table_rand_pvals(z = ps$z, X = ps$X, base_strata = ps$base_strata,
                           options = list(criterion = "combo", wMax = 10, nrand = 10))
  expect_equal(dim(tab1), c(9, 4))
  expect_equal(tab1[4, 2], 0.1527478, tolerance = 10e-5)
})