## Tests for tableby
context("Testing the paired output")
dat <- data.frame(
tp = c(1, 2, 1, 2, 1, 2, 1, 2, 1, 2),
id = c(1, 1, 2, 2, 3, 3, 4, 4, 5, 6),
Cat = c("A", "A", "A", "B", "B", "B", "B", "A", NA, "B"),
Fac = factor(c("A", "B", "C", "A", "B", "C", "A", "B", "C", "A")),
Num = c(1, 2, 3, 4, 4, 3, 3, 4, 0, NA),
Num2 = c(1, 2, 1, 2, 2, 1, 2, 0, 2, NA),
Ord = ordered(c("I", "II", "II", "III", "III", "III", "I", "III", "II", "I")),
Lgl = c(TRUE, TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, FALSE, FALSE, FALSE),
Dat = as.Date("2018-05-01") + c(1, 1, 2, 2, 3, 4, 5, 6, 3, 4),
stringsAsFactors = FALSE
)
dat$s <- selectall(a = c(1, 1, 0, 0, 0, 1, 0, 1, 0, 0), b = c(0, 0, 1, 1, 1, 0, 1, 0, 1, 1))
dat2 <- dat
###########################################################################################################
#### Basic paired calls
###########################################################################################################
for(i in 1:3)
{
if(i == 2) dat$id <- as.character(dat$id) else if(i == 3) dat$id <- as.factor(dat$id)
test_that(paste0("Basic paired call; class(id) = ", class(dat$id), "; na.paired('asis')"), {
expect_identical(
capture.kable(summary(paired(tp ~ Cat + Fac + Num + Ord + Lgl + Dat + s, data = dat, id = id,
signed.rank.exact = FALSE, na.action = na.paired("asis")), text = TRUE)),
c("| | 1 (N=5) | 2 (N=5) | Difference (N=4) | p value|",
"|:------------|:-----------------------:|:-----------------------:|:----------------:|-------:|",
"|Cat | | | | 1.000|",
"|- N-Miss | 1 | 0 | 0 | |",
"|- A | 2 (50.0%) | 2 (40.0%) | 1 (50.0%) | |",
"|- B | 2 (50.0%) | 3 (60.0%) | 1 (50.0%) | |",
"|Fac | | | | 0.261|",
"|- A | 2 (40.0%) | 2 (40.0%) | 2 (100.0%) | |",
"|- B | 1 (20.0%) | 2 (40.0%) | 1 (100.0%) | |",
"|- C | 2 (40.0%) | 1 (20.0%) | 1 (100.0%) | |",
"|Num | | | | 0.391|",
"|- N-Miss | 0 | 1 | 0 | |",
"|- Mean (SD) | 2.200 (1.643) | 3.250 (0.957) | 0.500 (1.000) | |",
"|- Range | 0.000 - 4.000 | 2.000 - 4.000 | -1.000 - 1.000 | |",
"|Ord | | | | 0.174|",
"|- I | 2 (40.0%) | 1 (20.0%) | 2 (100.0%) | |",
"|- II | 2 (40.0%) | 1 (20.0%) | 1 (100.0%) | |",
"|- III | 1 (20.0%) | 3 (60.0%) | 0 (0.0%) | |",
"|Lgl | | | | 1.000|",
"|- FALSE | 3 (60.0%) | 2 (40.0%) | 2 (100.0%) | |",
"|- TRUE | 2 (40.0%) | 3 (60.0%) | 1 (50.0%) | |",
"|Dat | | | | 0.182|",
"|- Median | 2018-05-04 | 2018-05-05 | 0.500 | |",
"|- Range | 2018-05-02 - 2018-05-06 | 2018-05-02 - 2018-05-07 | 0.000 - 1.000 | |",
"|s | | | | |",
"|- a | 1 (20.0%) | 3 (60.0%) | 2 (50.0%) | |",
"|- b | 4 (80.0%) | 2 (40.0%) | 2 (50.0%) | |"
)
)
})
test_that(paste0("Basic paired call; class(id) = ", class(dat$id), "; na.paired('fill')"), {
expect_identical(
capture.kable(summary(paired(tp ~ Cat + Fac + Num + Ord + Lgl + Dat, data = dat, id = id,
signed.rank.exact = FALSE, na.action = na.paired("fill")), text = TRUE)),
c("| | 1 (N=6) | 2 (N=6) | Difference (N=6) | p value|",
"|:------------|:-----------------------:|:-----------------------:|:----------------:|-------:|",
"|Cat | | | | 1.000|",
"|- N-Miss | 2 | 1 | 2 | |",
"|- A | 2 (50.0%) | 2 (40.0%) | 1 (50.0%) | |",
"|- B | 2 (50.0%) | 3 (60.0%) | 1 (50.0%) | |",
"|Fac | | | | 0.261|",
"|- N-Miss | 1 | 1 | 2 | |",
"|- A | 2 (40.0%) | 2 (40.0%) | 2 (100.0%) | |",
"|- B | 1 (20.0%) | 2 (40.0%) | 1 (100.0%) | |",
"|- C | 2 (40.0%) | 1 (20.0%) | 1 (100.0%) | |",
"|Num | | | | 0.391|",
"|- N-Miss | 1 | 2 | 2 | |",
"|- Mean (SD) | 2.200 (1.643) | 3.250 (0.957) | 0.500 (1.000) | |",
"|- Range | 0.000 - 4.000 | 2.000 - 4.000 | -1.000 - 1.000 | |",
"|Ord | | | | 0.174|",
"|- N-Miss | 1 | 1 | 2 | |",
"|- I | 2 (40.0%) | 1 (20.0%) | 2 (100.0%) | |",
"|- II | 2 (40.0%) | 1 (20.0%) | 1 (100.0%) | |",
"|- III | 1 (20.0%) | 3 (60.0%) | 0 (0.0%) | |",
"|Lgl | | | | 1.000|",
"|- N-Miss | 1 | 1 | 2 | |",
"|- FALSE | 3 (60.0%) | 2 (40.0%) | 2 (100.0%) | |",
"|- TRUE | 2 (40.0%) | 3 (60.0%) | 1 (50.0%) | |",
"|Dat | | | | 0.182|",
"|- N-Miss | 1 | 1 | 2 | |",
"|- Median | 2018-05-04 | 2018-05-05 | 0.500 | |",
"|- Range | 2018-05-02 - 2018-05-06 | 2018-05-02 - 2018-05-07 | 0.000 - 1.000 | |"
)
)
})
test_that(paste0("Basic paired call; class(id) = ", class(dat$id), "; na.paired('in.both')"), {
expect_identical(
capture.kable(summary(paired(tp ~ Cat + Fac + Num + Ord + Lgl + Dat, data = dat, id = id,
signed.rank.exact = FALSE, na.action = na.paired("in.both")), text = TRUE)),
c("| | 1 (N=4) | 2 (N=4) | Difference (N=4) | p value|",
"|:------------|:-----------------------:|:-----------------------:|:----------------:|-------:|",
"|Cat | | | | 1.000|",
"|- A | 2 (50.0%) | 2 (50.0%) | 1 (50.0%) | |",
"|- B | 2 (50.0%) | 2 (50.0%) | 1 (50.0%) | |",
"|Fac | | | | 0.261|",
"|- A | 2 (50.0%) | 1 (25.0%) | 2 (100.0%) | |",
"|- B | 1 (25.0%) | 2 (50.0%) | 1 (100.0%) | |",
"|- C | 1 (25.0%) | 1 (25.0%) | 1 (100.0%) | |",
"|Num | | | | 0.391|",
"|- Mean (SD) | 2.750 (1.258) | 3.250 (0.957) | 0.500 (1.000) | |",
"|- Range | 1.000 - 4.000 | 2.000 - 4.000 | -1.000 - 1.000 | |",
"|Ord | | | | 0.174|",
"|- I | 2 (50.0%) | 0 (0.0%) | 2 (100.0%) | |",
"|- II | 1 (25.0%) | 1 (25.0%) | 1 (100.0%) | |",
"|- III | 1 (25.0%) | 3 (75.0%) | 0 (0.0%) | |",
"|Lgl | | | | 1.000|",
"|- FALSE | 2 (50.0%) | 1 (25.0%) | 2 (100.0%) | |",
"|- TRUE | 2 (50.0%) | 3 (75.0%) | 1 (50.0%) | |",
"|Dat | | | | 0.182|",
"|- Median | 2018-05-03 | 2018-05-04 | 0.500 | |",
"|- Range | 2018-05-02 - 2018-05-06 | 2018-05-02 - 2018-05-07 | 0.000 - 1.000 | |"
)
)
})
}
test_that(paste0("Basic paired call; na.paired('in.both')"), {
expect_identical(
capture.kable(summary(paired(tp ~ Cat + Fac + Lgl, data = dat, id = id,
test = FALSE, na.action = na.paired("in.both"),
cat.stats = c("Nmiss", "countrowpct", "countcellpct", "rowbinomCI")), text = TRUE)),
c("| | 1 (N=4) | 2 (N=4) | Difference (N=4) |",
"|:--------|:--------------------:|:--------------------:|:--------------------:|",
"|Cat | | | |",
"|- A | 2 (50.0%) | 2 (50.0%) | 1 (50.0%) |",
"|- B | 2 (50.0%) | 2 (50.0%) | 1 (50.0%) |",
"|- A | 2 (25.0%) | 2 (25.0%) | 1 (50.0%) |",
"|- B | 2 (25.0%) | 2 (25.0%) | 1 (50.0%) |",
"|- A | 0.500 (0.068, 0.932) | 0.500 (0.068, 0.932) | 0.500 (0.013, 0.987) |",
"|- B | 0.500 (0.068, 0.932) | 0.500 (0.068, 0.932) | 0.500 (0.013, 0.987) |",
"|Fac | | | |",
"|- A | 2 (66.7%) | 1 (33.3%) | 2 (100.0%) |",
"|- B | 1 (33.3%) | 2 (66.7%) | 1 (100.0%) |",
"|- C | 1 (50.0%) | 1 (50.0%) | 1 (100.0%) |",
"|- A | 2 (25.0%) | 1 (12.5%) | 2 (100.0%) |",
"|- B | 1 (12.5%) | 2 (25.0%) | 1 (100.0%) |",
"|- C | 1 (12.5%) | 1 (12.5%) | 1 (100.0%) |",
"|- A | 0.667 (0.094, 0.992) | 0.333 (0.008, 0.906) | 1.000 (0.158, 1.000) |",
"|- B | 0.333 (0.008, 0.906) | 0.667 (0.094, 0.992) | 1.000 (0.025, 1.000) |",
"|- C | 0.500 (0.013, 0.987) | 0.500 (0.013, 0.987) | 1.000 (0.025, 1.000) |",
"|Lgl | | | |",
"|- FALSE | 2 (66.7%) | 1 (33.3%) | 2 (100.0%) |",
"|- TRUE | 2 (40.0%) | 3 (60.0%) | 1 (50.0%) |",
"|- FALSE | 2 (25.0%) | 1 (12.5%) | 2 (100.0%) |",
"|- TRUE | 2 (25.0%) | 3 (37.5%) | 1 (50.0%) |",
"|- FALSE | 0.667 (0.094, 0.992) | 0.333 (0.008, 0.906) | 1.000 (0.158, 1.000) |",
"|- TRUE | 0.400 (0.053, 0.853) | 0.600 (0.147, 0.947) | 0.500 (0.013, 0.987) |"
)
)
})
dat$id[10] <- NA
dat$tp[9] <- NA
test_that("Paired with missings", {
expect_identical(
capture.kable(summary(paired(tp ~ Cat + Fac + Num + Ord + Lgl + Dat, data = dat, id = id, signed.rank.exact = FALSE), text = TRUE)),
c("| | 1 (N=4) | 2 (N=4) | Difference (N=4) | p value|",
"|:------------|:-----------------------:|:-----------------------:|:----------------:|-------:|",
"|Cat | | | | 1.000|",
"|- A | 2 (50.0%) | 2 (50.0%) | 1 (50.0%) | |",
"|- B | 2 (50.0%) | 2 (50.0%) | 1 (50.0%) | |",
"|Fac | | | | 0.261|",
"|- A | 2 (50.0%) | 1 (25.0%) | 2 (100.0%) | |",
"|- B | 1 (25.0%) | 2 (50.0%) | 1 (100.0%) | |",
"|- C | 1 (25.0%) | 1 (25.0%) | 1 (100.0%) | |",
"|Num | | | | 0.391|",
"|- Mean (SD) | 2.750 (1.258) | 3.250 (0.957) | 0.500 (1.000) | |",
"|- Range | 1.000 - 4.000 | 2.000 - 4.000 | -1.000 - 1.000 | |",
"|Ord | | | | 0.174|",
"|- I | 2 (50.0%) | 0 (0.0%) | 2 (100.0%) | |",
"|- II | 1 (25.0%) | 1 (25.0%) | 1 (100.0%) | |",
"|- III | 1 (25.0%) | 3 (75.0%) | 0 (0.0%) | |",
"|Lgl | | | | 1.000|",
"|- FALSE | 2 (50.0%) | 1 (25.0%) | 2 (100.0%) | |",
"|- TRUE | 2 (50.0%) | 3 (75.0%) | 1 (50.0%) | |",
"|Dat | | | | 0.182|",
"|- Median | 2018-05-03 | 2018-05-04 | 0.500 | |",
"|- Range | 2018-05-02 - 2018-05-06 | 2018-05-02 - 2018-05-07 | 0.000 - 1.000 | |"
)
)
})
test_that("09/07/2018: specifying different digits (#107) and cat.simplify (#134)", {
expect_identical(
capture.kable(summary(paired(tp ~ mcnemar(Cat, digits.count = 1, digits.pct = 0, cat.simplify = TRUE) + paired.t(Num, digits = 1) +
sign.test(Num2, "meansd") + paired.t(Dat, "median", date.simplify = TRUE),
data = dat, id = id, numeric.simplify = TRUE), text = TRUE, labelTranslations = list(Dat = "Date"))),
c("| | 1 (N=4) | 2 (N=4) | Difference (N=4) | p value|",
"|:------------|:-------------:|:-------------:|:----------------:|-------:|",
"|Cat | 2.0 (50%) | 2.0 (50%) | 1.0 (50%) | 1.000|",
"|Num | | | | 0.391|",
"|- Mean (SD) | 2.8 (1.3) | 3.2 (1.0) | 0.5 (1.0) | |",
"|- Range | 1.0 - 4.0 | 2.0 - 4.0 | -1.0 - 1.0 | |",
"|Num2 | 1.500 (0.577) | 1.250 (0.957) | -0.250 (1.500) | 1.000|",
"|Date | 2018-05-03 | 2018-05-04 | 0.500 | 0.182|"
)
)
})
dat$tp <- replace(as.character(dat$tp), dat$tp == "2", "")
test_that("08/23/2018: empty string in by-variable (#121)",
expect_warning(summary(paired(tp ~ Cat, id = id, data = dat, signed.rank.exact = FALSE)), "Empty"))
test_that("07/17/2019: fix bug with confidence limits and count (#234, #235)", {
tmp <- dat2
tmp$Cat[2] <- "B"
expect_identical(
capture.kable(summary(paired(tp ~ Cat, data = tmp, cat.stats = c("binomCI", "count", "countpct"), id = id,
control = tableby.control(conf.level = 0.9)), text = TRUE)),
c("| | 1 (N=4) | 2 (N=4) | Difference (N=4) | p value|",
"|:----|:--------------------:|:--------------------:|:--------------------:|-------:|",
"|Cat | | | | 0.248|",
"|- A | 0.500 (0.098, 0.902) | 0.250 (0.013, 0.751) | 1.000 (0.224, 1.000) | |",
"|- B | 0.500 (0.098, 0.902) | 0.750 (0.249, 0.987) | 0.500 (0.025, 0.975) | |",
"|- A | 2 | 1 | 2 | |",
"|- B | 2 | 3 | 1 | |",
"|- A | 2 (50.0%) | 1 (25.0%) | 2 (100.0%) | |",
"|- B | 2 (50.0%) | 3 (75.0%) | 1 (50.0%) | |"
)
)
})
test_that("12/27/2019: Nrowpct works (#263)", {
d <- data.frame(
tp = rep(c("Time 1", "Time 2"), times = 4),
id = c(1, 1, 2, 2, 3, 3, 4, 4),
a = c(1, 1, 2, 2, 3, 3, 4, 4),
b = c(1, 0, 2, 0, 3, 0, 4, 0)
)
expect_identical(
capture.kable(summary(paired(tp ~ notest(a) + b, id = id, data = d, numeric.stats = c("meansd", "Nrowpct")), text = TRUE)),
c("| | Time 1 (N=4) | Time 2 (N=4) | Difference (N=4) | p value|",
"|:------------|:-------------:|:-------------:|:----------------:|-------:|",
"|a | | | | |",
"|- Mean (SD) | 2.500 (1.291) | 2.500 (1.291) | 0.000 (0.000) | |",
"|- N (%) | 4 (50.0%) | 4 (50.0%) | 0 (0.0%) | |",
"|b | | | | 0.030|",
"|- Mean (SD) | 2.500 (1.291) | 0.000 (0.000) | -2.500 (1.291) | |",
"|- N (%) | 4 (50.0%) | 4 (50.0%) | 4 (100.0%) | |"
)
)
})
test_that("12/27/2019: changing the difference label (#271)", {
expect_identical(
capture.kable(summary(paired(tp ~ Cat + Fac + Num, data = dat2, id = id, signed.rank.exact = FALSE, cat.stats = c("countpct", "countrowpct"),
stats.labels = list(meansd = "Mean (sd)", range = "Ran", difference = "Diff")), text = TRUE)),
c("| | 1 (N=4) | 2 (N=4) | Diff (N=4) | p value|",
"|:------------|:-------------:|:-------------:|:--------------:|-------:|",
"|Cat | | | | 1.000|",
"|- A | 2 (50.0%) | 2 (50.0%) | 1 (50.0%) | |",
"|- B | 2 (50.0%) | 2 (50.0%) | 1 (50.0%) | |",
"|- A | 2 (50.0%) | 2 (50.0%) | 1 (50.0%) | |",
"|- B | 2 (50.0%) | 2 (50.0%) | 1 (50.0%) | |",
"|Fac | | | | 0.261|",
"|- A | 2 (50.0%) | 1 (25.0%) | 2 (100.0%) | |",
"|- B | 1 (25.0%) | 2 (50.0%) | 1 (100.0%) | |",
"|- C | 1 (25.0%) | 1 (25.0%) | 1 (100.0%) | |",
"|- A | 2 (66.7%) | 1 (33.3%) | 2 (100.0%) | |",
"|- B | 1 (33.3%) | 2 (66.7%) | 1 (100.0%) | |",
"|- C | 1 (50.0%) | 1 (50.0%) | 1 (100.0%) | |",
"|Num | | | | 0.391|",
"|- Mean (sd) | 2.750 (1.258) | 3.250 (0.957) | 0.500 (1.000) | |",
"|- Ran | 1.000 - 4.000 | 2.000 - 4.000 | -1.000 - 1.000 | |"
)
)
})
test_that("12/27/2019: informative error when no stats are computed (#273)", {
expect_error(summary(paired(tp ~ Cat, data = dat2, id = id, cat.stats = "Nmiss")), "Nothing to show for variable")
})
test_that("NAs in sign.test, plus Nsigntest (#326)", {
d <- data.frame(
tp = rep(c("Time 1", "Time 2"), times = 4),
id = c(1, 1, 2, 2, 3, 3, 4, 4),
a = c(1, 2, 2, 3, 3, 4, 5, NA)
)
expect_identical(
capture.kable(summary(paired(tp ~ sign.test(a), id = id, data = d, numeric.stats = c("Nmiss", "meansd", "range", "Nsigntest")), text = TRUE)),
c("| | Time 1 (N=4) | Time 2 (N=4) | Difference (N=4) | p value|",
"|:----------------|:-------------:|:-------------:|:----------------:|-------:|",
"|a | | | | 0.250|",
"|- N-Miss | 0 | 1 | 1 | |",
"|- Mean (SD) | 2.750 (1.708) | 3.000 (1.000) | 1.000 (0.000) | |",
"|- Range | 1.000 - 5.000 | 2.000 - 4.000 | 1.000 - 1.000 | |",
"|- N (sign test) | NA | NA | 3 | |"
)
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.