test-summarize.R
In papeR: A Toolbox for Writing Pretty Papers and Reports

library("papeR")
context("summarize functions")

if (require("nlme", quietly = TRUE)) {
    ## Use dataset Orthodont
    data(Orthodont, package = "nlme")
    Ortho_small <<- Orthodont[Orthodont$Subject %in% c("M01", "M02", "F01", "F02"), ]

############################################################
## test old functions latex.table.fac / latex.table.cont
############################################################

test_that("latex.table.cont works", {
    expect_output(latex.table.cont(Orthodont),
                  paste0("tabular.*",
                         "& N &   & Mean & SD &   & Min & Q1 & Median & Q3 & Max",
                         ".*",
                         "distance & 108 &  & 24.02 & 2.93 &  & 16.50 & 22.00 & 23.75 & 26.00 & 31.50",
                         ".*",
                         "age & 108 &  & 11.00 & 2.25 &  & 8.00 & 9.00 & 11.00 & 13.00 & 14.00"))
    ## check that longtable isn't printed here
    expect_output(latex.table.cont(Orthodont), "(longtable){0}")
    ## but here
    expect_output(latex.table.cont(Orthodont, table = "longtable"), "longtable")
})

test_that("latex.table.fac works", {
    expect_output(latex.table.fac(Orthodont),
                  paste0("tabular.*",
                         "& Level &   & N & \\\\%",
                         ".*",
                         "Subject & M16 &  &   4 & 3.7",
                         ".*",
                         "Sex & Male &  &  64 & 59.3",
                         ".*",
                         "& Female &  &  44 & 40.7"))
    ## check that longtable isn't printed here
    expect_output(latex.table.fac(Orthodont), "(longtable){0}")
    ## but here
    expect_output(latex.table.fac(Orthodont, table = "longtable"), "longtable")
})

############################################################
## test variable labels in summaries
############################################################

test_that("variable labels work", {
    factor <- sapply(Orthodont, is.factor)
    for (type in c("numeric", "factor")) {
        data <- Ortho_small
        labels(data) <- c("Distance (mm)", "Age (yr)", "ID", "Sex")
        which <- if (type  == "numeric") { !factor } else { factor }

        ## summary with data set labels
        summary <- summarize(data, type = type, variable.labels = TRUE)
        expect_equivalent(summary[summary[, 1] != "", 1],
                          labels(data)[which],
                          info = type)

        ## summary with user specified labels
        usr_labels <- summarize(data, type = type,
                                variable.labels = c("a", "b", "c", "d"))
        expect_equivalent(usr_labels[usr_labels[, 1] != "", 1],
                          c("a", "b", "c", "d")[which],
                          info = type)

        ## grouped summary with data set labels
        which[4] <- FALSE
        grouped <- summarize(data, type = type, group = "Sex",
                             variable.labels = TRUE)
        expect_equivalent(grouped[grouped[, 1] != "", 1],
                          labels(data)[which],
                          info = type)
    }
})

test_that("grouped summaries work", {
    ## grouped summaries for numerics
    numeric <- summarize(Orthodont, type = "numeric", group = "Sex")
    expect_equivalent(numeric[, 2], rep(levels(Orthodont$Sex), 2))
    expect_equivalent(numeric$p.value[c(1,3)], c("<0.001", "1.000"))
    ## grouped summaries for factors
    factor <- summarize(Ortho_small, type = "factor", group = "Sex")
    expect_equivalent(factor[, 2], levels(Ortho_small$Subject))
    expect_equivalent(ncol(factor), 10)
    expect_equivalent(factor$p.value[1], "< 0.001")
})

test_that("print.summary works", {
    expect_output(print(summarize(Orthodont, type = "numeric")),
                  paste0("     N    Mean   SD    Min Q1 Median Q3  Max\n",
                         "1 distance 108   24.02 2.93   16.5 22  23.75 26 31.5\n",
                         "2      age 108   11.00 2.25    8.0  9  11.00 13 14.0"))
    expect_output(print(summarize(Orthodont, group = "Sex", type = "numeric")),
                  paste0("              Sex    N    Mean   SD    Min Q1 Median    Q3  Max   p.value\n",
                         "1 distance   Male   64   24.97 2.90   17.0 23  24.75 26.50 31.5    <0.001\n",
                         "2          Female   44   22.65 2.40   16.5 21  22.75 24.25 28.0          \n",
                         "3      age   Male   64   11.00 2.25    8.0  9  11.00 13.00 14.0     1.000\n",
                         "4          Female   44   11.00 2.26    8.0  9  11.00 13.00 14.0          "))
    expect_output(print(summarize(Orthodont, type = "factor")),
                  paste0("            Level    N    %\n",
                         "1  Subject    M16    4  3.7\n",
                         "2             M05    4  3.7\n",
                         "3             M02    4  3.7\n",
                         ".*",
                         "28     Sex   Male   64 59.3\n",
                         "29         Female   44 40.7"))
    expect_output(print(summarize(Ortho_small, group = "Sex", type = "factor")),
                  paste0("                  Sex: Male        Sex: Female               \n",
                         "          Level           N    %             N    %   p.value\n",
                         "1 Subject   M02           4 50.0             0  0.0   < 0.001\n",
                         "2           M01           4 50.0             0  0.0          \n",
                         "3           F01           0  0.0             4 50.0          \n",
                         "4           F02           0  0.0             4 50.0          "))

})

test_that("caption works", {
    ## via call arguments
    expect_output(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test"),
                        floating = TRUE),
                  ".*\\caption\\{Test\\}.*")
    expect_output(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test",
                               label= "tab:Test"),
                        floating = TRUE),
                  ".*\\caption\\{Test\\}.*\\label\\{tab:Test\\}")

    expect_output(expect_warning(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test"),
                        tabular.environment = "longtable", floating = TRUE)),
                  ".*\\caption\\{Test\\}.*")
    expect_output(expect_warning(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test",
                               label= "tab:Test"),
                        tabular.environment = "longtable", floating = TRUE)),
                  ".*\\caption\\{Test\\}.*\\label\\{tab:Test\\}")

    expect_output(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test"),
                        tabular.environment = "longtable"),
                  ".*\\caption\\{Test\\}.*")
    expect_output(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test",
                               label= "tab:Test"),
                        tabular.environment = "longtable"),
                  ".*\\caption\\{Test\\}.*\\label\\{tab:Test\\}")

    ## requires capt-of
    expect_output(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test")),
                  paste0(".*begin\\{minipage\\}\\{.*linewidth\\}\n",
                         ".*captionof\\{table\\}\\{Test\\}\n",
                         ".*",
                         "end\\{minipage\\}"))
    expect_output(print(xtable(summarize(Orthodont, type = "numeric"), caption= "Test",
                               label= "tab:Test")),
                  paste0(".*begin\\{minipage\\}\\{.*linewidth\\}\n",
                         ".*captionof\\{table\\}\\{Test\\}\n",
                         ".*label\\{tab:Test\\}\n",
                         ".*",
                         "end\\{minipage\\}"))
    ## additionally test if this also works via options
})

test_that("endhead is included if necessary", {
    ## via call arguments
    expect_output(print(xtable(summarize(Orthodont, type = "numeric")),
                        tabular.environment = "longtable"),
                  ".*cmidrule\\{7-11\\}\n.*endhead\ndistance.*")
    ## via options
    options(xtable.tabular.environment = "longtable")
    expect_output(print(xtable(summarize(Orthodont, type = "numeric"))),
                  ".*cmidrule\\{7-11\\}\n.*endhead\ndistance.*")
    options(xtable.tabular.environment = NULL)
})

test_that("xtable works for summarize_factor with groups", {
    grouped <- summarize(Ortho_small, type = "factor", group = "Sex")
    expect_output(print(xtable(grouped)),
                  paste(".* & & &\\\\multicolumn\\{2\\}\\{c\\}\\{Sex: Male\\} &",
                        "& \\\\multicolumn\\{2\\}\\{c\\}\\{Sex: Female\\} &  &.*"))
    grouped <- summarize(Ortho_small, type = "factor", group = "Sex", test = FALSE)
    expect_output(print(xtable(grouped)),
                  paste(".* & & &\\\\multicolumn\\{2\\}\\{c\\}\\{Sex: Male\\} &",
                        "& \\\\multicolumn\\{2\\}\\{c\\}\\{Sex: Female\\}.*"))
})

test_that("include.rownames is ignored", {
    tab <- summarize(Orthodont, type = "numeric")
    expect_output(print(xtable(tab), include.rownames = FALSE),
                  ".*\n distance .*\n  age .*")
    ## expect output AND warning
    expect_output(expect_warning(print(xtable(tab), include.rownames = TRUE)),
                  ".*\n distance .*\n  age .*")
    expect_output(print(xtable(tab)),
                  ".*\n distance .*\n  age .*")
})

test_that("scoping works correctly", {
    test <- function(type) {
        a1 <- Orthodont
        ## get summary for continuous variables
        (tab1 <- summarize(a1, type = type))
    }
    expect_output(print(test("factor")), 
                  ".*\n1  Subject .*")
    expect_output(print(test("numeric")),
                  ".*\n1 distance .*\n2      age .*")
})

}