tests/testthat/test-header-footer.R

In rtables: Reporting Tables

context("headers and footers")
test_that("referential footnotes work", {
    analysisfun <- function(x, ...) {
        in_rows(row1 = 5,
                row2 = c(1, 2),
                .row_footnotes = list(row1 = "row 1 rfn"),
                .cell_footnotes = list(row2 = "row 2 cfn"))
    }

    lyt <- basic_table(title = "Title says Whaaaat", subtitles = "Oh, ok.",
                   main_footer = "ha HA! Footer!") %>%
        split_cols_by("ARM") %>%
        analyze("AGE", afun = analysisfun)

    result <-  build_table(lyt, ex_adsl)

    rdf <- make_row_df(result)
    expect_identical(rdf[2, "nrowrefs"], 0L)
    expect_identical(rdf[1, "nrowrefs"], 1L)
    expect_identical(rdf[2, "ncellrefs"], 3L)
    expect_identical(rdf[1, "ncellrefs"], 0L)

    rfn_out <- row_footnotes(result)
    expect_identical(list(row1 = list(rtables:::RefFootnote("row 1 rfn", 1L)),
                          row2 = list()),
                     rfn_out)
    cfn_out <- cell_footnotes(result)
    expect_identical(cfn_out[2, 1][[1]],
                     list(rtables:::RefFootnote("row 2 cfn", 2L)))

    analysisfun2 <- function(x, cutoff,  ...) {
        mn <- mean(x)
        if(mn >= cutoff)
            cf <- list(mean = "Elevated group mean")
        else
            cf <- list()
        in_rows(mean = mean(x),
                range = range(x),
                .cell_footnotes = cf,
                .formats = list(mean = "xx.x", range = "xx - xx"))
    }
    lyt2 <- basic_table() %>%
        split_cols_by("ARM") %>%
        analyze("AGE", afun = analysisfun2, extra_args = list(cutoff = mean(ex_adsl$AGE)))
    tbl <- build_table(lyt2, ex_adsl)
    rdf2 <- make_row_df(tbl)
    expect_identical(rdf2$nrowrefs, c(0L, 0L))
    expect_identical(rdf2$ncellrefs, c(2L, 0L))
})


test_that("post-processing addition of referential footnotes works", {

    race_levels <- c("WHITE",
                     "BLACK OR AFRICAN AMERICAN",
                     "ASIAN",
                     "AMERICAN INDIAN OR ALASKA NATIVE",
                     "MULTIPLE")
    l1 <- basic_table() %>%
        split_cols_by("ARM") %>%
        split_rows_by("RACE", split_fun = keep_split_levels(race_levels)) %>%
        summarize_row_groups() %>%
        analyze("AGE", mean, format = "xx.x")


    tb1 <- build_table(l1, DM)
    fnotes_at_path(tb1, rowpath = c("RACE", "WHITE", "AGE", "mean"),
                   colpath = c("ARM", "B: Placebo")) <- "white arm b mean"

    fnotes_at_path(tb1, rowpath = c("RACE", "ASIAN", "@content", "ASIAN"),
                   colpath = c("ARM", "C: Combination")) <- "asian arm c content"

    fnotes_at_path(tb1, rowpath = c("RACE", "MULTIPLE", "@content", "MULTIPLE"),
                   colpath = NULL) <-  c("race multiple row fn 1", "race multiple row fn 2")

    fnotes_at_path(tb1, rowpath = NULL,
                   colpath = c("ARM", "A: Drug X")) <- "drug x is a fake drug that isn't real"

    fnotes_at_path(tb1, rowpath = c("RACE", "WHITE")) <- "didn't specify content"
    fnotes_at_path(tb1, rowpath = c("RACE", "WHITE"),
                   colpath = c("ARM", "C: Combination")) <- "cell fnote didn't specify content"
    mform <- matrix_form(tb1)

    expect_identical(unname(mform$ref_footnotes),
                     c("{1} - drug x is a fake drug that isn't real",
                       "{2} - didn't specify content",
                       "{3} - cell fnote didn't specify content",
                       "{4} - white arm b mean",
                       "{5} - asian arm c content",
                       "{6} - race multiple row fn 1",
                       "{7} - race multiple row fn 2"))

    expect_identical(mform$strings[10, 1, drop = TRUE],
                     "MULTIPLE {6, 7}")

    expect_identical(mform$strings[1, 2, drop = TRUE],
                     "A: Drug X {1}")

    expect_identical(mform$strings[3, 3, drop = TRUE],
                     "36.9 {4}")
    rdf <- make_row_df(tb1)
    expect_identical(rdf$nrowrefs[[9]], 2L)
    expect_identical(rdf$ncellrefs,
                     c(1L, 1L, 0L, 0L, 1L, rep(0L, 5)))



    l2 <- basic_table() %>%
        split_cols_by("ARM") %>%
        split_rows_by("RACE", split_fun = keep_split_levels(race_levels)) %>%
        analyze("AGE", mean, format = "xx.x")

    tb2 <- build_table(l2, DM)

    fnotes_at_path(tb2, rowpath = c("RACE", "WHITE")) <- "fnote on label row"

    mform2 <- matrix_form(tb2)

    expect_identical(unname(mform2$ref_footnotes),
                     "{1} - fnote on label row")

    ## test that tf_wrap and pagination work in the presence of ref fnotes

    pag_nowrap <- paginate_table(tb1, lpp = 20, verbose = TRUE)
    pag_wrap <- paginate_table(tb1, lpp = 20, max_width = 20, tf_wrap = TRUE)

    expect_equal(nrow(pag_nowrap[[1]]), 8)
    expect_equal(nrow(pag_wrap[[1]]), 4)
})