skip_on_cran()
skip_on_ci()
# Init --------------------------------------------------------------------
compare_snapshot_doc = function(name){
doc1 = read_docx(paste0('tests/testthat/docx/4-officer/snap_',name,'.docx'))
doc2 = read_docx(paste0('tests/testthat/docx/4-officer/snap_',name,'_new.docx'))
x1 = doc1$doc_obj$get() %>% xml2::as_list() %>% jsonlite::serializeJSON(pretty = TRUE)
x2 = doc2$doc_obj$get() %>% xml2::as_list() %>% jsonlite::serializeJSON(pretty = TRUE)
waldo::compare(x1,x2)
}
expect_snapshot_doc = function(doc){
skip_on_os(c("mac", "linux", "solaris"))
doc_xml = xml2::as_list(doc$doc_obj$get())
sp = testthat:::get_snapshotter()
if(is.null(sp)) cli_abort("Can't compare snapshot to reference when testing interactively")
test_file = sp$file
test_name = sp$test %>% tolower() %>%
str_replace_all("\\W+", "_") %>%
stringi::stri_trans_general(id = "Latin-ASCII")
x = expect_snapshot_value(digest::digest(doc_xml))
folder=paste0("docx/", test_file)
filename=paste0(folder, "/snap_", test_name, ".docx")
if(!file.exists(filename)){
dir.create(folder, recursive=TRUE, showWarnings=FALSE)
print(doc, filename)
}
filename_new=paste0(folder, "/snap_", test_name, "_new.docx")
if(!inherits(x, "expectation_success")){
print(doc, filename_new)
#TODO cli
cli_warn(glue("Word document snapshot has changed. Explore changes by running:\n",
" compare_snapshot_doc('{test_name}')\n",
" browseURL('tests/testthat/{filename}')\n",
" browseURL('tests/testthat/{filename_new}')\n\n"))
} else {
if(file.exists(filename_new)) file.remove(filename_new)
print(doc, filename)
}
}
# crosstables don't throw errors in officer -------------------------------
crosstables = suppressWarnings({
set.seed(12345)
list(
Simple = crosstable(esoph, test=TRUE),
Double_effect = crosstable(mtcars, c(mpg, cyl, disp), by=am, effect=TRUE),
Triple = crosstable(iris, by=Species, showNA="always", total="both")
)
})
test_that("crosstables: Simple", {
# skip_on_os(c("mac", "linux", "solaris"))
i="Simple"
ct = crosstables[[i]]
expect_s3_class(ct, c("crosstable"))
doc = read_docx() %>%
body_add_title(i, 1) %>%
body_add_normal("This dataset has {nrow(ct)} rows and {x} columns.",
x=ncol(ct)) %>%
body_add_title("Not compacted", 2) %>%
body_add_crosstable(ct, show_test_name=FALSE) %>%
body_add_table_legend(paste0(i, ", not compacted")) %>%
body_add_break() %>%
body_add_title("Compacted in function", 2) %>%
body_add_crosstable(ct, compact=TRUE) %>%
body_add_table_legend(paste0(i, ", compacted inside function")) %>%
body_add_break() %>%
body_add_normal("Look, there are labels!") %>%
body_add_title("Compacted before function", 2) %>%
body_add_crosstable(ct_compact(ct), show_test_name=FALSE) %>%
body_add_table_legend(paste0(i, ", compacted before function")) %>%
body_add_break()
# expect_snapshot_doc(doc)
expect_true(TRUE)
})
test_that("crosstables: Double with effects", {
# skip_on_os(c("mac", "linux", "solaris"))
i="Double_effect"
ct = crosstables[[i]]
expect_s3_class(ct, c("crosstable"))
doc = read_docx() %>%
body_add_title(i, 1) %>%
body_add_normal("This dataset has {nrow(ct)} rows and {x} columns.",
x=ncol(ct)) %>%
body_add_title("Not compacted", 2) %>%
body_add_crosstable(ct, show_test_name=FALSE) %>%
body_add_table_legend(paste0(i, ", not compacted")) %>%
body_add_break() %>%
body_add_title("Compacted in function", 2) %>%
body_add_crosstable(ct, compact=TRUE) %>%
body_add_table_legend(paste0(i, ", compacted inside function")) %>%
body_add_break() %>%
body_add_normal("Look, there are labels!") %>%
body_add_title("Compacted before function", 2) %>%
body_add_crosstable(ct_compact(ct), show_test_name=FALSE) %>%
body_add_table_legend(paste0(i, ", compacted before function")) %>%
body_add_break()
# expect_snapshot_doc(doc)
expect_true(TRUE)
})
test_that("crosstables: Triple", {
# skip_on_os(c("mac", "linux", "solaris"))
i="Triple"
ct = crosstables[[i]]
expect_s3_class(ct, c("crosstable"))
doc = read_docx() %>%
body_add_title(i, 1) %>%
body_add_normal("This dataset has {nrow(ct)} rows and {x} columns.",
x=ncol(ct)) %>%
body_add_title("Not compacted", 2) %>%
body_add_crosstable(ct, show_test_name=FALSE) %>%
body_add_table_legend(paste0(i, ", not compacted")) %>%
body_add_break() %>%
body_add_title("Compacted in function", 2) %>%
body_add_crosstable(ct, compact=TRUE) %>%
body_add_table_legend(paste0(i, ", compacted inside function")) %>%
body_add_break() %>%
body_add_normal("Look, there are labels!") %>%
body_add_title("Compacted before function", 2) %>%
body_add_crosstable(ct_compact(ct), show_test_name=FALSE) %>%
body_add_table_legend(paste0(i, ", compacted before function")) %>%
body_add_break()
# expect_snapshot_doc(doc)
expect_true(TRUE)
})
# Markdown ------------------------------------------------------------------------------------
test_that("Markdown", {
x= read_docx() %>%
body_add_normal("This is **bold and *italic* (see Table @ref(my_bkm)). **
This is **bold `console \\*CODE\\*` and *bold _and_ italic* **") %>%
body_add_normal("This is red **bold** text, this is ~subscript *italic*~, and this is ^superscript with yellow^") %>%
body_add_normal("This is a fancy font and this `is code`!!") %>% #you might need to change "Alibi" to "alibi" here
body_add_normal("This is *b*") %>%
body_add_normal("This is not formatted at all") %>%
body_add_normal("This will eventually throw a warning: *italic text without closing") %>%
body_add_normal() %>%
body_add_table_legend("Some table legend", bookmark="my_bkm") %>%
write_and_open()
# write_and_open(x)
expect_true(TRUE)
})
# Helpers -----------------------------------------------------------------
test_that("Tests body_add_table_list", {
ctl = list(iris2=crosstable(iris2, 1),
"Just a flextable"=flextable::flextable(mtcars2[1:5,1:5]),
"Just a dataframe"=iris2[1:5,1:5])
fun1 = function(doc, .name){
doc %>%
body_add_title(" This is table '{.name}' as a flex/crosstable", level=2) %>%
body_add_normal("Here is the table:")
}
fun2 = function(doc, .name){
doc %>% body_add_table_legend("{.name}", bookmark=.name)
}
read_docx() %>%
body_add_title("Separated by subtitle", 1) %>%
body_add_table_list(ctl, fun_before="title2") %>%
body_add_break() %>%
body_add_title("Separated using a custom function", 1) %>%
body_add_normal("You can therefore use bookmarks, for instance here are tables \\@ref(iris2), \\@ref(just_a_flextable) and \\@ref(just_a_dataframe).") %>%
body_add_table_list(ctl, fun_before=fun1, fun_after=fun2, body_fontsize=8) %>%
write_and_open()
expect_true(TRUE)
})
test_that("Crosstables helpers", {
skip_on_os(c("mac", "linux", "solaris"))
skip_on_cran()
# skip("Run `test-officer > crosstables helpers` manually one in a while!")
rlang::local_options(crosstable_style_list_ordered="toc 1",
crosstable_style_list_unordered="toc 2",
crosstable_style_image="centered",
crosstable_units="cm")
img.file = file.path( R.home("doc"), "html", "logo.jpg" )
p = ggplot2::ggplot(data = iris ) +
ggplot2::geom_point(mapping = ggplot2::aes(Sepal.Length, Petal.Length))
doc = read_docx() %>%
body_add_normal("Iris has {nrow(iris)} rows and {x} columns.",
x=ncol(iris)) %>%
body_add_normal("I can write multiple {x}. ", "Just like {y}.",
x="paragraphs", y="this") %>%
body_add_normal("You can format in **bold**, *italic*, _underlined_, and `code`, and reference the figure \\@ref(fig1).") %>%
body_add_normal("You can ignore refs: formats (**bold**, *italic*, _underlined_), code (`mean(x)+5`), and refs (figure \\@ref(fig1))", parse=c("format", "code")) %>%
body_add_normal("You can ignore formats: formats (**bold**, *italic*, _underlined_), code (`mean(x)+5`), and refs (figure \\@ref(fig1))", parse=c("ref", "code")) %>%
body_add_normal("You can ignore code: formats (**bold**, *italic*, _underlined_), code (`mean(x)+5`), and refs (figure \\@ref(fig1))", parse=c("ref", "format")) %>%
body_add_normal("You can ignore all: formats (**bold**, *italic*, _underlined_), code (`mean(x)+5`), and refs (figure \\@ref(fig1))", parse=NULL) %>%
body_add_list(c("Numbered item 1", "Numbered item 2"), ordered = TRUE) %>%
body_add_list_item("Numbered item 3", ordered = TRUE) %>%
body_add_list(c("Bullet item 1", "Bullet item 2"), ordered = FALSE) %>%
body_add_list_item("Bullet item 3", ordered = FALSE) %>%
body_add_img2(img.file, h=3, w=5, style="Normal") %>%
body_add_img2(img.file, h=7, w=10, units="mm") %>%
body_add_figure_legend("legend", bookmark="fig1") %>%
body_add_gg2(p, w=14, h=10, scale=1.5, style="Normal") %>%
body_add_gg2(p, w=14, h=10, scale=1.5, units="mm") %>%
body_add_crosstable_footnote() %>%
body_add_break()
write_and_open(doc)
# expect_snapshot_doc(doc)
expect_true(TRUE)
})
test_that("Utils functions", {
skip_on_os(c("mac", "linux", "solaris"))
rlang::local_options(crosstable_units="cm")
info_rows = c("Also, table iris has {nrow(iris)} rows.", "And table mtcars has {nrow(mtcars)} rows.")
img.file = file.path( R.home("doc"), "html", "logo.jpg" )
p = ggplot2::ggplot(data = iris ) +
ggplot2::geom_point(mapping = ggplot2::aes(Sepal.Length, Petal.Length))
doc = read_docx() %>%
body_add_title("Tests", 1) %>%
body_add_normal("Table iris has", ncol(iris), "columns.", .sep=" ") %>%
body_add_normal("However, table mtcars has {ncol(mtcars)} columns") %>%
body_add_normal(info_rows) %>%
body_add_crosstable(crosstables[[2]], show_test_name=FALSE,
body_fontsize = 8, header_fontsize = 10) %>%
body_add_break() %>%
body_add_img2(img.file, h=7.6, w=10, style="centered") %>%
body_add_img2(img.file, h=7.6/2.5, w=10/2.5, units="in") %>%
body_add_gg2(p, w=14, h=10, scale=1.5) %>%
body_add_gg2(p, w=14/2.5, h=10/2.5, scale=1.5, units="in") %>%
identity()
# expect_snapshot_doc(doc)
expect_true(TRUE)
})
test_that("Legend fields", {
# skip_on_os(c("mac", "linux", "solaris"))
#cannot use snapshot as fields are identified with uuid
fp = fp_text_lite(bold=FALSE, italic=FALSE, underlined=TRUE, font.size=15)
fp2 = fp_text_lite(font.size=9)
doc = read_docx() %>%
body_add_normal("As you can see in Table \\@ref(tab1) and in Figure @ref(fig1), ",
"the iris dataset is about flowers.") %>%
body_add_table_legend("standard format (table)", bookmark="tab1") %>%
body_add_figure_legend("standard format (figure)", bookmark="fig1") %>%
body_add_table_legend("underlined, size 15",
name_format=fp, bookmark="tab2") %>%
body_add_table_legend("size 9",
name_format=fp2, legend_style="Normal",
bookmark="tab3") %>%
identity()
write_and_open(doc)
expect_true(TRUE)
})
# Warnings and errors -----------------------------------------------------
test_that("Officers warnings and errors", {
# skip_on_os(c("mac", "linux", "solaris"))
pars1 = c("Paragraphe 1.1", "Paragraphe 1.2")
pars2 = c("Paragraphe 2.1", "Paragraphe 2.2")
expect_error(body_add_normal(read_docx(), pars1, pars2),
class="crosstable_officer_wrong_vector_error")
expect_snapshot_error(body_add_table_legend(read_docx(), "xxx", foo=1, fun=mean, 5)) #rlib_error_dots_nonempty
lifecycle::expect_deprecated(body_add_glued(read_docx(), "Paragraphe"))
ct = crosstable(mtcars3, vs, by=model)
expect_error(body_add_crosstable(read_docx(), ct),
class="crosstable_body_add_large_error")
ll = list("a"=crosstable(iris), crosstable(mtcars))
expect_error(body_add_table_list(read_docx(), ll),
class="body_add_table_list_named")
ll = list("a"=crosstable(iris), "b"=5, "c"=lm(am~vs, data=mtcars))
expect_error(body_add_table_list(read_docx(), ll),
class="body_add_table_list_class")
ll = list(iris=crosstable(iris), mtcars=crosstable(mtcars))
expect_error(body_add_table_list(read_docx(), ll,
fun_before="foobar"),
class="body_add_table_list_fun_name")
expect_error(body_add_table_list(read_docx(), ll,
fun_before=function(x, y) x),
class="body_add_table_list_fun_args")
expect_error(body_add_table_list(read_docx(), ll,
fun_before=function(doc, .name) .name),
class="body_add_table_list_return")
expect_error(body_add_table_list(read_docx(), ll,
fun_after=function(doc, .name) .name),
class="body_add_table_list_return2")
})
# Other reporting functions -----------------------------------------------
## openxlsx workbooks ------------------------------------------------------
test_that("openxlsx is working", {
set.seed(1234)
#by=NULL
x1=crosstable(mtcars2, c(mpg, vs, gear), total=T, test=T)
wb1=as_workbook(x1, keep_id=FALSE)
wb2=as_workbook(x1, keep_id=TRUE)
expect_true(TRUE)
#by=cyl
x2=crosstable(mtcars2, c(mpg, vs, gear), by=cyl, total=T, test=T)
wb3=as_workbook(x2, keep_id=FALSE)
wb4=as_workbook(x2, keep_id=TRUE)
#by=c(cyl, am)
x3=crosstable(mtcars2, c(mpg, vs, gear), by=c(cyl, am), total=T)
wb5=as_workbook(x3, keep_id=FALSE)
xl=list("with by"=x2, noby=x1, x3)
wb6=as_workbook(xl)
if(!is_testing()){
openxlsx::saveWorkbook(wb1, file = "tests/testthat/xlsx/test_openxlsx1.xlsx", overwrite = TRUE)
openxlsx::saveWorkbook(wb2, file = "tests/testthat/xlsx/test_openxlsx2.xlsx", overwrite = TRUE)
openxlsx::saveWorkbook(wb3, file = "tests/testthat/xlsx/test_openxlsx3.xlsx", overwrite = TRUE)
openxlsx::saveWorkbook(wb4, file = "tests/testthat/xlsx/test_openxlsx4.xlsx", overwrite = TRUE)
openxlsx::saveWorkbook(wb5, file = "tests/testthat/xlsx/test_openxlsx5.xlsx", overwrite = TRUE)
openxlsx::saveWorkbook(wb6, file = "tests/testthat/xlsx/test_openxlsx6.xlsx", overwrite = TRUE)
}
})
## gt ----------------------------------------------------------------------
test_that("gt is working", {
rlang::local_options(tidyselect_verbosity = "verbose") #oddly needed for as_gt(x2)
#by=NULL
x1=crosstable(mtcars2, c(mpg, vs, gear), total=T, test=T)
as_gt(x1)
as_gt(x1, keep_id=TRUE)
expect_true(TRUE)
#by=cyl
x2=crosstable(mtcars2, c(mpg, vs, gear), by=cyl, total=T, test=T)
as_gt(x2)
as_gt(x2, keep_id=TRUE, show_test_name=FALSE, by_header="Cylinders")
#by=c(cyl, am) --> error pour l'instant
x3=crosstable(mtcars2, c(mpg, vs, gear), by=c(cyl, am), total=T)
expect_snapshot_error(as_gt(x3))
})