Nothing
################################################################################
# Tests for utility functions
################################################################################
context("Matching summaries")
test_that("Failing subgroups", {
# good case:
m <- matrix(1, nrow = 3, ncol = 4, dimnames = list(letters[1:3], LETTERS[23:26]))
expect_warning(res.good <- summary(fullmatch(m)))
expect_true(all(res.good$matching.failed == 0))
# good case, but one unit unmatched
m[, 4] <- Inf
expect_warning(res.one.unmatched <- summary(fullmatch(m)))
expect_true(all(res.one.unmatched$matching.failed == 0))
# matching fails for all
f <- matrix(Inf, nrow = 3, ncol = 4, dimnames = list(letters[1:3], LETTERS[23:26]))
expect_warning(res.all.fail <- summary(fullmatch(f)))
expect_true(all(res.all.fail$matching.failed > 0))
# blocked good, 2 2x2 groups
b <- rep(c("A", "B"), each = 8)
z <- rep(c(0, 1), 8)
names(z) <- names(b) <- letters[1:16]
em <- exactMatch(z ~ b)
expect_warning(res.bg <- summary(fullmatch(em)))
expect_true(all(res.bg$matching.failed == 0))
# blocked group as above but with one un-matched unit
x <- matrix(0, nrow = 8, ncol = 8, dimnames = list(letters[c(2,4,6,8,10,12,14,16)],
letters[c(1,3,5,7,9,11,13,15)]))
x[, "a"] <- Inf
expect_warning(res.b.one.unmatched <- summary(fullmatch(em + x)))
expect_true(all(res.b.one.unmatched$matching.failed == 0))
# now mock up a match in which one group failed (and there is also one unmatched unit)
expect_warning(tmp <- fullmatch(em + x))
tmp[c(letters[9:16])] <- NA
res.b.subgrp.fail <- summary(tmp)
expect_true(all(res.b.subgrp.fail$matching.failed == c(4,4)))
# Failing subgroups, at least one but not all of which
# has an NA in treatment variable
data(nuclearplants)
np_mod <- nuclearplants
np_mod[which.max(np_mod$pt==1), "pr"] <- NA
expect_warning(tmp <- fullmatch(pr~cap + strata(pt), min.c=2, data=np_mod),
"atching failed")
expect_equivalent(optmatch:::subproblemSuccess(tmp),
c("0"=TRUE, "1"=FALSE))
expect_silent(summary(tmp))
# As above, but now all subgroups fail
expect_warning(tmp <- fullmatch(pr~cap + strata(pt), min.c=3, data=np_mod),
"atching failed")
expect_equivalent(optmatch:::subproblemSuccess(tmp),
c("0"=FALSE, "1"=FALSE))
expect_silent(summary(tmp))
})
test_that("New matching.failed", {
data(nuclearplants)
# one subproblem, good
# should be NULL
f <- fullmatch(pt ~ cost, data=nuclearplants)
expect_true(is.null(summary(f)$matching.failed))
# one subproblem, bad
# should be row matrix
expect_warning(f <- fullmatch(pt ~ cost, data=nuclearplants, caliper=1e-8))
expect_true(all(summary(f)$matching.failed == c(26,6)))
# many subproblems, all good
# should be NULL
np <- nuclearplants[nuclearplants$pt==0,]
frame <- exactMatch(pr ~ ne + ct, data=np)
frame@.Data[frame@rows==2] <- Inf
m <- match_on(pr ~ cost, within=frame, data=np)
f <- fullmatch(m, data=np)
expect_true(is.null(summary(f)$matching.failed))
# many subproblems, all good, some excluded individuals
# should be empty matrix
f <- fullmatch(pt ~ cost, data=nuclearplants, within=exactMatch(pt ~ ne, data=nuclearplants))
expect_true(is.null(summary(f)$matching.failed))
# many subproblems, 1 bad
# should be row matrix
f <- fullmatch(m, data=np)
f[attr(f, "subproblem") == "0.0"] <- NA
expect_true(all(summary(f)$matching.failed == c(7,3)))
# many subproblems, many bad
# should be matrix of 2 rows
f[attr(f, "subproblem") == "0.0"] <- NA
f[attr(f, "subproblem") == "1.0"] <- NA
mf <- summary(f)$matching.failed
expect_true(all(row.names(mf) == c("0.0", "1.0")))
expect_true(all(as.numeric(mf) == c(7,3,3,1)))
# many subproblems, all bad
# should be table of all z's
f[1:26] <- NA
mf <- summary(f)$matching.failed
expect_true(all(row.names(mf) == c("0.0", "0.1", "1.0", "1.1")))
expect_true(all(as.numeric(mf) == c(7,6,3,3,3,2,1,1)))
# recovered
data(nuclearplants)
m <- match_on(pr ~ cost, data=nuclearplants, within=exactMatch(pr ~ ct + ne, data=nuclearplants))
m@.Data[m@rows==2] <- Inf
expect_warning(f <- fullmatch(m, data=nuclearplants))
f[1] <- NA
# there are 5 NA's, but matching.failed only reports the 4 in the bad subgroup
expect_equal(sum(is.na(f)), 5)
expect_true(all(summary(f)$matching.failed == c(3,1)))
})
test_that("#118 missing subproblem attribute", {
data(nuclearplants)
f <- fullmatch(pr ~ cost, data=nuclearplants)
attr(f, "subproblem") <- NULL
expect_warning(summary(f))
f2 <- fullmatch(pr ~ cost + strata(pt), data = nuclearplants)
attr(f2, "subproblem") <- NULL
expect_warning(summary(f2))
f3 <- fullmatch(pr ~ cost + strata(pt), data = nuclearplants)
s <- summary(f3)
attr(s$thematch, "subproblem") <- NULL
expect_silent(s)
})
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.