tests/testthat/test.stratumStructure.R

In optmatch: Functions for Optimal Matching

################################################################################
# Tests for utility functions
################################################################################

context("StratumStructure tests")

test_that("Basics", {
  m <- matrix(c(1,Inf,Inf,Inf, 1,Inf,Inf,Inf, Inf,1,Inf,Inf, Inf,Inf,1,Inf, Inf,Inf,Inf,1), nrow = 4,
              dimnames = list(LETTERS[1:4], letters[22:26]))

  expect_warning(fm <- fullmatch(m))
  res.ss <- stratumStructure(fm)

  # current implementation has res.ss as an array with attributes
  # casting to numeric is just easy to to test.
  expect_equal(as.numeric(res.ss), c(3,1))

})


test_that("Helper functions to compute small bits about matches", {
  Z <- rep(c(0,1), 8)
  B <- rep(c("foo", "bar"), each = 8)
  names(Z) <- names(B) <- letters[1:16]

  # effective sample size should be equal 8
  res.pairs <- pairmatch(exactMatch(Z ~ B), data = Z)
  expect_equal(effectiveSampleSize(res.pairs), 8)

  expect_equal(effectiveSampleSize.default(res.pairs, Z), 8)
  # effective sample size should be 2/(1/4)
  res.mixed <- fullmatch(exactMatch(Z~B), max.controls = 2, omit.fraction = 1/4, data = Z)
  expect_equal(sum(!is.na(res.mixed)), 14)

  # should throw away 2 controls and create 2 groups with 2 treated, 6 groups total
  # the sum of the harmonic means is: 4 * 2/(1/1 + 1/1) + 2 * 2 / (1/2 + 1/1) = 20/3
  expect_equal(effectiveSampleSize(res.mixed), 20/3)

  #todo: pass a Z argument, say after reordering a match, an error if contrast.group is not found
  # ok, I actually found it really hard to break up the optmatch data, but ust in case it happens
  tmp <- as.numeric(res.pairs)
  names(tmp) <- names(res.pairs)
  expect_error(effectiveSampleSize.factor(tmp), "contrast.group")
  expect_error(effectiveSampleSize(tmp))

  expect_equal(effectiveSampleSize(tmp, Z), 8)
})


test_that("Correct output for full failures", {
  expect_equal(effectiveSampleSize(rep(NA, 10), rep(c(T,F), 5)), 0)

})