## Tests for freqlist
context("Testing the freqlist strata and multiple LHS output")
tab <- table(mockstudy[c("arm", "sex", "mdquality.s")], useNA = "ifany")
dat <- data.frame(
wts1 = rep(1:2, each = 6),
wts2 = rep(1:2, times = 6),
wts3 = rep(1:3, times = 4),
a = rep(c("A", "B", "C"), each = 4),
b = rep(c("D", "E", "F", "G"), each = 3),
d = rep(c("H", "I"), each = 6),
stringsAsFactors = FALSE
)
tab.wts <- freqlist(list(wts1, wts2) ~ a + b + d, strata = "d", data = dat, sparse = FALSE)
#####################################
test_that("Multiple strata work", {
expect_identical(
capture.kable(summary(freqlist(tab, strata = c("arm", "sex")))),
capture.kable(summary(freqlist(~ arm + sex + addNA(mdquality.s), data = mockstudy, strata = c("arm", "sex")),
labelTranslations = c(arm = "arm", "addNA(mdquality.s)" = "mdquality.s")))
)
})
test_that("Multiple endpoints work", {
expect_identical(
capture.kable(summary(freqlist(list(wts1, wts2) ~ a + b, data = dat))),
c(
capture.kable(summary(freqlist(wts1 ~ a + b, data = dat))), "", "",
capture.kable(summary(freqlist(wts2 ~ a + b, data = dat)))
)
)
})
test_that("Multiple endpoints and strata work", {
expect_identical(
capture.kable(summary(tab.wts)),
c(
capture.kable(summary(freqlist(wts1 ~ a + b + d, strata = "d", data = dat))), "", "",
capture.kable(summary(freqlist(wts2 ~ a + b + d, strata = "d", data = dat)))
)
)
expect_identical(
capture.kable(summary(tab.wts)),
c(
"|d |a |b | Freq| Cumulative Freq| Percent| Cumulative Percent|",
"|:--|:--|:--|----:|---------------:|-------:|------------------:|",
"|H |A |D | 3| 3| 50.00| 50.00|",
"| | |E | 1| 4| 16.67| 66.67|",
"| |B |E | 2| 6| 33.33| 100.00|",
"" ,
"" ,
"|d |a |b | Freq| Cumulative Freq| Percent| Cumulative Percent|",
"|:--|:--|:--|----:|---------------:|-------:|------------------:|",
"|I |B |F | 4| 4| 33.33| 33.33|",
"| |C |F | 2| 6| 16.67| 50.00|",
"| | |G | 6| 12| 50.00| 100.00|",
"" ,
"" ,
"|d |a |b | Freq| Cumulative Freq| Percent| Cumulative Percent|",
"|:--|:--|:--|----:|---------------:|-------:|------------------:|",
"|H |A |D | 4| 4| 44.44| 44.44|",
"| | |E | 2| 6| 22.22| 66.67|",
"| |B |E | 3| 9| 33.33| 100.00|",
"" ,
"" ,
"|d |a |b | Freq| Cumulative Freq| Percent| Cumulative Percent|",
"|:--|:--|:--|----:|---------------:|-------:|------------------:|",
"|I |B |F | 3| 3| 33.33| 33.33|",
"| |C |F | 1| 4| 11.11| 44.44|",
"| | |G | 5| 9| 55.56| 100.00|"
)
)
})
#####################################
test_that("Reordering variables and subsetting", {
expect_identical(
capture.kable(summary(tab.wts[c("b", "d", "a", "Freq")], text = TRUE)),
c(
"|b |d |a | Freq|",
"|:--|:--|:--|----:|",
"|D |H |A | 3|",
"|E |H |A | 1|",
"| | |B | 2|",
"" ,
"" ,
"|b |d |a | Freq|",
"|:--|:--|:--|----:|",
"|F |I |B | 4|",
"| | |C | 2|",
"|G |I |C | 6|",
"" ,
"" ,
"|b |d |a | Freq|",
"|:--|:--|:--|----:|",
"|D |H |A | 4|",
"|E |H |A | 2|",
"| | |B | 3|",
"" ,
"" ,
"|b |d |a | Freq|",
"|:--|:--|:--|----:|",
"|F |I |B | 3|",
"| | |C | 1|",
"|G |I |C | 5|"
)
)
expect_identical(
capture.kable(summary(tab.wts[c(3,1,2,4)], text = TRUE)),
capture.kable(summary(tab.wts[c("b", "d", "a", "Freq")], text = TRUE))
)
expect_identical(
capture.kable(summary(tab.wts[, 2:1], text = TRUE)),
capture.kable(summary(tab.wts[, c("wts2", "wts1")], text = TRUE))
)
expect_identical(
capture.kable(summary(tab.wts[1:4], text = TRUE)),
capture.kable(summary(tab.wts[c(TRUE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE)], text = TRUE))
)
expect_identical(
capture.kable(summary(tab.wts[, 2], text = TRUE)),
capture.kable(summary(tab.wts[, c(FALSE, TRUE)], text = TRUE))
)
expect_warning(tab.wts[1:8], "Some indices not found")
expect_warning(tab.wts[, 1:3], "Some indices not found")
expect_error(tab.wts[TRUE], "Logical vector")
expect_error(tab.wts[, TRUE], "Logical vector")
})
test_that("Merging freqlist objects", {
tb1 <- tab.wts
tb2 <- freqlist(wts3 ~ b + d, strata = "d", data = dat)
tb3 <- freqlist(~ a + d, strata = "d", data = dat)
tb4 <- freqlist(~ b, data = dat)
expect_error(merge(tb1, freqlist(wts1 ~ a + d, strata = "d", data = dat)), "Can only merge freqlist objects")
expect_identical(
capture.kable(summary(merge(tb1, tb2))),
c(capture.kable(summary(tb1)), "", "", capture.kable(summary(tb2)))
)
expect_identical(
capture.kable(summary(merge(tb1, merge(tb3, tb4)))),
c(capture.kable(summary(tb1)), "", "", capture.kable(summary(tb3)), "", "", capture.kable(summary(tb4)))
)
})
test_that("head() and tail() work with freqlist (#188)", {
expect_identical(
capture.kable(head(summary(tab.wts), 2)),
capture.kable(summary(tab.wts))[2-7*(1:4)] # we already tested this above
)
expect_identical(
capture.kable(head(summary(tab.wts, sparse = TRUE))),
c("|d |a |b | Freq| Cumulative Freq| Percent| Cumulative Percent|",
"|:--|:--|:--|----:|---------------:|-------:|------------------:|",
"|H |A |D | 3| 3| 50.00| 50.00|",
"| | |E | 1| 4| 16.67| 66.67|",
"| | |F | 0| 4| 0.00| 66.67|",
"| | |G | 0| 4| 0.00| 66.67|",
"| |B |D | 0| 4| 0.00| 66.67|",
"| | |E | 2| 6| 33.33| 100.00|",
"" ,
"" ,
"|d |a |b | Freq| Cumulative Freq| Percent| Cumulative Percent|",
"|:--|:--|:--|----:|---------------:|-------:|------------------:|",
"|I |A |D | 0| 0| 0.00| 0.00|",
"| | |E | 0| 0| 0.00| 0.00|",
"| | |F | 0| 0| 0.00| 0.00|",
"| | |G | 0| 0| 0.00| 0.00|",
"| |B |D | 0| 0| 0.00| 0.00|",
"| | |E | 0| 0| 0.00| 0.00|",
"" ,
"" ,
"|d |a |b | Freq| Cumulative Freq| Percent| Cumulative Percent|",
"|:--|:--|:--|----:|---------------:|-------:|------------------:|",
"|H |A |D | 4| 4| 44.44| 44.44|",
"| | |E | 2| 6| 22.22| 66.67|",
"| | |F | 0| 6| 0.00| 66.67|",
"| | |G | 0| 6| 0.00| 66.67|",
"| |B |D | 0| 6| 0.00| 66.67|",
"| | |E | 3| 9| 33.33| 100.00|",
"" ,
"" ,
"|d |a |b | Freq| Cumulative Freq| Percent| Cumulative Percent|",
"|:--|:--|:--|----:|---------------:|-------:|------------------:|",
"|I |A |D | 0| 0| 0.00| 0.00|",
"| | |E | 0| 0| 0.00| 0.00|",
"| | |F | 0| 0| 0.00| 0.00|",
"| | |G | 0| 0| 0.00| 0.00|",
"| |B |D | 0| 0| 0.00| 0.00|",
"| | |E | 0| 0| 0.00| 0.00|"
)
)
})
test_that("sort() works with freqlist() (#187)", {
expect_error(sort(freqlist(~ arm, data = mockstudy)[c("arm", "cumFreq")]), "You tried to create or sort a freqlist")
mockstudy.wts <- mockstudy
mockstudy.wts$one <- 1
mockstudy.wts$two <- 2
mck.wts <- freqlist(list(one, two) ~ arm + addNA(mdquality.s) + sex, data = mockstudy.wts, strata = "sex",
na.options = 'showexclude', labelTranslations = c("addNA(mdquality.s)" = "QOL"))
mck.wts2 <- freqlist(list(one, two) ~ arm + addNA(mdquality.s) + sex, data = mockstudy.wts, strata = "sex",
na.options = 'include', labelTranslations = c("addNA(mdquality.s)" = "QOL"))
mck.wts3 <- freqlist(list(one, two) ~ arm + addNA(mdquality.s) + sex, data = mockstudy.wts, strata = "sex", na.options = 'remove')
expect_true(
all(capture.kable(summary(sort(mck.wts[c(1:4, 6)]), dupLabels = TRUE)) %in% capture.kable(summary(mck.wts[c(1:4, 6)], dupLabels = TRUE)))
)
expect_true(
all(capture.kable(summary(sort(mck.wts[c(1:4, 6)], decreasing = TRUE), dupLabels = TRUE)) %in%
capture.kable(summary(mck.wts[c(1:4, 6)], dupLabels = TRUE)))
)
expect_true(
all(capture.kable(summary(sort(mck.wts2[c(1:4, 6)]), dupLabels = TRUE)) %in% capture.kable(summary(mck.wts2[c(1:4, 6)], dupLabels = TRUE)))
)
expect_true(
all(capture.kable(summary(sort(mck.wts3[c(1:4, 6)]), dupLabels = TRUE)) %in% capture.kable(summary(mck.wts3[c(1:4, 6)], dupLabels = TRUE)))
)
## this checks that each table recalculates with its own na.options
expect_identical(
capture.kable(summary(sort(merge(mck.wts[, 1], mck.wts2[, 2]), decreasing = TRUE))),
c("|sex |Treatment Arm |QOL | Freq| Cumulative Freq| Percent| Cumulative Percent|" ,
"|:----|:-------------|:---|----:|---------------:|-------:|------------------:|" ,
"|Male |F: FOLFOX |1 | 285| 285| 37.35| 37.35|" ,
"| |A: IFL |1 | 214| 499| 28.05| 65.40|" ,
"| |G: IROX |1 | 187| 686| 24.51| 89.91|" ,
"| |F: FOLFOX |NA | 95| NA| NA| NA|" ,
"| |A: IFL |NA | 34| NA| NA| NA|" ,
"| |F: FOLFOX |0 | 31| 717| 4.06| 93.97|" ,
"| |A: IFL |0 | 29| 746| 3.80| 97.77|" ,
"| |G: IROX |NA | 24| NA| NA| NA|" ,
"| | |0 | 17| 763| 2.23| 100.00|" ,
"" ,
"" ,
"|sex |Treatment Arm |QOL | Freq| Cumulative Freq| Percent| Cumulative Percent|",
"|:------|:-------------|:---|----:|---------------:|-------:|------------------:|",
"|Female |F: FOLFOX |1 | 198| 198| 40.91| 40.91|",
"| |G: IROX |1 | 121| 319| 25.00| 65.91|",
"| |A: IFL |1 | 118| 437| 24.38| 90.29|",
"| |F: FOLFOX |NA | 61| NA| NA| NA|",
"| |A: IFL |NA | 21| NA| NA| NA|",
"| |F: FOLFOX |0 | 21| 458| 4.34| 94.63|",
"| |G: IROX |NA | 17| NA| NA| NA|",
"| | |0 | 14| 472| 2.89| 97.52|",
"| |A: IFL |0 | 12| 484| 2.48| 100.00|",
"" ,
"" ,
"|sex |Treatment Arm |QOL | Freq| Cumulative Freq| Percent| Cumulative Percent|" ,
"|:----|:-------------|:---|----:|---------------:|-------:|------------------:|" ,
"|Male |F: FOLFOX |1 | 570| 570| 31.11| 31.11|" ,
"| |A: IFL |1 | 428| 998| 23.36| 54.48|" ,
"| |G: IROX |1 | 374| 1372| 20.41| 74.89|" ,
"| |F: FOLFOX |NA | 190| 1562| 10.37| 85.26|" ,
"| |A: IFL |NA | 68| 1630| 3.71| 88.97|" ,
"| |F: FOLFOX |0 | 62| 1692| 3.38| 92.36|" ,
"| |A: IFL |0 | 58| 1750| 3.17| 95.52|" ,
"| |G: IROX |NA | 48| 1798| 2.62| 98.14|" ,
"| | |0 | 34| 1832| 1.86| 100.00|" ,
"" ,
"" ,
"|sex |Treatment Arm |QOL | Freq| Cumulative Freq| Percent| Cumulative Percent|",
"|:------|:-------------|:---|----:|---------------:|-------:|------------------:|",
"|Female |F: FOLFOX |1 | 396| 396| 33.96| 33.96|",
"| |G: IROX |1 | 242| 638| 20.75| 54.72|",
"| |A: IFL |1 | 236| 874| 20.24| 74.96|",
"| |F: FOLFOX |NA | 122| 996| 10.46| 85.42|",
"| |A: IFL |NA | 42| 1038| 3.60| 89.02|",
"| |F: FOLFOX |0 | 42| 1080| 3.60| 92.62|",
"| |G: IROX |NA | 34| 1114| 2.92| 95.54|",
"| | |0 | 28| 1142| 2.40| 97.94|",
"| |A: IFL |0 | 24| 1166| 2.06| 100.00|"
)
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.