tests/testthat/test_freqlist.R

## Tests for freqlist


context("Testing the freqlist output")

# "mdat" now defined in helper-data.R

TAB <- table(mdat[, c("Group", "Sex", "Phase")])
TAB.subset <- table(mdat[!(mdat$Group == "Low" & mdat$Sex == "Male"), c("Group", "Sex", "Phase")])
TAB.na <- table(mdat[, c("trt", "ethan")], useNA = 'a')
old.labs <- c(cumFreq = "cumFreq", freqPercent = "freqPercent", cumPercent = "cumPercent")

###########################################################################################################
#### Basic freqlist
###########################################################################################################

test_that("A basic freqlist call", {
  expect_identical(
    capture.kable(summary(freqlist(TAB), labelTranslations = old.labs)),
    c("|Group |Sex    |Phase | Freq| cumFreq| freqPercent| cumPercent|",
      "|:-----|:------|:-----|----:|-------:|-----------:|----------:|",
      "|High  |Female |I     |    4|       4|        4.44|       4.44|",
      "|      |       |II    |    8|      12|        8.89|      13.33|",
      "|      |       |III   |    3|      15|        3.33|      16.67|",
      "|      |Male   |I     |    7|      22|        7.78|      24.44|",
      "|      |       |II    |    2|      24|        2.22|      26.67|",
      "|      |       |III   |    6|      30|        6.67|      33.33|",
      "|Low   |Female |I     |    7|      37|        7.78|      41.11|",
      "|      |       |II    |    8|      45|        8.89|      50.00|",
      "|      |       |III   |    2|      47|        2.22|      52.22|",
      "|      |Male   |I     |    5|      52|        5.56|      57.78|",
      "|      |       |II    |    4|      56|        4.44|      62.22|",
      "|      |       |III   |    4|      60|        4.44|      66.67|",
      "|Med   |Female |II    |   11|      71|       12.22|      78.89|",
      "|      |       |III   |    3|      74|        3.33|      82.22|",
      "|      |Male   |II    |    8|      82|        8.89|      91.11|",
      "|      |       |III   |    8|      90|        8.89|     100.00|"
    )
  )
})

test_that("strata option in freqlist call", {
  expect_identical(
    capture.kable(summary(freqlist(TAB, strata = "Group"), single = FALSE, labelTranslations = old.labs)),
    c("|Group |Sex    |Phase | Freq| cumFreq| freqPercent| cumPercent|",
      "|:-----|:------|:-----|----:|-------:|-----------:|----------:|",
      "|High  |Female |I     |    4|       4|       13.33|      13.33|",
      "|      |       |II    |    8|      12|       26.67|      40.00|",
      "|      |       |III   |    3|      15|       10.00|      50.00|",
      "|      |Male   |I     |    7|      22|       23.33|      73.33|",
      "|      |       |II    |    2|      24|        6.67|      80.00|",
      "|      |       |III   |    6|      30|       20.00|     100.00|",
      ""                                                               ,
      ""                                                               ,
      "|Group |Sex    |Phase | Freq| cumFreq| freqPercent| cumPercent|",
      "|:-----|:------|:-----|----:|-------:|-----------:|----------:|",
      "|Low   |Female |I     |    7|       7|       23.33|      23.33|",
      "|      |       |II    |    8|      15|       26.67|      50.00|",
      "|      |       |III   |    2|      17|        6.67|      56.67|",
      "|      |Male   |I     |    5|      22|       16.67|      73.33|",
      "|      |       |II    |    4|      26|       13.33|      86.67|",
      "|      |       |III   |    4|      30|       13.33|     100.00|",
      ""                                                               ,
      ""                                                               ,
      "|Group |Sex    |Phase | Freq| cumFreq| freqPercent| cumPercent|",
      "|:-----|:------|:-----|----:|-------:|-----------:|----------:|",
      "|Med   |Female |II    |   11|      11|       36.67|      36.67|",
      "|      |       |III   |    3|      14|       10.00|      46.67|",
      "|      |Male   |II    |    8|      22|       26.67|      73.33|",
      "|      |       |III   |    8|      30|       26.67|     100.00|"
    )
  )

  expect_error(freqlist(TAB, strata = "group"), "strata variable not found")
})

test_that("sparse option in freqlist call", {
  expect_identical(
    capture.kable(summary(freqlist(TAB, sparse = TRUE), labelTranslations = old.labs)),
    c("|Group |Sex    |Phase | Freq| cumFreq| freqPercent| cumPercent|",
      "|:-----|:------|:-----|----:|-------:|-----------:|----------:|",
      "|High  |Female |I     |    4|       4|        4.44|       4.44|",
      "|      |       |II    |    8|      12|        8.89|      13.33|",
      "|      |       |III   |    3|      15|        3.33|      16.67|",
      "|      |Male   |I     |    7|      22|        7.78|      24.44|",
      "|      |       |II    |    2|      24|        2.22|      26.67|",
      "|      |       |III   |    6|      30|        6.67|      33.33|",
      "|Low   |Female |I     |    7|      37|        7.78|      41.11|",
      "|      |       |II    |    8|      45|        8.89|      50.00|",
      "|      |       |III   |    2|      47|        2.22|      52.22|",
      "|      |Male   |I     |    5|      52|        5.56|      57.78|",
      "|      |       |II    |    4|      56|        4.44|      62.22|",
      "|      |       |III   |    4|      60|        4.44|      66.67|",
      "|Med   |Female |I     |    0|      60|        0.00|      66.67|",
      "|      |       |II    |   11|      71|       12.22|      78.89|",
      "|      |       |III   |    3|      74|        3.33|      82.22|",
      "|      |Male   |I     |    0|      74|        0.00|      82.22|",
      "|      |       |II    |    8|      82|        8.89|      91.11|",
      "|      |       |III   |    8|      90|        8.89|     100.00|"
    )
  )
})

test_that("NA options in freqlist call", {
  expect_identical(
    capture.kable(summary(freqlist(TAB.na, na.options = "include"))),
    c("|trt |ethan   | Freq| Cumulative Freq| Percent| Cumulative Percent|",
      "|:---|:-------|----:|---------------:|-------:|------------------:|",
      "|A   |Ethan   |   17|              17|   18.89|              18.89|",
      "|    |Heinzen |   16|              33|   17.78|              36.67|",
      "|    |NA      |    3|              36|    3.33|              40.00|",
      "|B   |Ethan   |   25|              61|   27.78|              67.78|",
      "|    |Heinzen |   29|              90|   32.22|             100.00|"
    )
  )
  expect_identical(
    capture.kable(summary(freqlist(TAB.na, na.options = "showexclude"))),
    c("|trt |ethan   | Freq| Cumulative Freq| Percent| Cumulative Percent|",
      "|:---|:-------|----:|---------------:|-------:|------------------:|",
      "|A   |Ethan   |   17|              17|   19.54|              19.54|",
      "|    |Heinzen |   16|              33|   18.39|              37.93|",
      "|    |NA      |    3|              NA|      NA|                 NA|",
      "|B   |Ethan   |   25|              58|   28.74|              66.67|",
      "|    |Heinzen |   29|              87|   33.33|             100.00|"
    )
  )
  expect_identical(
    capture.kable(summary(freqlist(TAB.na, na.options = "remove"))),
    c("|trt |ethan   | Freq| Cumulative Freq| Percent| Cumulative Percent|",
      "|:---|:-------|----:|---------------:|-------:|------------------:|",
      "|A   |Ethan   |   17|              17|   19.54|              19.54|",
      "|    |Heinzen |   16|              33|   18.39|              37.93|",
      "|B   |Ethan   |   25|              58|   28.74|              66.67|",
      "|    |Heinzen |   29|              87|   33.33|             100.00|"
    )
  )
})

test_that("Changing the labels on non-grouped freqlists", {

  ref <- c(
    "|Treatment |Ethan Rocks | Freq| Cumulative Freq| Percent| Cumulative Percent|",
    "|:---------|:-----------|----:|---------------:|-------:|------------------:|",
    "|A         |Ethan       |   17|              17|   18.89|              18.89|",
    "|          |Heinzen     |   16|              33|   17.78|              36.67|",
    "|          |NA          |    3|              36|    3.33|              40.00|",
    "|B         |Ethan       |   25|              61|   27.78|              67.78|",
    "|          |Heinzen     |   29|              90|   32.22|             100.00|"
  )

  expect_identical(
    capture.kable(summary(freqlist(TAB.na, na.options = "include"), labelTranslations = c(trt = "Treatment", ethan = "Ethan Rocks"))),
    ref
  )

  expect_identical(
    capture.kable(summary(freqlist(TAB.na, na.options = "include", labelTranslations = list(trt = "Treatment", ethan = "Ethan Rocks")))),
    ref
  )

  expect_identical(
    capture.kable(summary(freqlist(TAB.na, na.options = "include", labelTranslations = c(trt = "Treatment", ethan ="Ethan Rocks")))),
    ref
  )

  expect_error(freqlist(TAB.na, labelTranslations = c("Treatment", "Ethan Rocks")), "Unnamed label")
  expect_error(freqlist(TAB.na, labelTranslations = c(hi = "Treatment", ethan = "Ethan Rocks")), NA)

  tmp <- freqlist(TAB.na, na.options = "include")
  labels(tmp) <- c(trt = "Treatment", ethan = "Ethan Rocks")
  expect_identical(
    capture.kable(summary(tmp)),
    ref
  )
  labels(tmp) <- NULL
  expect_identical(
    capture.kable(summary(tmp)),
    c("|trt |ethan   | Freq| cumFreq| freqPercent| cumPercent|",
      "|:---|:-------|----:|-------:|-----------:|----------:|",
      "|A   |Ethan   |   17|      17|       18.89|      18.89|",
      "|    |Heinzen |   16|      33|       17.78|      36.67|",
      "|    |NA      |    3|      36|        3.33|      40.00|",
      "|B   |Ethan   |   25|      61|       27.78|      67.78|",
      "|    |Heinzen |   29|      90|       32.22|     100.00|"
    )
  )

  labels(tmp) <- c(ethan = "Ethan Rocks", trt = "Treatment", dummy = "Dummy")
  expect_identical(
    capture.kable(summary(tmp)),
    c(
      "|Treatment |Ethan Rocks | Freq| cumFreq| freqPercent| cumPercent|",
      "|:---------|:-----------|----:|-------:|-----------:|----------:|",
      "|A         |Ethan       |   17|      17|       18.89|      18.89|",
      "|          |Heinzen     |   16|      33|       17.78|      36.67|",
      "|          |NA          |    3|      36|        3.33|      40.00|",
      "|B         |Ethan       |   25|      61|       27.78|      67.78|",
      "|          |Heinzen     |   29|      90|       32.22|     100.00|"
    )
  )
})


test_that("Changing the labels on grouped freqlists", {
  expect_identical(
    capture.kable(summary(freqlist(TAB.na, options = "include", strata = "ethan",
                                   labelTranslations = c(trt = "Treatment", ethan = "Ethan", old.labs)))),
    c("|Ethan |Treatment | Freq| cumFreq| freqPercent| cumPercent|"  ,
      "|:-----|:---------|----:|-------:|-----------:|----------:|"  ,
      "|Ethan |A         |   17|      17|       40.48|      40.48|"  ,
      "|      |B         |   25|      42|       59.52|     100.00|"  ,
      ""                                                             ,
      ""                                                             ,
      "|Ethan   |Treatment | Freq| cumFreq| freqPercent| cumPercent|",
      "|:-------|:---------|----:|-------:|-----------:|----------:|",
      "|Heinzen |A         |   16|      16|       35.56|      35.56|",
      "|        |B         |   29|      45|       64.44|     100.00|",
      ""                                                             ,
      ""                                                             ,
      "|Ethan |Treatment | Freq| cumFreq| freqPercent| cumPercent|"  ,
      "|:-----|:---------|----:|-------:|-----------:|----------:|"  ,
      "|NA    |A         |    3|       3|      100.00|     100.00|"
    )
  )
})


test_that("dupLabels works", {
  expect_identical(
    capture.kable(summary(freqlist(TAB, labelTranslations = old.labs), dupLabels = TRUE)),
    c("|Group |Sex    |Phase | Freq| cumFreq| freqPercent| cumPercent|",
      "|:-----|:------|:-----|----:|-------:|-----------:|----------:|",
      "|High  |Female |I     |    4|       4|        4.44|       4.44|",
      "|High  |Female |II    |    8|      12|        8.89|      13.33|",
      "|High  |Female |III   |    3|      15|        3.33|      16.67|",
      "|High  |Male   |I     |    7|      22|        7.78|      24.44|",
      "|High  |Male   |II    |    2|      24|        2.22|      26.67|",
      "|High  |Male   |III   |    6|      30|        6.67|      33.33|",
      "|Low   |Female |I     |    7|      37|        7.78|      41.11|",
      "|Low   |Female |II    |    8|      45|        8.89|      50.00|",
      "|Low   |Female |III   |    2|      47|        2.22|      52.22|",
      "|Low   |Male   |I     |    5|      52|        5.56|      57.78|",
      "|Low   |Male   |II    |    4|      56|        4.44|      62.22|",
      "|Low   |Male   |III   |    4|      60|        4.44|      66.67|",
      "|Med   |Female |II    |   11|      71|       12.22|      78.89|",
      "|Med   |Female |III   |    3|      74|        3.33|      82.22|",
      "|Med   |Male   |II    |    8|      82|        8.89|      91.11|",
      "|Med   |Male   |III   |    8|      90|        8.89|     100.00|"
    )
  )
  expect_identical(
    capture.kable(summary(freqlist(TAB, strata = "Group", labelTranslations = old.labs), single = FALSE, dupLabels = TRUE)),
    c("|Group |Sex    |Phase | Freq| cumFreq| freqPercent| cumPercent|",
      "|:-----|:------|:-----|----:|-------:|-----------:|----------:|",
      "|High  |Female |I     |    4|       4|       13.33|      13.33|",
      "|High  |Female |II    |    8|      12|       26.67|      40.00|",
      "|High  |Female |III   |    3|      15|       10.00|      50.00|",
      "|High  |Male   |I     |    7|      22|       23.33|      73.33|",
      "|High  |Male   |II    |    2|      24|        6.67|      80.00|",
      "|High  |Male   |III   |    6|      30|       20.00|     100.00|",
      ""                                                               ,
      ""                                                               ,
      "|Group |Sex    |Phase | Freq| cumFreq| freqPercent| cumPercent|",
      "|:-----|:------|:-----|----:|-------:|-----------:|----------:|",
      "|Low   |Female |I     |    7|       7|       23.33|      23.33|",
      "|Low   |Female |II    |    8|      15|       26.67|      50.00|",
      "|Low   |Female |III   |    2|      17|        6.67|      56.67|",
      "|Low   |Male   |I     |    5|      22|       16.67|      73.33|",
      "|Low   |Male   |II    |    4|      26|       13.33|      86.67|",
      "|Low   |Male   |III   |    4|      30|       13.33|     100.00|",
      ""                                                               ,
      ""                                                               ,
      "|Group |Sex    |Phase | Freq| cumFreq| freqPercent| cumPercent|",
      "|:-----|:------|:-----|----:|-------:|-----------:|----------:|",
      "|Med   |Female |II    |   11|      11|       36.67|      36.67|",
      "|Med   |Female |III   |    3|      14|       10.00|      46.67|",
      "|Med   |Male   |II    |    8|      22|       26.67|      73.33|",
      "|Med   |Male   |III   |    8|      30|       26.67|     100.00|"
    )
  )
})


test_that("Adding a title", {
  expect_identical(
    capture.kable(summary(freqlist(TAB.na, options = "include", labelTranslations = c(trt = "Treatment", ethan = "Ethan", old.labs)),
                          dupLabels = TRUE, title = "Ethan Rocks")),
    c("Table: Ethan Rocks"                                           ,
      ""                                                             ,
      "|Treatment |Ethan   | Freq| cumFreq| freqPercent| cumPercent|",
      "|:---------|:-------|----:|-------:|-----------:|----------:|",
      "|A         |Ethan   |   17|      17|       18.89|      18.89|",
      "|A         |Heinzen |   16|      33|       17.78|      36.67|",
      "|A         |NA      |    3|      36|        3.33|      40.00|",
      "|B         |Ethan   |   25|      61|       27.78|      67.78|",
      "|B         |Heinzen |   29|      90|       32.22|     100.00|"
    )
  )

  expect_identical(
    capture.kable(summary(freqlist(TAB.na, options = "include", strata = "ethan",
                                    labelTranslations = c(trt = "Treatment", ethan = "Ethan", old.labs)),
                          dupLabels = TRUE, title = "Ethan Rocks")),
    c("Table: Ethan Rocks"                                           ,
      ""                                                             ,
      "|Ethan |Treatment | Freq| cumFreq| freqPercent| cumPercent|"  ,
      "|:-----|:---------|----:|-------:|-----------:|----------:|"  ,
      "|Ethan |A         |   17|      17|       40.48|      40.48|"  ,
      "|Ethan |B         |   25|      42|       59.52|     100.00|"  ,
      ""                                                             ,
      ""                                                             ,
      "|Ethan   |Treatment | Freq| cumFreq| freqPercent| cumPercent|",
      "|:-------|:---------|----:|-------:|-----------:|----------:|",
      "|Heinzen |A         |   16|      16|       35.56|      35.56|",
      "|Heinzen |B         |   29|      45|       64.44|     100.00|",
      ""                                                             ,
      ""                                                             ,
      "|Ethan |Treatment | Freq| cumFreq| freqPercent| cumPercent|"  ,
      "|:-----|:---------|----:|-------:|-----------:|----------:|"  ,
      "|NA    |A         |    3|       3|      100.00|     100.00|"
    )
  )
})


test_that("Formula method works", {
  expect_identical(
    capture.kable(summary(freqlist(TAB.na, options = "include"), labelTranslations = c(trt = "Trt", ethan = "Ethan"))),
    capture.kable(summary(freqlist(~ trt + addNA(ethan), data = mdat), labelTranslations = c("addNA(ethan)" = "Ethan", trt = "Trt")))
  )
  if(getRversion() >= "3.4.0")
  {
    expect_identical(
      capture.kable(summary(freqlist(~ trt + ethan, data = mdat, addNA = TRUE), labelTranslations = c(trt = "Trt", ethan = "Ethan"))),
      capture.kable(summary(freqlist(~ trt + addNA(ethan), data = mdat), labelTranslations = c("addNA(ethan)" = "Ethan", trt = "Trt")))
    )
  } else skip("R version isn't right to use 'addNA=TRUE'")
})


test_that("digits specification", {
  expect_identical(
    capture.kable(summary(freqlist(~ trt + addNA(ethan), data = mdat), digits.pct = 1, digits.count = 1)),
    capture.kable(summary(freqlist(~ trt + addNA(ethan), data = mdat, digits.pct = 1, digits.count = 1)))
  )
  expect_identical(
    capture.kable(summary(freqlist(~ trt + addNA(ethan), data = mdat), digits.pct = 1, digits.count = 1)),
    c(
      "|Treatment Arm |addNA(ethan) | Freq| Cumulative Freq| Percent| Cumulative Percent|",
      "|:-------------|:------------|----:|---------------:|-------:|------------------:|",
      "|A             |Ethan        | 17.0|            17.0|    18.9|               18.9|",
      "|              |Heinzen      | 16.0|            33.0|    17.8|               36.7|",
      "|              |NA           |  3.0|            36.0|     3.3|               40.0|",
      "|B             |Ethan        | 25.0|            61.0|    27.8|               67.8|",
      "|              |Heinzen      | 29.0|            90.0|    32.2|              100.0|"
    )
  )
})

###########################################################################################################
#### Reported bugs for freqlist
###########################################################################################################


test_that("11/18/16: Emily Lundt's subsetted table and duplicate label problem", {
  expect_identical(
    capture.kable(summary(freqlist(TAB.subset), labelTranslations = old.labs)),
    c("|Group |Sex    |Phase | Freq| cumFreq| freqPercent| cumPercent|",
      "|:-----|:------|:-----|----:|-------:|-----------:|----------:|",
      "|High  |Female |I     |    4|       4|        5.19|       5.19|",
      "|      |       |II    |    8|      12|       10.39|      15.58|",
      "|      |       |III   |    3|      15|        3.90|      19.48|",
      "|      |Male   |I     |    7|      22|        9.09|      28.57|",
      "|      |       |II    |    2|      24|        2.60|      31.17|",
      "|      |       |III   |    6|      30|        7.79|      38.96|",
      "|Low   |Female |I     |    7|      37|        9.09|      48.05|",
      "|      |       |II    |    8|      45|       10.39|      58.44|",
      "|      |       |III   |    2|      47|        2.60|      61.04|",
      "|Med   |Female |II    |   11|      58|       14.29|      75.32|",
      "|      |       |III   |    3|      61|        3.90|      79.22|",
      "|      |Male   |II    |    8|      69|       10.39|      89.61|",
      "|      |       |III   |    8|      77|       10.39|     100.00|"
    )
  )
})

test_that("04/17/18: using 'method' in freqlist (#95)", {
  dat <- data.frame(method = c(1, 1, 2, 2, 3, 3, 4, 4))

  expect_identical(
    capture.kable(summary(freqlist(~method, data = dat))),
    c("|method | Freq| Cumulative Freq| Percent| Cumulative Percent|",
      "|:------|----:|---------------:|-------:|------------------:|",
      "|1      |    2|               2|   25.00|              25.00|",
      "|2      |    2|               4|   25.00|              50.00|",
      "|3      |    2|               6|   25.00|              75.00|",
      "|4      |    2|               8|   25.00|             100.00|"
    )
  )
})

test_that("02/26/19: don't drop labels with subset= argument (#184)", {
  expect_identical(
    capture.kable(summary(freqlist(~ age, data = mockstudy, subset = age > 80))),
    c("|Age in Years | Freq| Cumulative Freq| Percent| Cumulative Percent|",
      "|:------------|----:|---------------:|-------:|------------------:|",
      "|81           |   12|              12|   41.38|              41.38|",
      "|82           |    6|              18|   20.69|              62.07|",
      "|83           |    6|              24|   20.69|              82.76|",
      "|84           |    1|              25|    3.45|              86.21|",
      "|85           |    2|              27|    6.90|              93.10|",
      "|88           |    2|              29|    6.90|             100.00|"
    )
  )
})

test_that("03/20/2019: freqlist still works with all zero counts (#194, #186).", {
  tab0 <- table(factor(c(), levels = c("m", "f")))
  expect_error(print(summary(freqlist(tab0))), "There wasn't anything")
  expect_identical(
    capture.kable(summary(freqlist(tab0), sparse = TRUE)),
    c("|Var1 | Freq| Cumulative Freq| Percent| Cumulative Percent|",
      "|:----|----:|---------------:|-------:|------------------:|",
      "|m    |    0|               0|      NA|                 NA|",
      "|f    |    0|               0|      NA|                 NA|"
    )
  )
})

test_that("03/21/2019: freqlist doesn't lose labels when subsetting (#196)", {
  expect_identical(
    capture.kable(summary(freqlist(~ sex + ps + arm, data = mockstudy, strata = "arm",
                                   subset = arm == "F: FOLFOX" & !is.na(ps))[c(1:2, 4)])),
    c("|Treatment Arm |sex    | Freq|",
      "|:-------------|:------|----:|",
      "|F: FOLFOX     |Male   |  168|",
      "|              |       |  148|",
      "|              |       |   16|",
      "|              |Female |  110|",
      "|              |       |   95|",
      "|              |       |   13|"
    )
  )
})

test_that("02/28/2020: freqlist.formula works without needing addNA AND na.option (#265)", {
  expect_identical(
    capture.kable(summary(freqlist(~ sex + ps, data = mockstudy))),
    c("|sex    |ps | Freq| Cumulative Freq| Percent| Cumulative Percent|",
      "|:------|:--|----:|---------------:|-------:|------------------:|",
      "|Male   |0  |  391|             391|   26.08|              26.08|",
      "|       |1  |  329|             720|   21.95|              48.03|",
      "|       |2  |   34|             754|    2.27|              50.30|",
      "|       |NA |  162|             916|   10.81|              61.11|",
      "|Female |0  |  244|            1160|   16.28|              77.38|",
      "|       |1  |  202|            1362|   13.48|              90.86|",
      "|       |2  |   33|            1395|    2.20|              93.06|",
      "|       |NA |  104|            1499|    6.94|             100.00|"
    )
  )
  expect_identical(
    capture.kable(summary(freqlist(~ sex + ps, data = mockstudy, addNA = FALSE))),
    capture.kable(summary(freqlist(~ sex + ps, data = mockstudy, na.options = "remove")))
  )
})
eheinzen/arsenal documentation built on Sept. 11, 2022, 10:59 a.m.