tests/testthat/test.xBalance.R

In markmfredrickson/RItools: Randomization Inference Tools

################################################################################
# Tests for xBalance function
################################################################################
## if working interactively in inst/tests you'll need
## library(RItools, lib.loc = '../../.local')
library("testthat")

context("xBalance Functions")

test_that("xBal univariate desriptive means agree w/ lm",{
    set.seed(20160406)
    n <- 7 
     dat <- data.frame(x1=rnorm(n), x2=rnorm(n),
                        s=rep(c("a", "b"), c(floor(n/2), ceiling(n/2)))
                        )
     dat = transform(dat, z=as.numeric( (x1+x2+rnorm(n))>0 ) )

     lm1 <- lm(x1~z, data=dat)
     xb1 <- xBalance(z~x1, strata = list(`Unstrat` = NULL, s = ~s), data=dat, report=c("adj.mean.diffs"))
     expect_equal(xb1$results["x1", "adj.diff", "Unstrat"], coef(lm1)["z"], check.attributes=F)

     lm2a <- lm(x1~z+s, data=dat) 
     expect_equivalent(xb1$results["x1", "adj.diff", "s"], coef(lm2a)[["z"]])
})

test_that("xBal univariate inferentials agree w/ conditional logistic Rao score test",{
    library(survival)
    set.seed(20160406)
    n <- 7 
     dat <- data.frame(x1=rnorm(n), x2=rnorm(n),
                        s=rep(c("a", "b"), c(floor(n/2), ceiling(n/2)))
                        )
     dat = transform(dat, z=as.numeric( (x1+x2+rnorm(n))>0 ) )
    xb1b <- xBalance(z~x1, strata = list(`Unstrat` = NULL, s = ~s), data=dat, report=c("z.scores"))
     cl1 <- clogit(z~x1, data=dat)
     cl2 <- clogit(z~x1+strata(s), data=dat)


    expect_equal(summary(cl1)$sctest['test'],(xb1b$results["x1", "z", "Unstrat"])^2 , check.attributes=F)
    expect_equal(summary(cl2)$sctest['test'],(xb1b$results["x1", "z", "s"])^2 , check.attributes=F)
}
          )

test_that("xBalance returns covariance of tests", {
  set.seed(20130801)
  n <- 500

  library(MASS)
  xs <- mvrnorm(n,
                mu = c(1,2,3),
                Sigma = matrix(c(1, 0.5, 0.2,
                    0.5, 1, 0,
                    0.2, 0, 1), nrow = 3, byrow = T))

  p <- plogis(xs[,1]- 0.25 * xs[,2] - 1)
  z <- rbinom(n, p = p, size = 1)
  s <- rep(c(0,1), each = n/2)

  dat <- cbind(z, xs, s)


  res <- xBalance(z ~ . - s,
                  data = as.data.frame(dat),
                  report = 'all',
                  strata = list("Unadj" = NULL,
                      "Adj"   = ~ s))

  tcov <- attr(res$overall, "tcov")

  expect_false(is.null(tcov))

  expect_equal(length(tcov), 2)
  expect_equal(dim(tcov[[1]]), c(3,3))

  # variance should be the squares of the reported null SDs
  expect_equal(sqrt(diag(tcov[[1]])), res$results[, "adj.diff.null.sd", 1])
  expect_equal(sqrt(diag(tcov[[2]])), res$results[, "adj.diff.null.sd", 2])
})

test_that("partial arguments to report", {
  data(nuclearplants)

  expect_error(xBalance(pr ~ ., data=nuclearplants, report = "a"), "multiple")
  expect_error(xBalance(pr ~ ., data=nuclearplants, report = "b"), "Invalid")
  expect_error(xBalance(pr ~ ., data=nuclearplants, report = "adj.mean"), "multiple")

  # just to test these don't error
  res <- xBalance(pr ~ ., data=nuclearplants, report = "adj.means")
  res <- xBalance(pr ~ ., data=nuclearplants, report = "adj.mean.diffs")
  res <- xBalance(pr ~ ., data=nuclearplants, report = "adj.mean.diffs.null.sd")

  # everything should be identical
  res.z1 <- xBalance(pr ~ ., data=nuclearplants, report = "z.scores")
  res.z2 <- xBalance(pr ~ ., data=nuclearplants, report = "z")
  expect_true(identical(res.z1, res.z2))

  res.chi1 <- xBalance(pr ~ ., data=nuclearplants, report = "chisquare.test")
  res.chi2 <- xBalance(pr ~ ., data=nuclearplants, report = "chi")
  expect_true(identical(res.chi1, res.chi2))

  res.std.d1 <- xBalance(pr ~ ., data=nuclearplants, report = "std.diffs")
  res.std.d2 <- xBalance(pr ~ ., data=nuclearplants, report = "std.d")
  expect_true(identical(res.std.d1, res.std.d2))

  res.a.m.d.n1 <- xBalance(pr ~ ., data=nuclearplants, report = "adj.mean.diffs.null.sd")
  res.a.m.d.n2 <- xBalance(pr ~ ., data=nuclearplants, report = "adj.mean.diffs.n")
  expect_true(identical(res.a.m.d.n1, res.a.m.d.n2))

  res.mult1 <- xBalance(pr ~ ., data=nuclearplants,
                        report = c("adj.means", "z.scores", "chisquare.test", "p.values", "adj.mean.diffs", "adj.mean.diffs.null.sd"))
  res.mult2 <- xBalance(pr ~ ., data=nuclearplants,
                        report = c("adj.means", "z", "chi", "p", "adj.mean.diffs", "adj.mean.diffs.null"))
  expect_true(identical(res.mult1, res.mult2))

  res.all1 <- xBalance(pr ~ ., data=nuclearplants, report = "al")
  res.all2 <- xBalance(pr ~ ., data=nuclearplants, report = "all")
  expect_true(identical(res.all1, res.all2))

  # let's make sure the outputs are what we expect

  # Only z and p (p is always returned)
  expect_true(all(colnames(res.z1$results) == c("z", "p")))
  expect_true(all(colnames(res.z2$results) == c("z", "p")))

  # `results` is empty; overall isn't
  expect_true(is.null(colnames(res.chi1$results)))
  expect_true(is.null(colnames(res.chi2$results)))
  expect_true(!is.null(colnames(res.chi1$overall)))
  expect_true(!is.null(colnames(res.chi2$overall)))

  # Only z and p (p is always returned)
  expect_true(all(colnames(res.a.m.d.n1$results) == c("adj.diff.null.sd", "p")))
  expect_true(all(colnames(res.a.m.d.n2$results) == c("adj.diff.null.sd", "p")))

  expect_true(all(colnames(res.mult1$results) == c("Control", "Treatment", "adj.diff", "adj.diff.null.sd", "z", "p")))
  expect_true(all(colnames(res.mult2$results) == c("Control", "Treatment", "adj.diff", "adj.diff.null.sd", "z", "p")))
  expect_true(!is.null(colnames(res.chi1$overall)))
  expect_true(!is.null(colnames(res.chi2$overall)))

})

test_that("Passing post.alignment.transform, #26", {
  data(nuclearplants)

  # Identity shouldn't have an effect
  res1 <- xBalance(pr ~ ., data=nuclearplants)
  res2 <- xBalance(pr ~ ., data=nuclearplants, post.alignment.transform = function(x) x)

  expect_true(all.equal(res1, res2)) ## allow for small numerical differences

  res3 <- xBalance(pr ~ ., data=nuclearplants, post.alignment.transform = rank)

  expect_true(all(dim(res1$results) == dim(res3$results)))

  expect_error(xBalance(pr ~ ., data=nuclearplants, post.alignment.transform = mean),
               "Invalid post.alignment.transform given")

  res4 <- xBalance(pr ~ ., data=nuclearplants, post.alignment.transform = rank, report="all")
  res5 <- xBalance(pr ~ ., data=nuclearplants, report="all")

  expect_false(isTRUE(all.equal(res4,res5)))

  # a wilcoxon rank sum test, asymptotic and w/o continuity correction
  res6 <- xBalance(pr ~ cost, data=nuclearplants, post.alignment.transform = rank, report="all")

  expect_equal(res6$results["cost", "p", "unstrat"],
               wilcox.test(cost~pr, data=nuclearplants, exact=FALSE, correct=FALSE)$p.value)

  # w/ one variable, chisquare p value should be same as p value on that variable
  expect_equal(res6$results["cost", "p", "unstrat"],
               res6$overall["unstrat","p.value"])

  # to dos: test combo of a transform with non-default stratum weights.
  
})