init_flextable_defaults() snap_folder_test_file <- "borders" defer_cleaning_snapshot_directory(snap_folder_test_file) set.seed(2) USUBJID <- sprintf("01-ABC-%04.0f", 1:200) VISITS <- c("SCREENING 1", "WEEK 2", "MONTH 3") LBTEST <- c("Albumin", "Sodium") VISITNUM <- seq_along(VISITS) LBBLFL <- rep(NA_character_, length(VISITNUM)) LBBLFL[1] <- "Y" VISIT <- data.frame(VISIT = VISITS, VISITNUM = VISITNUM, LBBLFL = LBBLFL, stringsAsFactors = FALSE) labdata <- expand.grid(USUBJID = USUBJID, LBTEST = LBTEST, VISITNUM = VISITNUM, stringsAsFactors = FALSE) setDT(labdata) labdata <- merge(labdata, VISIT, by = "VISITNUM") labdata[, c("LBNRIND") := list(sample(x = c("LOW", "NORMAL", "HIGH"), size = .N, replace = TRUE, prob = c(.03, .9, .07)))] setDF(labdata) SHIFT_TABLE <- shift_table( x = labdata, cn_visit = "VISIT", cn_grade = "LBNRIND", cn_usubjid = "USUBJID", cn_lab_cat = "LBTEST", cn_is_baseline = "LBBLFL", baseline_identifier = "Y", grade_levels = c("LOW", "NORMAL", "HIGH") ) SHIFT_TABLE_VISIT <- attr(SHIFT_TABLE, "VISIT_N") SHIFT_TABLE$VISIT <- attr(SHIFT_TABLE, "FUN_VISIT")(SHIFT_TABLE$VISIT) SHIFT_TABLE$BASELINE <- attr(SHIFT_TABLE, "FUN_GRADE")(SHIFT_TABLE$BASELINE) SHIFT_TABLE$LBNRIND <- attr(SHIFT_TABLE, "FUN_GRADE")(SHIFT_TABLE$LBNRIND) SHIFT_TABLE_VISIT$VISIT <- attr(SHIFT_TABLE, "FUN_VISIT")(SHIFT_TABLE_VISIT$VISIT) tab <- tabulator( x = SHIFT_TABLE, hidden_data = SHIFT_TABLE_VISIT, row_compose = list( VISIT = as_paragraph(VISIT, "\n(N=", N_VISIT, ")") ), rows = c("LBTEST", "VISIT", "BASELINE"), columns = c("LBNRIND"), `n` = as_paragraph(N), `%` = as_paragraph(as_chunk(PCT, formatter = function(z) { formatC(z * 100, digits = 1, format = "f", flag = "0", width = 4) })) ) ft_1 <- as_flextable( x = tab, separate_with = "VISIT", label_rows = c( LBTEST = "Lab Test", VISIT = "Visit", BASELINE = "Reference\nRange\nIndicator" ) ) ft_1 <- width(ft_1, j = 3, width = 1) test_that("pptx, docx, and html borders", { skip_if_not_local_testing(check_html = TRUE) # pptx borders handle_manual_snapshots(snap_folder_test_file, "pptx-borders") doconv::expect_snapshot_doc( x = save_as_pptx(ft_1, path = tempfile(fileext = ".pptx")), name = "pptx-borders", engine = "testthat" ) # docx borders handle_manual_snapshots(snap_folder_test_file, "docx-borders") doconv::expect_snapshot_doc( x = save_as_docx(ft_1, path = tempfile(fileext = ".docx")), name = "docx-borders", engine = "testthat" ) # html borders handle_manual_snapshots(snap_folder_test_file, "html-borders") path <- save_as_html(ft_1, path = tempfile(fileext = ".html")) skip_if_not_installed("chromote") suppressMessages(is_there_chrome <- chromote::find_chrome()) skip_if(is.null(is_there_chrome)) doconv::expect_snapshot_html(name = "html-borders", path, engine = "testthat") }) rmd_file_0 <- "rmd/borders.Rmd" if (!file.exists(rmd_file_0)) { # just for dev purpose rmd_file_0 <- "tests/testthat/rmd/borders.Rmd" } rmd_file <- tempfile(fileext = ".Rmd") file.copy(rmd_file_0, rmd_file, overwrite = TRUE) html_file <- gsub("\\.Rmd$", ".html", rmd_file) docx_file <- gsub("\\.Rmd$", ".docx", rmd_file) pdf_file <- gsub("\\.Rmd$", ".pdf", rmd_file) pptx_file <- gsub("\\.Rmd$", ".pptx", rmd_file) test_that("pdf and office complex borders", { skip_if_not_local_testing(min_pandoc_version = "2.7.3") # pdf office complex borders render(rmd_file, output_format = rmarkdown::pdf_document(latex_engine = "xelatex"), output_file = pdf_file, envir = new.env(), quiet = TRUE ) handle_manual_snapshots(snap_folder_test_file, "pdf-complex-borders") doconv::expect_snapshot_doc(name = "pdf-complex-borders", pdf_file, engine = "testthat") # office complex borders render(rmd_file, output_format = "word_document", output_file = docx_file, envir = new.env(), quiet = TRUE ) handle_manual_snapshots(snap_folder_test_file, "docx-complex-borders") doconv::expect_snapshot_doc(name = "docx-complex-borders", docx_file, engine = "testthat") render(rmd_file, output_format = "powerpoint_presentation", output_file = pptx_file, envir = new.env(), quiet = TRUE ) handle_manual_snapshots(snap_folder_test_file, "pptx-complex-borders") doconv::expect_snapshot_doc(name = "pptx-complex-borders", pptx_file, engine = "testthat") }) init_flextable_defaults()