## Tests for tableby
context("Testing the tableby output")
# "mdat" now defined in helper-data.R
###########################################################################################################
#### Basic two-sided tableby
###########################################################################################################
test_that("A basic two-sided tableby call--no labels, no missings", {
expect_identical(
capture.kable(summary(tableby(Group ~ Sex + time + dt, data = mdat, numeric.stats = c("meansd", "q1q3", "range")), text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | Total (N=90) | p value|",
"|:------------|:-----------------------:|:-----------------------:|:-----------------------:|:-----------------------:|-------:|",
"|Sex | | | | | 0.733|",
"|- Female | 15 (50.0%) | 17 (56.7%) | 14 (46.7%) | 46 (51.1%) | |",
"|- Male | 15 (50.0%) | 13 (43.3%) | 16 (53.3%) | 44 (48.9%) | |",
"|time | | | | | 0.025|",
"|- Mean (SD) | 4.567 (1.813) | 3.167 (2.036) | 3.833 (2.001) | 3.856 (2.014) | |",
"|- Q1, Q3 | 3.250, 6.000 | 1.250, 5.000 | 2.000, 5.000 | 2.000, 6.000 | |",
"|- Range | 0.000 - 7.000 | 0.000 - 6.000 | 1.000 - 7.000 | 0.000 - 7.000 | |",
"|dt | | | | | 0.391|",
"|- Median | 1950-01-07 | 1951-06-13 | 1948-09-13 | 1949-10-07 | |",
"|- Range | 1935-08-15 - 1968-05-14 | 1937-02-08 - 1959-09-06 | 1939-04-01 - 1958-07-30 | 1935-08-15 - 1968-05-14 | |"
)
)
})
test_that("A basic two-sided tableby call--labels, no missings", {
skip_if_not_installed("coin")
expect_identical(
capture.kable(summary(tableby(Group ~ Age + trt + Phase, data = mdat, numeric.stats = c("meansd", "q1q3", "range")), text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | Total (N=90) | p value|",
"|:-------------|:---------------:|:---------------:|:---------------:|:---------------:|-------:|",
"|Age in Years | | | | | 0.906|",
"|- Mean (SD) | 40.033 (6.217) | 39.633 (3.873) | 39.433 (5.569) | 39.700 (5.258) | |",
"|- Q1, Q3 | 36.000, 44.500 | 37.250, 41.750 | 35.250, 44.000 | 36.000, 43.000 | |",
"|- Range | 29.000 - 53.000 | 32.000 - 48.000 | 30.000 - 52.000 | 29.000 - 53.000 | |",
"|Treatment Arm | | | | | 0.659|",
"|- A | 14 (46.7%) | 11 (36.7%) | 11 (36.7%) | 36 (40.0%) | |",
"|- B | 16 (53.3%) | 19 (63.3%) | 19 (63.3%) | 54 (60.0%) | |",
"|Phase | | | | | 0.008|",
"|- I | 11 (36.7%) | 12 (40.0%) | 0 (0.0%) | 23 (25.6%) | |",
"|- II | 10 (33.3%) | 12 (40.0%) | 19 (63.3%) | 41 (45.6%) | |",
"|- III | 9 (30.0%) | 6 (20.0%) | 11 (36.7%) | 26 (28.9%) | |"
)
)
})
test_that("A basic two-sided tableby call--no labels, some missings", {
expect_identical(
capture.kable(summary(tableby(Group ~ ethan, data = mdat), text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | Total (N=90) | p value|",
"|:----------|:-----------:|:----------:|:----------:|:------------:|-------:|",
"|ethan | | | | | 0.178|",
"|- N-Miss | 3 | 0 | 0 | 3 | |",
"|- Ethan | 17 (63.0%) | 13 (43.3%) | 12 (40.0%) | 42 (48.3%) | |",
"|- Heinzen | 10 (37.0%) | 17 (56.7%) | 18 (60.0%) | 45 (51.7%) | |"
)
)
})
###########################################################################################################
#### Basic one-sided tableby
###########################################################################################################
test_that("A basic one-sided tableby call--no labels, no missings", {
expect_identical(
capture.kable(summary(tableby(~ Sex + time + dt, data = mdat), text = TRUE)),
c("| | Overall (N=90) |",
"|:------------|:-----------------------:|",
"|Sex | |",
"|- Female | 46 (51.1%) |",
"|- Male | 44 (48.9%) |",
"|time | |",
"|- Mean (SD) | 3.856 (2.014) |",
"|- Range | 0.000 - 7.000 |",
"|dt | |",
"|- Median | 1949-10-07 |",
"|- Range | 1935-08-15 - 1968-05-14 |"
)
)
})
test_that("A basic one-sided tableby call--labels, no missings", {
expect_identical(
capture.kable(summary(tableby(~ Age + trt, data = mdat, numeric.stats = c("meansd", "q1q3", "range")), text = TRUE)),
c("| | Overall (N=90) |",
"|:-------------|:---------------:|",
"|Age in Years | |",
"|- Mean (SD) | 39.700 (5.258) |",
"|- Q1, Q3 | 36.000, 43.000 |",
"|- Range | 29.000 - 53.000 |",
"|Treatment Arm | |",
"|- A | 36 (40.0%) |",
"|- B | 54 (60.0%) |"
)
)
})
test_that("A basic one-sided tableby call--no labels, some missings (Sarah Jenkins's Error)", {
expect_identical(
capture.kable(summary(tableby(~ ethan, data = mdat), text = TRUE)),
c("| | Overall (N=90) |",
"|:----------|:--------------:|",
"|ethan | |",
"|- N-Miss | 3 |",
"|- Ethan | 42 (48.3%) |",
"|- Heinzen | 45 (51.7%) |"
)
)
})
###########################################################################################################
#### Change totals/p-values
###########################################################################################################
test_that("A basic two-sided tableby call--no p-value, no total", {
expect_identical(
capture.kable(summary(tableby(Group ~ Age + Sex, data = mdat, test = FALSE, total = FALSE), text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) |",
"|:------------|:---------------:|:---------------:|:---------------:|",
"|Age in Years | | | |",
"|- Mean (SD) | 40.033 (6.217) | 39.633 (3.873) | 39.433 (5.569) |",
"|- Range | 29.000 - 53.000 | 32.000 - 48.000 | 30.000 - 52.000 |",
"|Sex | | | |",
"|- Female | 15 (50.0%) | 17 (56.7%) | 14 (46.7%) |",
"|- Male | 15 (50.0%) | 13 (43.3%) | 16 (53.3%) |"
)
)
expect_identical(
capture.kable(summary(tableby(Group ~ Age + Sex, data = mdat), test = FALSE, total = FALSE, text = TRUE)),
capture.kable(summary(tableby(Group ~ Age + Sex, data = mdat, test = FALSE, total = FALSE), text = TRUE))
)
})
test_that("A basic two-sided tableby call--p-value, no total", {
expect_identical(
capture.kable(summary(tableby(Group ~ Age + Sex, data = mdat, total = FALSE), text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | p value|",
"|:------------|:---------------:|:---------------:|:---------------:|-------:|",
"|Age in Years | | | | 0.906|",
"|- Mean (SD) | 40.033 (6.217) | 39.633 (3.873) | 39.433 (5.569) | |",
"|- Range | 29.000 - 53.000 | 32.000 - 48.000 | 30.000 - 52.000 | |",
"|Sex | | | | 0.733|",
"|- Female | 15 (50.0%) | 17 (56.7%) | 14 (46.7%) | |",
"|- Male | 15 (50.0%) | 13 (43.3%) | 16 (53.3%) | |"
)
)
expect_identical(
capture.kable(summary(tableby(Group ~ Age + Sex, data = mdat), total = FALSE, text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | p value|",
"|:------------|:---------------:|:---------------:|:---------------:|-------:|",
"|Age in Years | | | | 0.906|",
"|- Mean (SD) | 40.033 (6.217) | 39.633 (3.873) | 39.433 (5.569) | |",
"|- Range | 29.000 - 53.000 | 32.000 - 48.000 | 30.000 - 52.000 | |",
"|Sex | | | | 0.733|",
"|- Female | 15 (50.0%) | 17 (56.7%) | 14 (46.7%) | |",
"|- Male | 15 (50.0%) | 13 (43.3%) | 16 (53.3%) | |"
)
)
})
###########################################################################################################
#### markdown output
###########################################################################################################
test_that("A basic two-sided tableby markdown output", {
expect_identical(
capture.kable(summary(tableby(Group ~ Age + Sex + notest(ethan) + dt, data = mdat,
numeric.stats = c("meansd", "q1q3", "range"), total = FALSE), pfootnote = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | p value|",
"|:---------------------------|:-----------------------:|:-----------------------:|:-----------------------:|--------:|",
"|**Age in Years** | | | | 0.906^1^|",
"| Mean (SD) | 40.033 (6.217) | 39.633 (3.873) | 39.433 (5.569) | |",
"| Q1, Q3 | 36.000, 44.500 | 37.250, 41.750 | 35.250, 44.000 | |",
"| Range | 29.000 - 53.000 | 32.000 - 48.000 | 30.000 - 52.000 | |",
"|**Sex** | | | | 0.733^2^|",
"| Female | 15 (50.0%) | 17 (56.7%) | 14 (46.7%) | |",
"| Male | 15 (50.0%) | 13 (43.3%) | 16 (53.3%) | |",
"|**ethan** | | | | |",
"| N-Miss | 3 | 0 | 0 | |",
"| Ethan | 17 (63.0%) | 13 (43.3%) | 12 (40.0%) | |",
"| Heinzen | 10 (37.0%) | 17 (56.7%) | 18 (60.0%) | |",
"|**dt** | | | | 0.391^3^|",
"| Median | 1950-01-07 | 1951-06-13 | 1948-09-13 | |",
"| Range | 1935-08-15 - 1968-05-14 | 1937-02-08 - 1959-09-06 | 1939-04-01 - 1958-07-30 | |",
"1. Linear Model ANOVA" ,
"2. Pearson's Chi-squared test" ,
"3. Kruskal-Wallis rank sum test"
)
)
})
###########################################################################################################
#### Other warnings and tests and things...
###########################################################################################################
test_that("A warning occurs using one-sided formula and na.tableby", {
expect_error(tableby(~ ethan, data = mdat, na.action = na.tableby), "na.tableby now generates functions")
expect_warning(tableby(~ ethan, data = mdat, na.action = na.tableby(TRUE)))
})
test_that("The by-variable droplevels is working correctly", {
expect_identical(
capture.kable(summary(tableby(Group.fac ~ Sex + time + dt, data = mdat[mdat$Group.fac %in% c("High", "Low"), ]), text = TRUE)),
c("| | High (N=30) | Low (N=30) | Total (N=60) | p value|",
"|:------------|:-----------------------:|:-----------------------:|:-----------------------:|-------:|",
"|Sex | | | | 0.605|",
"|- Female | 15 (50.0%) | 17 (56.7%) | 32 (53.3%) | |",
"|- Male | 15 (50.0%) | 13 (43.3%) | 28 (46.7%) | |",
"|time | | | | 0.007|",
"|- Mean (SD) | 4.567 (1.813) | 3.167 (2.036) | 3.867 (2.038) | |",
"|- Range | 0.000 - 7.000 | 0.000 - 6.000 | 0.000 - 7.000 | |",
"|dt | | | | 0.574|",
"|- Median | 1950-01-07 | 1951-06-13 | 1950-07-02 | |",
"|- Range | 1935-08-15 - 1968-05-14 | 1937-02-08 - 1959-09-06 | 1935-08-15 - 1968-05-14 | |"
)
)
})
test_that("Using cat.simplify", {
expect_identical(
capture.kable(summary(tableby(Group ~ Sex + trt, data = mdat, cat.simplify = TRUE), text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | Total (N=90) | p value|",
"|:-------------|:-----------:|:----------:|:----------:|:------------:|-------:|",
"|Sex | 15 (50.0%) | 13 (43.3%) | 16 (53.3%) | 44 (48.9%) | 0.733|",
"|Treatment Arm | 16 (53.3%) | 19 (63.3%) | 19 (63.3%) | 54 (60.0%) | 0.659|"
)
)
})
test_that("Reordering variables", {
expect_identical(
capture.kable(summary(tableby(Group ~ Sex + dt + Age, data = mdat)[c(3,1,2)], text = TRUE)),
capture.kable(summary(tableby(Group ~ Age + Sex + dt, data = mdat), text = TRUE))
)
expect_identical(
capture.kable(summary(sort(tableby(Group ~ Sex + dt + Age, data = mdat)))),
capture.kable(summary(tableby(Group ~ dt + Sex + Age, data = mdat)))
)
expect_identical(
capture.kable(summary(tableby(Group ~ fe(Sex) + dt + Age, data = mdat)[c(3,1,2)], text = TRUE)),
capture.kable(summary(tableby(Group ~ fe(Sex) + dt + Age, data = mdat)[c("Age", "Sex", "dt")], text = TRUE))
)
expect_identical(
capture.kable(summary(tableby(Group ~ fe(Sex) + dt + Age, data = mdat)[1:2], text = TRUE)),
capture.kable(summary(tableby(Group ~ fe(Sex) + dt + Age, data = mdat)[c(TRUE, TRUE, FALSE)], text = TRUE))
)
expect_identical(
capture.kable(summary(tableby(Group ~ fe(Sex) + dt + Age, data = mdat), text = TRUE)),
capture.kable(summary(tableby(Group ~ fe(Sex) + dt + Age, data = mdat)[], text = TRUE))
)
expect_warning(tableby(Group ~ fe(Sex) + dt + Age, data = mdat)[1:4], "Some indices not found")
expect_error(tableby(Group ~ fe(Sex) + dt + Age, data = mdat)[TRUE], "Logical vector")
})
test_that("Merging tableby objects", {
skip_if_not_installed("coin")
tb1 <- tableby(Group ~ Sex + Phase, data = mdat)
tb2 <- tableby(Group.fac ~ Age, data = mdat)
tb3 <- tableby(Group ~ Age + dt, data = mdat)
tb4 <- tableby(Group ~ chisq(Sex, "count"), data = mdat)
expect_error(merge(tb1, tb2), "No terms in common")
expect_error(merge(tb1, tableby(Group ~ Age, data = set_labels(mdat, list(Group = "Eek")))), "By-variables not identical")
expect_identical(
capture.kable(summary(merge(tb1, tb2, all = TRUE))),
c(capture.kable(summary(tb1)), "", "", capture.kable(summary(tb2)))
)
expect_identical(
capture.kable(summary(merge(tb1, tb3), text = TRUE)),
capture.kable(summary(tableby(Group ~ Sex + Phase + Age + dt, data = mdat), text = TRUE))
)
expect_identical(
capture.kable(summary(merge(tb1, tb4), text = TRUE)),
capture.kable(summary(tableby(Group ~ chisq(Sex, "count") + Phase, data = mdat), text = TRUE))
)
})
test_that("Changing tests", {
expect_identical(
capture.kable(summary(tableby(Group ~ fe(Sex) + kwt(Age) + notest(Phase), data = mdat, numeric.stats = c("meansd", "q1q3", "range")), text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | Total (N=90) | p value|",
"|:------------|:---------------:|:---------------:|:---------------:|:---------------:|-------:|",
"|Sex | | | | | 0.806|",
"|- Female | 15 (50.0%) | 17 (56.7%) | 14 (46.7%) | 46 (51.1%) | |",
"|- Male | 15 (50.0%) | 13 (43.3%) | 16 (53.3%) | 44 (48.9%) | |",
"|Age in Years | | | | | 0.869|",
"|- Mean (SD) | 40.033 (6.217) | 39.633 (3.873) | 39.433 (5.569) | 39.700 (5.258) | |",
"|- Q1, Q3 | 36.000, 44.500 | 37.250, 41.750 | 35.250, 44.000 | 36.000, 43.000 | |",
"|- Range | 29.000 - 53.000 | 32.000 - 48.000 | 30.000 - 52.000 | 29.000 - 53.000 | |",
"|Phase | | | | | |",
"|- I | 11 (36.7%) | 12 (40.0%) | 0 (0.0%) | 23 (25.6%) | |",
"|- II | 10 (33.3%) | 12 (40.0%) | 19 (63.3%) | 41 (45.6%) | |",
"|- III | 9 (30.0%) | 6 (20.0%) | 11 (36.7%) | 26 (28.9%) | |"
)
)
expect_identical(
capture.kable(summary(tableby(Group ~ Sex + Age + Phase, data = mdat, numeric.test = "kwt", cat.test = "fe", ordered.test = "notest"), text = TRUE)),
capture.kable(summary(tableby(Group ~ fe(Sex) + kwt(Age) + notest(Phase), data = mdat), text = TRUE))
)
})
test_that("Changing labels", {
tb <- tableby(Group ~ Sex + Age, data = mdat)
expect_error(labels(tb) <- c("Group", "Sex", "Age"))
expect_warning(labels(tb) <- c(hi = "hi", Sex = "Sex", Age = "Age"), NA)
expect_identical(
capture.kable(summary(tb, text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | Total (N=90) | p value|",
"|:------------|:---------------:|:---------------:|:---------------:|:---------------:|-------:|",
"|Sex | | | | | 0.733|",
"|- Female | 15 (50.0%) | 17 (56.7%) | 14 (46.7%) | 46 (51.1%) | |",
"|- Male | 15 (50.0%) | 13 (43.3%) | 16 (53.3%) | 44 (48.9%) | |",
"|Age | | | | | 0.906|",
"|- Mean (SD) | 40.033 (6.217) | 39.633 (3.873) | 39.433 (5.569) | 39.700 (5.258) | |",
"|- Range | 29.000 - 53.000 | 32.000 - 48.000 | 30.000 - 52.000 | 29.000 - 53.000 | |"
)
)
labels(tb) <- NULL
expect_identical(
capture.kable(summary(tb, text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | Total (N=90) | p value|",
"|:------------|:---------------:|:---------------:|:---------------:|:---------------:|-------:|",
"|Sex | | | | | 0.733|",
"|- Female | 15 (50.0%) | 17 (56.7%) | 14 (46.7%) | 46 (51.1%) | |",
"|- Male | 15 (50.0%) | 13 (43.3%) | 16 (53.3%) | 44 (48.9%) | |",
"|Age | | | | | 0.906|",
"|- Mean (SD) | 40.033 (6.217) | 39.633 (3.873) | 39.433 (5.569) | 39.700 (5.258) | |",
"|- Range | 29.000 - 53.000 | 32.000 - 48.000 | 30.000 - 52.000 | 29.000 - 53.000 | |"
)
)
labels(tb) <- list(Age = "Age (yrs)", Sex = "Gender")
expect_identical(labels(tb), c(Group = "Group", Sex = "Gender", Age = "Age (yrs)"))
expect_identical(
capture.kable(summary(tb, text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | Total (N=90) | p value|",
"|:------------|:---------------:|:---------------:|:---------------:|:---------------:|-------:|",
"|Gender | | | | | 0.733|",
"|- Female | 15 (50.0%) | 17 (56.7%) | 14 (46.7%) | 46 (51.1%) | |",
"|- Male | 15 (50.0%) | 13 (43.3%) | 16 (53.3%) | 44 (48.9%) | |",
"|Age (yrs) | | | | | 0.906|",
"|- Mean (SD) | 40.033 (6.217) | 39.633 (3.873) | 39.433 (5.569) | 39.700 (5.258) | |",
"|- Range | 29.000 - 53.000 | 32.000 - 48.000 | 30.000 - 52.000 | 29.000 - 53.000 | |"
)
)
})
round.p <- function(x)
{
x$p.value <- round(x$p.value, 5)
row.names(x) <- NULL
x
}
set.seed(1000)
test_that("05/25/2017: simulate.p.value option for chisq.test", {
expect_true(identical(
round.p(tests(tableby(Group ~ Sex + time + dt, data = mdat, subset=Group != "High",simulate.p.value=TRUE))),
data.frame(Group = "Group", Variable = c("Sex", "time", "dt"), p.value = c(0.61169, 0.20595, 0.17144),
Method = c("Pearson's Chi-squared test with simulated p-value\n\t (based on 2000 replicates)",
"Linear Model ANOVA", "Kruskal-Wallis rank sum test"), stringsAsFactors = FALSE)
))
})
test_that("05/25/2017: chisq.correct=FALSE option for chisq.test", {
expect_true(identical(
round.p(tests(tableby(Group ~ Sex + time + dt, data = mdat, subset=Group != "High", chisq.correct=FALSE))),
data.frame(Group = "Group", Variable = c("Sex", "time", "dt"), p.value = c(0.43832, 0.20595, 0.17144),
Method = c("Pearson's Chi-squared test", "Linear Model ANOVA", "Kruskal-Wallis rank sum test"),
stringsAsFactors = FALSE)
))
})
set.seed(1000)
test_that("05/25/2017: simulate.p.value=TRUE option for fisher.test", {
expect_true(identical(
round.p(tests(tableby(Group ~ fe(Sex) + time + dt, data = mdat, simulate.p.value=TRUE, B = 1999))),
data.frame(Group = "Group", Variable = c("Sex", "time", "dt"), p.value = c(0.80000, 0.02480, 0.39127),
Method = c("Fisher's Exact Test for Count Data with simulated p-value\n\t (based on 1999 replicates)",
"Linear Model ANOVA", "Kruskal-Wallis rank sum test"), stringsAsFactors = FALSE)
))
})
###########################################################################################################
#### Reported bugs for tableby
###########################################################################################################
test_that("02/07/2017: Ryan Lennon's R Markdown spacing problem. Also 02/14/2018 (#65)", {
expect_error(capture.kable(summary(tableby(Group ~ Sex + time + dt, data = mdat), text = TRUE)), NA)
})
dat <- data.frame(x = c("A", "A", "A", rep(c("B", "C"), each = 7)),
y = c("cough", "pneumonia", NA,
"chest pain", "chest pain", "chest pain", "cough", "cough", "pneumonia", "cough",
"cough", "pneumonia", "chest pain", "chest pain", "pneumonia", NA, NA))
dat$y <- factor(dat$y)
test_that("02/07/2017: Jason Sinnwell's countpct problem", {
expect_identical(
capture.kable(summary(tableby(x ~ fe(y), data = dat), text = TRUE)),
c("| | A (N=3) | B (N=7) | C (N=7) | Total (N=17) | p value|",
"|:-------------|:---------:|:---------:|:---------:|:------------:|-------:|",
"|y | | | | | 0.750|",
"|- N-Miss | 1 | 0 | 2 | 3 | |",
"|- chest pain | 0 (0.0%) | 3 (42.9%) | 2 (40.0%) | 5 (35.7%) | |",
"|- cough | 1 (50.0%) | 3 (42.9%) | 1 (20.0%) | 5 (35.7%) | |",
"|- pneumonia | 1 (50.0%) | 1 (14.3%) | 2 (40.0%) | 4 (28.6%) | |"
)
)
})
test_that("02/07/2017: Jason Sinnwell's chisq problem", {
expect_identical(
capture.kable(summary(tableby(x ~ y, data = dat[dat$y == "cough",]), text = TRUE)),
c("| | A (N=1) | B (N=3) | C (N=1) | Total (N=5) | p value|",
"|:-------------|:----------:|:----------:|:----------:|:-----------:|-------:|",
"|y | | | | | |",
"|- chest pain | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) | |",
"|- cough | 1 (100.0%) | 3 (100.0%) | 1 (100.0%) | 5 (100.0%) | |",
"|- pneumonia | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) | |"
)
)
expect_identical(
capture.kable(summary(tableby(x ~ as.character(y), data = dat[dat$y == "cough",]), text = TRUE)),
c("| | A (N=1) | B (N=3) | C (N=1) | Total (N=5) | p value|",
"|:---------------|:----------:|:----------:|:----------:|:-----------:|-------:|",
"|as.character(y) | | | | | 0.449|",
"|- cough | 1 (100.0%) | 3 (100.0%) | 1 (100.0%) | 5 (100.0%) | |"
)
)
})
rm(dat)
test_that("03/17/2017: Beth's medianq1q3 label", {
expect_identical(
capture.kable(summary(tableby(Group ~ ht_in + time, data = mdat,
control = tableby.control(numeric.stats = c("Nmiss2", "medianq1q3"))), text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | Total (N=90) | p value|",
"|:------------------|:-----------------------:|:-----------------------:|:-----------------------:|:-----------------------:|-------:|",
"|Height in Inches | | | | | 0.785|",
"|- N-Miss | 0 | 0 | 0 | 0 | |",
"|- Median (Q1, Q3) | 64.500 (62.000, 68.000) | 64.000 (61.000, 68.750) | 64.500 (62.000, 68.000) | 64.000 (62.000, 68.000) | |",
"|time | | | | | 0.025|",
"|- N-Miss | 0 | 0 | 0 | 0 | |",
"|- Median (Q1, Q3) | 5.000 (3.250, 6.000) | 3.000 (1.250, 5.000) | 4.000 (2.000, 5.000) | 4.000 (2.000, 6.000) | |"
)
)
})
test_that("04/12/2017: Katherine King's cat.simplify vs tableby.control", {
expect_identical(
capture.kable(summary(tableby(Group ~ trt + Sex, data = mdat, control = tableby.control(), cat.simplify = TRUE), text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | Total (N=90) | p value|",
"|:-------------|:-----------:|:----------:|:----------:|:------------:|-------:|",
"|Treatment Arm | 16 (53.3%) | 19 (63.3%) | 19 (63.3%) | 54 (60.0%) | 0.659|",
"|Sex | 15 (50.0%) | 13 (43.3%) | 16 (53.3%) | 44 (48.9%) | 0.733|"
)
)
})
data(mockstudy)
temp <- mockstudy[1:5,]
test_that("05/24/2017: Katherine King's count vs countpct", {
expect_identical(
capture.kable(summary(tableby(arm ~ sex + age, data=temp, cat.stats="count", test = FALSE), text = TRUE)),
c("| | A: IFL (N=2) | F: FOLFOX (N=2) | G: IROX (N=1) | Total (N=5) |",
"|:------------|:---------------:|:---------------:|:---------------:|:---------------:|",
"|sex | | | | |",
"|- Male | 0 | 1 | 0 | 1 |",
"|- Female | 2 | 1 | 1 | 4 |",
"|age | | | | |",
"|- Mean (SD) | 62.000 (16.971) | 68.000 (1.414) | 71.000 (NA) | 66.200 (9.418) |",
"|- Range | 50.000 - 74.000 | 67.000 - 69.000 | 71.000 - 71.000 | 50.000 - 74.000 |"
)
)
})
df <- data.frame(x = c("a ", "a ", "b", "b ", "c", "c"), y = c("A", "A", "A", "B", "B", "B"), stringsAsFactors = FALSE)
##table(df$x, df$y)
test_that("05/24/2017: Missy Larson and Ethan Heinzen trailing spaces on char x variable", {
expect_identical(
capture.kable(summary(tableby(y ~ x, data = df, test = FALSE), text = TRUE)),
c("| | A (N=3) | B (N=3) | Total (N=6) |",
"|:----|:---------:|:---------:|:-----------:|",
"|x | | | |",
"|- a | 2 (66.7%) | 0 (0.0%) | 2 (33.3%) |",
"|- b | 1 (33.3%) | 0 (0.0%) | 1 (16.7%) |",
"|- b | 0 (0.0%) | 1 (33.3%) | 1 (16.7%) |",
"|- c | 0 (0.0%) | 2 (66.7%) | 2 (33.3%) |"
)
)
})
test_that("08/02/2017: Chi-square warnings are suppressed", {
expect_warning(tableby(arm ~ sex, data = mockstudy, subset = 1:5), NA)
})
test_that("08/26/2017: Richard Pendegraft and using formulize and tableby (#21)", {
# tableby was having trouble identifying one-sided formulas when you use formulize
expect_warning(tableby(formulize(x = 11, data = mdat), data = mdat, na.action = na.tableby(TRUE)), "It appears you're using na.tableby")
expect_identical(
capture.kable(summary(tableby(Group ~ fe(Sex) + kwt(Age), data = mdat), text = TRUE)),
capture.kable(summary(tableby(formulize("Group", c("fe(Sex)", "kwt(Age)")), data = mdat), text = TRUE))
)
})
df <- data.frame(a = c("b", "b", "b", "a", "a"), d = NA_character_, e = c(1, 2, 2, 1, 2), stringsAsFactors = FALSE)
test_that("08/30/2017: Brendan Broderick and zero-length levels (#22)", {
expect_error(tableby(a ~ d + e, data = df), "Zero-length levels")
})
test_that("09/13/2017: Peter Martin and rounding to integers (#23)", {
expect_identical(
capture.kable(summary(tableby(Group ~ Sex + time + dt, data = mdat,
numeric.stats = c("meansd", "q1q3", "range"), digits = 0, digits.p = 3), text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | Total (N=90) | p value|",
"|:------------|:-----------------------:|:-----------------------:|:-----------------------:|:-----------------------:|-------:|",
"|Sex | | | | | 0.733|",
"|- Female | 15 (50.0%) | 17 (56.7%) | 14 (46.7%) | 46 (51.1%) | |",
"|- Male | 15 (50.0%) | 13 (43.3%) | 16 (53.3%) | 44 (48.9%) | |",
"|time | | | | | 0.025|",
"|- Mean (SD) | 5 (2) | 3 (2) | 4 (2) | 4 (2) | |",
"|- Q1, Q3 | 3, 6 | 1, 5 | 2, 5 | 2, 6 | |",
"|- Range | 0 - 7 | 0 - 6 | 1 - 7 | 0 - 7 | |",
"|dt | | | | | 0.391|",
"|- Median | 1950-01-07 | 1951-06-13 | 1948-09-13 | 1949-10-07 | |",
"|- Range | 1935-08-15 - 1968-05-14 | 1937-02-08 - 1959-09-06 | 1939-04-01 - 1958-07-30 | 1935-08-15 - 1968-05-14 | |"
)
)
expect_warning(tableby(Group ~ Sex + time + dt, data = mdat, digits.p = -1))
expect_warning(tableby(Group ~ Sex + time + dt, data = mdat, digits = -1))
})
dat <- data.frame(a = c("b", "b", "b", "a", "a", "a"), b = c("a", "b", "a", "b", "a", "b"), stringsAsFactors = FALSE)
attr(dat$a, "stats") <- c("countpct", "Nmiss")
test_that("11/10/2017: trouble with 'stats' attribute (#39)", {
expect_error(tableby(~ a + b, data = dat), NA)
})
colnames(dat) <- c("1y", "2x")
test_that("11/15/2017: Krista Goergen and non-syntactic names (#41)", {
expect_identical(
capture.kable(summary(tableby(`1y` ~ `2x`, data = dat), text = TRUE)),
c("| | a (N=3) | b (N=3) | Total (N=6) | p value|",
"|:----|:---------:|:---------:|:-----------:|-------:|",
"|2x | | | | 0.414|",
"|- a | 1 (33.3%) | 2 (66.7%) | 3 (50.0%) | |",
"|- b | 2 (66.7%) | 1 (33.3%) | 3 (50.0%) | |"
)
)
expect_identical(
capture.kable(summary(tableby(`1y` ~ fe(`2x`), data = dat), text = TRUE)),
c("| | a (N=3) | b (N=3) | Total (N=6) | p value|",
"|:----|:---------:|:---------:|:-----------:|-------:|",
"|2x | | | | 1.000|",
"|- a | 1 (33.3%) | 2 (66.7%) | 3 (50.0%) | |",
"|- b | 2 (66.7%) | 1 (33.3%) | 3 (50.0%) | |"
)
)
expect_identical(
capture.kable(summary(tableby( ~ `2x`, data = dat), text = TRUE)),
c("| | Overall (N=6) |",
"|:----|:-------------:|",
"|2x | |",
"|- a | 3 (50.0%) |",
"|- b | 3 (50.0%) |"
)
)
})
test_that("7/27/2017: as.data.frame.tableby and dates (#10)", {
expect_identical(as.data.frame(tableby(~ dt, data = mdat))$Overall[[3]][2], as.Date("1968-05-14"))
})
test_that("01/24/2018: count, countN, and countpct at the same time (#51, #201)", {
dat <- data.frame(y = rep(c("C", "D"), times = 5), x = rep(c("A", "B"), each = 5), stringsAsFactors = FALSE)
expect_identical(
capture.kable(summary(tableby(y ~ x, data = dat, cat.stats = c("count", "countN", "countpct")), text = TRUE)),
c("| | C (N=5) | D (N=5) | Total (N=10) | p value|",
"|:----|:---------:|:---------:|:------------:|-------:|",
"|x | | | | 0.527|",
"|- A | 3 | 2 | 5 | |",
"|- B | 2 | 3 | 5 | |",
"|- A | 3/5 | 2/5 | 5/10 | |",
"|- B | 2/5 | 3/5 | 5/10 | |",
"|- A | 3 (60.0%) | 2 (40.0%) | 5 (50.0%) | |",
"|- B | 2 (40.0%) | 3 (60.0%) | 5 (50.0%) | |"
)
)
})
test_that("01/30/2018: additional follow-up statistics (#32)", {
skip_if_not(getRversion() >= "3.3.0")
skip_if_not_installed("survival", "2.41-3")
require(survival)
expect_identical(
capture.kable(summary(tableby(sex ~ Surv(fu.time/365.25, fu.stat), data=mockstudy, times=1:5,
surv.stats=c("medSurv", "Nevents", "NeventsSurv", "Nrisk", "NriskSurv", "medTime")), text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:-----------------------------|:------------:|:--------------:|:--------------:|-------:|",
"|Surv(fu.time/365.25, fu.stat) | | | | 0.975|",
"|- Median Survival | 1.506 | 1.487 | 1.495 | |",
"|- Events | 829 | 527 | 1356 | |",
"|- time = 1 | 286 (68.7) | 202 (65.3) | 488 (67.4) | |",
"|- time = 2 | 597 (34.4) | 391 (32.8) | 988 (33.7) | |",
"|- time = 3 | 748 (17.5) | 481 (17.0) | 1229 (17.3) | |",
"|- time = 4 | 809 (9.4) | 513 (10.9) | 1322 (10.1) | |",
"|- time = 5 | 825 (6.3) | 525 (7.4) | 1350 (6.8) | |",
"|- time = 1 | 626 | 380 | 1006 | |",
"|- time = 2 | 309 | 190 | 499 | |",
"|- time = 3 | 152 | 95 | 247 | |",
"|- time = 4 | 57 | 51 | 108 | |",
"|- time = 5 | 24 | 18 | 42 | |",
"|- time = 1 | 626 (68.7) | 380 (65.3) | 1006 (67.4) | |",
"|- time = 2 | 309 (34.4) | 190 (32.8) | 499 (33.7) | |",
"|- time = 3 | 152 (17.5) | 95 (17.0) | 247 (17.3) | |",
"|- time = 4 | 57 (9.4) | 51 (10.9) | 108 (10.1) | |",
"|- time = 5 | 24 (6.3) | 18 (7.4) | 42 (6.8) | |",
"|- Median Follow-Up | 4.665 | 4.413 | 4.561 | |"
)
)
})
test_that("01/31/2018 and 6/4/18: row and cell percents (#9, #106)", {
catstats <- c("Nmiss", "countpct", "countrowpct", "countcellpct", "binomCI", "rowbinomCI")
expect_identical(
capture.kable(summary(tableby(Group ~ Sex + ethan, data = mdat, cat.stats = catstats), text = TRUE)),
c("| | High (N=30) | Low (N=30) | Med (N=30) | Total (N=90) | p value|",
"|:----------|:--------------------:|:--------------------:|:--------------------:|:--------------------:|-------:|",
"|Sex | | | | | 0.733|",
"|- Female | 15 (50.0%) | 17 (56.7%) | 14 (46.7%) | 46 (51.1%) | |",
"|- Male | 15 (50.0%) | 13 (43.3%) | 16 (53.3%) | 44 (48.9%) | |",
"|- Female | 15 (32.6%) | 17 (37.0%) | 14 (30.4%) | 46 (100.0%) | |",
"|- Male | 15 (34.1%) | 13 (29.5%) | 16 (36.4%) | 44 (100.0%) | |",
"|- Female | 15 (16.7%) | 17 (18.9%) | 14 (15.6%) | 46 (51.1%) | |",
"|- Male | 15 (16.7%) | 13 (14.4%) | 16 (17.8%) | 44 (48.9%) | |",
"|- Female | 0.500 (0.313, 0.687) | 0.567 (0.374, 0.745) | 0.467 (0.283, 0.657) | 0.511 (0.403, 0.618) | |",
"|- Male | 0.500 (0.313, 0.687) | 0.433 (0.255, 0.626) | 0.533 (0.343, 0.717) | 0.489 (0.382, 0.597) | |",
"|- Female | 0.326 (0.195, 0.480) | 0.370 (0.232, 0.525) | 0.304 (0.177, 0.458) | 1.000 (0.923, 1.000) | |",
"|- Male | 0.341 (0.205, 0.499) | 0.295 (0.168, 0.452) | 0.364 (0.224, 0.522) | 1.000 (0.920, 1.000) | |",
"|ethan | | | | | 0.178|",
"|- N-Miss | 3 | 0 | 0 | 3 | |",
"|- Ethan | 17 (63.0%) | 13 (43.3%) | 12 (40.0%) | 42 (48.3%) | |",
"|- Heinzen | 10 (37.0%) | 17 (56.7%) | 18 (60.0%) | 45 (51.7%) | |",
"|- Ethan | 17 (40.5%) | 13 (31.0%) | 12 (28.6%) | 42 (100.0%) | |",
"|- Heinzen | 10 (22.2%) | 17 (37.8%) | 18 (40.0%) | 45 (100.0%) | |",
"|- Ethan | 17 (19.5%) | 13 (14.9%) | 12 (13.8%) | 42 (48.3%) | |",
"|- Heinzen | 10 (11.5%) | 17 (19.5%) | 18 (20.7%) | 45 (51.7%) | |",
"|- Ethan | 0.630 (0.424, 0.806) | 0.433 (0.255, 0.626) | 0.400 (0.227, 0.594) | 0.483 (0.374, 0.592) | |",
"|- Heinzen | 0.370 (0.194, 0.576) | 0.567 (0.374, 0.745) | 0.600 (0.406, 0.773) | 0.517 (0.408, 0.626) | |",
"|- Ethan | 0.405 (0.256, 0.567) | 0.310 (0.176, 0.471) | 0.286 (0.157, 0.446) | 1.000 (0.916, 1.000) | |",
"|- Heinzen | 0.222 (0.112, 0.371) | 0.378 (0.238, 0.535) | 0.400 (0.257, 0.557) | 1.000 (0.921, 1.000) | |"
)
)
})
test_that("01/31/2018: include NAs in percents (#57, #62)", {
mdat2 <- mdat
attr(mdat2$ethan, "label") <- "Ethan"
expect_identical(
capture.kable(summary(tableby(Sex ~ includeNA(ethan, label = "N-Miss") + includeNA(ethan, first = TRUE, label = "N-Miss"),
data = mdat2, cat.stats = "countrowpct"), text = TRUE)),
c("| | Female (N=46) | Male (N=44) | Total (N=90) | p value|",
"|:----------|:-------------:|:-----------:|:------------:|-------:|",
"|Ethan | | | | 0.229|",
"|- Ethan | 18 (42.9%) | 24 (57.1%) | 42 (100.0%) | |",
"|- Heinzen | 27 (60.0%) | 18 (40.0%) | 45 (100.0%) | |",
"|- N-Miss | 1 (33.3%) | 2 (66.7%) | 3 (100.0%) | |",
"|Ethan | | | | 0.229|",
"|- N-Miss | 1 (33.3%) | 2 (66.7%) | 3 (100.0%) | |",
"|- Ethan | 18 (42.9%) | 24 (57.1%) | 42 (100.0%) | |",
"|- Heinzen | 27 (60.0%) | 18 (40.0%) | 45 (100.0%) | |"
)
)
expect_identical(
capture.kable(summary(tableby(Sex ~ includeNA(ethan, label = "N-Miss"), data = mdat2, cat.stats = "countpct"), text = TRUE)),
c("| | Female (N=46) | Male (N=44) | Total (N=90) | p value|",
"|:----------|:-------------:|:-----------:|:------------:|-------:|",
"|Ethan | | | | 0.229|",
"|- Ethan | 18 (39.1%) | 24 (54.5%) | 42 (46.7%) | |",
"|- Heinzen | 27 (58.7%) | 18 (40.9%) | 45 (50.0%) | |",
"|- N-Miss | 1 (2.2%) | 2 (4.5%) | 3 (3.3%) | |"
)
)
})
test_that("02/23/2018: wrapping long labels (#59)", {
labs <- list(
Group = "This is a really long label for the Group variable",
time = "Another really long label. Can you believe how long this is",
dt = "ThisLabelHasNoSpacesSoLetsSeeHowItBehaves"
)
expect_identical(
capture.kable(print(summary(tableby(Sex ~ Group + time + dt, data = set_labels(mdat, labs)), text = TRUE), width = 30)),
c("| | Female (N=46) | Male (N=44) | Total (N=90) | p value|",
"|:------------------------------|:-----------------------:|:-----------------------:|:-----------------------:|-------:|",
"|This is a really long label | | | | 0.733|",
"|for the Group variable | | | | |",
"|- High | 15 (32.6%) | 15 (34.1%) | 30 (33.3%) | |",
"|- Low | 17 (37.0%) | 13 (29.5%) | 30 (33.3%) | |",
"|- Med | 14 (30.4%) | 16 (36.4%) | 30 (33.3%) | |",
"|Another really long label. | | | | 0.237|",
"|Can you believe how long this | | | | |",
"|is | | | | |",
"|- Mean (SD) | 3.609 (1.926) | 4.114 (2.093) | 3.856 (2.014) | |",
"|- Range | 0.000 - 7.000 | 0.000 - 7.000 | 0.000 - 7.000 | |",
"|ThisLabelHasNoSpacesSoLetsSeeH | | | | 0.339|",
"|owItBehaves | | | | |",
"|- Median | 1948-12-07 | 1951-03-26 | 1949-10-07 | |",
"|- Range | 1935-08-15 - 1959-09-06 | 1937-02-08 - 1968-05-14 | 1935-08-15 - 1968-05-14 | |"
)
)
})
test_that("02/26/2018: all NA vars (#80, #81, #82, #83, #84)", {
dat <- data.frame(y = factor(c("A", "A", "A", "B", "B")), x = c(1, 2, 3, NA, NA))
expect_identical(
capture.kable(summary(tableby(y ~ x, data = dat, numeric.test = "anova"), text = TRUE)),
c("| | A (N=3) | B (N=2) | Total (N=5) | p value|",
"|:------------|:-------------:|:-------:|:-------------:|-------:|",
"|x | | | | |",
"|- N-Miss | 0 | 2 | 2 | |",
"|- Mean (SD) | 2.000 (1.000) | NA | 2.000 (1.000) | |",
"|- Range | 1.000 - 3.000 | NA | 1.000 - 3.000 | |"
)
)
expect_identical(
capture.kable(summary(tableby(y ~ x, data = dat, numeric.test = "kwt"), text = TRUE)),
c("| | A (N=3) | B (N=2) | Total (N=5) | p value|",
"|:------------|:-------------:|:-------:|:-------------:|-------:|",
"|x | | | | |",
"|- N-Miss | 0 | 2 | 2 | |",
"|- Mean (SD) | 2.000 (1.000) | NA | 2.000 (1.000) | |",
"|- Range | 1.000 - 3.000 | NA | 1.000 - 3.000 | |"
)
)
dat2 <- data.frame(Group = rep(1:2, each=5), A = rep(c(1, NA), each=5), B = rep(factor(c("A", NA)), each=5))
expect_identical(
capture.kable(summary(tableby(Group ~ A + B, data = dat2), text = TRUE)),
c("| | 1 (N=5) | 2 (N=5) | Total (N=10) | p value|",
"|:------------|:-------------:|:-------:|:-------------:|-------:|",
"|A | | | | |",
"|- N-Miss | 0 | 5 | 5 | |",
"|- Mean (SD) | 1.000 (0.000) | NA | 1.000 (0.000) | |",
"|- Range | 1.000 - 1.000 | NA | 1.000 - 1.000 | |",
"|B | | | | 0.025|",
"|- N-Miss | 0 | 5 | 5 | |",
"|- A | 5 (100.0%) | 0 | 5 (100.0%) | |"
)
)
skip_if_not(getRversion() >= "3.3.0")
skip_if_not_installed("survival", "2.41-3")
require(survival)
expect_identical(
capture.kable(summary(tableby(y ~ Surv(x), data=dat, times = 1:2,
surv.stats=c("medSurv", "Nevents", "NeventsSurv", "Nrisk", "NriskSurv", "medTime")), text = TRUE)),
c("| | A (N=3) | B (N=2) | Total (N=5) | p value|",
"|:-------------------|:--------:|:-------:|:-----------:|-------:|",
"|Surv(x) | | | | |",
"|- Median Survival | 2.000 | NA | 2.000 | |",
"|- Events | 3 | NA | 3 | |",
"|- time = 1 | 1 (66.7) | NA | 1 (66.7) | |",
"|- time = 2 | 2 (33.3) | NA | 2 (33.3) | |",
"|- time = 1 | 3 | NA | 3 | |",
"|- time = 2 | 2 | NA | 2 | |",
"|- time = 1 | 3 (66.7) | NA | 3 (66.7) | |",
"|- time = 2 | 2 (33.3) | NA | 2 (33.3) | |",
"|- Median Follow-Up | NA | NA | NA | |"
)
)
})
test_that("03/07/2018 and 07/17/2019: quantiles for dates and IQR and mad (#86)", {
expect_identical(
capture.kable(summary(tableby(Sex ~ dt + ht_in + Age, data = mdat,
numeric.stats = c("q1q3", "iqr", "medianmad"), date.stats = c("q1q3", "iqr", "medianmad")), text = TRUE)),
c("| | Female (N=46) | Male (N=44) | Total (N=90) | p value|",
"|:----------------|:--------------------------:|:--------------------------:|:--------------------------:|-------:|",
"|dt | | | | 0.339|",
"|- Q1, Q3 | 1946-04-26, 1953-11-07 | 1946-11-27, 1954-06-13 | 1946-06-13, 1954-04-26 | |",
"|- IQR | 2751.250 days | 2755.500 days | 2873.250 days | |",
"|- Median (MAD) | 1948-12-07 (1574.000 days) | 1951-03-26 (1420.500 days) | 1949-10-07 (1601.500 days) | |",
"|Height in Inches | | | | 0.786|",
"|- Q1, Q3 | 61.250, 68.000 | 62.000, 68.000 | 62.000, 68.000 | |",
"|- IQR | 6.750 | 6.000 | 6.000 | |",
"|- Median (MAD) | 65.000 (3.000) | 64.000 (3.000) | 64.000 (4.000) | |",
"|Age in Years | | | | 0.818|",
"|- Q1, Q3 | 36.000, 44.000 | 37.000, 41.250 | 36.000, 43.000 | |",
"|- IQR | 8.000 | 4.250 | 7.000 | |",
"|- Median (MAD) | 39.000 (4.000) | 39.500 (2.500) | 39.000 (3.000) | |"
)
)
})
test_that("06/19/2018: term.name (#109)", {
expect_identical(
capture.kable(summary(tableby(Group ~ ethan, data = mdat), text = TRUE, term.name = "Term")),
c("|Term | High (N=30) | Low (N=30) | Med (N=30) | Total (N=90) | p value|",
"|:----------|:-----------:|:----------:|:----------:|:------------:|-------:|",
"|ethan | | | | | 0.178|",
"|- N-Miss | 3 | 0 | 0 | 3 | |",
"|- Ethan | 17 (63.0%) | 13 (43.3%) | 12 (40.0%) | 42 (48.3%) | |",
"|- Heinzen | 10 (37.0%) | 17 (56.7%) | 18 (60.0%) | 45 (51.7%) | |"
)
)
})
mockstudy$grp <- c(rep("Group1", 749), rep("Group2",749), "")
test_that("08/23/2018: empty string in by-variable (#121)", expect_warning(summary(tableby(grp ~ race, data=mockstudy)), "Empty"))
test_that("08/24/2018: latex (#123, #258)", {
expect_identical(
capture.output(summary(tableby(Group ~ ethan, data = mdat), text = "latex")),
c("" ,
"\\begin{tabular}{l|c|c|c|c|r}" ,
"\\hline" ,
" & High (N=30) & Low (N=30) & Med (N=30) & Total (N=90) & p value\\\\",
"\\hline" ,
"\\textbf{ethan} & & & & & 0.178\\\\" ,
"\\hline" ,
"~~~N-Miss & 3 & 0 & 0 & 3 & \\\\" ,
"\\hline" ,
"~~~Ethan & 17 (63.0\\%) & 13 (43.3\\%) & 12 (40.0\\%) & 42 (48.3\\%) & \\\\" ,
"\\hline" ,
"~~~Heinzen & 10 (37.0\\%) & 17 (56.7\\%) & 18 (60.0\\%) & 45 (51.7\\%) & \\\\",
"\\hline" ,
"\\end{tabular}" ,
""
)
)
})
test_that("09/07/2018: using countpct with numerics (#137)", {
expect_identical(
capture.kable(summary(tableby(y ~ chisq(x, "countpct"), data = data.frame(y = c("A", "B", "C"), x = c(1, 2, 3))), text = TRUE)),
c("| | A (N=1) | B (N=1) | C (N=1) | Total (N=3) | p value|",
"|:----|:----------:|:----------:|:----------:|:-----------:|-------:|",
"|x | | | | | 0.199|",
"|- 1 | 1 (100.0%) | 0 (0.0%) | 0 (0.0%) | 1 (33.3%) | |",
"|- 2 | 0 (0.0%) | 1 (100.0%) | 0 (0.0%) | 1 (33.3%) | |",
"|- 3 | 0 (0.0%) | 0 (0.0%) | 1 (100.0%) | 1 (33.3%) | |"
)
)
expect_identical(
capture.kable(summary(tableby(sex ~ anova(ps, "count", "meansd"), data = mockstudy), text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:------------|:-------------:|:--------------:|:--------------:|-------:|",
"|ps | | | | 0.345|",
"|- 0 | 391 | 244 | 635 | |",
"|- 1 | 329 | 202 | 531 | |",
"|- 2 | 34 | 33 | 67 | |",
"|- Mean (SD) | 0.527 (0.583) | 0.559 (0.621) | 0.539 (0.598) | |"
)
)
})
test_that("09/07/2018: specifying different digits (#107) and cat.simplify (#134) and numeric.simplify (#139)", {
tmp.mockstudy <- mockstudy
tmp.mockstudy$date <- as.Date("2019-03-01") + c(rep(1, times = 750), rep(2, times = 749))
tmp.mockstudy$date2 <- tmp.mockstudy$date
tmp.mockstudy$ord <- ordered(c(rep("A", times = 749), rep("B", times = 750)))
tmp.mockstudy$ord2 <- tmp.mockstudy$ord
expect_identical(
capture.kable(summary(tableby(arm ~ I(age/10) + chisq(sex, digits.count=1, digits.pct=0, cat.simplify=TRUE) + race +
anova(ast, digits=0, digits.count=1) + kwt(fu.time, "medianq1q3", digits=0) +
kwt(date, date.simplify=TRUE) + notest(ord, ordered.simplify=TRUE) + date2 + notest(ord2),
numeric.simplify=TRUE, date.stats = "median", data = tmp.mockstudy), text=TRUE)),
c("| | A: IFL (N=428) | F: FOLFOX (N=691) | G: IROX (N=380) | Total (N=1499) | p value|",
"|:-------------------|:--------------:|:-----------------:|:---------------:|:--------------:|-------:|",
"|Age in Years | | | | | 0.614|",
"|- Mean (SD) | 5.967 (1.136) | 6.030 (1.163) | 5.976 (1.150) | 5.999 (1.152) | |",
"|- Range | 2.700 - 8.800 | 1.900 - 8.800 | 2.600 - 8.500 | 1.900 - 8.800 | |",
"|sex | 151.0 (35%) | 280.0 (41%) | 152.0 (40%) | 583.0 (39%) | 0.190|",
"|Race | | | | | 0.367|",
"|- N-Miss | 0 | 6 | 1 | 7 | |",
"|- African-Am | 39 (9.1%) | 49 (7.2%) | 27 (7.1%) | 115 (7.7%) | |",
"|- Asian | 1 (0.2%) | 14 (2.0%) | 3 (0.8%) | 18 (1.2%) | |",
"|- Caucasian | 371 (86.7%) | 586 (85.5%) | 331 (87.3%) | 1288 (86.3%) | |",
"|- Hawaii/Pacific | 1 (0.2%) | 3 (0.4%) | 1 (0.3%) | 5 (0.3%) | |",
"|- Hispanic | 12 (2.8%) | 28 (4.1%) | 14 (3.7%) | 54 (3.6%) | |",
"|- Native-Am/Alaska | 2 (0.5%) | 1 (0.1%) | 2 (0.5%) | 5 (0.3%) | |",
"|- Other | 2 (0.5%) | 4 (0.6%) | 1 (0.3%) | 7 (0.5%) | |",
"|ast | | | | | 0.507|",
"|- N-Miss | 69.0 | 141.0 | 56.0 | 266.0 | |",
"|- Mean (SD) | 37 (28) | 35 (27) | 36 (26) | 36 (27) | |",
"|- Range | 10 - 205 | 7 - 174 | 5 - 176 | 5 - 205 | |",
"|fu.time | 446 (256, 724) | 601 (345, 1046) | 516 (306, 807) | 542 (310, 878) | < 0.001|",
"|date | 2019-03-02 | 2019-03-03 | 2019-03-02 | 2019-03-02 | < 0.001|",
"|ord | 170 (39.7%) | 439 (63.5%) | 141 (37.1%) | 750 (50.0%) | |",
"|date2 | | | | | < 0.001|",
"|- Median | 2019-03-02 | 2019-03-03 | 2019-03-02 | 2019-03-02 | |",
"|ord2 | | | | | |",
"|- A | 258 (60.3%) | 252 (36.5%) | 239 (62.9%) | 749 (50.0%) | |",
"|- B | 170 (39.7%) | 439 (63.5%) | 141 (37.1%) | 750 (50.0%) | |"
)
)
})
test_that("09/19/2018: specifying different stats for character and logical variables (#142)", {
expect_identical(
capture.kable(summary(tableby(arm ~ chisq(race, "countpct") + chisq(I(sex == "Male"), "count"), data = mockstudy), text = TRUE)),
c('| | A: IFL (N=428) | F: FOLFOX (N=691) | G: IROX (N=380) | Total (N=1499) | p value|',
'|:-------------------|:--------------:|:-----------------:|:---------------:|:--------------:|-------:|',
'|Race | | | | | 0.367|',
'|- African-Am | 39 (9.1%) | 49 (7.2%) | 27 (7.1%) | 115 (7.7%) | |',
'|- Asian | 1 (0.2%) | 14 (2.0%) | 3 (0.8%) | 18 (1.2%) | |',
'|- Caucasian | 371 (86.7%) | 586 (85.5%) | 331 (87.3%) | 1288 (86.3%) | |',
'|- Hawaii/Pacific | 1 (0.2%) | 3 (0.4%) | 1 (0.3%) | 5 (0.3%) | |',
'|- Hispanic | 12 (2.8%) | 28 (4.1%) | 14 (3.7%) | 54 (3.6%) | |',
'|- Native-Am/Alaska | 2 (0.5%) | 1 (0.1%) | 2 (0.5%) | 5 (0.3%) | |',
'|- Other | 2 (0.5%) | 4 (0.6%) | 1 (0.3%) | 7 (0.5%) | |',
'|I(sex == "Male") | | | | | 0.190|',
'|- FALSE | 151 | 280 | 152 | 583 | |',
'|- TRUE | 277 | 411 | 228 | 916 | |'
)
)
})
test_that("10/19/2018: padjust works on tableby objects (#146)", {
tab <- tableby(sex ~ age + arm + race + ps + alk.phos, data = mockstudy)
expect_identical(
capture.kable(summary(padjust(tab, method = "bonfer"), text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:-------------------|:-----------------:|:-----------------:|:-----------------:|-------:|",
"|Age in Years | | | | 0.238|",
"|- Mean (SD) | 60.455 (11.369) | 59.247 (11.722) | 59.985 (11.519) | |",
"|- Range | 19.000 - 88.000 | 22.000 - 88.000 | 19.000 - 88.000 | |",
"|Treatment Arm | | | | 0.952|",
"|- A: IFL | 277 (30.2%) | 151 (25.9%) | 428 (28.6%) | |",
"|- F: FOLFOX | 411 (44.9%) | 280 (48.0%) | 691 (46.1%) | |",
"|- G: IROX | 228 (24.9%) | 152 (26.1%) | 380 (25.4%) | |",
"|Race | | | | 1.000|",
"|- N-Miss | 6 | 1 | 7 | |",
"|- African-Am | 65 (7.1%) | 50 (8.6%) | 115 (7.7%) | |",
"|- Asian | 11 (1.2%) | 7 (1.2%) | 18 (1.2%) | |",
"|- Caucasian | 787 (86.5%) | 501 (86.1%) | 1288 (86.3%) | |",
"|- Hawaii/Pacific | 2 (0.2%) | 3 (0.5%) | 5 (0.3%) | |",
"|- Hispanic | 37 (4.1%) | 17 (2.9%) | 54 (3.6%) | |",
"|- Native-Am/Alaska | 3 (0.3%) | 2 (0.3%) | 5 (0.3%) | |",
"|- Other | 5 (0.5%) | 2 (0.3%) | 7 (0.5%) | |",
"|ps | | | | 1.000|",
"|- N-Miss | 162 | 104 | 266 | |",
"|- Mean (SD) | 0.527 (0.583) | 0.559 (0.621) | 0.539 (0.598) | |",
"|- Range | 0.000 - 2.000 | 0.000 - 2.000 | 0.000 - 2.000 | |",
"|alk.phos | | | | 1.000|",
"|- N-Miss | 162 | 104 | 266 | |",
"|- Mean (SD) | 167.893 (130.754) | 170.664 (124.965) | 168.969 (128.492) | |",
"|- Range | 10.000 - 1014.000 | 7.000 - 771.000 | 7.000 - 1014.000 | |"
)
)
expect_identical(
capture.kable(summary(padjust(tab, "bonfer"), pfootnote = TRUE)),
capture.kable(padjust(summary(tab, pfootnote = TRUE), "bonfer"))
)
})
test_that("02/26/2019: digits and stats are maintained when subsetting (#182, #183)", {
mck <- mockstudy
attr(mck$arm, "name") <- "armm"
tmp <- tableby(sex ~ kwt(age, digits = 1, "meansd") + chisq(arm, "count", digits.count = 1), data = mck, subset = age < 65)
expect_identical(
capture.kable(summary(tmp)),
c("| | Male (N=552) | Female (N=375) | Total (N=927) | p value|",
"|:---------------------------|:------------:|:--------------:|:-------------:|-------:|",
"|**Age in Years** | | | | 0.143|",
"| Mean (SD) | 53.3 (8.4) | 52.5 (8.6) | 53.0 (8.5) | |",
"|**Treatment Arm** | | | | 0.404|",
"| A: IFL | 169.0 | 100.0 | 269.0 | |",
"| F: FOLFOX | 246.0 | 173.0 | 419.0 | |",
"| G: IROX | 137.0 | 102.0 | 239.0 | |"
)
)
})
test_that("03/27/2019: cat.simplify and numeric.simplify work right, even with custom stats (#199, #200, #203)", {
dat <- data.frame(x = c("A", "A"))
expect_identical(
capture.kable(summary(tableby(~ x, data = dat, numeric.simplify = TRUE), text = TRUE)),
c("| | Overall (N=2) |",
"|:----|:-------------:|",
"|x | |",
"|- A | 2 (100.0%) |"
)
)
expect_identical(
capture.kable(summary(tableby(~ x, data = dat, cat.simplify = TRUE), text = TRUE)),
c("| | Overall (N=2) |",
"|:--|:-------------:|",
"|x | 2 (100.0%) |"
)
)
# mystat <- countpct
# expect_identical(
# capture.kable(summary(tableby(~ x, data = dat, cat.simplify = TRUE, cat.stats = "mystat"), text = TRUE)),
# c("| | Overall (N=2) |",
# "|:--|:-------------:|",
# "|x | 2 (100.0%) |"
# )
# )
})
test_that("04/12/2019: Missing Surv()[,2] (#208)", {
skip_if_not(getRversion() >= "3.3.0")
skip_if_not_installed("survival", "2.41-3")
require(survival)
dat <- data.frame(by = c(1, 1, 2), time = c(1, 2, 2), event = c(0, NA, 1))
expect_identical(
capture.kable(summary(tableby(by ~ Surv(time, event), data = dat), text = TRUE)),
c("| | 1 (N=2) | 2 (N=1) | Total (N=3) | p value|",
"|:------------------|:-------:|:-------:|:-----------:|-------:|",
"|Surv(time, event) | | | | 1.000|",
"|- N-Miss | 1 | 0 | 1 | |",
"|- Events | 0 | 1 | 1 | |",
"|- Median Survival | NA | 2.000 | 2.000 | |"
)
)
})
test_that("06/12/2019: labelTranslations for non-default stat tests (#220, #222)", {
expect_identical(
capture.kable(summary(tableby(sex ~ age + kwt(fu.time), data = mockstudy), labelTranslations = list(fu.time = "FU time"), text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:------------|:-----------------:|:-----------------:|:-----------------:|-------:|",
"|Age in Years | | | | 0.048|",
"|- Mean (SD) | 60.455 (11.369) | 59.247 (11.722) | 59.985 (11.519) | |",
"|- Range | 19.000 - 88.000 | 22.000 - 88.000 | 19.000 - 88.000 | |",
"|FU time | | | | 0.679|",
"|- Mean (SD) | 649.345 (454.332) | 648.674 (475.472) | 649.084 (462.511) | |",
"|- Range | 0.000 - 2472.000 | 9.000 - 2441.000 | 0.000 - 2472.000 | |"
)
)
expect_identical(
capture.kable(summary(tableby(sex ~ age + kwt(fu.time), data = mockstudy), labelTranslations = list(fu.time = "FU time"), text = TRUE)),
capture.kable(summary(tableby(sex ~ age + kwt(fu.time), data = mockstudy), labelTranslations = list(`kwt(fu.time)` = "FU time"), text = TRUE))
)
expect_identical(
capture.kable(summary(tableby(sex ~ kwt(fu.time), data = set_labels(mockstudy, list(fu.time = "FU time"))), labelTranslations = list(NULL))),
capture.kable(summary(tableby(sex ~ kwt(fu.time), data = mockstudy)))
)
})
test_that("06/24/2019: fe() and chisq() works with only one level (#227)", {
skip_if_not_installed("coin")
expect_identical(
capture.kable(summary(tableby(sex ~ fe(arm), data = mockstudy, subset = arm == "F: FOLFOX"), text = TRUE)),
c("| | Male (N=411) | Female (N=280) | Total (N=691) | p value|",
"|:-------------|:------------:|:--------------:|:-------------:|-------:|",
"|Treatment Arm | | | | |",
"|- F: FOLFOX | 411 (100.0%) | 280 (100.0%) | 691 (100.0%) | |"
)
)
expect_identical(
capture.kable(summary(tableby(sex ~ chisq(arm), data = mockstudy, subset = arm == "F: FOLFOX"), text = TRUE)),
c("| | Male (N=411) | Female (N=280) | Total (N=691) | p value|",
"|:-------------|:------------:|:--------------:|:-------------:|-------:|",
"|Treatment Arm | | | | < 0.001|",
"|- F: FOLFOX | 411 (100.0%) | 280 (100.0%) | 691 (100.0%) | |"
)
)
expect_identical(
capture.kable(summary(tableby(sex ~ ordered(arm), data = mockstudy, subset = arm == "F: FOLFOX"), text = TRUE)),
c("| | Male (N=411) | Female (N=280) | Total (N=691) | p value|",
"|:------------|:------------:|:--------------:|:-------------:|-------:|",
"|ordered(arm) | | | | |",
"|- A: IFL | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) | |",
"|- F: FOLFOX | 411 (100.0%) | 280 (100.0%) | 691 (100.0%) | |",
"|- G: IROX | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) | |"
)
)
})
test_that("07/16/2019: n's in tableby header work with weights (#229, #257)", {
d <- data.frame(a = 1:10, b = rep(c("A", "B"), 5), w = 1:10)
expect_identical(
capture.kable(summary(tableby(b ~ a, weights = w, data = d), text = TRUE)),
c("| | A (N=25) | B (N=30) | Total (N=55) |",
"|:------------|:-------------:|:--------------:|:--------------:|",
"|a | | | |",
"|- Mean (SD) | 6.600 (2.719) | 7.333 (2.870) | 7.000 (2.622) |",
"|- Range | 1.000 - 9.000 | 2.000 - 10.000 | 1.000 - 10.000 |"
)
)
d$w <- d$w + 0.111
expect_identical(
capture.kable(summary(tableby(b ~ a, weights = w, data = d, digits.n = 2), text = TRUE)),
c("| | A (N=25.55) | B (N=30.55) | Total (N=56.11) |",
"|:------------|:-------------:|:--------------:|:---------------:|",
"|a | | | |",
"|- Mean (SD) | 6.565 (2.741) | 7.309 (2.881) | 6.970 (2.640) |",
"|- Range | 1.000 - 9.000 | 2.000 - 10.000 | 1.000 - 10.000 |"
)
)
})
test_that("07/17/2019: fix bug with confidence limits (#234)", {
expect_identical(
capture.kable(summary(tableby(sex ~ arm, data = mockstudy, cat.stats = "binomCI",
control = tableby.control(conf.level = 0.9)), text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:-------------|:--------------------:|:--------------------:|:--------------------:|-------:|",
"|Treatment Arm | | | | 0.190|",
"|- A: IFL | 0.302 (0.277, 0.328) | 0.259 (0.229, 0.291) | 0.286 (0.266, 0.305) | |",
"|- F: FOLFOX | 0.449 (0.421, 0.476) | 0.480 (0.446, 0.515) | 0.461 (0.440, 0.483) | |",
"|- G: IROX | 0.249 (0.225, 0.274) | 0.261 (0.231, 0.292) | 0.254 (0.235, 0.273) | |"
)
)
})
test_that("07/17/2019: run stat test even if one group has 0 observations (#233, #250)", {
skip_if_not_installed("coin")
dd <- data.frame(group=factor(rep(c("A", "B", "C"), 20)), x1=1:60, x2 = rep(c("D", "E", "F"), each = 20))
dd$x1[dd$group == "C"] <- NA
dd$x2[dd$group == "C"] <- NA
expect_identical(
capture.kable(summary(tableby(group ~ x1, data = dd), text = TRUE)),
c("| | A (N=20) | B (N=20) | C (N=20) | Total (N=60) | p value|",
"|:------------|:---------------:|:---------------:|:--------:|:---------------:|-------:|",
"|x1 | | | | | |",
"|- N-Miss | 0 | 0 | 20 | 20 | |",
"|- Mean (SD) | 29.500 (17.748) | 30.500 (17.748) | NA | 30.000 (17.527) | |",
"|- Range | 1.000 - 58.000 | 2.000 - 59.000 | NA | 1.000 - 59.000 | |"
)
)
expect_identical(
capture.kable(summary(tableby(group ~ x1, data = dd, test.always = TRUE), text = TRUE)),
c("| | A (N=20) | B (N=20) | C (N=20) | Total (N=60) | p value|",
"|:------------|:---------------:|:---------------:|:--------:|:---------------:|-------:|",
"|x1 | | | | | 0.860|",
"|- N-Miss | 0 | 0 | 20 | 20 | |",
"|- Mean (SD) | 29.500 (17.748) | 30.500 (17.748) | NA | 30.000 (17.527) | |",
"|- Range | 1.000 - 58.000 | 2.000 - 59.000 | NA | 1.000 - 59.000 | |"
)
)
expect_identical(
capture.kable(summary(tableby(group ~ x2, data = dd), text = TRUE)),
c("| | A (N=20) | B (N=20) | C (N=20) | Total (N=60) | p value|",
"|:---------|:---------:|:---------:|:--------:|:------------:|-------:|",
"|x2 | | | | | |",
"|- N-Miss | 0 | 0 | 20 | 20 | |",
"|- D | 7 (35.0%) | 7 (35.0%) | 0 | 14 (35.0%) | |",
"|- E | 7 (35.0%) | 6 (30.0%) | 0 | 13 (32.5%) | |",
"|- F | 6 (30.0%) | 7 (35.0%) | 0 | 13 (32.5%) | |"
)
)
expect_identical(
capture.kable(summary(tableby(group ~ x2, data = dd, test.always = TRUE), text = TRUE)),
c("| | A (N=20) | B (N=20) | C (N=20) | Total (N=60) | p value|",
"|:---------|:---------:|:---------:|:--------:|:------------:|-------:|",
"|x2 | | | | | 0.926|",
"|- N-Miss | 0 | 0 | 20 | 20 | |",
"|- D | 7 (35.0%) | 7 (35.0%) | 0 | 14 (35.0%) | |",
"|- E | 7 (35.0%) | 6 (30.0%) | 0 | 13 (32.5%) | |",
"|- F | 6 (30.0%) | 7 (35.0%) | 0 | 13 (32.5%) | |"
)
)
expect_identical(
capture.kable(summary(tableby(group ~ x2, data = dd), text = TRUE)),
capture.kable(summary(tableby(group ~ fe(x2), data = dd), text = TRUE))
)
expect_identical(
capture.kable(summary(tableby(group ~ fe(x2), data = dd, test.always = TRUE, subset = group != "A" | x2 != "F"), text = TRUE)),
c("| | A (N=14) | B (N=20) | C (N=20) | Total (N=54) | p value|",
"|:---------|:---------:|:---------:|:--------:|:------------:|-------:|",
"|x2 | | | | | 0.055|",
"|- N-Miss | 0 | 0 | 20 | 20 | |",
"|- D | 7 (50.0%) | 7 (35.0%) | 0 | 14 (41.2%) | |",
"|- E | 7 (50.0%) | 6 (30.0%) | 0 | 13 (38.2%) | |",
"|- F | 0 (0.0%) | 7 (35.0%) | 0 | 7 (20.6%) | |"
)
)
expect_identical(
capture.kable(summary(tableby(group ~ x2, data = dd), text = TRUE)),
capture.kable(summary(tableby(group ~ ordered(x2), data = dd), labelTranslations = list("ordered(x2)" = "x2"), text = TRUE))
)
skip_if_not(getRversion() >= "3.3.0")
skip_if_not_installed("coin")
expect_identical(
capture.kable(summary(tableby(group ~ ordered(x2), data = dd, test.always = TRUE), labelTranslations = list("ordered(x2)" = "x2"), text = TRUE)),
c("| | A (N=20) | B (N=20) | C (N=20) | Total (N=60) | p value|",
"|:---------|:---------:|:---------:|:--------:|:------------:|-------:|",
"|x2 | | | | | 0.849|",
"|- N-Miss | 0 | 0 | 20 | 20 | |",
"|- D | 7 (35.0%) | 7 (35.0%) | 0 | 14 (35.0%) | |",
"|- E | 7 (35.0%) | 6 (30.0%) | 0 | 13 (32.5%) | |",
"|- F | 6 (30.0%) | 7 (35.0%) | 0 | 13 (32.5%) | |"
)
)
skip_if_not_installed("survival", "2.41-3")
require(survival)
dd$surv <- Surv(1:60)
dd$surv[dd$group == "C"] <- NA
expect_identical(
capture.kable(summary(tableby(group ~ surv, data = dd), text = TRUE)),
c("| | A (N=20) | B (N=20) | C (N=20) | Total (N=60) | p value|",
"|:------------------|:--------:|:--------:|:--------:|:------------:|-------:|",
"|surv | | | | | |",
"|- N-Miss | 0 | 0 | 20 | 20 | |",
"|- Events | 20 | 20 | NA | 40 | |",
"|- Median Survival | 29.500 | 30.500 | NA | 30.000 | |"
)
)
expect_identical(
capture.kable(summary(tableby(group ~ surv, data = dd, test.always = TRUE), text = TRUE)),
c("| | A (N=20) | B (N=20) | C (N=20) | Total (N=60) | p value|",
"|:------------------|:--------:|:--------:|:--------:|:------------:|-------:|",
"|surv | | | | | 0.690|",
"|- N-Miss | 0 | 0 | 20 | 20 | |",
"|- Events | 20 | 20 | NA | 40 | |",
"|- Median Survival | 29.500 | 30.500 | NA | 30.000 | |"
)
)
})
test_that("07/30/2019: modpval.tableby and factors (#239)", {
tab1 <- tableby(arm ~ sex + age + race, total = FALSE, test = FALSE, data = mockstudy)
mypval <- data.frame(
byvar = factor("arm"),
variable = factor(c("sex", "age", "race")),
adj.pvalue = 1:3
)
tab2 <- modpval.tableby(tab1, mypval, use.pname = TRUE)
expect_equal(tests(tab2)$adj.pvalue, mypval$adj.pvalue)
})
test_that("07/30/2019: summary.tableby and pre-formatted p-values (#249)", {
tab1 <- tableby(arm ~ sex + age, total = FALSE, test = FALSE, data = mockstudy)
mypval <- data.frame(byvar = "arm", variable = "sex", adj.pvalue = "0.0001", stringsAsFactors = FALSE)
tab2 <- modpval.tableby(tab1, mypval, use.pname = TRUE)
expect_identical(
capture.kable(summary(tab2, text = TRUE)),
c("| | A: IFL (N=428) | F: FOLFOX (N=691) | G: IROX (N=380) | adj.pvalue|",
"|:------------|:---------------:|:-----------------:|:---------------:|----------:|",
"|sex | | | | 0.0001|",
"|- Male | 277 (64.7%) | 411 (59.5%) | 228 (60.0%) | |",
"|- Female | 151 (35.3%) | 280 (40.5%) | 152 (40.0%) | |",
"|Age in Years | | | | |",
"|- Mean (SD) | 59.673 (11.365) | 60.301 (11.632) | 59.763 (11.499) | |",
"|- Range | 27.000 - 88.000 | 19.000 - 88.000 | 26.000 - 85.000 | |"
)
)
})
test_that("10/09/2019: change title for overall and total (#253, #261, #272)", {
tab1 <- tableby(~ sex + age, data = mockstudy, stats.labels = list(overall = "Total"))
tab2 <- tableby(~ sex + age, data = mockstudy, stats.labels = list(overall = "Hello"))
expect_identical(
capture.kable(summary(tab1, text = TRUE)),
c("| | Total (N=1499) |",
"|:------------|:---------------:|",
"|sex | |",
"|- Male | 916 (61.1%) |",
"|- Female | 583 (38.9%) |",
"|Age in Years | |",
"|- Mean (SD) | 59.985 (11.519) |",
"|- Range | 19.000 - 88.000 |"
)
)
expect_identical(
capture.kable(summary(tab1, text = TRUE)),
sub("Hello", "Total", capture.kable(summary(tab2, text = TRUE)))
)
d <- data.frame(
x = 10:1,
by = factor(rep(c("b", "Total"), each = 5), levels = c("b", "Total"))
)
tab <- tableby(by ~ x, data = d, stats.labels = list(total = "Total 2"))
expect_identical(
capture.kable(summary(tab, text = TRUE)),
c("| | b (N=5) | Total (N=5) | Total 2 (N=10) | p value|",
"|:------------|:--------------:|:-------------:|:--------------:|-------:|",
"|x | | | | 0.001|",
"|- Mean (SD) | 8.000 (1.581) | 3.000 (1.581) | 5.500 (3.028) | |",
"|- Range | 6.000 - 10.000 | 1.000 - 5.000 | 1.000 - 10.000 | |"
)
)
expect_identical(
capture.kable(summary(tab, text = TRUE, total = FALSE)),
c("| | b (N=5) | Total (N=5) | p value|",
"|:------------|:--------------:|:-------------:|-------:|",
"|x | | | 0.001|",
"|- Mean (SD) | 8.000 (1.581) | 3.000 (1.581) | |",
"|- Range | 6.000 - 10.000 | 1.000 - 5.000 | |"
)
)
tab3 <- tableby(sex ~ age + arm, data = mockstudy, stats.labels = list(total = "Overa"), cat.stats = c("countpct", "countrowpct", "rowbinomCI"))
tab4 <- tableby(sex ~ age + arm, data = mockstudy, stats.labels = list(total = "Hello"), cat.stats = c("countpct", "countrowpct", "rowbinomCI"))
tab5 <- tableby(sex ~ age + arm, data = mockstudy, stats.labels = list(total = "Total"), cat.stats = c("countpct", "countrowpct", "rowbinomCI"))
expect_identical(
capture.kable(summary(tab5, text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:-------------|:--------------------:|:--------------------:|:--------------------:|-------:|",
"|Age in Years | | | | 0.048|",
"|- Mean (SD) | 60.455 (11.369) | 59.247 (11.722) | 59.985 (11.519) | |",
"|- Range | 19.000 - 88.000 | 22.000 - 88.000 | 19.000 - 88.000 | |",
"|Treatment Arm | | | | 0.190|",
"|- A: IFL | 277 (30.2%) | 151 (25.9%) | 428 (28.6%) | |",
"|- F: FOLFOX | 411 (44.9%) | 280 (48.0%) | 691 (46.1%) | |",
"|- G: IROX | 228 (24.9%) | 152 (26.1%) | 380 (25.4%) | |",
"|- A: IFL | 277 (64.7%) | 151 (35.3%) | 428 (100.0%) | |",
"|- F: FOLFOX | 411 (59.5%) | 280 (40.5%) | 691 (100.0%) | |",
"|- G: IROX | 228 (60.0%) | 152 (40.0%) | 380 (100.0%) | |",
"|- A: IFL | 0.647 (0.600, 0.692) | 0.353 (0.308, 0.400) | 1.000 (0.991, 1.000) | |",
"|- F: FOLFOX | 0.595 (0.557, 0.632) | 0.405 (0.368, 0.443) | 1.000 (0.995, 1.000) | |",
"|- G: IROX | 0.600 (0.549, 0.650) | 0.400 (0.350, 0.451) | 1.000 (0.990, 1.000) | |"
)
)
expect_identical(
capture.kable(summary(tab3, text = TRUE)),
sub("Total", "Overa", capture.kable(summary(tab5, text = TRUE)))
)
expect_identical(
capture.kable(summary(tab4, text = TRUE)),
sub("Total", "Hello", capture.kable(summary(tab5, text = TRUE)))
)
})
test_that("11/05/2019: remove N's in title (#256)", {
expect_identical(
capture.kable(summary(tableby(sex ~ age, data = mockstudy, digits.n = NA), text = TRUE)),
c("| | Male | Female | Total | p value|",
"|:------------|:---------------:|:---------------:|:---------------:|-------:|",
"|Age in Years | | | | 0.048|",
"|- Mean (SD) | 60.455 (11.369) | 59.247 (11.722) | 59.985 (11.519) | |",
"|- Range | 19.000 - 88.000 | 22.000 - 88.000 | 19.000 - 88.000 | |"
)
)
expect_identical(
capture.kable(summary(tableby(sex ~ age, data = mockstudy, digits.n = NA), text = TRUE))[-1],
capture.kable(summary(tableby(sex ~ age, data = mockstudy), text = TRUE))[-1]
)
})
test_that("11/12/2019: base summary stats work (#259, #281); meanse (#315)", {
allstats <- c("min", "max", "range", "mean", "sd", "meansd", "meanse", "meanCI", "var", "median", "medianrange", "sum")
expect_identical(
capture.kable(summary(tableby(Sex ~ Age, data = mdat, numeric.stats = allstats), text = TRUE)),
c("| | Female (N=46) | Male (N=44) | Total (N=90) | p value|",
"|:-----------------|:-----------------------:|:-----------------------:|:-----------------------:|-------:|",
"|Age in Years | | | | 0.818|",
"|- Min | 30.000 | 29.000 | 29.000 | |",
"|- Max | 49.000 | 53.000 | 53.000 | |",
"|- Range | 30.000 - 49.000 | 29.000 - 53.000 | 29.000 - 53.000 | |",
"|- Mean | 39.826 | 39.568 | 39.700 | |",
"|- SD | 5.259 | 5.315 | 5.258 | |",
"|- Mean (SD) | 39.826 (5.259) | 39.568 (5.315) | 39.700 (5.258) | |",
"|- Mean (SE) | 39.826 (0.775) | 39.568 (0.801) | 39.700 (0.554) | |",
"|- Mean (CI) | 39.826 (38.264, 41.388) | 39.568 (37.952, 41.184) | 39.700 (38.599, 40.801) | |",
"|- Var | 27.658 | 28.251 | 27.651 | |",
"|- Median | 39.000 | 39.500 | 39.000 | |",
"|- Median (Range) | 39.000 (30.000, 49.000) | 39.500 (29.000, 53.000) | 39.000 (29.000, 53.000) | |",
"|- Sum | 1832.000 | 1741.000 | 3573.000 | |"
)
)
expect_identical(
capture.kable(summary(tableby(Sex ~ dt, data = mdat, date.stats = setdiff(allstats, "sum")), text = TRUE)),
c("| | Female (N=46) | Male (N=44) | Total (N=90) | p value|",
"|:-----------------|:-----------------------------------:|:-----------------------------------:|:-----------------------------------:|-------:|",
"|dt | | | | 0.339|",
"|- Min | 1935-08-15 | 1937-02-08 | 1935-08-15 | |",
"|- Max | 1959-09-06 | 1968-05-14 | 1968-05-14 | |",
"|- Range | 1935-08-15 - 1959-09-06 | 1937-02-08 - 1968-05-14 | 1935-08-15 - 1968-05-14 | |",
"|- Mean | 1949-06-11 | 1950-07-14 | 1949-12-23 | |",
"|- SD | 1981.348 days | 2227.654 days | 2103.010 days | |",
"|- Mean (SD) | 1949-06-11 (1981.348 days) | 1950-07-14 (2227.654 days) | 1949-12-23 (2103.010 days) | |",
"|- Mean (SE) | 1949-06-11 (292.134 days) | 1950-07-14 (335.832 days) | 1949-12-23 (221.677 days) | |",
"|- Mean (CI) | 1949-06-11 (1947-10-31, 1951-01-20) | 1950-07-14 (1948-09-05, 1952-05-22) | 1949-12-23 (1948-10-08, 1951-03-08) | |",
"|- Var | 3925741.628 | 4962443.482 | 4422652.929 | |",
"|- Median | 1948-12-07 | 1951-03-26 | 1949-10-07 | |",
"|- Median (Range) | 1948-12-07 (1935-08-15, 1959-09-06) | 1951-03-26 (1937-02-08, 1968-05-14) | 1949-10-07 (1935-08-15, 1968-05-14) | |"
)
)
})
test_that("11/13/2019: geometric summaries (#260)", {
allstats <- c("gmean", "gsd", "gmeansd", "gmeanCI")
blah <- data.frame(
a = rep(c("A", "B", "C"), each = 5),
b = c(0:4, 1:5, -1, 1:4),
d = Sys.Date() + c(-1, 1:14),
stringsAsFactors = FALSE
)
expect_identical(
capture.kable(summary(tableby(a ~ b + d, data = blah, numeric.stats = allstats, date.stats = allstats), text = TRUE)),
c("| | A (N=5) | B (N=5) | C (N=5) | Total (N=15) | p value|",
"|:----------------------|:----------:|:--------------------:|:-------:|:------------:|-------:|",
"|b | | | | | 0.510|",
"|- Geom Mean | 0.000 | 2.605 | NA | NA | |",
"|- Geom SD | NA | 1.765 | NA | NA | |",
"|- Geom Mean (Geom SD) | 0.000 (NA) | 2.605 (1.765) | NA | NA | |",
"|- Geom Mean (CI) | 0.000 (NA) | 2.605 (1.286, 5.277) | NA | NA | |",
"|d | | | | | 0.002|",
"|- Geom Mean | NA | NA | NA | NA | |",
"|- Geom SD | NA | NA | NA | NA | |",
"|- Geom Mean (Geom SD) | NA | NA | NA | NA | |",
"|- Geom Mean (CI) | NA | NA | NA | NA | |"
)
)
})
test_that("12/20/2019: Nrowpct (#263)", {
expect_identical(
capture.kable(summary(tableby(sex ~ arm + ps, data = mockstudy, cat.stats = "Nrowpct", numeric.stats = c("Nrowpct", "Nmiss")), text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:-------------|:------------:|:--------------:|:--------------:|-------:|",
"|Treatment Arm | | | | 0.190|",
"|- N (%) | 916 (61.1%) | 583 (38.9%) | 1499 (100.0%) | |",
"|ps | | | | 0.345|",
"|- N (%) | 754 (61.2%) | 479 (38.8%) | 1233 (100.0%) | |",
"|- N-Miss | 162 | 104 | 266 | |"
)
)
})
test_that("12/27/2019: informative error when no stats are computed (#273)", {
expect_error(summary(tableby(~ sex, data = mockstudy, cat.stats = "Nmiss")), "Nothing to show for variable")
})
test_that("02/28/2020: as.tbstat is better described (#283, #351)", {
trim510bracket <- function(x, weights=rep(1,length(x)), ...){
tmp <- c(mean(x, trim = 0.05, ...), mean(x, trim = 0.1, ...))
as.tbstat(tmp, fmt = "{y[1]} [{y[2]}]")
}
trim10pct <- function(x, weights=rep(1,length(x)), ...){
tmp <- mean(x, trim = 0.05, ...)
as.tbstat(c(tmp, 10), fmt = "{y[1]} ({y[2]}%)", which.count = 0L, which.pct = 2L)
}
expect_identical(
capture.kable(summary(tableby(sex ~ hgb, data=mockstudy, numeric.stats=c("Nmiss", "trim510bracket"),
stats.labels = list(Nmiss = "N-Missing", trim510bracket = "Trimmed means"),
digits.count = 0, digits = 2), text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:----------------|:-------------:|:--------------:|:--------------:|-------:|",
"|hgb | | | | < 0.001|",
"|- N-Missing | 162 | 104 | 266 | |",
"|- Trimmed means | 12.57 [12.56] | 11.92 [11.91] | 12.31 [12.29] | |"
)
)
expect_identical(
capture.kable(summary(tableby(sex ~ hgb, data=mockstudy, numeric.stats=c("Nmiss", "trim10pct"),
digits = 2, digits.pct = 0, digits.count = 1), text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:------------|:------------:|:--------------:|:--------------:|-------:|",
"|hgb | | | | < 0.001|",
"|- N-Miss | 162.0 | 104.0 | 266.0 | |",
"|- trim10pct | 12.57 (10%) | 11.92 (10%) | 12.31 (10%) | |"
)
)
})
test_that("Warn if reserved word is used in tableby by-variable (#277)", {
for(v in c("group.term", "group.label", "strata.term", "strata.value", "variable", "term",
"label", "variable.type", "test", "p.value"))
{
expect_error(tableby(y ~ x, data = data.frame(y = rep(c("hi", v), each = 5), x = 1:10)), v)
}
expect_identical(
capture.kable(summary(tableby(y ~ x, data = data.frame(y = rep(c("hi", "test "), each = 5), x = 1:10)), text = TRUE)),
c("| | hi (N=5) | test (N=5) | Total (N=10) | p value|",
"|:------------|:-------------:|:--------------:|:--------------:|-------:|",
"|x | | | | 0.001|",
"|- Mean (SD) | 3.000 (1.581) | 8.000 (1.581) | 5.500 (3.028) | |",
"|- Range | 1.000 - 5.000 | 6.000 - 10.000 | 1.000 - 10.000 | |"
)
)
})
test_that("HTML footnotes (#298)", {
expect_identical(
capture.output(summary(tableby(sex ~ age + arm, data = mockstudy), text = "html", pfootnote = "html")),
c("<table>" ,
" <thead>" ,
" <tr>" ,
" <th style=\"text-align:left;\"> </th>" ,
" <th style=\"text-align:center;\"> Male (N=916) </th>" ,
" <th style=\"text-align:center;\"> Female (N=583) </th>" ,
" <th style=\"text-align:center;\"> Total (N=1499) </th>" ,
" <th style=\"text-align:right;\"> p value </th>" ,
" </tr>" ,
" </thead>" ,
"<tbody>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> <strong>Age in Years</strong> </td>" ,
" <td style=\"text-align:center;\"> </td>" ,
" <td style=\"text-align:center;\"> </td>" ,
" <td style=\"text-align:center;\"> </td>" ,
" <td style=\"text-align:right;\"> 0.048<sup>1</sup> </td>" ,
" </tr>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> Mean (SD) </td>" ,
" <td style=\"text-align:center;\"> 60.455 (11.369) </td>" ,
" <td style=\"text-align:center;\"> 59.247 (11.722) </td>" ,
" <td style=\"text-align:center;\"> 59.985 (11.519) </td>" ,
" <td style=\"text-align:right;\"> </td>" ,
" </tr>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> Range </td>" ,
" <td style=\"text-align:center;\"> 19.000 - 88.000 </td>" ,
" <td style=\"text-align:center;\"> 22.000 - 88.000 </td>" ,
" <td style=\"text-align:center;\"> 19.000 - 88.000 </td>" ,
" <td style=\"text-align:right;\"> </td>" ,
" </tr>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> <strong>Treatment Arm</strong> </td>",
" <td style=\"text-align:center;\"> </td>" ,
" <td style=\"text-align:center;\"> </td>" ,
" <td style=\"text-align:center;\"> </td>" ,
" <td style=\"text-align:right;\"> 0.190<sup>2</sup> </td>" ,
" </tr>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> A: IFL </td>" ,
" <td style=\"text-align:center;\"> 277 (30.2%) </td>" ,
" <td style=\"text-align:center;\"> 151 (25.9%) </td>" ,
" <td style=\"text-align:center;\"> 428 (28.6%) </td>" ,
" <td style=\"text-align:right;\"> </td>" ,
" </tr>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> F: FOLFOX </td>" ,
" <td style=\"text-align:center;\"> 411 (44.9%) </td>" ,
" <td style=\"text-align:center;\"> 280 (48.0%) </td>" ,
" <td style=\"text-align:center;\"> 691 (46.1%) </td>" ,
" <td style=\"text-align:right;\"> </td>" ,
" </tr>" ,
" <tr>" ,
" <td style=\"text-align:left;\"> G: IROX </td>" ,
" <td style=\"text-align:center;\"> 228 (24.9%) </td>" ,
" <td style=\"text-align:center;\"> 152 (26.1%) </td>" ,
" <td style=\"text-align:center;\"> 380 (25.4%) </td>" ,
" <td style=\"text-align:right;\"> </td>" ,
" </tr>" ,
"</tbody>" ,
"</table>" ,
"<ol>" ,
"<li>Linear Model ANOVA</li>" ,
"<li>Pearson's Chi-squared test</li>" ,
"</ol>" ,
""
)
)
})
test_that("selectall", {
d <- data.frame(
grp = rep(c("A", "B"), each = 5),
option1 = c(rep(1, 4), rep(0, 6)),
option2 = c(0, 1, 0, 0, 0, 1, 1, 1, 0, 0),
option3 = 1,
option4 = c(rep(0, 9), NA)
)
d$s <- selectall(`Option 1` = d$option1, `Option 2` = d$option2, `Option 3` = d$option3, `Option 4` = d$option4)
expect_identical(
capture.kable(summary(tableby(grp ~ s, data = d[1:9, ]), text = TRUE)),
c("| | A (N=5) | B (N=4) | Total (N=9) | p value|",
"|:-----------|:----------:|:----------:|:-----------:|-------:|",
"|s | | | | |",
"|- Option 1 | 4 (80.0%) | 0 (0.0%) | 4 (44.4%) | |",
"|- Option 2 | 1 (20.0%) | 3 (75.0%) | 4 (44.4%) | |",
"|- Option 3 | 5 (100.0%) | 4 (100.0%) | 9 (100.0%) | |",
"|- Option 4 | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) | |"
)
)
expect_identical(
capture.kable(summary(tableby(grp ~ notest(s, "count", "Nmiss"), data = d), text = TRUE)),
c("| | A (N=5) | B (N=5) | Total (N=10) | p value|",
"|:-----------|:-------:|:-------:|:------------:|-------:|",
"|s | | | | |",
"|- Option 1 | 4 | 0 | 4 | |",
"|- Option 2 | 1 | 3 | 4 | |",
"|- Option 3 | 5 | 4 | 9 | |",
"|- Option 4 | 0 | 0 | 0 | |",
"|- N-Miss | 0 | 1 | 1 | |"
)
)
})
test_that("Labels work for cat.simplify and ord.simplify (#288)", {
expect_identical(
capture.kable(summary(tableby(arm ~ sex + as.character(fu.stat), data = mockstudy, cat.simplify = "label"), text = TRUE)),
c("| | A: IFL (N=428) | F: FOLFOX (N=691) | G: IROX (N=380) | Total (N=1499) | p value|",
"|:-------------------------|:--------------:|:-----------------:|:---------------:|:--------------:|-------:|",
"|sex (Female) | 151 (35.3%) | 280 (40.5%) | 152 (40.0%) | 583 (38.9%) | 0.190|",
"|as.character(fu.stat) (2) | 410 (95.8%) | 592 (85.7%) | 354 (93.2%) | 1356 (90.5%) | < 0.001|"
)
)
expect_identical(
capture.kable(summary(tableby(arm ~ sex + notest(as.character(fu.stat), cat.simplify = "label"), data = mockstudy, cat.simplify = TRUE), text = TRUE)),
c("| | A: IFL (N=428) | F: FOLFOX (N=691) | G: IROX (N=380) | Total (N=1499) | p value|",
"|:-------------------------|:--------------:|:-----------------:|:---------------:|:--------------:|-------:|",
"|sex | 151 (35.3%) | 280 (40.5%) | 152 (40.0%) | 583 (38.9%) | 0.190|",
"|as.character(fu.stat) (2) | 410 (95.8%) | 592 (85.7%) | 354 (93.2%) | 1356 (90.5%) | |"
)
)
})
test_that("Titles work with knitr::kable(caption=) (#310)", {
expect_identical(
capture.kable(summary(tableby(arm ~ sex + age, data = mockstudy), title = "My cool table", text = TRUE)),
c("Table: My cool table" ,
"" ,
"| | A: IFL (N=428) | F: FOLFOX (N=691) | G: IROX (N=380) | Total (N=1499) | p value|",
"|:------------|:---------------:|:-----------------:|:---------------:|:---------------:|-------:|",
"|sex | | | | | 0.190|",
"|- Male | 277 (64.7%) | 411 (59.5%) | 228 (60.0%) | 916 (61.1%) | |",
"|- Female | 151 (35.3%) | 280 (40.5%) | 152 (40.0%) | 583 (38.9%) | |",
"|Age in Years | | | | | 0.614|",
"|- Mean (SD) | 59.673 (11.365) | 60.301 (11.632) | 59.763 (11.499) | 59.985 (11.519) | |",
"|- Range | 27.000 - 88.000 | 19.000 - 88.000 | 26.000 - 85.000 | 19.000 - 88.000 | |"
)
)
expect_identical(
capture.kable(print(summary(tableby(arm ~ sex + age, data = mockstudy), title = "My cool table", text = TRUE), format = "pandoc")),
c("Table: My cool table" ,
"" ,
" A: IFL (N=428) F: FOLFOX (N=691) G: IROX (N=380) Total (N=1499) p value",
"------------- ----------------- ------------------- ----------------- ----------------- --------",
"sex 0.190",
"- Male 277 (64.7%) 411 (59.5%) 228 (60.0%) 916 (61.1%) ",
"- Female 151 (35.3%) 280 (40.5%) 152 (40.0%) 583 (38.9%) ",
"Age in Years 0.614",
"- Mean (SD) 59.673 (11.365) 60.301 (11.632) 59.763 (11.499) 59.985 (11.519) ",
"- Range 27.000 - 88.000 19.000 - 88.000 26.000 - 85.000 19.000 - 88.000 "
)
)
expect_true(any(grepl("<caption>", capture.output(print(summary(tableby(arm ~ sex, data = mockstudy), title = "hi"), format = "html")))))
expect_true(any(grepl("\\\\caption", capture.output(print(summary(tableby(arm ~ sex, data = mockstudy), title = "hi"), format = "latex")))))
})
test_that("stats.labels doesn't overwrite existing labels (#316)", {
expect_identical(
capture.kable(summary(tableby(sex ~ age, data = mockstudy, stats.labels=list(medSurv = 'Median')), text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:------------|:---------------:|:---------------:|:---------------:|-------:|",
"|Age in Years | | | | 0.048|",
"|- Mean (SD) | 60.455 (11.369) | 59.247 (11.722) | 59.985 (11.519) | |",
"|- Range | 19.000 - 88.000 | 22.000 - 88.000 | 19.000 - 88.000 | |"
)
)
expect_identical(
capture.kable(summary(tableby(sex ~ age, data = mockstudy, stats.labels=NULL), text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:------------|:---------------:|:---------------:|:---------------:|-------:|",
"|Age in Years | | | | 0.048|",
"|- meansd | 60.455 (11.369) | 59.247 (11.722) | 59.985 (11.519) | |",
"|- range | 19.000 - 88.000 | 22.000 - 88.000 | 19.000 - 88.000 | |"
)
)
})
test_that("wt (#321)", {
expect_identical(
capture.kable(summary(tableby(sex ~ kwt(age), data = mockstudy), text = TRUE)),
capture.kable(summary(tableby(sex ~ wt(age), data = mockstudy), text = TRUE))
)
expect_identical(
capture.kable(summary(tableby(sex ~ wt(age), data = head(mockstudy, 10), wilcox.correct = TRUE, wilcox.exact = FALSE), text = TRUE)),
c("| | Male (N=5) | Female (N=5) | Total (N=10) | p value|",
"|:------------|:---------------:|:---------------:|:---------------:|-------:|",
"|age | | | | 0.463|",
"|- Mean (SD) | 58.600 (6.580) | 63.000 (11.554) | 60.800 (9.163) | |",
"|- Range | 50.000 - 67.000 | 50.000 - 74.000 | 50.000 - 74.000 | |"
)
)
})
test_that("medtest (#327)", {
skip_if_not_installed("coin")
expect_identical(
capture.kable(summary(tableby(sex ~ medtest(ast), data = mockstudy, numeric.stats = c("meansd", "range", "N")), text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:------------|:---------------:|:----------------:|:---------------:|-------:|",
"|ast | | | | 0.705|",
"|- Mean (SD) | 35.873 (26.606) | 36.029 (27.238) | 35.933 (26.843) | |",
"|- Range | 5.000 - 205.000 | 10.000 - 178.000 | 5.000 - 205.000 | |",
"|- N | 754 | 479 | 1233 | |"
)
)
})
test_that("rowpct and pct (#337)", {
expect_identical(
capture.kable(summary(tableby(sex ~ arm, data = mockstudy, cat.stats = c("rowpct", "pct", "countpct")), text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:-------------|:------------:|:--------------:|:--------------:|-------:|",
"|Treatment Arm | | | | 0.190|",
"|- A: IFL | 64.7% | 35.3% | 100.0% | |",
"|- F: FOLFOX | 59.5% | 40.5% | 100.0% | |",
"|- G: IROX | 60.0% | 40.0% | 100.0% | |",
"|- A: IFL | 30.2% | 25.9% | 28.6% | |",
"|- F: FOLFOX | 44.9% | 48.0% | 46.1% | |",
"|- G: IROX | 24.9% | 26.1% | 25.4% | |",
"|- A: IFL | 277 (30.2%) | 151 (25.9%) | 428 (28.6%) | |",
"|- F: FOLFOX | 411 (44.9%) | 280 (48.0%) | 691 (46.1%) | |",
"|- G: IROX | 228 (24.9%) | 152 (26.1%) | 380 (25.4%) | |"
)
)
})
test_that("subsetting tableby (#338)", {
expect_identical(
capture.output(tableby(list(sex, arm, ps) ~ age, data = mockstudy)[, c("ps", "sex")]),
c("tableby Object" ,
"" ,
"Function Call:" ,
"tableby(formula = list(sex, arm, ps) ~ age, data = mockstudy)",
"" ,
"Variable(s):" ,
"ps ~ age" ,
"sex ~ age"
)
)
})
test_that("Subsetting y-levels (#336)", {
tb <- tableby(list(arm, ps, sex) ~ age + ast + mdquality.s, data = mockstudy)
expect_warning(tb[, list(arm = "F: FOLFOX", ps = c("3", "1"))], "Some indices not found")
expect_error(tb[, list(arm = TRUE)], "Logical vector")
expect_identical(
capture.kable(summary(tb["age", list(ps = "0", sex = 2:3, arm = c(TRUE, TRUE, FALSE, TRUE))], text = TRUE, term.name = TRUE)),
c("|ps | 0 (N=635) | p value|" ,
"|:------------|:---------------:|-------:|" ,
"|Age in Years | | 0.335|" ,
"|- Mean (SD) | 59.935 (11.261) | |" ,
"|- Range | 22.000 - 85.000 | |" ,
"" ,
"" ,
"|sex | Female (N=583) | Total (N=1499) | p value|" ,
"|:------------|:---------------:|:---------------:|-------:|" ,
"|Age in Years | | | 0.048|" ,
"|- Mean (SD) | 59.247 (11.722) | 59.985 (11.519) | |" ,
"|- Range | 22.000 - 88.000 | 19.000 - 88.000 | |" ,
"" ,
"" ,
"|Treatment Arm | A: IFL (N=428) | F: FOLFOX (N=691) | Total (N=1499) | p value|",
"|:-------------|:---------------:|:-----------------:|:---------------:|-------:|",
"|Age in Years | | | | 0.614|",
"|- Mean (SD) | 59.673 (11.365) | 60.301 (11.632) | 59.985 (11.519) | |",
"|- Range | 27.000 - 88.000 | 19.000 - 88.000 | 19.000 - 88.000 | |")
)
})
test_that("stddiff", {
expect_error(tableby(arm ~ stddiff(sex), data = mockstudy), "exactly two by-groups")
expect_error(tableby(sex ~ stddiff(age.ord), data = mockstudy), "unless the object is ")
expect_error(tableby(sex ~ stddiff(arm), subset = arm == "F: FOLFOX", data = mockstudy), "At least two levels")
tb <- tableby(sex ~ stddiff(arm) + stddiff(age) + stddiff(ps == 2), data = mockstudy)
expect_identical(
capture.kable(summary(tb, text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:-------------|:---------------:|:---------------:|:---------------:|-------:|",
"|Treatment Arm | | | | 0.097|",
"|- A: IFL | 277 (30.2%) | 151 (25.9%) | 428 (28.6%) | |",
"|- F: FOLFOX | 411 (44.9%) | 280 (48.0%) | 691 (46.1%) | |",
"|- G: IROX | 228 (24.9%) | 152 (26.1%) | 380 (25.4%) | |",
"|Age in Years | | | | 0.105|",
"|- Mean (SD) | 60.455 (11.369) | 59.247 (11.722) | 59.985 (11.519) | |",
"|- Range | 19.000 - 88.000 | 22.000 - 88.000 | 19.000 - 88.000 | |",
"|ps == 2 | | | | 0.103|",
"|- N-Miss | 162 | 104 | 266 | |",
"|- FALSE | 720 (95.5%) | 446 (93.1%) | 1166 (94.6%) | |",
"|- TRUE | 34 (4.5%) | 33 (6.9%) | 67 (5.4%) | |")
)
})
test_that("meanpmsd and meanpmse (#343)", {
tb <- tableby(sex ~ age, data = mockstudy, numeric.stats = c("meanpmsd", "meanpmse", "meansd", "meanse"))
expect_identical(
capture.kable(summary(tb, text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:---------------|:------------------:|:------------------:|:------------------:|-------:|",
"|Age in Years | | | | 0.048|",
"|- Mean ± SD | 60.455 ± 11.369 | 59.247 ± 11.722 | 59.985 ± 11.519 | |",
"|- Mean ± SE | 60.455 ± 0.376 | 59.247 ± 0.485 | 59.985 ± 0.298 | |",
"|- Mean (SD) | 60.455 (11.369) | 59.247 (11.722) | 59.985 (11.519) | |",
"|- Mean (SE) | 60.455 (0.376) | 59.247 (0.485) | 59.985 (0.298) | |")
)
})
test_that("deparse works (#342)", {
this_is_a_along_variable_name_to_make_deparse_split_the_expression_into_multiple_pieces <- 1
expect_error(
tableby(arm ~ age, data = mockstudy, strata = paste(this_is_a_along_variable_name_to_make_deparse_split_the_expression_into_multiple_pieces, sex)),
NA
)
})
test_that("Nmisspct and Nmisspct2 (#346)", {
tb <- tableby(sex ~ age + ast, data = mockstudy, numeric.stats = c("Nmisspct", "Nmisspct2"))
expect_identical(
capture.kable(summary(tb, text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:-------------|:------------:|:--------------:|:--------------:|-------:|",
"|Age in Years | | | | 0.048|",
"|- N-Miss (%) | 0 (0.0%) | 0 (0.0%) | 0 (0.0%) | |",
"|ast | | | | 0.921|",
"|- N-Miss (%) | 162 (17.7%) | 104 (17.8%) | 266 (17.7%) | |",
"|- N-Miss (%) | 162 (17.7%) | 104 (17.8%) | 266 (17.7%) | |")
)
})
test_that("Passing a character vector of stats to tableby (#348)", {
s1 <- c("meansd", "Nmiss2")
s2 <- c("medianq1q3", "range")
tb1 <- tableby(sex ~ notest(age, "medianq1q3", "range") + anova(ast, "meansd", "Nmiss2"), data = mockstudy)
tb2 <- tableby(sex ~ notest(age, stats = s2) + anova(ast, stats = s1), data = mockstudy)
expect_identical(
capture.kable(summary(tb1, text = TRUE)),
capture.kable(summary(tb2, text = TRUE))
)
})
test_that("Currency formatting (#209)", {
dollarmean <- function(x, na.rm = TRUE, ...) {
if(na.rm && allNA(x)) {
as.tbstat(NA_real_)
} else {
out <- arsenal_mean(x, na.rm = na.rm, ...)
attr(out, "fmt") <- "${y}"
out
}
}
tb <- tableby(sex ~ notest(age, "dollarmean", digits = 2), data = mockstudy)
expect_identical(
capture.kable(summary(tb, text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:-------------|:------------:|:--------------:|:--------------:|-------:|",
"|Age in Years | | | | |",
"|- dollarmean | $60.46 | $59.25 | $59.99 | |")
)
})
test_that("Custom p-value formatting (#345)", {
tb <- tableby(sex ~ stddiff(age, format.p = "{round(100*p, digits.p)}%", digits.p = 1) + ast, data = mockstudy)
expect_identical(
capture.kable(summary(tb, text = TRUE)),
c("| | Male (N=916) | Female (N=583) | Total (N=1499) | p value|",
"|:------------|:---------------:|:----------------:|:---------------:|-------:|",
"|Age in Years | | | | 10.5%|",
"|- Mean (SD) | 60.455 (11.369) | 59.247 (11.722) | 59.985 (11.519) | |",
"|- Range | 19.000 - 88.000 | 22.000 - 88.000 | 19.000 - 88.000 | |",
"|ast | | | | 0.921|",
"|- N-Miss | 162 | 104 | 266 | |",
"|- Mean (SD) | 35.873 (26.606) | 36.029 (27.238) | 35.933 (26.843) | |",
"|- Range | 5.000 - 205.000 | 10.000 - 178.000 | 5.000 - 205.000 | |")
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.