Nothing
################################################################################
# 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.
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.