## Tests for write2
context("Testing the write2 output")
data(mockstudy)
expect_write2_worked <- function(FUN, object, reference, ...)
{
skip_on_cran()
skip_on_os("mac")
skip_on_os("windows")
FUN <- match.fun(FUN)
filename <- tempfile()
# on.exit(expect_true(file.remove(paste0(filename, ".Rmd"))))
if(!file.exists(reference)) skip("Couldn't find the reference file.")
if(!file.create(paste0(filename, ".Rmd"))) skip("Couldn't create the temporary file.")
expect_error(FUN(list(object, yaml(title = "Test title")), file = filename, ..., render. = TRUE, keep.rmd = TRUE, append. = FALSE, quiet = TRUE), NA)
# on.exit(expect_true(file.remove(filename)), add = TRUE)
generated <- readLines(paste0(filename, ".Rmd"))
expect_output_file(cat(generated, sep = "\n"), reference)
}
###########################################################################################################
#### Internal output
###########################################################################################################
test_that("write2.tableby -> HTML", {
expect_write2_worked(write2html, tableby(arm ~ sex + age, data=mockstudy, numeric.stats = c("meansd", "q1q3", "range")),
reference = "write2.tableby.html.Rmd",
title = "My test table", labelTranslations = list(sex = "SEX", age ="Age, yrs"), total = FALSE)
})
test_that("write2.modelsum -> HTML", {
expect_write2_worked(write2html, modelsum(alk.phos ~ arm + ps + hgb, adjust= ~ age + sex, family = "gaussian", data = mockstudy),
reference = "write2.modelsum.html.Rmd",
title = "My test table", show.intercept = FALSE, digits = 5)
})
old.labs <- c(cumFreq = "cumFreq", freqPercent = "freqPercent", cumPercent = "cumPercent")
test_that("write2.freqlist -> HTML", {
expect_write2_worked(write2html, freqlist(table(mockstudy[c("arm", "sex", "mdquality.s")], useNA = "ifany"), strata = c("arm", "sex")),
reference = "write2.freqlist.html.Rmd", single = TRUE, labelTranslations = old.labs)
})
test_that("write2.freqlist -> doc", {
expect_write2_worked(write2word, freqlist(table(mockstudy[c("arm", "sex", "mdquality.s")], useNA = "ifany"), strata = c("arm", "sex")),
reference = "write2.freqlist.doc.Rmd", single = TRUE, title = "My cool title", labelTranslations = old.labs)
})
## From the vignette
test_that("write2.list (summary objects) -> PDF", {
mylist6 <- list(
summary(tableby(sex ~ age, data = mockstudy), title = "A Title for tableby"),
summary(modelsum(age ~ sex, data = mockstudy), title = "A Title for modelsum"),
summary(freqlist(~ sex, data = mockstudy, labelTranslations = old.labs), title = "A Title for freqlist")
)
expect_write2_worked(write2pdf, mylist6, reference = "write2.multititles.pdf.Rmd")
})
###########################################################################################################
#### External output, commented out on 11/9/17 because of external package changes
###########################################################################################################
#
# test_that("write2.knitr_kable -> HTML", {
# if(require(knitr))
# {
# expect_write2_worked(write2html, knitr::kable(head(mockstudy)), reference = "write2.kable.html.Rmd")
# } else skip("library(knitr) not available.")
# })
#
# test_that("write2.xtable -> HTML", {
# if(require(xtable))
# {
# expect_write2_worked(write2html, xtable::xtable(head(mockstudy), caption = "My xtable"), reference = "write2.xtable.html.Rmd",
# type = "html", comment = FALSE, include.rownames = FALSE, caption.placement = 'top')
# } else skip("library(xtable) not available.")
# })
#
# test_that("write2.character (pander) -> HTML", {
# if(require(pander))
# {
# expect_write2_worked(write2html, pander::pander_return(head(mockstudy)), reference = "write2.pander.html.Rmd")
# } else skip("library(pander) not available.")
# })
#
###########################################################################################################
#### List output
###########################################################################################################
mylist <- list(tableby(sex ~ age, data = mockstudy, numeric.stats = c("meansd", "q1q3", "range")),
freqlist(table(mockstudy[, c("sex", "arm")]), labelTranslations = old.labs),
knitr::kable(utils::head(mockstudy)))
mylist2 <- list("# Header 1",
"This is a small paragraph.",
tableby(sex ~ age, data = mockstudy, numeric.stats = c("meansd", "q1q3", "range")))
test_that("write2.list -> PDF", {
expect_write2_worked(write2pdf, mylist, reference = "write2.mylist.pdf.Rmd")
})
test_that("write2.list -> Word", {
expect_write2_worked(write2word, mylist2, reference = "write2.mylist2.doc.Rmd")
})
test_that("write2.list recursion -> PDF", {
expect_write2_worked(write2word, list(mylist2, mylist),
reference = "write2.mylists.pdf.Rmd")
})
###########################################################################################################
#### verbatim output
###########################################################################################################
my.lm <- summary(lm(age ~ sex, data = mockstudy))
test_that("write2.default -> PDF", {
expect_write2_worked(write2pdf, my.lm,
reference = "write2.lm.pdf.Rmd")
})
test_that("write2.verbatim -> html", {
expect_write2_worked(write2pdf, verbatim(paste0("Hi.", 1:5)),
reference = "write2.char.html.Rmd")
})
test_that("Writing HTML from PDF works (#162)", {
expect_write2_worked(write2pdf, list(
"hi there",
code.chunk(
arsenal::write2html(list("hi there", yaml(title = "hi there")), "hi_there.html", clean = TRUE)
)
), reference = "write2.render.html.Rmd")
})
test_that("verbatim(call()) works (#248)", {
expect_identical(
capture.output(print(verbatim(call("hi", x = 1), NULL, "hi"))),
c("```" ,
"hi(x = 1)" ,
"" ,
"```" ,
"" ,
"```" ,
"NULL" ,
"" ,
"```" ,
"" ,
"```" ,
"[1] \"hi\"",
"" ,
"```" ,
""
)
)
})
###########################################################################################################
#### YAML output
###########################################################################################################
mylist3 <- list(
"# Header 1",
"This is a small paragraph.",
tableby(sex ~ age, data = mockstudy, numeric.stats = c("meansd", "q1q3", "range")),
yaml(title = "My title"),
my.lm,
yaml(author = "Ethan P Heinzen"),
yaml("header-includes" = list("\\usepackage[labelformat=empty]{caption}")),
code.chunk(a <- 1, "b <- 2", a + b, "a - b", chunk.opts = "r echo = FALSE, eval = TRUE")
)
mylist4 <- list(
yaml(title = "My title", author = "Ethan P Heinzen", "header-includes" = list("\\usepackage[labelformat=empty]{caption}")),
"# Header 1",
"This is a small paragraph.",
tableby(sex ~ age, data = mockstudy, numeric.stats = c("meansd", "q1q3", "range")),
my.lm,
code.chunk(a <- 1, "b <- 2", a + b, "a - b", chunk.opts = "r echo = FALSE, eval = TRUE")
)
test_that("write2.yaml -> PDF", {
expect_write2_worked(write2pdf, mylist3, reference = "write2.yaml.pdf.Rmd")
expect_write2_worked(write2pdf, mylist4, reference = "write2.yaml.pdf.Rmd")
})
###########################################################################################################
#### Code used to generate the files
###########################################################################################################
#
# write2html(tableby(arm ~ sex + age, data=mockstudy, numeric.stats = c("meansd", "q1q3", "range")), "tests/testthat/write2.tableby.html",
# title = "My test table", labelTranslations = list(sex = "SEX", age ="Age, yrs"), total = FALSE, render. = FALSE)
#
# write2html(modelsum(alk.phos ~ arm + ps + hgb, adjust= ~ age + sex, family = "gaussian", data = mockstudy),
# "tests/testthat/write2.modelsum.html",
# title = "My test table", show.intercept = FALSE, digits = 5, render. = FALSE)
#
# write2html(freqlist(table(mockstudy[, c("arm", "sex", "mdquality.s")], useNA = "ifany"), groupBy = c("arm", "sex")),
# "tests/testthat/write2.freqlist.html", single = TRUE, render. = FALSE)
#
# write2word(freqlist(table(mockstudy[, c("arm", "sex", "mdquality.s")], useNA = "ifany"), groupBy = c("arm", "sex")),
# "tests/testthat/write2.freqlist.doc", single = TRUE, title = "My cool title", render. = FALSE)
#
# write2pdf(mylist6, "tests/testthat/write2.multititles.pdf", render. = FALSE)
#
## write2html(knitr::kable(head(mockstudy)),
## "tests/testthat/write2.kable.html", render. = FALSE)
##
## write2html(xtable::xtable(head(mockstudy), caption = "My xtable"),
## "tests/testthat/write2.xtable.html",
## type = "html", comment = FALSE, include.rownames = FALSE, caption.placement = "top", render. = FALSE)
##
## write2html(pander::pander_return(head(mockstudy)),
## "tests/testthat/write2.pander.html", render. = FALSE)
#
#
# write2pdf(mylist, "tests/testthat/write2.mylist.pdf", render. = FALSE)
# write2word(mylist2, "tests/testthat/write2.mylist2.doc", render. = FALSE)
# write2pdf(list(mylist2, mylist), "tests/testthat/write2.mylists.pdf", render. = FALSE)
#
# write2pdf(my.lm, "tests/testthat/write2.lm.pdf", render. = FALSE)
# write2html(verbatim(paste0("Hi.", 1:5)),
# "tests/testthat/write2.char.html", render. = FALSE)
# write2pdf(mylist3, "tests/testthat/write2.yaml.pdf", render. = FALSE)
###########################################################################################################
#### Reported bugs for write2
###########################################################################################################
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.