Nothing
tests/testthat/test-rtf2.R
In reporter: Creates Statistical Reports
context("RTF2 Tests")
base_path <- paste0(getwd(),"/tests/testthat")
data_dir <- base_path
base_path <- tempdir()
data_dir <- "."
cnt <- paste0("Lorem ipsum dolor sit amet, consectetur adipiscing elit, ",
"sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. ",
"Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris ",
"nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in ",
"reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla ",
"pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa ",
"qui officia deserunt mollit anim id est laborum.")
fnt <- "Arial"
fsz <- 10
dev <- FALSE
# Basic Tests 1 - 10 ------------------------------------------------------
test_that("rtf2-0a: Fixed report is correct.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test0a.rtf")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
titles("Table 0.0", "Baseline Characteristics") %>%
add_content(create_table(mtcars[1:10, ]))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-0b: Fixed report with font_size is correct.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test0b.rtf")
rpt <- create_report(fp, output_type = "RTF", font = "fixed",
font_size = 12) %>%
titles("Table 0.0", "Baseline Characteristics") %>%
add_content(create_table(mtcars[1:10, ]))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-0c: Fixed report with font_size options is correct.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test0c.rtf")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
options_fixed(font_size = 12) %>%
titles("Table 0.0", "Baseline Characteristics") %>%
add_content(create_table(mtcars[1:10, ]))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-0d: Fixed report with conflicting font size is correct.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test0d.rtf")
rpt <- create_report(fp, output_type = "RTF", font = "fixed",
font_size = 8) %>%
options_fixed(font_size = 12) %>%
titles("Table 0.0", "Baseline Characteristics") %>%
add_content(create_table(mtcars[1:10, ]))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-1: One page text spec works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test1.rtf")
txt <- create_text(cnt, width = 6, borders = "outside", align = "right") %>%
titles("Text 1.0", "My Nice Text", borders = "outside", font_size = 12) %>%
footnotes("My footnote 1", "My footnote 2", borders = "outside")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 10) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
add_content(txt, align = "right") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-2: Two page text spec works as expected in 12pt font.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test2.rtf")
cnttxt <- paste(rep(cnt, 12), collapse = "")
txt <- create_text(cnttxt) %>%
titles("Text 1.0", "My Nice Text")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
add_content(txt) %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-3: Three page text spec increased margins works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test3.rtf")
cnttxt <- paste(rep(cnt, 15), collapse = "")
txt <- create_text(cnttxt) %>%
titles("Text 1.0", "My Nice Text") %>%
footnotes("My footnote 1", "My footnote 2")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
set_margins(top = 2, bottom = 2) %>%
page_header("Left", c("Right1", "Right2")) %>%
add_content(txt) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-4: Two page text spec works as expected in 10pt font.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test4.rtf")
cnttxt <- paste(rep(cnt, 12), collapse = "")
txt <- create_text(cnttxt)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 10) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
add_content(txt) %>%
page_footer("Left1", "Center1", "Right1") %>%
titles("Text 1.0", "My Nice Text") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-5: Two page text spec works as expected in 8pt font.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test5.rtf")
cnttxt <- paste(rep(cnt, 20), collapse = "")
txt <- create_text(cnttxt)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 8) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
add_content(txt) %>%
page_footer("Left1", "Center1", "Right1") %>%
titles("Text 1.0", "My Nice Text") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-6: One page table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test6.rtf")
dat <- mtcars[1:15, ]
attr(dat[[2]], "label") <- "Cylin."
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table", borders = "outside", bold = TRUE) %>%
add_content(create_table(dat, borders = "outside")) %>%
footnotes("My footnote 1", "My footnote 2", borders = "outside") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-7: Multi page table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test7.rtf")
dat <- iris
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Irises", "Another Title") %>%
define(Sepal.Length, label = "Sepal Length", width = 1, align = "center") %>%
define(Sepal.Width, label = "Sepal Width", width = 1, align = "centre") %>%
define(Species, blank_after = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1")) %>%
add_content(tbl, blank_row = "none") %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 7)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-8: Portrait table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test8.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 10, orientation = "portrait") %>%
# set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 11)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-9: Wide table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test9.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat) %>%
column_defaults(width = 1)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "portrait") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", valign = "top") %>% # Works!
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-10: Preview works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test10.rtf")
dat <- iris
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Irises", "Another Title") %>%
footnotes("My footnote 1", "My footnote 2")
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1")) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt, preview = 2)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
# Basic Tests 11 - 20 ------------------------------------------------------
# This is awesome. Shows cell wrapping, page break, and valign
# Very good for testing.
test_that("rtf2-11: Forced page wrap works as expected.", {
fp <- file.path(base_path, "rtf2/test11.rtf")
dat <- data.frame(labels = rownames(mtcars), mtcars)
tbl <- create_table(dat, borders = "all") %>%
titles("Table 1.0", "My Nice Irises", "Another Title") %>%
footnotes("My footnote 1", "My footnote 2", valign = "bottom") %>%
define(labels, id_var = TRUE) %>%
define(wt, page_wrap = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1")) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
})
test_that("rtf2-12: Table Borders work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test12.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c("left", "right", "bottom", "top")) %>%
define(mpg, label = "Miles Per Gallon")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 11)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
# Nice.
test_that("rtf2-13: Spanning headers work as expected.", {
fp <- file.path(base_path, "rtf2/test13.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c("top", "bottom")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = FALSE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(drat, gear, "Super Duper\nWrapped Span", n = 11, level = 2)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-14: Labels and show_cols work as expected.", {
fp <- file.path(base_path, "rtf2/test14.rtf")
dat <- mtcars[1:15, ]
attr(dat$mpg, "label") <- "Miles Per Gallon"
attr(dat$cyl, "label") <- "Cylinders"
tbl <- create_table(dat, show_cols = c("mpg", "hp", "cyl", "disp", "drat")) %>%
define(mpg, width = 1.25) %>%
define(disp, label = "Displacement")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-15: Valign on report footnotes works as expected.", {
fp <- file.path(base_path, "rtf2/test15.rtf")
dat <- iris[1:100, ]
tbl <- create_table(dat) %>%
define(Species, page_break = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 9, orientation = "portrait") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", valign = "top") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
expect_equal(length(res$column_widths[[1]]), 5)
class(dat$Species)
})
# Works
test_that("rtf2-16: Valign on table footnotes works as expected.", {
fp <- file.path(base_path, "rtf2/test16.rtf")
dat <- iris[1:100, ]
tbl <- create_table(dat) %>%
footnotes("My footnote 1", "My footnote 2", valign = "bottom") %>%
define(Species, page_break = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 10, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 6)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-17: Title header on table works as expected.", {
fp <- file.path(base_path, "rtf2/test17.rtf")
dat <- iris[1:25, ]
tbl <- create_table(dat, width = 8.9) %>%
title_header("Table 1.0", "My Nice Table",
right = c("Right1",
"Right2", "Page [pg] of [tpg]")) %>%
footnotes("My footnote 1", "My footnote 2") #%>%
#define(Petal.Length, page_wrap = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 10, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-18: Title header on report works as expected.", {
fp <- file.path(base_path, "rtf2/test18.rtf")
dat <- iris[1:50, ]
tbl <- create_table(dat)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]") %>%
title_header("Table 1.0", "My Nice Table", right = c("Page [pg] of [tpg]",
"Right2", "Right3")) %>%
footnotes("My footnote 1", "My footnote 2", valign = "bottom")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-19: Title and Footnote borders work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test19.rtf")
dat <- iris[1:20, ]
tbl <- create_table(dat, borders = "all") %>%
titles("Table 1.0", "My Nice Report with Borders",
borders = c("top", "bottom", "left", "right"),
blank_row = "both") %>%
footnotes("My footnote 1", "My footnote 2", valign = "top",
borders = c("top", "bottom", "left", "right"),
blank_row = "both")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 5)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-20: Title Header borders work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test20.rtf")
dat <- iris[1:25, ]
tbl <- create_table(dat, borders = "all") %>%
title_header("Table 1.0", "My Nice Report with Borders",
right = c("Right1", "Right2", "Right3"),
borders = c("outside"),
blank_row = "both") %>%
footnotes("My footnote 1", "My footnote 2", valign = "top",
borders = c("top", "bottom", "left", "right"),
blank_row = "both")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
expect_equal(length(res$column_widths[[1]]), 5)
} else
expect_equal(TRUE, TRUE)
})
# Basic Tests 21 - 30 ------------------------------------------------------
# Works unless drat column is too narrow and spanning label wraps unexpectedly
test_that("rtf2-21: Page wrap with spanning header works as expected.", {
fp <- file.path(base_path, "rtf2/test21.rtf")
df <- data.frame(vehicle = rownames(mtcars), mtcars, stringsAsFactors = FALSE)
rownames(df) = NULL
tbl <- create_table(df) %>%
spanning_header(2, 5,
label = "Span 1", label_align = "center", n = 10) %>%
spanning_header(6, 8,
label = "Span 2", label_align = "center", n = 10) %>%
spanning_header(9, 12,
label = "Span 3", label_align = "center", n = 10) %>%
spanning_header(6, 12, label = "Super Span",
label_align = "center",
level = 2) %>%
define(vehicle, label = "Vehicle", id_var = TRUE) %>%
define(mpg, format = "%.1f") %>%
define(drat, width = 1) %>%
define(wt, page_wrap = TRUE) %>%
define(vs, page_wrap = TRUE)
rpt <- create_report(fp, output_type = "RTF",
orientation = "portrait", font = fnt) %>%
add_content(tbl) %>%
titles("Table 1.0", "MTCARS Subset Test") %>%
footnotes("My footnote") %>%
page_header("Left") %>%
page_footer("Left", right = "Right")
#print(rpt)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 3)
})
# This is a good one for testing height calculations. Looks good for now.
test_that("rtf2-22: Page by works as expected.", {
fp <- file.path(base_path, "rtf2/test22.rtf")
dat <- iris
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Report with a Page By", borders = "none") %>%
page_by(Species, label = "Species: ", align = "right", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_header("Left", "Right") %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 6)
expect_equal(length(res$column_widths[[1]]), 5)
})
# Works!
test_that("rtf2-23: Two contents on one page works as expected.", {
fp <- file.path(base_path, "rtf2/test23.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat) %>%
titles("Table 1.0", "My Nice Table") %>%
footnotes("My footnote 1", "My footnote 2")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
add_content(tbl, page_break = FALSE, blank_row = "below") %>%
add_content(create_text(cnt, width = 5), align = "center") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
# Working.
test_that("rtf2-24: Two tables one headerless works as expected.", {
fp <- file.path(base_path, "rtf2/test24.rtf")
dat <- mtcars
dat2 <- mtcars[16:20, ]
tbl <- create_table(dat) %>%
titles("Table 1.0", "My Nice Table") %>%
column_defaults(width = .5)
tbl2 <- create_table(dat2, headerless = TRUE) %>%
column_defaults(width = .5)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
add_content(tbl, page_break = FALSE, blank_row = "none") %>%
add_content(tbl2, align = "center") %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
})
# Works!
test_that("rtf2-25: Simplest RTF Plot works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test25.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8, borders = c("top", "bottom", "all")) %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", borders = "none") %>%
footnotes("* Motor Trend, 1974", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size =fsz) %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt, align = "right") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-26: RTF Table with Plot on same page works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test26.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8)
tbl <- create_table(mtcars[1:3, ])
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", blank_row = "none") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt, page_break = FALSE, blank_row = "none") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-27: Plot with page by on plot works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test27.rtf")
fmt <- value(condition(x == 4, "4 Cylinder"),
condition(x == 6, "6 Cylinder"),
condition(x == 8, "8 Cylinder"))
dat <- mtcars[order(mtcars$cyl), ]
p <- ggplot(dat, aes(x=disp, y=mpg)) + geom_point()
#dats <- split(p$data, p$data$grp)
#tbl <- create_table(dat[1:3, ])
plt <- create_plot(p, height = 4, width = 8) %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", blank_row = "none") %>%
page_by(cyl, "Cylinders: ", format = fmt) %>%
footnotes("* Motor Trend, 1974")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt) %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 3)
})
test_that("rtf2-28: Plot with page by on report works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test28.rtf")
dat <- mtcars[order(mtcars$cyl), ]
p <- ggplot(dat, aes(x=disp, y=mpg)) + geom_point()
#dats <- split(p$data, p$data$grp)
#tbl <- create_table(dat[1:3, ])
plt <- create_plot(p, height = 4, width = 8)
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot",
blank_row = "none", borders = "none") %>%
set_margins(top = 1, bottom = 1) %>%
page_by(cyl, "Cylinders: ") %>%
add_content(plt) %>%
footnotes("* Motor Trend, 1974", borders = "none") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 3)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-29: Simplest RTF Plot with valign top works as expected.", {
if (dev) {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test29.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8)
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt, align = "center") %>%
footnotes("* Motor Trend, 1974", valign = "top") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-30: Simplest RTF Plot with valign bottom works as expected.", {
if (dev) {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test30.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8) %>%
footnotes("* Motor Trend, 1974", valign = "bottom")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt, align = "center") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
# Basic Tests 31 - 40 ------------------------------------------------------
test_that("rtf2-31: Simplest RTF Text with valign top works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test31.rtf")
txt <- create_text(cnt, width = 6, borders = "outside")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
titles("Text 1.0", "MTCARS Miles per Cylinder Text", borders = "outside") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(txt, align = "center") %>%
footnotes("* Motor Trend, 1974", valign = "top", borders = "outside") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-32: Simplest RTF Text with valign bottom works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test32.rtf")
txt <- create_text(cnt, width = 6) %>%
footnotes("* Motor Trend, 1974", valign = "bottom")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(txt, align = "center") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-33: Table with long cell and label values wraps as expected.", {
fp <- file.path(base_path, "rtf2/test33.rtf")
# Setup
arm <- c(rep("A", 5), rep("B", 5))
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa \nand more and more", "Schaffer, Ashley", "Laner, Tahma",
"Perry, Sean", "Crews, Deshawn Joseph", "Person, Ladon",
"Smith, Shaileigh")
sex <- c("M", "F", "F", "M", "M", "F", "M", "F", "F", "M")
age <- c(41, 53, 43, 39, 47, 52, 21, 38, 62, 26)
# Create data frame
df <- data.frame(arm, subjid, name, sex, age, stringsAsFactors = FALSE)
tbl1 <- create_table(df, first_row_blank = TRUE) %>%
define(subjid, label = "Subject ID for a patient", n = 10, align = "left",
width = 1) %>%
define(name, label = "Subject Name", width = 1) %>%
define(sex, label = "Sex", n = 10, align = "center") %>%
define(age, label = "Age", n = 10) %>%
define(arm, label = "Arm",
blank_after = TRUE,
dedupe = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
titles("Table 1.0", align = "center") %>%
add_content(tbl1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
# Works on all combinations on font and font size. Needed adjustments to row height.
test_that("rtf2-34: Table with break between sections works as expected.", {
fp <- file.path(base_path, "rtf2/test34.rtf")
# Setup
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa", "Schaffer, Ashley", "Laner, Tahma",
"Perry, Sean", "Crews, Deshawn Joseph", "Person, Ladon",
"Smith, Shaileigh")
sex <- c("M", "F", "F", "M", "M", "F", "M", "F", "F", "M")
age <- c(41, 53, 43, 39, 47, 52, 21, 38, 62, 26)
arm <- c(rep("A", 5), rep("B", 5))
# Create data frame
df <- data.frame(subjid, name, sex, age, arm)
tbl1 <- create_table(df, first_row_blank = FALSE) %>%
define(subjid, label = "Subject ID", align = "left", width = 1) %>%
define(name, label = "Subject Name", width = 1) %>%
define(sex, label = "Sex") %>%
define(age, label = "Age") %>%
define(arm, label = "Arm",
blank_after = FALSE,
dedupe = TRUE,
align = "right") #%>%
# spanning_header(sex, arm, label = "Here is a spanning header")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header(left = "Experis", right = c("Study ABC", "Status: Closed")) %>%
# options_fixed(line_count = 46) %>%
titles("Table 1.0", "Analysis Data Subject Listing\n And more stuff",
"Safety Population", align = "center") %>%
footnotes("Program Name: table1_0.R",
"Here is a big long footnote that is going to wrap\n at least once") %>%
page_footer(left = "Time", center = "Confidential",
right = "Page [pg] of [tpg]") %>%
add_content(tbl1)
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-35: Title Header and page header/footer wrapping work as expected.", {
fp <- file.path(base_path, "rtf2/test35.rtf")
dat <- iris[1:10, ]
tbl <- create_table(dat, borders = "none") %>%
title_header("Table 1.0", "My Nice Report with Borders",
right = c("Right1", "Right2",
"Right3 long enough to wrap around at least once"),
borders = "none",
blank_row = "none") %>%
footnotes("My footnote 1", "My footnote 2", valign = "bottom",
borders = "none",
blank_row = "above")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_header(c("Left1", "Left2\nwrap"), "Right 1") %>%
page_footer("Left1",
"Center1 here is a whole bunch of stuff to try and make it wrap",
"Right1\nwrap\n and wrap again")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-36: Title and Footnote widths work as expected on table.", {
fp <- file.path(base_path, "rtf2/test36.rtf")
dat <- iris[1:20, ]
tbl <- create_table(dat) %>%
titles("Table 1.0", "My Nice Report with Widths",
width = "page") %>%
footnotes("My footnote 1", "My footnote 2", valign = "top",
width = "page")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-37: Title and Footnote widths work as expected on report", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test37.rtf")
dat <- iris[1:20, ]
tbl <- create_table(dat, borders = "all")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1") %>%
titles("Table 1.0", "My Nice Report with Widths",
borders = c("top", "bottom", "left", "right"),
width = 7) %>%
footnotes("My footnote 1", "My footnote 2", valign = "top",
borders = c("top", "bottom", "left", "right"),
width = 7)
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 5)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-38: Title and Footnote specific widths work as expected.", {
fp <- file.path(base_path, "rtf2/test38.rtf")
dat <- iris[1:20, ]
tbl <- create_table(dat, borders = "all") %>%
titles("Table 1.0", "My Nice Report with Borders",
borders = c("top", "bottom", "left", "right"),
width = 7) %>%
footnotes("My footnote 1", "My footnote 2", valign = "top",
borders = c("top", "bottom", "left", "right"),
width = 7)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-39: One page table works as expected in centimeters and times.", {
fp <- file.path(base_path, "rtf2/test39.rtf")
dat <- mtcars[1:15, ]
attr(dat[[2]], "label") <- "Cylin."
rpt <- create_report(fp, output_type = "RTF", font = "Times",
font_size = fsz, orientation = "landscape",
units = "cm") %>%
set_margins(top = 3, bottom = 3) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(create_table(dat)) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-40: One page table works as expected in courier.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test40.rtf")
dat <- mtcars[1:15, ]
attr(dat[[2]], "label") <- "Cylin."
rpt <- create_report(fp, output_type = "RTF", font = "Courier",
font_size = fsz, orientation = "landscape",
units = "cm") %>%
set_margins(top = 3, bottom = 3) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(create_table(dat)) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
# Basic Tests 41 - 50 ------------------------------------------------------
# Good for testing borders and spacing are working correctly
test_that("rtf2-41: Page by with borders works as expected.", {
fp <- file.path(base_path, "rtf2/test41.rtf")
dat <- iris
brdrs <- "outside"
tbl <- create_table(dat, borders = "all") %>%
titles("Table 1.0", "My Nice Report with a Page By", borders = brdrs) %>%
page_by(Species, label = "Species: ", align = "left", borders = brdrs,
blank_row = "below") %>%
footnotes("My footnote 1", "My footnote 2", borders = brdrs)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 9)
expect_equal(length(res$column_widths[[1]]), 5)
})
# Test for borders and page wraps
test_that("rtf2-42: Long table with borders and footnotes on report.", {
fp <- file.path(base_path, "rtf2/test42.rtf")
dat <- data.frame(labels = rownames(mtcars), mtcars)
tbl <- create_table(dat, borders = "all") %>%
define(labels, id_var = TRUE) %>%
define(wt, page_wrap = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1")) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]") %>%
titles("Table 1.0", "My Nice Irises", "Another Title") %>%
footnotes("My footnote 1", "My footnote 2", valign = "bottom")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
})
test_that("rtf2-43: use_attributes parameter table works as expected.", {
if (dev == TRUE) {
fp1 <- file.path(base_path, "rtf2/test43a.rtf")
fp2 <- file.path(base_path, "rtf2/test43b.rtf")
fp3 <- file.path(base_path, "rtf2/test43c.rtf")
dat <- mtcars[1:10, ]
attr(dat$mpg, "label") <- "Miles per gallon"
attr(dat$cyl, "format") <- "%.1f"
attr(dat$hp, "width") <- 2
fattr(dat$vs) <- list(width = 2, justify = "center")
tbl <- create_table(dat)
# Test default
rpt <- create_report(fp1, output_type = "RTF", font = fnt) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp1), TRUE)
expect_equal(res$pages, 1)
# Test none
tbl <- create_table(dat, use_attributes = "none")
rpt <- create_report(fp2, output_type = "RTF", font = fnt) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp2), TRUE)
# Test some
tbl <- create_table(dat, use_attributes = c("format", "width"))
rpt <- create_report(fp3, output_type = "RTF", font = fnt) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp3), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-45: Title bold and font size works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test45.rtf")
dat <- mtcars[1:15, ]
attr(dat[[2]], "label") <- "Cylin."
attr(dat[[2]], "width") <- 1
attr(dat[[2]], "justify") <- "center"
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Table", borders = c("none"),
width = "content", font_size = 14, bold = TRUE) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none",
align = "left", width = "content") %>%
define(wt, width = 1, label = "Weight", align = "center",
label_align = "right")
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 9, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"),
blank_row = "below") %>%
add_content(tbl, align = "center") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-46: 9 pt font inches works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test46.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 9,
font = "Courier",
orientation = "portrait") %>%
page_header("left", "right") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris)) %>%
page_footer("left", "center", "Page [pg] of [tpg]") %>%
set_margins(top = 1, bottom = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-47: 9 pt font cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test47.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 9,
font = "Courier",
orientation = "portrait",
units = "cm") %>%
page_header("left", "right") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris)) %>%
page_footer("left", "center", "Page [pg] of [tpg]") %>%
set_margins(top = 1, bottom = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-48: 11 pt font inches works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test48.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 11,
font = "Courier",
orientation = "portrait") %>%
page_header("left", "right") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris)) %>%
page_footer("left", "center", "Page [pg] of [tpg]") %>%
set_margins(top = 1, bottom = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-49: 11 pt font cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test49.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 11,
font = "Courier",
orientation = "portrait",
units = "cm") %>%
page_header("left", "right") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris)) %>%
page_footer("left", "center", "Page [pg] of [tpg]") %>%
set_margins(top = 1, bottom = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-50: Spanning headers borders work as expected.", {
fp <- file.path(base_path, "rtf2/test50.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c("outside")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = FALSE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(drat, gear, "Super Duper\nWrapped Span", n = 11, level = 2) %>%
titles("Table 1.0", "My Nice Table", borders = "outside") %>%
footnotes("My footnote 1", "My footnote 2", borders = "outside")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl)
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
# Basic Tests 51-60 -------------------------------------------------------
test_that("rtf2-51: RTF Image file works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test51.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
pltpath <- file.path(base_path, "rtf2/test51.jpg")
ggsave(pltpath, width = 8, height = 4,
units = "in",
dpi = 300)
plt <- create_plot(pltpath, height = 4, width = 8)
rpt <- create_report(fp, output_type = "RTF", font = "Arial") %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt, align = "center") %>%
footnotes("* Motor Trend, 1974") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-52: Table with break between sections works as expected.", {
fp <- file.path(base_path, "rtf2/test52.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "\\fi-87\\li267 N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-53: Text with line feed works as expected.", {
fp <- file.path(base_path, "rtf2/test53.rtf")
cnt2 <- paste0("Hello here \nis something ", cnt)
txt <- create_text(cnt2) %>%
titles("Report 1.0", "Simple Text Report") %>%
footnotes("My footnote")
rpt <- create_report(fp, orientation = "portrait",
output_type = "RTF", font = "Arial") %>%
add_content(txt)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-54: Header_bold works as expected", {
dat <- mtcars[1:10, 1:3]
fp <- file.path(base_path, "rtf2/test54.rtf")
tbl <- create_table(dat, header_bold = TRUE, borders = "all") %>%
column_defaults(width = 1) %>%
titles("Report 1.0", "Simple Report", borders = "outside",
blank_row = "none", bold = TRUE) %>%
footnotes("My footnote", blank_row = "none")
rpt <- create_report(fp, orientation = "portrait",
output_type = "RTF", font = "Arial") %>%
add_content(tbl) %>%
set_margins(top = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-55: Titles and footnotes in header and footer works as expected", {
dat <- mtcars[1:10, 1:3]
fp <- file.path(base_path, "rtf2/test55.rtf")
tbl <- create_table(dat) %>%
column_defaults(width = 1)
rpt <- create_report(fp, orientation = "landscape",
output_type = "RTF", font = "Arial") %>%
add_content(tbl) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
titles("Report 1.0", "Simple Report",
blank_row = "none", header = TRUE, columns = 1) %>%
footnotes("My footnote", "Another footnote", "And another",
blank_row = "none", footer = TRUE) %>%
page_footer("Left", "Center", "Right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-56: Titles and footnotes variations in header and footer work as expected", {
dat <- mtcars[1:10, 1:3]
fp <- file.path(base_path, "rtf2/test56.rtf")
tbl <- create_table(dat) %>%
column_defaults(width = 1)
rpt <- create_report(fp, orientation = "landscape",
output_type = "RTF", font = "Arial") %>%
add_content(tbl) %>%
set_margins(top = 1) %>%
page_header("Left", "Right") %>%
titles("Report 1.0", "Simple Report", align = "left", width = 6,
blank_row = "none", header = TRUE) %>%
titles("Report 1.0", "Simple Report", align = "right", width = 6,
blank_row = "below", header = TRUE, borders = "bottom") %>%
footnotes("My footnote", blank_row = "none", footer = TRUE, borders = "top") %>%
footnotes("My footnote2", blank_row = "none", footer = TRUE, align = "right") %>%
footnotes("My footnote3", blank_row = "none", footer = TRUE, align = "center") %>%
page_footer("Left", "Center", "Right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-57: Titles and footnotes in header and footer no page header/footer works as expected", {
dat <- mtcars[1:10, 1:3]
fp <- file.path(base_path, "rtf2/test57.rtf")
tbl <- create_table(dat) %>%
column_defaults(width = 1)
rpt <- create_report(fp, orientation = "landscape",
output_type = "RTF", font = "Arial") %>%
add_content(tbl) %>%
set_margins(top = 1, bottom = 1) %>%
titles("Report 1.0 here is a big long title", "Simple Report", align = "left",
blank_row = "none", header = TRUE) %>%
titles("Report 1.0", "Simple Report", align = "center", width = 6,
blank_row = "below", header = TRUE) %>%
footnotes("My footnote1", "My footnote2", blank_row = "none", footer = TRUE)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-58: Label row is one cell.", {
fp <- file.path(base_path, "rtf2/test58.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder and more perhaps more" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to see if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label"), width = .8) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-59: Blank after on invisible column.", {
fp <- file.path(base_path, "rtf2/test59.rtf")
tbl <- create_table(iris, borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
page_header("Left", "Right") %>%
add_content(tbl) %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-60: Blank nested stub works as expected.", {
fp <- file.path(base_path, "rtf2/test60.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "Stats" "19" "13"
"ampg" "Stats" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Stats" "16.4" "21.4"
"ampg" "Stats" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Stats" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to see if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25, dedupe = TRUE) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
# Basic Tests 61-70 -------------------------------------------------------
test_that("rtf2-61: Page header width works.", {
fp <- file.path(base_path, "rtf2/test61.rtf")
tbl <- create_table(iris, borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
page_header("Left and here is a really long left cell text to put it",
"Right", width = 8) %>%
add_content(tbl) %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-62: Carriage return in label row works.", {
fp <- file.path(base_path, "rtf2/test62.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - \n21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to \nsee if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-63: Glue works.", {
# if (dev) {
fp <- file.path(base_path, "rtf2/test63.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - \n21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to \nsee if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label"), label = "Stub{supsc('2')}") %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A{supsc('1')}", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = c("Client: Motor Trend{supsc('6')}",
"Test{supsc('8')}"), right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table{supsc('3')}") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974{supsc('4')}") %>%
page_footer(left = "Left{supsc('6')}",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
# } else {
#
# expect_equal(TRUE, TRUE)
#
# }
})
test_that("rtf2-64: Title columns work 1 column.", {
fp <- file.path(base_path, "rtf2/test64.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "left") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-65: Title columns work 2 columns.", {
fp <- file.path(base_path, "rtf2/test65.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame", "Left", "Right",
blank_row = "below", columns = 2) %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-66: Title columns work 3 columns.", {
fp <- file.path(base_path, "rtf2/test66.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame", "My right thing", "", "Center",
blank_row = "below", columns = 3) %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-67: Multiple title blocks work as expected.", {
fp <- file.path(base_path, "rtf2/test67.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
titles("Table 2.0", "IRIS Data Frame2", "Left", "Right",
blank_row = "below", columns = 2, borders = "all") %>%
titles("Table 3.0", "IRIS Data Frame3", "My right thing", "", "Center",
blank_row = "below", columns = 3, borders = "all") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-68: Custom page size works as expected.", {
fp <- file.path(base_path, "rtf2/test68.rtf")
tbl <- create_table(iris[1:15, ]) %>%
define(Species, visible = FALSE)
ttl <- c("Title1", "Title2", "Title3")
rpt <- create_report(fp, output_type = "RTF",
font = "Courier",
paper_size = c(6.5, 7.5),
orientation = "portrait") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles(ttl,
blank_row = "below", columns = 1, align = "center",
borders = "none") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-69: Breaks removed after titles and footnotes.", {
fp <- file.path(base_path, "rtf2/test69.rtf")
tbl <- create_table(iris[1:15, ], borders = "outside") %>%
define(Species, visible = FALSE) %>%
titles("Here is a title") %>%
footnotes("Here is a footnote")
rpt <- create_report(fp, output_type = "RTF",
font = "Courier",
orientation = "landscape") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-70: Breaks removed after 2 titles and footnotes.", {
fp <- file.path(base_path, "rtf2/test70.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, visible = FALSE) %>%
titles("Here is a title") %>%
titles("There is a title") %>%
footnotes("Here is a footnote") %>%
footnotes("There is a footnote")
rpt <- create_report(fp, output_type = "RTF",
font = "Courier",
orientation = "landscape") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
# Basic Tests 71-80 -------------------------------------------------------
test_that("rtf2-71: RTF Plot with path works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test71.rtf")
tmp <- file.path(base_path, "plot.jpg")
jpeg(tmp, width = 600, height = 500)
plot(mtcars$mpg)
dev.off()
plt <- create_plot(tmp, height = 5, width = 6, borders = c("top", "bottom", "all")) %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", borders = "none") %>%
footnotes("* Motor Trend, 1974", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size =fsz) %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt) %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-72: Symbols are proper orientation on portrait.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test72.rtf")
dat <- mtcars[1:10, ]
tbl <- create_table(dat) %>%
titles("My Table{symbol('dagger')}")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl)
res <- write_report(rpt)
#file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-73: Symbols are proper orientation on landscape.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test73.rtf")
dat <- mtcars[1:10, ]
tbl <- create_table(dat) %>%
titles("My Table{symbol('dagger')}")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "landscape") %>%
add_content(tbl)
res <- write_report(rpt)
#file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-74: Multi-page continuous tables work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test74.rtf")
dat <- iris
tbl <- create_table(dat, continuous = TRUE, borders = "all") %>%
# titles("My Title") %>%
footnotes("My footnotes", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl) %>%
footnotes("Here", footer = TRUE)
res <- write_report(rpt)
# file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
# expect_equal(res$pages, 3)
} else {
expect_equal(TRUE, TRUE)
}
})
# Works!
test_that("rtf2-75: Simplest EMF Plot works as expected.", {
if (dev == TRUE) {
library(devEMF)
fp <- file.path(base_path, "rtf2/test75.rtf")
tmp <- file.path(base_path, "rtf2/plot.emf")
emf(tmp)
plot(1, 1)
dev.off()
plt <- create_plot(tmp, height = 5, width = 6, borders = c("top", "bottom", "all")) %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", borders = "none") %>%
footnotes("* Motor Trend, 1974", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size =fsz) %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt) %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
# Works!
test_that("rtf2-76: Patchwork Plot works as expected.", {
if (dev == TRUE) {
library(ggplot2)
library(patchwork)
fp <- file.path(base_path, "rtf2/test76.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
p2 <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
ptch <- (p | p2)
plt <- create_plot(ptch, height = 4, width = 8, borders = c("top", "bottom", "all")) %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", borders = "none") %>%
footnotes("* Motor Trend, 1974", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size =fsz) %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt, align = "right") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-77: One-page continuous tables work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test77.rtf")
dat <- iris[1:15, ]
tbl <- create_table(dat, continuous = TRUE, borders = "all") %>%
titles("My title") %>%
footnotes("My footnotes", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl) %>%
footnotes("Here", footer = TRUE)
res <- write_report(rpt)
# file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-78: Two one-page continuous tables work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test78.rtf")
dat <- iris[1:15, ]
tbl1 <- create_table(dat, continuous = TRUE, borders = "all") %>%
titles("My title 1") %>%
footnotes("My footnotes 1", blank_row = "none")
tbl2 <- create_table(dat, continuous = TRUE, borders = "all") %>%
titles("My title 2") %>%
footnotes("My footnotes 2", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl1) %>%
add_content(tbl2) %>%
footnotes("Here", footer = TRUE)
res <- write_report(rpt)
# file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-79: Two multi-page continuous tables work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test79.rtf")
dat <- iris[1:125, ]
tbl1 <- create_table(dat, continuous = TRUE, borders = "all") %>%
titles("My title 1") %>%
footnotes("My footnotes 1", blank_row = "none")
tbl2 <- create_table(dat, continuous = TRUE, borders = "all") %>%
titles("My title 2") %>%
footnotes("My footnotes 2", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl1) %>%
add_content(tbl2) %>%
footnotes("Here", footer = TRUE) %>%
page_header("Left", "Right") %>%
page_footer(right = "Page [pg] of [tpg]")
res <- write_report(rpt)
# file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
#expect_equal(res$pages, 6)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-80: Two tables one continuous works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test80.rtf")
dat <- iris[1:125, ]
tbl1 <- create_table(dat, continuous = TRUE, borders = "all") %>%
titles("My title 1") %>%
footnotes("My footnotes 1", blank_row = "none")
tbl2 <- create_table(dat, continuous = FALSE, borders = "all") %>%
titles("My title 2") %>%
footnotes("My footnotes 2", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl1) %>%
add_content(tbl2) %>%
footnotes("Here", footer = TRUE) %>%
page_header("Left", "Right") %>%
page_footer(right = "Page [pg] of [tpg]")
res <- write_report(rpt)
# file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 6)
} else {
expect_equal(TRUE, TRUE)
}
})
# Basic Tests 81-90 -------------------------------------------------------
# Can't reproduce Raphael's problem
test_that("rtf2-81: Column widths work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test81.rtf")
dat <- mtcars[, 1:9]
tbl <- create_table(dat, width = 8.84) %>%
titles("My title") %>%
column_defaults(width = .75) %>%
define(mpg, width = 2.09) %>%
define(cyl, width = 1.5) %>%
footnotes("My footnotes", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait",
paper_size = c(9.5, 11.5)) %>%
add_content(tbl) %>%
footnotes("Here", footer = TRUE) %>%
set_margins(top = .25, bottom = .25, left = .25, right = .25)
res <- write_report(rpt)
#file.show(res$modified_path)
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-82: Basic cell style bold works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test82.rtf")
dat <- mtcars[, 1:5]
dat$hpflg <- ifelse(dat$hp > 100, TRUE, FALSE)
tbl <- create_table(dat, width = 7) %>%
titles("My title") %>%
column_defaults(width = .75) %>%
define(mpg, width = 1, style = cell_style(bold = TRUE)) %>%
define(cyl, width = 1) %>%
define(disp, style = cell_style(bold = TRUE)) %>%
define(hp, style = cell_style(bold = TRUE, indicator = hpflg)) %>%
define(hpflg, visible = FALSE) %>%
footnotes("My footnotes", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl) %>%
footnotes("Here", footer = TRUE)
res <- write_report(rpt)
# file.show(res$modified_path)
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-83: Bolding works with stub.", {
fp <- file.path(base_path, "rtf2/test83.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
df$cylflg <- ifelse(df$var == "cyl", TRUE, FALSE)
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
column_defaults(vars = c("stub", "A"),
style = cell_style(bold = TRUE, indicator = cylflg)) %>%
stub(c("var", "label"),
style = cell_style(bold = TRUE, indicator = "labelrow")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19,
style = cell_style(bold = TRUE, indicator = cylflg)) %>%
define(B, label = "Group B", align = "center", n = 13,
style = cell_style(bold = TRUE, indicator = "datarow")) %>%
define(cylflg, visible = FALSE)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
# file.show(res$modified_path)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-84: Bold cell style with column defaults.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test84.rtf")
dat <- mtcars[, 1:5]
dat$hpflg <- ifelse(dat$hp > 100, TRUE, FALSE)
tbl <- create_table(dat) %>%
titles("My title") %>%
column_defaults(width = .75, vars = c("cyl", "disp", "hp"),
style = cell_style(bold=TRUE, indicator = hpflg)) %>%
define(mpg) %>%
define(cyl) %>%
define(disp) %>%
define(hp) %>%
define(hpflg, visible = FALSE) %>%
footnotes("My footnotes", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl) %>%
footnotes("Here", footer = TRUE)
res <- write_report(rpt)
# file.show(res$modified_path)
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-85: Bolding, column defaults, and stub works.", {
fp <- file.path(base_path, "rtf2/test85.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
df$cylflg <- ifelse(df$var == "cyl", FALSE, TRUE)
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
column_defaults(style = cell_style(bold = TRUE, indicator = cylflg)) %>%
stub(c("var", "label"), width = 2,
style = cell_style(bold = TRUE, indicator = cylflg)) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13,
style = cell_style(bold = TRUE, indicator = "datarow")) %>%
define(cylflg, visible = FALSE)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
# file.show(res$modified_path)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-86: Spanning header bold work as expected.", {
fp <- file.path(base_path, "rtf2/test86.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c( "none")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = FALSE, bold = TRUE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(drat, gear, "Super Duper\nWrapped Span",
n = 11, level = 2, bold = TRUE) %>%
titles("Table 1.0", "My Nice Table", blank_row = "none",
borders = c("top", "bottom")) %>%
footnotes("My footnote 1", "My footnote 2",
blank_row = "none", borders = c("top", "bottom"))
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(res$modified_path), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-87: Italic footnotes work as expected.", {
fp <- file.path(base_path, "rtf2/test87.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c( "none")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = FALSE, bold = FALSE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(drat, gear, "Super Duper\nWrapped Span",
n = 11, level = 2, bold = FALSE) %>%
titles("Table 1.0", "My Nice Table", blank_row = "none",
borders = c("top", "bottom")) %>%
footnotes("My italic footnote1", "My italic footnote2", italics = TRUE,
blank_row = "none", borders = "top") %>%
footnotes("My italic footnote2", "My footnote 2",
blank_row = "none", borders = c("bottom"))
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(res$modified_path), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-88: Footnote columns work 1 column.", {
fp <- file.path(base_path, "rtf2/test88.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE) %>%
footnotes("Here is a footnote", "And another",
borders = "all", columns = 1)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "left") %>%
footnotes("Here is a footnote", "And another", columns = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-89: Footnote columns work 2 columns.", {
fp <- file.path(base_path, "rtf2/test89.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = FALSE, visible = FALSE) %>%
footnotes("Here is a footnote", "And another",
borders = "all", columns = 2)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame", "Left", "Right",
blank_row = "below", columns = 2) %>%
footnotes("Here is a footnote that is really long and is going to wrap",
"And another",
"Another left", "Another right", columns = 2)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-90: Footnote columns work 3 columns.", {
fp <- file.path(base_path, "rtf2/test90.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = FALSE, visible = FALSE) %>%
footnotes("Here is a footnote", "And another", "And more",
"", "centered",
borders = "all", columns = 3, blank_row = "both")
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame", "My right thing", "", "Center",
blank_row = "below", columns = 3) %>%
footnotes("Here is a footnote that is really long an is going to wrap a few times",
"And another", "and more",
"", "Footnote Center", columns = 3)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
# Basic Tests 91-100 ------------------------------------------------------
test_that("rtf2-91: Multiple footnote blocks work as expected.", {
fp <- file.path(base_path, "rtf2/test91.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE) %>%
footnotes("Footnote left", "Footnote right", columns = 2)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Table 1.0", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
footnotes("Table 2.0", "IRIS Data Frame2", "Left", "Right",
blank_row = "below", columns = 2, borders = "all") %>%
footnotes("Table 3.0", "IRIS Data Frame3", "My right thing", "", "Center",
blank_row = "below", columns = 3, borders = "all") %>%
titles("Here is a title", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-92: Page by with wrap works as expected.", {
fp <- file.path(base_path, "rtf2/test92.rtf")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat$Pgby <- paste0("Flower Type\n", dat$Pgby)
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Report with a Page By", borders = "none") %>%
page_by(Pgby, label = "Species: ", align = "right", borders = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_header("Left", "Right") %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 9)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-93: Page by with format works as expected.", {
fp <- file.path(base_path, "rtf2/test93.rtf")
fmt1 <- c(setosa = 1, versicolor = 2, virginica = 3)
fmt2 <- value(condition(x == 1, "Setosa"),
condition(x == 2, "Versicolor"),
condition(x == 3, "Virginica"))
dat <- iris
fmtval <- fmt1[dat$Species]
names(fmtval) <- NULL
dat$Pgby <- fmtval
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Report with a Page By", borders = "none") %>%
page_by(Pgby, align = "left", label = "Flower:", borders = "none", format = fmt2) %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF",
orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_header("Left", "Right") %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 6)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-94: Label with invisible column works as expected.", {
fp <- file.path(base_path, "rtf2/test94.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE, label = "Fork") %>%
footnotes("Left", "right", columns = 2)
rpt <- create_report(fp, output_type = "RTF") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Footnote1", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
titles("Table 1.0", "My little title")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-95: Page break with blank row after works as expected.", {
fp <- file.path(base_path, "rtf2/test95.rtf")
dat <- sort(iris, by = c("Species", "Petal.Width"))
PG <- c(rep(1, 25), rep(2, 25),
rep(4, 25), rep(5, 25),
rep(7, 25), rep(8, 25))
dat$PG <- PG
tbl <- create_table(dat, borders = "all") %>%
stub(c("Species", "Petal.Width"), label = "My stuff") %>%
define(Species, visible = TRUE, label_row = TRUE) %>%
define(Petal.Width, blank_after = TRUE, indent = .25) %>%
define(PG, page_break = TRUE, visible = TRUE) %>%
footnotes("Left", "right", columns = 2)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "Page [pg] of [tpg]") %>%
footnotes("Footnote1", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
titles("Table 1.0", "My little title")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 11)
})
test_that("rtf2-96: Outside borders on continuous tables work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test96.rtf")
dat <- iris
tbl <- create_table(dat, continuous = TRUE, borders = "outside") %>%
# titles("My Title") %>%
footnotes("My footnotes", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl) %>%
footnotes("Here", footer = TRUE)
res <- write_report(rpt)
# file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
# expect_equal(res$pages, 3)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-97: Page X of Y works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test97.rtf")
dat <- iris
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Irises", "Another Title", "Page [pg] of [tpg]") %>%
define(Sepal.Length, label = "Sepal Length", width = 1, align = "center") %>%
define(Sepal.Width, label = "Sepal Width", width = 1, align = "centre") %>%
define(Species, blank_after = TRUE) %>%
footnotes("Table footnote Page [pg] of [tpg]")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
titles("Report Title", "Page [pg] of [tpg]") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Page [pg] of [tpg]")) %>%
add_content(tbl, blank_row = "none") %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]") %>%
footnotes("My footnote 1", "My footnote 2", "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 11)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-98: Title header blank rows work as expected.", {
fp <- file.path(base_path, "rtf2/test98.rtf")
dat <- iris
tbl <- create_table(dat, width = 8.9, borders = "all") %>%
title_header("Table 1.0", "My Nice Table",
right = c("Right1",
"Right2", "Page [pg] of [tpg]"),
blank_row = "both", borders = "all")
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 10, orientation = "landscape") %>%
page_header("Left", "Right", blank_row = "below") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 7)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-99: Multi page table removes blank spaces.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test99.rtf")
dat1 <- iris[1:10, ]
dat2 <- iris[11:20, ]
dat3 <- iris[21:30, ]
tbl1 <- create_table(dat1, borders = "none") %>%
titles("Table 1.0", "My Nice Irises1")
tbl2 <- create_table(dat2, borders = "none") %>%
titles("Table 1.0", "My Nice Irises2")
tbl3 <- create_table(dat3, borders = "none") %>%
titles("Table 1.0", "My Nice Irises3")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl1, blank_row = "none") |>
add_content(tbl2, blank_row = "none") |>
add_content(tbl3, blank_row = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 3)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-100: Spanning header gap works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test100.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c("outside")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = TRUE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(cyl, hp, "Super Span", n = 11, level = 2) |>
spanning_header(drat, gear, "Super Duper\nWrapped Span", n = 11, level = 2)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-100-2: Spanning header gap should not exist with all border.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test100-2.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c("all")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = TRUE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(cyl, hp, "Super Span", n = 11, level = 2) |>
spanning_header(drat, gear, "Super Duper\nWrapped Span", n = 11, level = 2)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-100-3: Spanning header gap should not exist with inside border.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test100-3.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c("inside")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = TRUE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(cyl, hp, "Super Span", n = 11, level = 2) |>
spanning_header(drat, gear, "Super Duper\nWrapped Span", n = 11, level = 2)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
# Basic Tests 101-110 ------------------------------------------------------
test_that("rtf2-101: Table with blank_before as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test101.rtf")
# Setup
arm <- c(rep("A", 5), rep("B", 5))
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa \nand more and more", "Schaffer, Ashley", "Laner, Tahma",
"Perry, Sean", "Crews, Deshawn Joseph", "Person, Ladon",
"Smith, Shaileigh")
sex <- c("M", "F", "F", "M", "M", "F", "M", "F", "F", "M")
age <- c(41, 53, 43, 39, 47, 52, 21, 38, 62, 26)
# Create data frame
df <- data.frame(arm, subjid, name, sex, age, stringsAsFactors = FALSE)
tbl1 <- create_table(df, first_row_blank = FALSE) %>%
define(subjid, label = "Subject ID for a patient", n = 10, align = "left",
width = 1) %>%
define(name, label = "Subject Name", width = 1) %>%
define(sex, label = "Sex", n = 10, align = "center") %>%
define(age, label = "Age", n = 10) %>%
define(arm, label = "Arm",
blank_before = TRUE,
dedupe = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
titles("Table 1.0", align = "center") %>%
add_content(tbl1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-102: Three level stub and indentation work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test102.rtf")
# Setup
cat <- c(rep("Kaplan-Meier estimates", 6),
rep("Cox PH estimates and some more really long stuff", 6))
grp <- c("25th percentile", "25th percentile",
"median (weeks)", "median (weeks)",
"75th percentile", "75th percentile",
"25th percentile", "25th percentile",
"median (weeks)", "median (weeks)",
"75th percentile", "75th percentile")
ci <- c(NA, "95% confidence interval",
NA, "95% confidence interval",
NA, "95% confidence interval",
NA, "95% confidence interval",
NA, "95% confidence interval",
NA, "95% confidence interval")
values <- c(41, 53, 43, 39, 47, 52, 38, 25, 37, 23, 78, 21)
# Create data frame
df <- data.frame(cat, grp, ci, values, stringsAsFactors = FALSE)
tbl1 <- create_table(df) %>%
stub(c(cat, grp, ci), "Estimates", width = 1.5) %>%
define(cat, label_row = TRUE, blank_after = TRUE, indent = 0.15) %>%
define(grp, indent = .25) %>%
define(ci, indent = .5) %>%
define(values, label = "Values")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
titles("Table 3.0", "Analysis of Time to Initial PSGA Success in Weeks") %>%
page_header("Sponsor", "Study") %>%
add_content(tbl1) %>%
page_footer("Time", "Confidential", "Page")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-103: Page footers with one assigned width work as expected.",{
if (dev) {
fp <- file.path(base_path, "rtf2/test103.rtf")
dat <- mtcars[,c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs")]
tbl <- create_table(dat, borders = "outside") %>%
footnotes("This is testing footnote", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
set_margins(top = 1, bottom = 1) %>%
titles("Table 1.0") %>%
add_content(tbl) %>%
page_footer(left = "this is a very long sentence whose length exceeds the limitation of the left part",
center = "Center footer", right = "Right footer",
width = c(5.5))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
}
)
test_that("rtf2-104: Page footers with multiple assigned widths work as expected.",{
if (dev) {
fp <- file.path(base_path, "rtf2/test104.rtf")
dat <- mtcars[,c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs")]
tbl <- create_table(dat, borders = "outside") %>%
footnotes("This is testing footnote", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
set_margins(top = 1, bottom = 1) %>%
titles("Table 1.0") %>%
add_content(tbl) %>%
page_footer(left = "this is a very long sentence whose length exceeds the limitation of the left part",
center = "", right = "Right Footer",
width = c(5.5, 0 , 2))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
}
)
test_that("rtf2-105: Page by with bold label and value works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test105.rtf")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = "Flower Type: ", bold = TRUE, blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-106: Page by with bold label as expected.", {
if (dev) {
# Label and Value are bold
fp <- file.path(base_path, "rtf2/test106.rtf")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = "Flower Type: ", bold = "label", blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-107: Page by with bold value as expected.", {
if (dev) {
# Label and Value are bold
fp <- file.path(base_path, "rtf2/test107.rtf")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = "Flower Type: ", bold = "value", blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-108: Page by with bold long label and value works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test108.rtf")
dat <- iris
long_string <- "This is long page by value which should take more than one sentence - "
dat$Pgby <- paste0(long_string, dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
long_label <- "This is a long page by label which should take more than one sentence: "
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = long_label, bold = TRUE, blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-109: Page by with bold long label works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test109.rtf")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
long_label <- "This is a long page by label which should take more than one sentence: "
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = long_label, bold = "label", blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-110: Page by with bold long value works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test110.rtf")
dat <- iris
long_string <- "This is long page by value which should take more than one sentence - "
dat$Pgby <- paste0(long_string, dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
long_label <- "This is a long page by label which should take more than one sentence:"
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = "Flower Type:", bold = "value", blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
# Basic Tests 111-120 ------------------------------------------------------
test_that("rtf2-111: Page by with bold long label filling one line works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test111.rtf")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
long_label <- "This is a long page by label which should take more: "
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = long_label, bold = "label", blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-112: Group border works as as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test112.rtf")
# Setup
arm <- c(rep("A", 3), rep("B", 2), rep("C", 3), rep("D", 2))
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa \nand more and more", "Schaffer, Ashley", "Laner, Tahma",
"Perry, Sean", "Crews, Deshawn Joseph", "Person, Ladon",
"Smith, Shaileigh")
sex <- c("M", "F", "F", "M", "M", "F", "M", "F", "F", "M")
age <- c(41, 53, 43, 39, 47, 52, 21, 38, 62, 26)
# Create data frame
df <- data.frame(arm, subjid, name, sex, age, stringsAsFactors = FALSE)
df <- rbind(df, df, df, df)
tbl1 <- create_table(df, first_row_blank = FALSE, borders = "outside") %>%
define(subjid, label = "Subject ID for a patient", n = 10, align = "left",
width = 1) %>%
define(name, label = "Subject Name", width = 1) %>%
define(sex, label = "Sex", n = 10, align = "center") %>%
define(age, label = "Age", n = 10) %>%
define(arm, label = "Arm",
dedupe = TRUE,
group_border = TRUE) %>%
footnotes("This is the footnote")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
titles(c("Table 1.0", "This is a table with group border"), align = "center") %>%
add_content(tbl1) %>%
footnotes(c("This is the footnote 1")) %>%
page_header(left = "Test header", right = "Test header") %>%
set_margins(top = 1, bottom = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-113: Group border with blank after works as as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test113.rtf")
# Setup
arm <- c(rep("A", 3), rep("B", 2), rep("C", 3), rep("D", 2))
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa \nand more and more", "Schaffer, Ashley", "Laner, Tahma",
"Perry, Sean", "Crews, Deshawn Joseph", "Person, Ladon",
"Smith, Shaileigh")
sex <- c("M", "F", "F", "M", "M", "F", "M", "F", "F", "M")
age <- c(41, 53, 43, 39, 47, 52, 21, 38, 62, 26)
# Create data frame
df <- data.frame(arm, subjid, name, sex, age, stringsAsFactors = FALSE)
df <- rbind(df, df, df, df)
tbl1 <- create_table(df, first_row_blank = FALSE, borders = "outside") %>%
define(subjid, label = "Subject ID for a patient", n = 10, align = "left",
width = 1) %>%
define(name, label = "Subject Name", width = 1) %>%
define(sex, label = "Sex", n = 10, align = "center") %>%
define(age, label = "Age", n = 10) %>%
define(arm, label = "Arm",
dedupe = TRUE,
blank_after = TRUE,
group_border = TRUE) %>%
footnotes("This is the footnote")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
titles(c("Table 1.0", "This is a table with group border"), align = "center") %>%
add_content(tbl1) %>%
footnotes(c("This is the footnote 1")) %>%
page_header(left = "Test header", right = "Test header") %>%
set_margins(top = 1, bottom = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-114: Center page header works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test114.rtf")
dat <- iris[1:50,]
dat <- dat[, c("Species" ,"Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")]
tbl <- create_table(dat, borders = "outside")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with a center header", header = T) %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none") %>%
page_header(left = "", center = "center", right = "right",
width = c(0, 5, 4)) %>%
page_footer(left = "Left", center = "center", right = "right",
width = c(3, 4, 2))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-115: Images in page header/footer work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test115.rtf")
dat <- iris[1:50,]
dat <- dat[, c("Species" ,"Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")]
image_path <- file.path(base_path, "data/logo.png")
image_path2 <- file.path(base_path, "data/logo.jpg")
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a page header picture")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none") %>%
page_header() %>%
header_image(image_path, height = 0.5, width = 0.8, align = "left") %>%
header_image(image_path, height = 0.6, width = 0.85, align = "right") %>%
header_image(c(image_path, image_path2), height = 0.38, width = 0.7, align = "center") %>%
page_footer() %>%
footer_image(c(image_path2, image_path), height = 0.38, width = 0.7, align = "left") %>%
footer_image(image_path, height = 0.5, width = 0.8, align = "right") %>%
footer_image(image_path, height = 0.6, width = 0.85, align = "center")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-116: Spanned images in page header/footer work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test116.rtf")
dat <- iris[1:50,]
dat <- dat[, c("Species" ,"Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")]
image_path <- file.path(base_path, "data/span_logo.png")
tbl <- create_table(dat, borders = "outside")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with a page header picture", header = T) %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none") %>%
page_header(width = c(0, 9, 0), left = "No display because width is 0") %>%
header_image(image_path, height = 1, width = 7.5, align = "centre") %>%
page_footer(width = c(0, 0, 9), center = "No display because width is 0") %>%
footer_image(image_path, height = 0.8, width = 7, align = "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-117: Return error when header_image/footer_image is used without page_header/page_footer.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test117.rtf")
dat <- iris[1:50,]
dat <- dat[, c("Species" ,"Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")]
image_path <- file.path(base_path, "data/span_logo.png")
tbl <- create_table(dat, borders = "outside")
# page_header is not set
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with a page header picture", header = T) %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none") %>%
header_image(image_path, height = 1, width = 7.5, align = "centre")
expect_error(
res <- write_report(rpt),
"`page_header` must be used when using `header_image`."
)
# page_footer is not set
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with a page header picture", header = T) %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none") %>%
footer_image(image_path, height = 0.8, width = 7, align = "right")
expect_error(
res <- write_report(rpt),
"`page_footer` must be used when using `footer_image`."
)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-118: group_cohesion puts the group in same page as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test118.rtf")
dat <- iris[1:86,]
dat$test_group <- c(
rep("A", 12),
rep("B", 6),
rep("C", 19),
rep("D", 18),
rep("E", 31)
)
dat$test_string <- c(
rep("Flower A\nSubgroup A1", 12), # 24 lines + 1
rep("Flower B\nSubgroup B1", 6), # 12 lines + 1
c(rep("Flower C", 19)), # 19 lines + 1
c(rep("Flower D", 16), rep("Flower D\nSubgroup D1", 2)), # 20 lines + 1
c(rep("Flower E", 31)) # 31 lines + 1
)
dat <- dat[, c("test_group", "test_string", "Sepal.Length",
"Sepal.Width", "Petal.Length","Petal.Width")]
tbl <- create_table(dat, borders = "outside") %>%
define(test_group, group_cohesion = TRUE, label = "Group", blank_after = T)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with Group Cohesion") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none",
blank_row = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-119: group_cohesion with min page proportion works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test119.rtf")
dat <- iris[1:86,]
dat$test_group <- c(
rep("A", 12),
rep("B", 6),
rep("C", 19),
rep("D", 18),
rep("E", 31)
)
dat$test_string <- c(
rep("Flower A\nSubgroup A1", 12), # 24 lines + 1
rep("Flower B\nSubgroup B1", 6), # 12 lines + 1
c(rep("Flower C", 19)), # 19 lines + 1
c(rep("Flower D", 16), rep("Flower D\nSubgroup D1", 2)), # 20 lines + 1
c(rep("Flower E", 31)) # 31 lines + 1
)
dat <- dat[, c("test_group", "test_string", "Sepal.Length",
"Sepal.Width", "Petal.Length","Petal.Width")]
tbl <- create_table(dat, borders = "outside") %>%
define(test_group, group_cohesion = 0.6,
label = "Group", blank_after = T) %>%
define(test_string, label = "Flower")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with Group Cohesion") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none",
blank_row = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-120: group_cohesion/min_page_prop return error properly.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test120.rtf")
dat <- iris[1:86,]
dat$test_group <- c(
rep("A", 12),
rep("B", 6),
rep("C", 19),
rep("D", 18),
rep("E", 31)
)
dat$test_string <- c(
rep("Flower A\nSubgroup A1", 12), # 24 lines + 1
rep("Flower B\nSubgroup B1", 6), # 12 lines + 1
c(rep("Flower C", 19)), # 19 lines + 1
c(rep("Flower D", 16), rep("Flower D\nSubgroup D1", 2)), # 20 lines + 1
c(rep("Flower E", 31)) # 31 lines + 1
)
dat <- dat[, c("test_group", "test_string", "Sepal.Length",
"Sepal.Width", "Petal.Length","Petal.Width")]
# ++++++++++++++++++++++
# group_cohesion is not in right range
# ++++++++++++++++++++++
myfun <- function(dat){
tbl <- create_table(dat, borders = "outside") %>%
define(test_group, group_cohesion = 2,
label = "Group", blank_after = T) %>%
define(test_string, label = "Flower")
}
expect_error(
res <- myfun(dat),
paste0("`group_cohesion` should be TRUE/FALSE or numeric value from 0 to 1 instead of 2.")
)
} else {
expect_equal(TRUE, TRUE)
}
})
# Basic Tests 121-130 ------------------------------------------------------
test_that("rtf2-121: Multiple group_cohesion work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test121.rtf")
dat <- iris[1:86,]
dat$test_group <- c(
rep("A", 12),
rep("B", 6),
rep("C", 19),
rep("D", 18),
rep("E", 31)
)
dat$test_string <- c(
rep("Flower A\nSubgroup A1", 12), # 24 lines + 1
rep("Flower B\nSubgroup B1", 3), # 12 lines + 1
rep("Flower B\nSubgroup B2", 3),
c(rep("Flower C1", 11)), # C1 ends at 24 lines, which is the minimum requirement
c(rep("Flower C2", 8)), # C2 would be moved to next page
c(rep("Flower D", 16), rep("Flower D\nSubgroup D1", 2)), # 20 lines + 1
c(rep("Flower E1", 24), rep("Flower E2", 7)) # E2 would be moved to next page
)
dat <- dat[, c("test_group", "test_string", "Sepal.Length",
"Sepal.Width", "Petal.Length","Petal.Width")]
tbl <- create_table(dat, borders = "outside") %>%
define(test_group, group_cohesion = TRUE, label = "Group", blank_after = T) %>%
define(test_string, group_cohesion = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with Group Cohesion") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none",
blank_row = "none")
res <- write_report(rpt)
# C2 would be moved to next page
# E2 would be moved to next page
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-122: Multiple group_cohesion with different cohesion strengths work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test122.rtf")
dat <- iris[1:92,]
dat$test_group <- c(
rep("A", 12),
rep("B", 6),
rep("C", 19),
rep("D", 18),
rep("E", 37)
)
dat$test_string <- c(
rep("Flower A\nSubgroup A1", 12), # 24 lines + 1
rep("Flower B\nSubgroup B1", 6), # 12 lines + 1
c(rep("Flower C1", 11)), # C1 ends at 24 lines, which is the minimum requirement
c(rep("Flower C2", 8)), # C2 would be not moved to next page
c(rep("Flower D", 16), rep("Flower D\nSubgroup D1", 2)), # 20 lines + 1
c(rep("Flower E1", 33), rep("Flower E2", 4)) # E2 would be moved to next page
)
dat <- dat[, c("test_group", "test_string", "Sepal.Length",
"Sepal.Width", "Petal.Length","Petal.Width")]
tbl <- create_table(dat, borders = "outside") %>%
define(test_group, group_cohesion = TRUE, label = "Group", blank_after = T) %>%
define(test_string, group_cohesion = 0.1)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with Group Cohesion") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none",
blank_row = "none")
res <- write_report(rpt)
# C2 would not be moved to next page because previous lines are only 24
# E2 would be moved to next page because previous lines are 27, which meets 30*0.9
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-123: break_label works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test123.rtf")
dat <- iris[1:86,]
dat$test_group <- c(
rep("A", 12),
rep("B", 6),
rep("C", 19),
rep("D", 18),
rep("E", 31)
)
dat$test_string <- c(
rep("Flower A\nSubgroup A1", 12), # 24 lines + 1
rep("Flower B\nSubgroup B1", 6), # 12 lines + 1
c(rep("Flower C", 19)), # 19 lines + 1
c(rep("Flower D", 16), rep("Flower D\nSubgroup D1", 2)), # 20 lines + 1
c(rep("Flower E", 31)) # 31 lines + 1
)
dat <- dat[, c("test_group", "test_string", "Sepal.Length",
"Sepal.Width", "Petal.Length","Petal.Width")]
tbl <- create_table(dat, borders = "outside") %>%
define(test_group, break_label = "(Continued)", blank_before = T) %>%
define(test_string,
break_label = paste0("(This is a long text which should take more ",
"than one line. It's to test if the package is able to handle this ",
"situation.)"),
indent = 0.16)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with Break Label") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none",
blank_row = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-124: Page numbers work every in title, footnote, header, and footer.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test124.rtf")
dat <- iris
tbl <- create_table(dat, borders = "outside") %>%
titles("Table Title: Page [pg] of [tpg]") %>%
footnotes("Table footnote: Page [pg] of [tpg]")
rpt <- create_report(fp, output_type = "rtf", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
add_content(tbl) %>%
titles("Report Title: Page [pg] of [tpg]") %>%
footnotes("Report footnote: Page [pg] of [tpg]", borders = "none") %>%
page_header("Header: Page [pg] of [tpg]") %>%
page_footer("Footer: Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-125: Missing stub row label won't be displayed.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test125.rtf")
df <- read.table(header = TRUE, text = '
var label A B
"A" "Some text 1" "11" "8"
"A" "Some text 2" "10" "7"
"RACE" " White" "6 (54.5)" "4 (50.0)"
"RACE" " Black" "4 (36.4)" "3 (37.5)"
"RACE" " Others" "1 (9.1)" "1 (12.5)"
"B" "Some text 3" "6 (54.5)" "4 (50.0)"
"B" "Some text 4" "4 (36.4)" "3 (37.5)"
')
df$var <- ifelse(df$var == "A", NA, df$var)
df$var <- ifelse(df$var == "B", "", df$var)
tbl <- create_table(df, first_row_blank = FALSE, borders = c("top", "bottom")) %>%
titles("Table 1.0 Demographics", font_size = 10) %>%
stub(vars = c("var", "label"), "", width = 2.5) %>%
define(var, blank_after = TRUE, label_row = TRUE) %>%
define(A, align = "center", width=1.2, label = "Placebo", n=11) %>%
define(B, align = "center", width=1.2, label = "Drug", n=8)
rpt <- create_report(fp, output_type = "rtf", font = "Arial") %>%
add_content(tbl)
# "" will still be row label. Only remove NA
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-126: RTF codes work as expected", {
if (dev) {
fp <- file.path(base_path, "rtf2/test126.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "\\li360 N" "19" "13"
"ampg" "\\li360 Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "\\li360 Median" "16.4" "21.4"
"ampg" "\\li360 Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "\\li360 Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "\\li360 8\\line Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "\\li360 6\\line Cylinder and more perhaps more" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "\\li360 4\\line Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to see if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label"), width = .8) %>%
# stub(c("var", "label"), width = 1.2) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
# define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
# With allow_code = TRUE, line breaking wouldn't consider RTF code, but
# the reporter package wouldn't detect if it's indentation code and wouldn't
# keep the space for indentation. That it to say, users should be responsible
# for doing line wrapping from data set.
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
report_options(allow_code = TRUE) %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
# The output should be the same as rtf2-58
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-127: More RTF codes work as expected", {
if (dev) {
fp <- file.path(base_path, "rtf2/test127.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "\\li360 N" "19" "13"
"ampg" "\\li360 Mean" "18.8" "22.0 (4.9)"
"ampg" "\\li360 Median" "16.4{\\sub mm}" "21.4{\\super 2}"
"ampg" "\\li360 Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "\\li360 Range" "{\\cf12 10.4 - 33.9}" "14.7 - 32.4"
"cyl" "\\li360 8\\line Cylinder" "\\ul 10 ( 52.6%) \\ul0" "4 ( 30.8%)"
"cyl" "\\li360 6\\line {\\cf10 Cylinder and more perhaps more}" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "\\li360 {\\cf6 4}\\line Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "\\i Here is a italic label \\i0."
# Please double the curly braces otherwise the glue will fail.
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label"), width = .8) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "\\ul Under line \\ul0")) %>%
define(A, label = "\\shad {{\\cf3 Group A}} {common::supsc('2')}\\shad0", align = "center", n = 19) %>%
define(B, label = "\\outl Group B \\outl0", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
report_options(allow_code = TRUE) %>%
page_header(left = "\\strike Strikethrough header \\strike0", right = "Study: Cars") %>%
titles("\\b\\i {{\\highlight7 This is yellow italic highlight}} \\b0\\i0",
"\\fs0\\fs28 {{\\cf2 This is a blue big title}} \\fs18") %>%
add_content(tbl) %>%
footnotes("\\i * Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
# The output should contain bold, italic, strike through, super script,
# sub script, shadow, hollow
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-127b: More RTF codes with \\line code work as expected", {
if (dev) {
fp <- file.path(base_path, "rtf2/test127b.rtf")
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "\\li360 N" "19" "13"
"ampg" "\\li360 Mean" "18.8" "22.0 (4.9)"
"ampg" "\\li360 Median" "16.4{\\sub mm}" "21.4{\\super 2}"
"ampg" "\\li360 {\\cf12 Q1 - Q3}" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "\\li360 Range" "{\\cf2 10.4 - 33.9}" "14.7 - 32.4"
"cyl" "\\li360 8\\line Cylinder" "\\ul 10 ( 52.6%) \\ul0" "4 ( 30.8%)"
"cyl" "\\li360 6\\line {\\cf11 Cylinder and more. \\line When \\line this very long string the body footnote can flow to the next page}" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "\\li0 Sometime this is needed\\line{ }Cylinder" "\\ul\\line 5 ( 26.3%) \\ul0" "\\line 6 ( 46.2%)"')
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders=c("top", "bottom")) |>
stub(c("var", "label"), width = .8) |> # vary the width here to see unpredictable result. width=2.8 looks ok. when 0.8 page footnote overlfow
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = "\\i Here is a italic label \\i0.",
cyl = "\\ul Under line label \\ul0")) |>
define(A, label = "\\shad {{\\cf6 Group A}} {common::supsc('2')}\\shad0", align = "center", n = 19) |>
define(B, label = "\\outl Group B \\outl0", align = "center", n = 13) |>
footnotes("\\i\\fs14 * Italic Small Table Footnote{common::supsc('2')} \\fs18")
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") |>
report_options(allow_code = TRUE, title_block = "paragraph", line_break = FALSE) |>
page_header(left = "\\strike Strikethrough header \\strike0", right = "Study: Cars") |>
titles("{{\\b\\i\\highlight7\\cf2 This is yellow italic highlight}}",
"\\fs0\\fs28 {{\\cf2 This is a blue big title{{\\super{{a}}}}}} \\fs18") |>
add_content(tbl) |>
footnotes("\\i\\fs14\\cf6 * Italic Small \\line\\li207\\fi-207 Report Footnote {{\\ul\\super{common::symbol('alpha')}}} OK \\fs18") |>
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-128: Line break can be turned off by report_options as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test128.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder and more perhaps more" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a label\nwith manual line break."
df$sub_title <- "This is a long page by value which would not be inserted any line break characters."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label"), width = .8) %>%
page_by(sub_title, label = "This is a long label which would make multiple lines:",
bold = "label") %>%
define(sub_title, visible = FALSE) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center") %>%
define(B, label = "Group B", align = "center")
# Create report and add content
# !! Please note that `line_break` in `report_options` would affect:
# 1. All the data content of tables
# 2. All the titles and footnotes in both table objects and report objects
# 3. All page headers and footers
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Arial") %>%
report_options(line_break = FALSE) %>%
page_header(left = "This is a long left header which would not be inserted any line break characters.",
right = "This is a long right header which would not be inserted any line break characters.") %>%
titles("Table 1.0",
paste0("This is a title which is turned off the automatically line breaks",
" so it should not contain any line break characters and it should",
" prevent from overflow because the wrapping lines are turned off.")) %>%
add_content(tbl) %>%
footnotes(paste0("This is a long footnote which would not be inserted any line break characters even though it",
" has multiple lines. There should be no overflow because lines have been counted.")) %>%
page_footer(left = "This is a long left footer which would not be inserted any line break characters.",
center = "This is a long center footer which would not be inserted any line break characters.",
right = "This is a long right footer which would not be inserted any line break characters.")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
# Check if there is only one manual line break "\line"
rtf <- readLines(fp, warn = FALSE)
manual_break_count <- 0
for (r in rtf) {
matches <- gregexpr("\\line", r, fixed = TRUE)
count_result <- ifelse(matches[[1]][1] == -1, 0, length(matches[[1]]))
manual_break_count <- manual_break_count + count_result
}
expect_equal(manual_break_count, 1)
# expect_equal(any(grepl("\\\\line", rtf)), FALSE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-129: Page wrap can be turned off as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test129.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
USUBJID STUDYID DOMAIN SUBJID RFSTDTC RFENDTC RFXSTDTC RFXENDTC RFICDTC
"001" "ABC" "DM" "01" "2021-12-01" "2021-12-20" "2021-12-02" "2021-12-20" "2021-12-01"
"002" "ABC" "DM" "02" "2021-12-02" "2021-12-21" "2021-12-03" "2021-12-21" "2021-12-02"
"003" "ABC" "DM" "03" "2021-12-03" "2021-12-22" "2021-12-04" "2021-12-22" "2021-12-03"
"004" "ABC" "DM" "04" "2021-12-04" "2021-12-23" "2021-12-05" "2021-12-23" "2021-12-04"
"005" "ABC" "DM" "05" "2021-12-05" "2021-12-24" "2021-12-06" "2021-12-24" "2021-12-05"
"006" "ABC" "DM" "06" "2021-12-06" "2021-12-25" "2021-12-07" "2021-12-25" "2021-12-06"
"007" "ABC" "DM" "07" "2021-12-07" "2021-12-26" "2021-12-08" "2021-12-26" "2021-12-07"
"008" "ABC" "DM" "08" "2021-12-08" "2021-12-27" "2021-12-09" "2021-12-27" "2021-12-08"')
# Test that any assigned formats are applied
# attr(df$SUBJID, "width") <- 1
# attr(df$SUBJID, "justify") <- "left"
# attr(df$SUBJID, "format") <- "S:%s"
# Define table
tbl <- create_table(df, page_wrap = FALSE) |>
titles("page_wrap = FALSE in create_table()")
tbl2 <- create_table(df) |>
titles("page_wrap = FALSE in report_options()")
tbl3 <- create_table(df, page_wrap = TRUE)
# Define Report
# !! Please note that when `page_wrap` is set in `create_table`. It'll be the top choice
# even though we set TRUE in `report_options`. Therefore, table 1 doesn't have
# the page wrap, but table 2 have the page wrap.
rpt <- create_report(fp, font = "Arial", font_size = 10, units = "cm",
orientation = "portrait") %>%
report_options(page_wrap = FALSE) %>%
titles("Listing 1.0",
"Demographics Dataset") %>%
add_content(tbl, align = "left") %>%
add_content(tbl2, align = "left") %>%
add_content(tbl3, align = "left") %>%
page_header("Sponsor", "Drug") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]") %>%
footnotes("My footnote")
# If page is wrapped, RFICDTC will be in the next page
# Now page is not wrapped, we can see RFICDTC is out of the margin.
res <- write_report(rpt, output_type = "rtf")
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-130: auto_page can be turned off as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test130.rtf")
dat <- iris[1:100, ]
dat$Species <- as.character(dat$Species)
dat$Species[1:25] <- rep("setosa1", 25)
dat$Species[26:50] <- rep("setosa2", 25)
tbl <- create_table(dat, auto_page = FALSE) %>%
footnotes("First Table with auto_page=FALSE in create_table", "My footnote 2", valign = "bottom") %>%
define(Species, page_break = TRUE)
tbl2 <- create_table(dat) %>%
footnotes("Second Table with auto_page=FALSE in report_options", "My footnote 2", valign = "bottom") %>%
define(Species, page_break = TRUE)
tbl3 <- create_table(dat, auto_page = TRUE) %>%
footnotes("Third Table with auto_page=TRUE in create_table", "My footnote 2", valign = "bottom") %>%
define(Species, page_break = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 10, orientation = "landscape") %>%
report_options(auto_page = FALSE) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
add_content(tbl2) %>%
add_content(tbl3) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
# If auto_page is still TRUE, setosa1 would have 2 pages because only 24 records
# on first page.
expect_equal(file.exists(fp), TRUE)
# Please note that res$pages would be 3 instead of 4 because versicolor is overflow
} else {
expect_equal(TRUE, TRUE)
}
})
# Basic Tests 131-140 ------------------------------------------------------
test_that("rtf2-131: Titles can be output in paragraph for table as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test131.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat) %>%
column_defaults(width = 1) %>%
titles("This is subtitle", align = "left")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "portrait") %>%
report_options(title_block = "paragraph") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table", font_size = 14) %>%
titles("Title in Header", header = TRUE) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", valign = "top") %>% # Works!
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-132: Titles can be output in paragraph for figure as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test132.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8, borders = c("top", "bottom", "all")) %>%
titles("This is subtitle", borders = "none") %>%
footnotes("* Motor Trend, 1974", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size =fsz) %>%
report_options(title_block = "paragraph") %>%
titles("Figure 1.0", "My Nice Figure", font_size = 14) %>%
titles("Title in Header", header = TRUE) %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt) %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-133: Titles can be output in paragraph for text as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test133.rtf")
txt <- create_text(cnt, width = 6, borders = "outside", align = "right") %>%
titles("Text 1.0", "My Nice Text", borders = "none", font_size = 12) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 10) %>%
report_options(title_block = "paragraph") %>%
titles("Text 1.0", "My Nice Text", font_size = 14) %>%
titles("Title in Header", header = TRUE) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
add_content(txt, align = "right") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-134: line_count can be set in report_options as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test134.rtf")
dat <- iris[1:100, ]
tbl <- create_table(dat) %>%
footnotes("line_count setting in report_options()", "My footnote 2", valign = "bottom")
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 10, orientation = "landscape") %>%
report_options(line_count = 18) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "Table with line_count = 18") %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-135: Empty page_by works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test135.rtf")
# Prepare data
dat <- mtcars[order(mtcars$cyl), ]
dat <- data.frame(vehicle = rownames(dat), dat)
dat$cyl[1] <- ""
dat$cyl[2] <- NA
# Define table
tbl <- create_table(dat, show_cols = 1:8) %>%
page_by(cyl, label="Cylinders: ")
# Create the report
rpt <- create_report(fp, output_type = "rtf",
font = "Courier", font_size = 12) %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Listing 3.0", "Empty and NA page_by") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer(left = Sys.time(),
center = "Confidential",
right = "Page [pg] of [tpg]")
# Write the report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-136: Numeric page_by works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test136.rtf")
# Prepare data
dat <- mtcars[order(mtcars$cyl), ]
dat <- data.frame(vehicle = rownames(dat), dat)
dat$cyl[1] <- NA
# Define table
tbl <- create_table(dat, show_cols = 1:8) %>%
page_by(cyl, label="Cylinders: ")
# Create the report
rpt <- create_report(fp, output_type = "rtf",
font = "Courier", font_size = 12) %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Listing 3.0", "Numeric and NA page_by") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer(left = Sys.time(),
center = "Confidential",
right = "Page [pg] of [tpg]")
# Write the report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-137: Multiple dedupe works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test137.rtf")
# Setup
subjid <- c(100,100,101,101,101,102,103,103,104,104)
param <- c(rep("Hemoglobin", 3), rep("Triglycerides", 4), rep("Platelets", 3))
result <- c(41, 53, 43, 39, 47, 52, 21, 38, 62, 26)
Lab <- c(NA, NA, "central", "central", "central", NA, "local", "local", NA, NA)
arm <- c(rep("A", 5), rep("B", 5))
df <- data.frame(subjid, arm, param, Lab, result)
tbl1 <- create_table(df, first_row_blank = FALSE) %>%
define(subjid, label = "Subject", align = "left", dedupe = TRUE) %>%
define(param, label = "Lab Test", dedupe = c("subjid", "param")) %>%
define(result, label = "Result") %>%
define(Lab, visible = FALSE) %>%
define(arm, label = "Arm",
blank_after = TRUE,
dedupe = c("Lab", "arm"),
align = "right")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header(left = "Company", right = c("Study ABC", "Status: Closed")) %>%
titles("Table 1.0", "Multiple Dedupe of subjid, arm, and lab test",
"Lab is non-visible for arm's dedupe", align = "center") %>%
footnotes("Program Name: table1_0.R") %>%
page_footer(left = "Time", center = "Confidential",
right = "Page [pg] of [tpg]") %>%
add_content(tbl1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-138: Courier is displayed as Courier New as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test138.rtf")
txt <- create_text(cnt, width = 6, borders = "outside", align = "right") %>%
titles("Text 1.0", "My Nice Text", borders = "none", font_size = 12) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = "courier",
font_size = 10) %>%
report_options(title_block = "paragraph") %>%
titles("Text 1.0", "My Nice Text", font_size = 14) %>%
titles("Title in Header", header = TRUE) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
add_content(txt, align = "right") %>%
page_footer("Left1", "Center1", "Right1")
# There is no visual difference between Courier and Courier New
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
# Check if there is Courier New
rtf <- readLines(fp, warn = FALSE)
expect_equal(rtf[1],
"{\\rtf1\\ansi\\deff0 {\\fonttbl {\\f0 Courier New;}}")
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-139: Customized small line height works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test139.rtf")
dat <- iris[1:100, ]
dat$row_number <- 1:100
dat <- dat[, c("row_number", "Sepal.Width", "Petal.Length", "Petal.Width", "Species")]
tbl <- create_table(dat) %>%
footnotes("line_height setting in report_options()", "My footnote 2", valign = "bottom") %>%
spanning_header(from = 1, to = 2, label = "First Spanning") %>%
spanning_header(from = 3, to = 5, label = "Second Spanning") %>%
page_by(Species, label = "Page by Label:")
rpt <- create_report(fp, output_type = "rtf", font = "Arial",
font_size = 10, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
# report_options(line_height = 0.12, title_block = "paragraph") %>%
report_options(line_height = 0.12) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "Table with line height adjustment") %>%
# title_header("Table 1.0", "Table with line height adjustment") %>%
add_content(tbl) %>%
page_footer(c("Left1", "Left2"), "Center1", "Right1")
# The text squishing is expected.
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-139b: Customized large line height works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test139b.rtf")
dat <- iris[1:100, ]
dat$row_number <- 1:100
dat <- dat[, c("row_number", "Sepal.Width", "Petal.Length", "Petal.Width", "Species")]
tbl <- create_table(dat) %>%
footnotes("line_height setting in report_options()", "My footnote 2", valign = "bottom") %>%
spanning_header(from = 1, to = 2, label = "First Spanning") %>%
spanning_header(from = 3, to = 5, label = "Second Spanning") %>%
page_by(Species, label = "Page by Label:")
rpt <- create_report(fp, output_type = "rtf", font = "Arial",
font_size = 10, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
report_options(line_height = 0.2) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "Table with line height adjustment") %>%
# title_header("Table 1.0", "Table with line height adjustment") %>%
add_content(tbl) %>%
page_footer(c("Left1", "Left2"), "Center1", "Right1")
# Large line height should not cause overflow.
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-140: Percentage column widths work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test140.rtf")
dat <- iris
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Irises", "Another Title") %>%
define(Sepal.Length, label = "Sepal Length", width = "33.33333%", align = "center") %>%
define(Sepal.Width, label = "Sepal Width", width = "20%", align = "centre") %>%
define(Species, blank_after = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1")) %>%
add_content(tbl, blank_row = "none") %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-140b: Percentage column widths work with 100% as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test140b.rtf")
dat <- iris
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Irises", "Another Title") %>%
define(Sepal.Length, label = "Sepal Length", width = "20.17%", align = "center") %>%
define(Sepal.Width, label = "Sepal Width", width = "20.17%", align = "centre") %>%
define(Petal.Length, label = "Petal Length", width = "20.17%", align = "centre") %>%
define(Petal.Width, label = "Petal.Width", width = "20.17%", align = "centre") %>%
define(Species, width = "19.32%", blank_after = TRUE)
total_width <- round(9*0.2017, 2) * 4 + round(9*0.1932, 2)
# The total width is 9.02, which is greater than 9
# The algorithm needs to prevent from total width exceeding 9
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1")) %>%
add_content(tbl, blank_row = "none") %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-141: Output Chinese as expected.", {
if (dev == TRUE) {
# Read in prepared data
df <- read.table(header = TRUE, text = '
group1 group2 trt1 trt2 subgroup
"性别" "男" "75 (51.7)" "91 (59.5)" "≥65岁"
"性别" "女" "70 (48.3)" "62 (40.5)" "≥65岁"
"年龄" "例数" "145" "153" "≥65岁"
"年龄" "平均数" "64.7" "65.8" "≥65岁"
"年龄" "中位数" "65.0" "66.0" "≥65岁"
"年龄" "标准差" "9.7" "8.3" "≥65岁"
"年龄" "最小值, 最大值" "40, 83" "43.85" "≥65岁"')
df$trt3 <- df$trt1
df$trt4 <- df$trt2
df$trt5 <- df$trt1
df <- rbind(df, df, df, df)
tbl <- create_table(df, borders = "all") %>%
titles("表 14-2.1. 基线人口学特征", "(安全分析集)", borders = "all") %>%
# stub(c("group1", "group2"), width = 1) %>%
stub(c("group1", "group2")) %>%
page_by(subgroup, label = "亚组 - 这是一段很长的字，预计会占两行以上。用来测试空白行的宽度是否需要缩减。切割文字的函數需 修改，分割不需要用空白：",
borders = "all") %>%
define(group1, label_row = T, blank_after = T) %>%
define(group2, indent = 0.25) %>%
define(trt1, label = "试验药物一") %>%
define(trt2, label = "试验药物二") %>%
define(trt3, label = "试验药物三") %>%
define(trt4, label = "试验药物四") %>%
define(trt5, label = "安慰剂") %>%
define(subgroup, visible = FALSE) %>%
spanning_header(from = "trt1", to = "trt3", label = "高试验药物") %>%
spanning_header(from = "trt4", to = "trt5", label = "低试验药物")
font_lst <- c(8, 9, 10, 11, 12)
for (f in font_lst) {
file_name <- paste0("test141_", f, ".rtf")
fp <- file.path(base_path, "rtf2/", file_name)
rpt <- create_report(fp, output_type = "RTF", font = "SimSun",
font_size = f, orientation = "portrait") %>%
set_margins(top = 1, bottom = 1) %>%
# report_options(line_height = 0.175) %>%
page_header("研究123", "分析数据审阅说明") %>%
add_content(tbl, blank_row = "none") %>%
page_footer("左页尾", "中页尾", "第 [pg] 页, 共 [tpg] 页") %>%
footnotes("用于分析目的。其中包括人口统计学、治疗组和人群标帜。",
"受试者水平分析数据集。", borders = "all")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
}
} else
expect_equal(TRUE, TRUE)
})
# User Tests --------------------------------------------------------------
test_that("user1: demo table works.", {
if (dev) {
library(tidyr)
library(dplyr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "rtf2/user1.rtf")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- subset(data_demo, data_demo$ARM != "SCREEN FAILURE")
sex_decode <- c("M" = "Male",
"F" = "Female")
race_decode <- c("WHITE" = "White",
"BLACK OR AFRICAN AMERICAN" = "Black or African American",
"ASIAN" = "Asian or Pacific Islander",
"NATIVE AMERICAN" = "Native American",
"UNKNOWN" = "Unknown")
arm_pop <- table(data_demo$ARM)
demo_age <-
data_demo %>%
group_by(ARM) %>%
summarise(across(.cols = AGE,
.fns = list(N = ~ fmt_n(.),
Mean = ~ fmt_mean_sd(.),
Median = ~ fmt_median(.),
`Q1 - Q3` = ~ fmt_quantile_range(.),
Range = ~ fmt_range(.)
))) %>%
pivot_longer(-ARM,
names_to = c("var", "label"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = ARM,
values_from = "value")
demo_sex <-
data_demo %>%
add_count(ARM, SEX, name = "n_SEX") %>%
select(ARM, SEX, n_SEX) %>%
distinct() %>%
pivot_longer(cols = c(SEX),
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_SEX,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(sex_decode),
labels = sex_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"]))
demo_race <-
data_demo %>%
add_count(ARM, RACE, name = "n_RACE") %>%
select(ARM, RACE, n_RACE) %>%
distinct() %>%
pivot_longer(cols = RACE,
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_RACE,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(race_decode),
labels = race_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"])) %>%
arrange(var, label)
demo <- bind_rows(demo_age, demo_sex, demo_race)
#View(demo)
# Stub decode
block_fmt <- c(AGE = "Age", SEX = "Sex", RACE = "Race")
# Define table
tbl <- create_table(demo, first_row_blank = TRUE, borders = c("outside")) %>%
column_defaults(from = "ARM A", to = "ARM D", width = 1.25) %>%
define(var, blank_after = TRUE, dedupe = TRUE,
format = block_fmt, label = "") %>%
define(label, label = "") %>%
define(`ARM A`, align = "center", label = "Placebo", n = 36) %>%
define(`ARM B`, align = "center", label = "Drug 10mg", n = 38) %>%
define(`ARM C`, align = "center", label = "Drug 20mg", n = 38) %>%
define(`ARM D`, align = "center", label = "Competitor", n = 38)
# Define Report
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
set_margins(top = 1, bottom = 1) %>%
options_fixed(font_size = 10) %>%
titles("Table 14.1/4",
"Demographics and Baseline to Characteristics",
"Specify Population Ω µ β ¥ ∑ ≠ ≤ £ ∞ ؈ ლ \Ub8a 鬼") %>%
add_content(tbl) %>%
footnotes("Special symbols \U221e to mess things up: Ω µ β ¥ ∑ ≠ ≤ £ ∞ ؈ ლ \Ub8a 鬼 标题") %>%
footnotes("Special symbols µ Ω £ there to mess things up: ", "Page [pg] of [tpg]",
align = 'right', italics = TRUE) %>%
page_header("Left µ Ω £ ", "Right") %>%
page_footer("Time µ Ω £ ", right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user2: demo table with stub works.", {
if (dev) {
library(tidyr)
library(dplyr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "rtf2/user2.rtf")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- subset(data_demo, data_demo$ARM != "SCREEN FAILURE")
sex_decode <- c("M" = "Male",
"F" = "Female")
race_decode <- c("WHITE" = "White more",
"BLACK OR AFRICAN AMERICAN" = "Black or African American",
"ASIAN" = "Asian or Pacific Islander",
"NATIVE AMERICAN" = "Native American",
"UNKNOWN" = "Unknown")
arm_pop <- table(data_demo$ARM)
demo_age <-
data_demo %>%
group_by(ARM) %>%
summarise(across(.cols = AGE,
.fns = list(N = ~ fmt_n(.),
Mean = ~ fmt_mean_sd(.),
Median = ~ fmt_median(.),
`Q1 - Q3` = ~ fmt_quantile_range(.),
Range = ~ fmt_range(.)
))) %>%
pivot_longer(-ARM,
names_to = c("var", "label"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = ARM,
values_from = "value")
demo_sex <-
data_demo %>%
add_count(ARM, SEX, name = "n_SEX") %>%
select(ARM, SEX, n_SEX) %>%
distinct() %>%
pivot_longer(cols = c(SEX),
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_SEX,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(sex_decode),
labels = sex_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"]))
demo_race <-
data_demo %>%
add_count(ARM, RACE, name = "n_RACE") %>%
select(ARM, RACE, n_RACE) %>%
distinct() %>%
pivot_longer(cols = RACE,
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_RACE,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(race_decode),
labels = race_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"])) %>%
arrange(var, label)
demo <- bind_rows(demo_age, demo_sex, demo_race)
#View(demo)
# Stub decode
block_fmt <- c(AGE = "Age", SEX = "Sex", RACE2 = "Race")
# Define table
tbl <- create_table(demo, first_row_blank = TRUE, borders = "all") %>%
stub(c("var", "label"), width = 1.5) %>%
column_defaults(width = 1) %>%
define(var, blank_after = TRUE, blank_before = TRUE,
format = block_fmt, label = "", label_row = TRUE) %>%
define(label, label = "", indent = .25) %>%
define(`ARM A`, align = "center", label = "Placebo", n = 36) %>%
define(`ARM B`, align = "center", label = "Drug 10mg", n = 38) %>%
define(`ARM C`, align = "center", label = "Drug 20mg", n = 38) %>%
define(`ARM D`, align = "center", label = "Competitor", n = 38) %>%
titles("Table 14.1/4",
"Demographics and Baseline Characteristics",
"Specify Population", borders = "outside", blank_row = "both",
align = "right") %>%
footnotes("Here is a footnote", "Here is another footnote",
borders = "outside", blank_row = "both", align = "right")
# Define Report
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", font_size = 10) %>%
add_content(tbl, align = "right") %>%
page_header("Sponsor", "Drug") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]") #%>%
#page_by(var = "var", label = "Variable: ")
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user3: listings works.", {
if (dev == TRUE) {
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "rtf2/user3.rtf")
# Removing to make last page exactly equal to available rows on page.
# In this case, any added blank rows should be skipped.
fil <- c("ABC-14-124",
"ABC-15-153",
"ABC-15-154",
"ABC-15-155",
"ABC-15-156",
"ABC-16-045",
"ABC-16-046",
"ABC-16-047",
"ABC-16-157",
"ABC-16-158",
"ABC-16-159",
"ABC-16-160")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- data_demo[!data_demo$USUBJID %in% fil, ]
# Test that any assigned formats are applied
attr(data_demo$SUBJID, "width") <- 1
attr(data_demo$SUBJID, "justify") <- "left"
attr(data_demo$SUBJID, "format") <- "S:%s"
#print(widths(data_demo))
names(data_demo)
# Define table
tbl <- create_table(data_demo) %>%
define(USUBJID, id_var = TRUE)
# Define Report
rpt <- create_report(fp, font = "Times", font_size = 8,
orientation = "landscape") %>%
titles("Listing 1.0",
"Demographics Dataset") %>%
add_content(tbl, align = "left") %>%
page_header("Sponsor", "Drug") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]") %>%
footnotes("My footnotes")
#Write out report
res <- write_report(rpt, output_type = "RTF")
expect_equal(file.exists(fp), TRUE)
# pdfpth <- file.path(base_path, "user/user3.pdf")
# write_report(rpt, pdfpth, output_type = "PDF")
# expect_equal(file.exists(pdfpth), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user4: listing in cm and times works.", {
if (dev == TRUE) {
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "rtf2/user4.rtf")
# Removing to make last page exactly equal to available rows on page.
# In this case, any added blank rows should be skipped.
fil <- c("ABC-14-124",
"ABC-15-153",
"ABC-15-154",
"ABC-15-155",
"ABC-15-156",
"ABC-16-045",
"ABC-16-046",
"ABC-16-047",
"ABC-16-157",
"ABC-16-158",
"ABC-16-159",
"ABC-16-160")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- data_demo[!data_demo$USUBJID %in% fil, ]
# Test that any assigned formats are applied
attr(data_demo$SUBJID, "width") <- 2.54
attr(data_demo$SUBJID, "justify") <- "left"
attr(data_demo$SUBJID, "format") <- "S:%s"
#print(widths(data_demo))
# Define table
tbl <- create_table(data_demo) %>%
define(USUBJID, id_var = TRUE)
# Define Report
rpt <- create_report(fp, font = "Arial", font_size = 10, units = "cm",
orientation = "portrait") %>%
titles("Listing 1.0",
"Demographics Dataset") %>%
add_content(tbl, align = "left") %>%
page_header("Sponsor", "Drug") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]") %>%
footnotes("My footnote")
#Write out report
res <- write_report(rpt, output_type = "RTF")
#print(res$column_widths)
expect_equal(file.exists(fp), TRUE)
# pdfpth <- file.path(base_path, "user/user3.pdf")
# write_report(rpt, pdfpth, output_type = "PDF")
# expect_equal(file.exists(pdfpth), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user5: Portrait in 12pt Arial works as expected.", {
if (dev == TRUE) {
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "rtf2/user5.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
define(var, label = "Variable", blank_after = TRUE, dedupe = TRUE,
format = c(ampg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, label = "") %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Arial", font_size = 12) %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user6: Borders with spanning headers work as expected.", {
if (dev == TRUE) {
df <- read.table(header = TRUE, text = '
var label A B C
"AGE" "n" "19" "13" "32"
"AGE" "Mean" "18.8 (6.5)" "22.0 (4.9)" "20.0 (5.9)"
"AGE" "Median" "16.4" "21.4" "20.1"
"AGE" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8" "15.2 - 21.8"
"RACE" "White" "10 (52.6)" "4 (30.8)" "14 (43.8)"
"RACE" "Black" "4 (21.1)" "3 (23.1)" "7 (21.9)"
"RACE" "Others\U1D47" "5 (26.3)" "6 (46.2)" "11 (34.4.2)"
')
var_fmt <- c(AGE = "Age (yrs)", RACE = "Race - n (%)")
fp <- file.path(base_path, "rtf2/user6.rtf")
tbl <- create_table(df, first_row_blank = TRUE, borders = c("outside")) %>%
stub(vars = c("var", "label"), " ", width = 2.5) %>%
spanning_header(from = "A", to = "B", label = "Treatments\U1D43") %>%
define(var, blank_after = TRUE, format = var_fmt, label_row = TRUE) %>%
define(label, indent=0.25) %>%
define(A, align = "center", label = "Placebo\n(N = 19)") %>%
define(B, align = "center", label = "Drug\n(N = 13)") %>%
define(C, align = "center", label = "Total\n(N = 32)") %>%
footnotes("\U1D43 study drug", blank_row="none" ) %>%
footnotes("\U1D47 Asian, Japanese and Chinese", blank_row="none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer(left = paste("Date:", "Left"), right = "Page [pg] of [tpg]", blank_row="none") %>%
footnotes("Program: C:/Users/Home/AppData/Local/Temp/tdemo.R", blank_row="above")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
# file.show(fp)
} else
expect_equal(TRUE, TRUE)
})
# This is good
test_that("user7: Check footnotes on page by.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/user7")
df <- read.table(header = TRUE, text = '
var stat A B
"Age (yrs)" "n" "19" "13"
" " "Mean" "18.8 (6.5)" "22.0 (4.9)"
" " "Median" "16.4" "21.4"
" " "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
" " " " " " " "
"Race" "White" "10 ( 52.6%)" "4 ( 30.8%)"
" " "Black" "4 ( 21.1%)" "3 ( 23.1%)"
" " "Others\U1D47" "5 ( 26.3%)" "6 ( 46.2%)"')
df1 <- df
df2 <- df
df3 <- df
df1$SEX <- 'Female'
df2$SEX <- 'Male'
df3$SEX <- 'Other'
df <- rbind(df1, df2, df3)
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders=c("top")) %>%
page_by(SEX, "Sex: ", align = "left", blank_row="none") %>%
# stub(c("var", "label")) %>%
column_defaults(width = 1.25) %>%
spanning_header(from = "A", to = "B", label = "Treatments\U1D43") %>%
define(SEX, visible = FALSE) %>%
define(var, label = " ", align = "left") %>%
define(stat,label = " ", align = "left") %>%
define(A, label = "Treament A", align = "center", n = 19) %>%
define(B, label = "Treament B", align = "center", n = 13) %>%
titles("Table 1.1 Demographics", "Randomised Population", font_size = 10) %>%
footnotes("Page [pg] of [tpg]", align = "right", blank_row="none", borders=c("top")) %>%
footnotes("\U1D43 study drug treatments", blank_row="none", borders=c("top") ) %>%
footnotes("\U1D47 Asian, Japanese and Chinese", blank_row="none", borders="bottom")
rpt <- create_report(fp, output_type = "RTF", font = "Arial", font_size = 10) %>%
#This is page header and it goes into the header of the table
page_header("Protocol: 9999") %>%
add_content(tbl) %>%
page_footer(left = paste("Date:", "Left"), right = "Page [pg] of [tpg]", blank_row="none") %>%
footnotes("Program: C:/Users/Home/AppData/Local/Temp/tdemo.R", blank_row="above", valign = "bottom")
res <- write_report(rpt)
expect_equal(file.exists(res$modified_path), TRUE)
expect_equal(res$pages, 3)
} else
expect_equal(TRUE, TRUE)
})
Try the reporter package in your browser
Any scripts or data that you put into this service are public.
reporter documentation built on Sept. 12, 2026, 5:09 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
context("RTF2 Tests")
base_path <- paste0(getwd(),"/tests/testthat")
data_dir <- base_path
base_path <- tempdir()
data_dir <- "."
cnt <- paste0("Lorem ipsum dolor sit amet, consectetur adipiscing elit, ",
"sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. ",
"Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris ",
"nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in ",
"reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla ",
"pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa ",
"qui officia deserunt mollit anim id est laborum.")
fnt <- "Arial"
fsz <- 10
dev <- FALSE
# Basic Tests 1 - 10 ------------------------------------------------------
test_that("rtf2-0a: Fixed report is correct.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test0a.rtf")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
titles("Table 0.0", "Baseline Characteristics") %>%
add_content(create_table(mtcars[1:10, ]))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-0b: Fixed report with font_size is correct.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test0b.rtf")
rpt <- create_report(fp, output_type = "RTF", font = "fixed",
font_size = 12) %>%
titles("Table 0.0", "Baseline Characteristics") %>%
add_content(create_table(mtcars[1:10, ]))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-0c: Fixed report with font_size options is correct.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test0c.rtf")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
options_fixed(font_size = 12) %>%
titles("Table 0.0", "Baseline Characteristics") %>%
add_content(create_table(mtcars[1:10, ]))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-0d: Fixed report with conflicting font size is correct.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test0d.rtf")
rpt <- create_report(fp, output_type = "RTF", font = "fixed",
font_size = 8) %>%
options_fixed(font_size = 12) %>%
titles("Table 0.0", "Baseline Characteristics") %>%
add_content(create_table(mtcars[1:10, ]))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-1: One page text spec works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test1.rtf")
txt <- create_text(cnt, width = 6, borders = "outside", align = "right") %>%
titles("Text 1.0", "My Nice Text", borders = "outside", font_size = 12) %>%
footnotes("My footnote 1", "My footnote 2", borders = "outside")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 10) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
add_content(txt, align = "right") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-2: Two page text spec works as expected in 12pt font.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test2.rtf")
cnttxt <- paste(rep(cnt, 12), collapse = "")
txt <- create_text(cnttxt) %>%
titles("Text 1.0", "My Nice Text")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
add_content(txt) %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-3: Three page text spec increased margins works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test3.rtf")
cnttxt <- paste(rep(cnt, 15), collapse = "")
txt <- create_text(cnttxt) %>%
titles("Text 1.0", "My Nice Text") %>%
footnotes("My footnote 1", "My footnote 2")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
set_margins(top = 2, bottom = 2) %>%
page_header("Left", c("Right1", "Right2")) %>%
add_content(txt) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-4: Two page text spec works as expected in 10pt font.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test4.rtf")
cnttxt <- paste(rep(cnt, 12), collapse = "")
txt <- create_text(cnttxt)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 10) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
add_content(txt) %>%
page_footer("Left1", "Center1", "Right1") %>%
titles("Text 1.0", "My Nice Text") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-5: Two page text spec works as expected in 8pt font.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test5.rtf")
cnttxt <- paste(rep(cnt, 20), collapse = "")
txt <- create_text(cnttxt)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 8) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
add_content(txt) %>%
page_footer("Left1", "Center1", "Right1") %>%
titles("Text 1.0", "My Nice Text") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-6: One page table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test6.rtf")
dat <- mtcars[1:15, ]
attr(dat[[2]], "label") <- "Cylin."
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table", borders = "outside", bold = TRUE) %>%
add_content(create_table(dat, borders = "outside")) %>%
footnotes("My footnote 1", "My footnote 2", borders = "outside") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-7: Multi page table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test7.rtf")
dat <- iris
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Irises", "Another Title") %>%
define(Sepal.Length, label = "Sepal Length", width = 1, align = "center") %>%
define(Sepal.Width, label = "Sepal Width", width = 1, align = "centre") %>%
define(Species, blank_after = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1")) %>%
add_content(tbl, blank_row = "none") %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 7)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-8: Portrait table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test8.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 10, orientation = "portrait") %>%
# set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 11)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-9: Wide table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test9.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat) %>%
column_defaults(width = 1)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "portrait") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", valign = "top") %>% # Works!
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-10: Preview works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test10.rtf")
dat <- iris
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Irises", "Another Title") %>%
footnotes("My footnote 1", "My footnote 2")
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1")) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt, preview = 2)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
# Basic Tests 11 - 20 ------------------------------------------------------
# This is awesome. Shows cell wrapping, page break, and valign
# Very good for testing.
test_that("rtf2-11: Forced page wrap works as expected.", {
fp <- file.path(base_path, "rtf2/test11.rtf")
dat <- data.frame(labels = rownames(mtcars), mtcars)
tbl <- create_table(dat, borders = "all") %>%
titles("Table 1.0", "My Nice Irises", "Another Title") %>%
footnotes("My footnote 1", "My footnote 2", valign = "bottom") %>%
define(labels, id_var = TRUE) %>%
define(wt, page_wrap = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1")) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
})
test_that("rtf2-12: Table Borders work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test12.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c("left", "right", "bottom", "top")) %>%
define(mpg, label = "Miles Per Gallon")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 11)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
# Nice.
test_that("rtf2-13: Spanning headers work as expected.", {
fp <- file.path(base_path, "rtf2/test13.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c("top", "bottom")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = FALSE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(drat, gear, "Super Duper\nWrapped Span", n = 11, level = 2)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-14: Labels and show_cols work as expected.", {
fp <- file.path(base_path, "rtf2/test14.rtf")
dat <- mtcars[1:15, ]
attr(dat$mpg, "label") <- "Miles Per Gallon"
attr(dat$cyl, "label") <- "Cylinders"
tbl <- create_table(dat, show_cols = c("mpg", "hp", "cyl", "disp", "drat")) %>%
define(mpg, width = 1.25) %>%
define(disp, label = "Displacement")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-15: Valign on report footnotes works as expected.", {
fp <- file.path(base_path, "rtf2/test15.rtf")
dat <- iris[1:100, ]
tbl <- create_table(dat) %>%
define(Species, page_break = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 9, orientation = "portrait") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", valign = "top") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
expect_equal(length(res$column_widths[[1]]), 5)
class(dat$Species)
})
# Works
test_that("rtf2-16: Valign on table footnotes works as expected.", {
fp <- file.path(base_path, "rtf2/test16.rtf")
dat <- iris[1:100, ]
tbl <- create_table(dat) %>%
footnotes("My footnote 1", "My footnote 2", valign = "bottom") %>%
define(Species, page_break = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 10, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 6)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-17: Title header on table works as expected.", {
fp <- file.path(base_path, "rtf2/test17.rtf")
dat <- iris[1:25, ]
tbl <- create_table(dat, width = 8.9) %>%
title_header("Table 1.0", "My Nice Table",
right = c("Right1",
"Right2", "Page [pg] of [tpg]")) %>%
footnotes("My footnote 1", "My footnote 2") #%>%
#define(Petal.Length, page_wrap = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 10, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-18: Title header on report works as expected.", {
fp <- file.path(base_path, "rtf2/test18.rtf")
dat <- iris[1:50, ]
tbl <- create_table(dat)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]") %>%
title_header("Table 1.0", "My Nice Table", right = c("Page [pg] of [tpg]",
"Right2", "Right3")) %>%
footnotes("My footnote 1", "My footnote 2", valign = "bottom")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-19: Title and Footnote borders work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test19.rtf")
dat <- iris[1:20, ]
tbl <- create_table(dat, borders = "all") %>%
titles("Table 1.0", "My Nice Report with Borders",
borders = c("top", "bottom", "left", "right"),
blank_row = "both") %>%
footnotes("My footnote 1", "My footnote 2", valign = "top",
borders = c("top", "bottom", "left", "right"),
blank_row = "both")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 5)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-20: Title Header borders work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test20.rtf")
dat <- iris[1:25, ]
tbl <- create_table(dat, borders = "all") %>%
title_header("Table 1.0", "My Nice Report with Borders",
right = c("Right1", "Right2", "Right3"),
borders = c("outside"),
blank_row = "both") %>%
footnotes("My footnote 1", "My footnote 2", valign = "top",
borders = c("top", "bottom", "left", "right"),
blank_row = "both")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
expect_equal(length(res$column_widths[[1]]), 5)
} else
expect_equal(TRUE, TRUE)
})
# Basic Tests 21 - 30 ------------------------------------------------------
# Works unless drat column is too narrow and spanning label wraps unexpectedly
test_that("rtf2-21: Page wrap with spanning header works as expected.", {
fp <- file.path(base_path, "rtf2/test21.rtf")
df <- data.frame(vehicle = rownames(mtcars), mtcars, stringsAsFactors = FALSE)
rownames(df) = NULL
tbl <- create_table(df) %>%
spanning_header(2, 5,
label = "Span 1", label_align = "center", n = 10) %>%
spanning_header(6, 8,
label = "Span 2", label_align = "center", n = 10) %>%
spanning_header(9, 12,
label = "Span 3", label_align = "center", n = 10) %>%
spanning_header(6, 12, label = "Super Span",
label_align = "center",
level = 2) %>%
define(vehicle, label = "Vehicle", id_var = TRUE) %>%
define(mpg, format = "%.1f") %>%
define(drat, width = 1) %>%
define(wt, page_wrap = TRUE) %>%
define(vs, page_wrap = TRUE)
rpt <- create_report(fp, output_type = "RTF",
orientation = "portrait", font = fnt) %>%
add_content(tbl) %>%
titles("Table 1.0", "MTCARS Subset Test") %>%
footnotes("My footnote") %>%
page_header("Left") %>%
page_footer("Left", right = "Right")
#print(rpt)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 3)
})
# This is a good one for testing height calculations. Looks good for now.
test_that("rtf2-22: Page by works as expected.", {
fp <- file.path(base_path, "rtf2/test22.rtf")
dat <- iris
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Report with a Page By", borders = "none") %>%
page_by(Species, label = "Species: ", align = "right", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_header("Left", "Right") %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 6)
expect_equal(length(res$column_widths[[1]]), 5)
})
# Works!
test_that("rtf2-23: Two contents on one page works as expected.", {
fp <- file.path(base_path, "rtf2/test23.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat) %>%
titles("Table 1.0", "My Nice Table") %>%
footnotes("My footnote 1", "My footnote 2")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
add_content(tbl, page_break = FALSE, blank_row = "below") %>%
add_content(create_text(cnt, width = 5), align = "center") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
# Working.
test_that("rtf2-24: Two tables one headerless works as expected.", {
fp <- file.path(base_path, "rtf2/test24.rtf")
dat <- mtcars
dat2 <- mtcars[16:20, ]
tbl <- create_table(dat) %>%
titles("Table 1.0", "My Nice Table") %>%
column_defaults(width = .5)
tbl2 <- create_table(dat2, headerless = TRUE) %>%
column_defaults(width = .5)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
add_content(tbl, page_break = FALSE, blank_row = "none") %>%
add_content(tbl2, align = "center") %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
})
# Works!
test_that("rtf2-25: Simplest RTF Plot works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test25.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8, borders = c("top", "bottom", "all")) %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", borders = "none") %>%
footnotes("* Motor Trend, 1974", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size =fsz) %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt, align = "right") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-26: RTF Table with Plot on same page works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test26.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8)
tbl <- create_table(mtcars[1:3, ])
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", blank_row = "none") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt, page_break = FALSE, blank_row = "none") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-27: Plot with page by on plot works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test27.rtf")
fmt <- value(condition(x == 4, "4 Cylinder"),
condition(x == 6, "6 Cylinder"),
condition(x == 8, "8 Cylinder"))
dat <- mtcars[order(mtcars$cyl), ]
p <- ggplot(dat, aes(x=disp, y=mpg)) + geom_point()
#dats <- split(p$data, p$data$grp)
#tbl <- create_table(dat[1:3, ])
plt <- create_plot(p, height = 4, width = 8) %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", blank_row = "none") %>%
page_by(cyl, "Cylinders: ", format = fmt) %>%
footnotes("* Motor Trend, 1974")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt) %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 3)
})
test_that("rtf2-28: Plot with page by on report works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test28.rtf")
dat <- mtcars[order(mtcars$cyl), ]
p <- ggplot(dat, aes(x=disp, y=mpg)) + geom_point()
#dats <- split(p$data, p$data$grp)
#tbl <- create_table(dat[1:3, ])
plt <- create_plot(p, height = 4, width = 8)
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot",
blank_row = "none", borders = "none") %>%
set_margins(top = 1, bottom = 1) %>%
page_by(cyl, "Cylinders: ") %>%
add_content(plt) %>%
footnotes("* Motor Trend, 1974", borders = "none") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 3)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-29: Simplest RTF Plot with valign top works as expected.", {
if (dev) {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test29.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8)
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt, align = "center") %>%
footnotes("* Motor Trend, 1974", valign = "top") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-30: Simplest RTF Plot with valign bottom works as expected.", {
if (dev) {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test30.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8) %>%
footnotes("* Motor Trend, 1974", valign = "bottom")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt, align = "center") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
# Basic Tests 31 - 40 ------------------------------------------------------
test_that("rtf2-31: Simplest RTF Text with valign top works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test31.rtf")
txt <- create_text(cnt, width = 6, borders = "outside")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
titles("Text 1.0", "MTCARS Miles per Cylinder Text", borders = "outside") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(txt, align = "center") %>%
footnotes("* Motor Trend, 1974", valign = "top", borders = "outside") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-32: Simplest RTF Text with valign bottom works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test32.rtf")
txt <- create_text(cnt, width = 6) %>%
footnotes("* Motor Trend, 1974", valign = "bottom")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(txt, align = "center") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-33: Table with long cell and label values wraps as expected.", {
fp <- file.path(base_path, "rtf2/test33.rtf")
# Setup
arm <- c(rep("A", 5), rep("B", 5))
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa \nand more and more", "Schaffer, Ashley", "Laner, Tahma",
"Perry, Sean", "Crews, Deshawn Joseph", "Person, Ladon",
"Smith, Shaileigh")
sex <- c("M", "F", "F", "M", "M", "F", "M", "F", "F", "M")
age <- c(41, 53, 43, 39, 47, 52, 21, 38, 62, 26)
# Create data frame
df <- data.frame(arm, subjid, name, sex, age, stringsAsFactors = FALSE)
tbl1 <- create_table(df, first_row_blank = TRUE) %>%
define(subjid, label = "Subject ID for a patient", n = 10, align = "left",
width = 1) %>%
define(name, label = "Subject Name", width = 1) %>%
define(sex, label = "Sex", n = 10, align = "center") %>%
define(age, label = "Age", n = 10) %>%
define(arm, label = "Arm",
blank_after = TRUE,
dedupe = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
titles("Table 1.0", align = "center") %>%
add_content(tbl1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
# Works on all combinations on font and font size. Needed adjustments to row height.
test_that("rtf2-34: Table with break between sections works as expected.", {
fp <- file.path(base_path, "rtf2/test34.rtf")
# Setup
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa", "Schaffer, Ashley", "Laner, Tahma",
"Perry, Sean", "Crews, Deshawn Joseph", "Person, Ladon",
"Smith, Shaileigh")
sex <- c("M", "F", "F", "M", "M", "F", "M", "F", "F", "M")
age <- c(41, 53, 43, 39, 47, 52, 21, 38, 62, 26)
arm <- c(rep("A", 5), rep("B", 5))
# Create data frame
df <- data.frame(subjid, name, sex, age, arm)
tbl1 <- create_table(df, first_row_blank = FALSE) %>%
define(subjid, label = "Subject ID", align = "left", width = 1) %>%
define(name, label = "Subject Name", width = 1) %>%
define(sex, label = "Sex") %>%
define(age, label = "Age") %>%
define(arm, label = "Arm",
blank_after = FALSE,
dedupe = TRUE,
align = "right") #%>%
# spanning_header(sex, arm, label = "Here is a spanning header")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header(left = "Experis", right = c("Study ABC", "Status: Closed")) %>%
# options_fixed(line_count = 46) %>%
titles("Table 1.0", "Analysis Data Subject Listing\n And more stuff",
"Safety Population", align = "center") %>%
footnotes("Program Name: table1_0.R",
"Here is a big long footnote that is going to wrap\n at least once") %>%
page_footer(left = "Time", center = "Confidential",
right = "Page [pg] of [tpg]") %>%
add_content(tbl1)
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-35: Title Header and page header/footer wrapping work as expected.", {
fp <- file.path(base_path, "rtf2/test35.rtf")
dat <- iris[1:10, ]
tbl <- create_table(dat, borders = "none") %>%
title_header("Table 1.0", "My Nice Report with Borders",
right = c("Right1", "Right2",
"Right3 long enough to wrap around at least once"),
borders = "none",
blank_row = "none") %>%
footnotes("My footnote 1", "My footnote 2", valign = "bottom",
borders = "none",
blank_row = "above")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_header(c("Left1", "Left2\nwrap"), "Right 1") %>%
page_footer("Left1",
"Center1 here is a whole bunch of stuff to try and make it wrap",
"Right1\nwrap\n and wrap again")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-36: Title and Footnote widths work as expected on table.", {
fp <- file.path(base_path, "rtf2/test36.rtf")
dat <- iris[1:20, ]
tbl <- create_table(dat) %>%
titles("Table 1.0", "My Nice Report with Widths",
width = "page") %>%
footnotes("My footnote 1", "My footnote 2", valign = "top",
width = "page")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-37: Title and Footnote widths work as expected on report", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test37.rtf")
dat <- iris[1:20, ]
tbl <- create_table(dat, borders = "all")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1") %>%
titles("Table 1.0", "My Nice Report with Widths",
borders = c("top", "bottom", "left", "right"),
width = 7) %>%
footnotes("My footnote 1", "My footnote 2", valign = "top",
borders = c("top", "bottom", "left", "right"),
width = 7)
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 5)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-38: Title and Footnote specific widths work as expected.", {
fp <- file.path(base_path, "rtf2/test38.rtf")
dat <- iris[1:20, ]
tbl <- create_table(dat, borders = "all") %>%
titles("Table 1.0", "My Nice Report with Borders",
borders = c("top", "bottom", "left", "right"),
width = 7) %>%
footnotes("My footnote 1", "My footnote 2", valign = "top",
borders = c("top", "bottom", "left", "right"),
width = 7)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-39: One page table works as expected in centimeters and times.", {
fp <- file.path(base_path, "rtf2/test39.rtf")
dat <- mtcars[1:15, ]
attr(dat[[2]], "label") <- "Cylin."
rpt <- create_report(fp, output_type = "RTF", font = "Times",
font_size = fsz, orientation = "landscape",
units = "cm") %>%
set_margins(top = 3, bottom = 3) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(create_table(dat)) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-40: One page table works as expected in courier.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test40.rtf")
dat <- mtcars[1:15, ]
attr(dat[[2]], "label") <- "Cylin."
rpt <- create_report(fp, output_type = "RTF", font = "Courier",
font_size = fsz, orientation = "landscape",
units = "cm") %>%
set_margins(top = 3, bottom = 3) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(create_table(dat)) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
# Basic Tests 41 - 50 ------------------------------------------------------
# Good for testing borders and spacing are working correctly
test_that("rtf2-41: Page by with borders works as expected.", {
fp <- file.path(base_path, "rtf2/test41.rtf")
dat <- iris
brdrs <- "outside"
tbl <- create_table(dat, borders = "all") %>%
titles("Table 1.0", "My Nice Report with a Page By", borders = brdrs) %>%
page_by(Species, label = "Species: ", align = "left", borders = brdrs,
blank_row = "below") %>%
footnotes("My footnote 1", "My footnote 2", borders = brdrs)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 9)
expect_equal(length(res$column_widths[[1]]), 5)
})
# Test for borders and page wraps
test_that("rtf2-42: Long table with borders and footnotes on report.", {
fp <- file.path(base_path, "rtf2/test42.rtf")
dat <- data.frame(labels = rownames(mtcars), mtcars)
tbl <- create_table(dat, borders = "all") %>%
define(labels, id_var = TRUE) %>%
define(wt, page_wrap = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1")) %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]") %>%
titles("Table 1.0", "My Nice Irises", "Another Title") %>%
footnotes("My footnote 1", "My footnote 2", valign = "bottom")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
})
test_that("rtf2-43: use_attributes parameter table works as expected.", {
if (dev == TRUE) {
fp1 <- file.path(base_path, "rtf2/test43a.rtf")
fp2 <- file.path(base_path, "rtf2/test43b.rtf")
fp3 <- file.path(base_path, "rtf2/test43c.rtf")
dat <- mtcars[1:10, ]
attr(dat$mpg, "label") <- "Miles per gallon"
attr(dat$cyl, "format") <- "%.1f"
attr(dat$hp, "width") <- 2
fattr(dat$vs) <- list(width = 2, justify = "center")
tbl <- create_table(dat)
# Test default
rpt <- create_report(fp1, output_type = "RTF", font = fnt) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp1), TRUE)
expect_equal(res$pages, 1)
# Test none
tbl <- create_table(dat, use_attributes = "none")
rpt <- create_report(fp2, output_type = "RTF", font = fnt) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp2), TRUE)
# Test some
tbl <- create_table(dat, use_attributes = c("format", "width"))
rpt <- create_report(fp3, output_type = "RTF", font = fnt) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp3), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-45: Title bold and font size works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test45.rtf")
dat <- mtcars[1:15, ]
attr(dat[[2]], "label") <- "Cylin."
attr(dat[[2]], "width") <- 1
attr(dat[[2]], "justify") <- "center"
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Table", borders = c("none"),
width = "content", font_size = 14, bold = TRUE) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none",
align = "left", width = "content") %>%
define(wt, width = 1, label = "Weight", align = "center",
label_align = "right")
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 9, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"),
blank_row = "below") %>%
add_content(tbl, align = "center") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-46: 9 pt font inches works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test46.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 9,
font = "Courier",
orientation = "portrait") %>%
page_header("left", "right") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris)) %>%
page_footer("left", "center", "Page [pg] of [tpg]") %>%
set_margins(top = 1, bottom = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-47: 9 pt font cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test47.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 9,
font = "Courier",
orientation = "portrait",
units = "cm") %>%
page_header("left", "right") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris)) %>%
page_footer("left", "center", "Page [pg] of [tpg]") %>%
set_margins(top = 1, bottom = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-48: 11 pt font inches works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test48.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 11,
font = "Courier",
orientation = "portrait") %>%
page_header("left", "right") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris)) %>%
page_footer("left", "center", "Page [pg] of [tpg]") %>%
set_margins(top = 1, bottom = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-49: 11 pt font cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test49.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 11,
font = "Courier",
orientation = "portrait",
units = "cm") %>%
page_header("left", "right") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris)) %>%
page_footer("left", "center", "Page [pg] of [tpg]") %>%
set_margins(top = 1, bottom = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-50: Spanning headers borders work as expected.", {
fp <- file.path(base_path, "rtf2/test50.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c("outside")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = FALSE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(drat, gear, "Super Duper\nWrapped Span", n = 11, level = 2) %>%
titles("Table 1.0", "My Nice Table", borders = "outside") %>%
footnotes("My footnote 1", "My footnote 2", borders = "outside")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl)
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
# Basic Tests 51-60 -------------------------------------------------------
test_that("rtf2-51: RTF Image file works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test51.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
pltpath <- file.path(base_path, "rtf2/test51.jpg")
ggsave(pltpath, width = 8, height = 4,
units = "in",
dpi = 300)
plt <- create_plot(pltpath, height = 4, width = 8)
rpt <- create_report(fp, output_type = "RTF", font = "Arial") %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt, align = "center") %>%
footnotes("* Motor Trend, 1974") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-52: Table with break between sections works as expected.", {
fp <- file.path(base_path, "rtf2/test52.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "\\fi-87\\li267 N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-53: Text with line feed works as expected.", {
fp <- file.path(base_path, "rtf2/test53.rtf")
cnt2 <- paste0("Hello here \nis something ", cnt)
txt <- create_text(cnt2) %>%
titles("Report 1.0", "Simple Text Report") %>%
footnotes("My footnote")
rpt <- create_report(fp, orientation = "portrait",
output_type = "RTF", font = "Arial") %>%
add_content(txt)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-54: Header_bold works as expected", {
dat <- mtcars[1:10, 1:3]
fp <- file.path(base_path, "rtf2/test54.rtf")
tbl <- create_table(dat, header_bold = TRUE, borders = "all") %>%
column_defaults(width = 1) %>%
titles("Report 1.0", "Simple Report", borders = "outside",
blank_row = "none", bold = TRUE) %>%
footnotes("My footnote", blank_row = "none")
rpt <- create_report(fp, orientation = "portrait",
output_type = "RTF", font = "Arial") %>%
add_content(tbl) %>%
set_margins(top = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-55: Titles and footnotes in header and footer works as expected", {
dat <- mtcars[1:10, 1:3]
fp <- file.path(base_path, "rtf2/test55.rtf")
tbl <- create_table(dat) %>%
column_defaults(width = 1)
rpt <- create_report(fp, orientation = "landscape",
output_type = "RTF", font = "Arial") %>%
add_content(tbl) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
titles("Report 1.0", "Simple Report",
blank_row = "none", header = TRUE, columns = 1) %>%
footnotes("My footnote", "Another footnote", "And another",
blank_row = "none", footer = TRUE) %>%
page_footer("Left", "Center", "Right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-56: Titles and footnotes variations in header and footer work as expected", {
dat <- mtcars[1:10, 1:3]
fp <- file.path(base_path, "rtf2/test56.rtf")
tbl <- create_table(dat) %>%
column_defaults(width = 1)
rpt <- create_report(fp, orientation = "landscape",
output_type = "RTF", font = "Arial") %>%
add_content(tbl) %>%
set_margins(top = 1) %>%
page_header("Left", "Right") %>%
titles("Report 1.0", "Simple Report", align = "left", width = 6,
blank_row = "none", header = TRUE) %>%
titles("Report 1.0", "Simple Report", align = "right", width = 6,
blank_row = "below", header = TRUE, borders = "bottom") %>%
footnotes("My footnote", blank_row = "none", footer = TRUE, borders = "top") %>%
footnotes("My footnote2", blank_row = "none", footer = TRUE, align = "right") %>%
footnotes("My footnote3", blank_row = "none", footer = TRUE, align = "center") %>%
page_footer("Left", "Center", "Right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-57: Titles and footnotes in header and footer no page header/footer works as expected", {
dat <- mtcars[1:10, 1:3]
fp <- file.path(base_path, "rtf2/test57.rtf")
tbl <- create_table(dat) %>%
column_defaults(width = 1)
rpt <- create_report(fp, orientation = "landscape",
output_type = "RTF", font = "Arial") %>%
add_content(tbl) %>%
set_margins(top = 1, bottom = 1) %>%
titles("Report 1.0 here is a big long title", "Simple Report", align = "left",
blank_row = "none", header = TRUE) %>%
titles("Report 1.0", "Simple Report", align = "center", width = 6,
blank_row = "below", header = TRUE) %>%
footnotes("My footnote1", "My footnote2", blank_row = "none", footer = TRUE)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-58: Label row is one cell.", {
fp <- file.path(base_path, "rtf2/test58.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder and more perhaps more" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to see if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label"), width = .8) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-59: Blank after on invisible column.", {
fp <- file.path(base_path, "rtf2/test59.rtf")
tbl <- create_table(iris, borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
page_header("Left", "Right") %>%
add_content(tbl) %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-60: Blank nested stub works as expected.", {
fp <- file.path(base_path, "rtf2/test60.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "Stats" "19" "13"
"ampg" "Stats" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Stats" "16.4" "21.4"
"ampg" "Stats" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Stats" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to see if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25, dedupe = TRUE) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
# Basic Tests 61-70 -------------------------------------------------------
test_that("rtf2-61: Page header width works.", {
fp <- file.path(base_path, "rtf2/test61.rtf")
tbl <- create_table(iris, borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
page_header("Left and here is a really long left cell text to put it",
"Right", width = 8) %>%
add_content(tbl) %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-62: Carriage return in label row works.", {
fp <- file.path(base_path, "rtf2/test62.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - \n21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to \nsee if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-63: Glue works.", {
# if (dev) {
fp <- file.path(base_path, "rtf2/test63.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - \n21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to \nsee if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label"), label = "Stub{supsc('2')}") %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A{supsc('1')}", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = c("Client: Motor Trend{supsc('6')}",
"Test{supsc('8')}"), right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table{supsc('3')}") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974{supsc('4')}") %>%
page_footer(left = "Left{supsc('6')}",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
# } else {
#
# expect_equal(TRUE, TRUE)
#
# }
})
test_that("rtf2-64: Title columns work 1 column.", {
fp <- file.path(base_path, "rtf2/test64.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "left") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-65: Title columns work 2 columns.", {
fp <- file.path(base_path, "rtf2/test65.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame", "Left", "Right",
blank_row = "below", columns = 2) %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-66: Title columns work 3 columns.", {
fp <- file.path(base_path, "rtf2/test66.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame", "My right thing", "", "Center",
blank_row = "below", columns = 3) %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-67: Multiple title blocks work as expected.", {
fp <- file.path(base_path, "rtf2/test67.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
titles("Table 2.0", "IRIS Data Frame2", "Left", "Right",
blank_row = "below", columns = 2, borders = "all") %>%
titles("Table 3.0", "IRIS Data Frame3", "My right thing", "", "Center",
blank_row = "below", columns = 3, borders = "all") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-68: Custom page size works as expected.", {
fp <- file.path(base_path, "rtf2/test68.rtf")
tbl <- create_table(iris[1:15, ]) %>%
define(Species, visible = FALSE)
ttl <- c("Title1", "Title2", "Title3")
rpt <- create_report(fp, output_type = "RTF",
font = "Courier",
paper_size = c(6.5, 7.5),
orientation = "portrait") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles(ttl,
blank_row = "below", columns = 1, align = "center",
borders = "none") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-69: Breaks removed after titles and footnotes.", {
fp <- file.path(base_path, "rtf2/test69.rtf")
tbl <- create_table(iris[1:15, ], borders = "outside") %>%
define(Species, visible = FALSE) %>%
titles("Here is a title") %>%
footnotes("Here is a footnote")
rpt <- create_report(fp, output_type = "RTF",
font = "Courier",
orientation = "landscape") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-70: Breaks removed after 2 titles and footnotes.", {
fp <- file.path(base_path, "rtf2/test70.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, visible = FALSE) %>%
titles("Here is a title") %>%
titles("There is a title") %>%
footnotes("Here is a footnote") %>%
footnotes("There is a footnote")
rpt <- create_report(fp, output_type = "RTF",
font = "Courier",
orientation = "landscape") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
# Basic Tests 71-80 -------------------------------------------------------
test_that("rtf2-71: RTF Plot with path works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test71.rtf")
tmp <- file.path(base_path, "plot.jpg")
jpeg(tmp, width = 600, height = 500)
plot(mtcars$mpg)
dev.off()
plt <- create_plot(tmp, height = 5, width = 6, borders = c("top", "bottom", "all")) %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", borders = "none") %>%
footnotes("* Motor Trend, 1974", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size =fsz) %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt) %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-72: Symbols are proper orientation on portrait.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test72.rtf")
dat <- mtcars[1:10, ]
tbl <- create_table(dat) %>%
titles("My Table{symbol('dagger')}")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl)
res <- write_report(rpt)
#file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-73: Symbols are proper orientation on landscape.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test73.rtf")
dat <- mtcars[1:10, ]
tbl <- create_table(dat) %>%
titles("My Table{symbol('dagger')}")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "landscape") %>%
add_content(tbl)
res <- write_report(rpt)
#file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-74: Multi-page continuous tables work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test74.rtf")
dat <- iris
tbl <- create_table(dat, continuous = TRUE, borders = "all") %>%
# titles("My Title") %>%
footnotes("My footnotes", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl) %>%
footnotes("Here", footer = TRUE)
res <- write_report(rpt)
# file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
# expect_equal(res$pages, 3)
} else {
expect_equal(TRUE, TRUE)
}
})
# Works!
test_that("rtf2-75: Simplest EMF Plot works as expected.", {
if (dev == TRUE) {
library(devEMF)
fp <- file.path(base_path, "rtf2/test75.rtf")
tmp <- file.path(base_path, "rtf2/plot.emf")
emf(tmp)
plot(1, 1)
dev.off()
plt <- create_plot(tmp, height = 5, width = 6, borders = c("top", "bottom", "all")) %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", borders = "none") %>%
footnotes("* Motor Trend, 1974", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size =fsz) %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt) %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
# Works!
test_that("rtf2-76: Patchwork Plot works as expected.", {
if (dev == TRUE) {
library(ggplot2)
library(patchwork)
fp <- file.path(base_path, "rtf2/test76.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
p2 <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
ptch <- (p | p2)
plt <- create_plot(ptch, height = 4, width = 8, borders = c("top", "bottom", "all")) %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", borders = "none") %>%
footnotes("* Motor Trend, 1974", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size =fsz) %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt, align = "right") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-77: One-page continuous tables work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test77.rtf")
dat <- iris[1:15, ]
tbl <- create_table(dat, continuous = TRUE, borders = "all") %>%
titles("My title") %>%
footnotes("My footnotes", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl) %>%
footnotes("Here", footer = TRUE)
res <- write_report(rpt)
# file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-78: Two one-page continuous tables work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test78.rtf")
dat <- iris[1:15, ]
tbl1 <- create_table(dat, continuous = TRUE, borders = "all") %>%
titles("My title 1") %>%
footnotes("My footnotes 1", blank_row = "none")
tbl2 <- create_table(dat, continuous = TRUE, borders = "all") %>%
titles("My title 2") %>%
footnotes("My footnotes 2", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl1) %>%
add_content(tbl2) %>%
footnotes("Here", footer = TRUE)
res <- write_report(rpt)
# file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-79: Two multi-page continuous tables work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test79.rtf")
dat <- iris[1:125, ]
tbl1 <- create_table(dat, continuous = TRUE, borders = "all") %>%
titles("My title 1") %>%
footnotes("My footnotes 1", blank_row = "none")
tbl2 <- create_table(dat, continuous = TRUE, borders = "all") %>%
titles("My title 2") %>%
footnotes("My footnotes 2", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl1) %>%
add_content(tbl2) %>%
footnotes("Here", footer = TRUE) %>%
page_header("Left", "Right") %>%
page_footer(right = "Page [pg] of [tpg]")
res <- write_report(rpt)
# file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
#expect_equal(res$pages, 6)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-80: Two tables one continuous works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test80.rtf")
dat <- iris[1:125, ]
tbl1 <- create_table(dat, continuous = TRUE, borders = "all") %>%
titles("My title 1") %>%
footnotes("My footnotes 1", blank_row = "none")
tbl2 <- create_table(dat, continuous = FALSE, borders = "all") %>%
titles("My title 2") %>%
footnotes("My footnotes 2", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl1) %>%
add_content(tbl2) %>%
footnotes("Here", footer = TRUE) %>%
page_header("Left", "Right") %>%
page_footer(right = "Page [pg] of [tpg]")
res <- write_report(rpt)
# file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 6)
} else {
expect_equal(TRUE, TRUE)
}
})
# Basic Tests 81-90 -------------------------------------------------------
# Can't reproduce Raphael's problem
test_that("rtf2-81: Column widths work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test81.rtf")
dat <- mtcars[, 1:9]
tbl <- create_table(dat, width = 8.84) %>%
titles("My title") %>%
column_defaults(width = .75) %>%
define(mpg, width = 2.09) %>%
define(cyl, width = 1.5) %>%
footnotes("My footnotes", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait",
paper_size = c(9.5, 11.5)) %>%
add_content(tbl) %>%
footnotes("Here", footer = TRUE) %>%
set_margins(top = .25, bottom = .25, left = .25, right = .25)
res <- write_report(rpt)
#file.show(res$modified_path)
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-82: Basic cell style bold works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test82.rtf")
dat <- mtcars[, 1:5]
dat$hpflg <- ifelse(dat$hp > 100, TRUE, FALSE)
tbl <- create_table(dat, width = 7) %>%
titles("My title") %>%
column_defaults(width = .75) %>%
define(mpg, width = 1, style = cell_style(bold = TRUE)) %>%
define(cyl, width = 1) %>%
define(disp, style = cell_style(bold = TRUE)) %>%
define(hp, style = cell_style(bold = TRUE, indicator = hpflg)) %>%
define(hpflg, visible = FALSE) %>%
footnotes("My footnotes", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl) %>%
footnotes("Here", footer = TRUE)
res <- write_report(rpt)
# file.show(res$modified_path)
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-83: Bolding works with stub.", {
fp <- file.path(base_path, "rtf2/test83.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
df$cylflg <- ifelse(df$var == "cyl", TRUE, FALSE)
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
column_defaults(vars = c("stub", "A"),
style = cell_style(bold = TRUE, indicator = cylflg)) %>%
stub(c("var", "label"),
style = cell_style(bold = TRUE, indicator = "labelrow")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19,
style = cell_style(bold = TRUE, indicator = cylflg)) %>%
define(B, label = "Group B", align = "center", n = 13,
style = cell_style(bold = TRUE, indicator = "datarow")) %>%
define(cylflg, visible = FALSE)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
# file.show(res$modified_path)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-84: Bold cell style with column defaults.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test84.rtf")
dat <- mtcars[, 1:5]
dat$hpflg <- ifelse(dat$hp > 100, TRUE, FALSE)
tbl <- create_table(dat) %>%
titles("My title") %>%
column_defaults(width = .75, vars = c("cyl", "disp", "hp"),
style = cell_style(bold=TRUE, indicator = hpflg)) %>%
define(mpg) %>%
define(cyl) %>%
define(disp) %>%
define(hp) %>%
define(hpflg, visible = FALSE) %>%
footnotes("My footnotes", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl) %>%
footnotes("Here", footer = TRUE)
res <- write_report(rpt)
# file.show(res$modified_path)
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-85: Bolding, column defaults, and stub works.", {
fp <- file.path(base_path, "rtf2/test85.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
df$cylflg <- ifelse(df$var == "cyl", FALSE, TRUE)
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
column_defaults(style = cell_style(bold = TRUE, indicator = cylflg)) %>%
stub(c("var", "label"), width = 2,
style = cell_style(bold = TRUE, indicator = cylflg)) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13,
style = cell_style(bold = TRUE, indicator = "datarow")) %>%
define(cylflg, visible = FALSE)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
# file.show(res$modified_path)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-86: Spanning header bold work as expected.", {
fp <- file.path(base_path, "rtf2/test86.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c( "none")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = FALSE, bold = TRUE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(drat, gear, "Super Duper\nWrapped Span",
n = 11, level = 2, bold = TRUE) %>%
titles("Table 1.0", "My Nice Table", blank_row = "none",
borders = c("top", "bottom")) %>%
footnotes("My footnote 1", "My footnote 2",
blank_row = "none", borders = c("top", "bottom"))
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(res$modified_path), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-87: Italic footnotes work as expected.", {
fp <- file.path(base_path, "rtf2/test87.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c( "none")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = FALSE, bold = FALSE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(drat, gear, "Super Duper\nWrapped Span",
n = 11, level = 2, bold = FALSE) %>%
titles("Table 1.0", "My Nice Table", blank_row = "none",
borders = c("top", "bottom")) %>%
footnotes("My italic footnote1", "My italic footnote2", italics = TRUE,
blank_row = "none", borders = "top") %>%
footnotes("My italic footnote2", "My footnote 2",
blank_row = "none", borders = c("bottom"))
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(res$modified_path), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf2-88: Footnote columns work 1 column.", {
fp <- file.path(base_path, "rtf2/test88.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE) %>%
footnotes("Here is a footnote", "And another",
borders = "all", columns = 1)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "left") %>%
footnotes("Here is a footnote", "And another", columns = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-89: Footnote columns work 2 columns.", {
fp <- file.path(base_path, "rtf2/test89.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = FALSE, visible = FALSE) %>%
footnotes("Here is a footnote", "And another",
borders = "all", columns = 2)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame", "Left", "Right",
blank_row = "below", columns = 2) %>%
footnotes("Here is a footnote that is really long and is going to wrap",
"And another",
"Another left", "Another right", columns = 2)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-90: Footnote columns work 3 columns.", {
fp <- file.path(base_path, "rtf2/test90.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = FALSE, visible = FALSE) %>%
footnotes("Here is a footnote", "And another", "And more",
"", "centered",
borders = "all", columns = 3, blank_row = "both")
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame", "My right thing", "", "Center",
blank_row = "below", columns = 3) %>%
footnotes("Here is a footnote that is really long an is going to wrap a few times",
"And another", "and more",
"", "Footnote Center", columns = 3)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
# Basic Tests 91-100 ------------------------------------------------------
test_that("rtf2-91: Multiple footnote blocks work as expected.", {
fp <- file.path(base_path, "rtf2/test91.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE) %>%
footnotes("Footnote left", "Footnote right", columns = 2)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Table 1.0", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
footnotes("Table 2.0", "IRIS Data Frame2", "Left", "Right",
blank_row = "below", columns = 2, borders = "all") %>%
footnotes("Table 3.0", "IRIS Data Frame3", "My right thing", "", "Center",
blank_row = "below", columns = 3, borders = "all") %>%
titles("Here is a title", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-92: Page by with wrap works as expected.", {
fp <- file.path(base_path, "rtf2/test92.rtf")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat$Pgby <- paste0("Flower Type\n", dat$Pgby)
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Report with a Page By", borders = "none") %>%
page_by(Pgby, label = "Species: ", align = "right", borders = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_header("Left", "Right") %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 9)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-93: Page by with format works as expected.", {
fp <- file.path(base_path, "rtf2/test93.rtf")
fmt1 <- c(setosa = 1, versicolor = 2, virginica = 3)
fmt2 <- value(condition(x == 1, "Setosa"),
condition(x == 2, "Versicolor"),
condition(x == 3, "Virginica"))
dat <- iris
fmtval <- fmt1[dat$Species]
names(fmtval) <- NULL
dat$Pgby <- fmtval
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Report with a Page By", borders = "none") %>%
page_by(Pgby, align = "left", label = "Flower:", borders = "none", format = fmt2) %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF",
orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_header("Left", "Right") %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 6)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-94: Label with invisible column works as expected.", {
fp <- file.path(base_path, "rtf2/test94.rtf")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE, label = "Fork") %>%
footnotes("Left", "right", columns = 2)
rpt <- create_report(fp, output_type = "RTF") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Footnote1", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
titles("Table 1.0", "My little title")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf2-95: Page break with blank row after works as expected.", {
fp <- file.path(base_path, "rtf2/test95.rtf")
dat <- sort(iris, by = c("Species", "Petal.Width"))
PG <- c(rep(1, 25), rep(2, 25),
rep(4, 25), rep(5, 25),
rep(7, 25), rep(8, 25))
dat$PG <- PG
tbl <- create_table(dat, borders = "all") %>%
stub(c("Species", "Petal.Width"), label = "My stuff") %>%
define(Species, visible = TRUE, label_row = TRUE) %>%
define(Petal.Width, blank_after = TRUE, indent = .25) %>%
define(PG, page_break = TRUE, visible = TRUE) %>%
footnotes("Left", "right", columns = 2)
rpt <- create_report(fp, output_type = "RTF", font = "Courier") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "Page [pg] of [tpg]") %>%
footnotes("Footnote1", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
titles("Table 1.0", "My little title")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 11)
})
test_that("rtf2-96: Outside borders on continuous tables work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test96.rtf")
dat <- iris
tbl <- create_table(dat, continuous = TRUE, borders = "outside") %>%
# titles("My Title") %>%
footnotes("My footnotes", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", orientation = "portrait") %>%
add_content(tbl) %>%
footnotes("Here", footer = TRUE)
res <- write_report(rpt)
# file.show(res$modified_path)
expect_equal(file.exists(fp), TRUE)
# expect_equal(res$pages, 3)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-97: Page X of Y works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test97.rtf")
dat <- iris
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Irises", "Another Title", "Page [pg] of [tpg]") %>%
define(Sepal.Length, label = "Sepal Length", width = 1, align = "center") %>%
define(Sepal.Width, label = "Sepal Width", width = 1, align = "centre") %>%
define(Species, blank_after = TRUE) %>%
footnotes("Table footnote Page [pg] of [tpg]")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
titles("Report Title", "Page [pg] of [tpg]") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Page [pg] of [tpg]")) %>%
add_content(tbl, blank_row = "none") %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]") %>%
footnotes("My footnote 1", "My footnote 2", "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 11)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-98: Title header blank rows work as expected.", {
fp <- file.path(base_path, "rtf2/test98.rtf")
dat <- iris
tbl <- create_table(dat, width = 8.9, borders = "all") %>%
title_header("Table 1.0", "My Nice Table",
right = c("Right1",
"Right2", "Page [pg] of [tpg]"),
blank_row = "both", borders = "all")
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 10, orientation = "landscape") %>%
page_header("Left", "Right", blank_row = "below") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 7)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("rtf2-99: Multi page table removes blank spaces.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test99.rtf")
dat1 <- iris[1:10, ]
dat2 <- iris[11:20, ]
dat3 <- iris[21:30, ]
tbl1 <- create_table(dat1, borders = "none") %>%
titles("Table 1.0", "My Nice Irises1")
tbl2 <- create_table(dat2, borders = "none") %>%
titles("Table 1.0", "My Nice Irises2")
tbl3 <- create_table(dat3, borders = "none") %>%
titles("Table 1.0", "My Nice Irises3")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl1, blank_row = "none") |>
add_content(tbl2, blank_row = "none") |>
add_content(tbl3, blank_row = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 3)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-100: Spanning header gap works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test100.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c("outside")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = TRUE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(cyl, hp, "Super Span", n = 11, level = 2) |>
spanning_header(drat, gear, "Super Duper\nWrapped Span", n = 11, level = 2)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-100-2: Spanning header gap should not exist with all border.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test100-2.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c("all")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = TRUE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(cyl, hp, "Super Span", n = 11, level = 2) |>
spanning_header(drat, gear, "Super Duper\nWrapped Span", n = 11, level = 2)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-100-3: Spanning header gap should not exist with inside border.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test100-3.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat, borders = c("inside")) %>%
spanning_header(cyl, disp, "Span 1", label_align = "left") %>%
spanning_header(hp, wt, "Span 2", underline = TRUE) %>%
spanning_header(qsec, vs, "Span 3", n = 10) %>%
spanning_header(cyl, hp, "Super Span", n = 11, level = 2) |>
spanning_header(drat, gear, "Super Duper\nWrapped Span", n = 11, level = 2)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else {
expect_equal(TRUE, TRUE)
}
})
# Basic Tests 101-110 ------------------------------------------------------
test_that("rtf2-101: Table with blank_before as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test101.rtf")
# Setup
arm <- c(rep("A", 5), rep("B", 5))
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa \nand more and more", "Schaffer, Ashley", "Laner, Tahma",
"Perry, Sean", "Crews, Deshawn Joseph", "Person, Ladon",
"Smith, Shaileigh")
sex <- c("M", "F", "F", "M", "M", "F", "M", "F", "F", "M")
age <- c(41, 53, 43, 39, 47, 52, 21, 38, 62, 26)
# Create data frame
df <- data.frame(arm, subjid, name, sex, age, stringsAsFactors = FALSE)
tbl1 <- create_table(df, first_row_blank = FALSE) %>%
define(subjid, label = "Subject ID for a patient", n = 10, align = "left",
width = 1) %>%
define(name, label = "Subject Name", width = 1) %>%
define(sex, label = "Sex", n = 10, align = "center") %>%
define(age, label = "Age", n = 10) %>%
define(arm, label = "Arm",
blank_before = TRUE,
dedupe = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
titles("Table 1.0", align = "center") %>%
add_content(tbl1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-102: Three level stub and indentation work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test102.rtf")
# Setup
cat <- c(rep("Kaplan-Meier estimates", 6),
rep("Cox PH estimates and some more really long stuff", 6))
grp <- c("25th percentile", "25th percentile",
"median (weeks)", "median (weeks)",
"75th percentile", "75th percentile",
"25th percentile", "25th percentile",
"median (weeks)", "median (weeks)",
"75th percentile", "75th percentile")
ci <- c(NA, "95% confidence interval",
NA, "95% confidence interval",
NA, "95% confidence interval",
NA, "95% confidence interval",
NA, "95% confidence interval",
NA, "95% confidence interval")
values <- c(41, 53, 43, 39, 47, 52, 38, 25, 37, 23, 78, 21)
# Create data frame
df <- data.frame(cat, grp, ci, values, stringsAsFactors = FALSE)
tbl1 <- create_table(df) %>%
stub(c(cat, grp, ci), "Estimates", width = 1.5) %>%
define(cat, label_row = TRUE, blank_after = TRUE, indent = 0.15) %>%
define(grp, indent = .25) %>%
define(ci, indent = .5) %>%
define(values, label = "Values")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
titles("Table 3.0", "Analysis of Time to Initial PSGA Success in Weeks") %>%
page_header("Sponsor", "Study") %>%
add_content(tbl1) %>%
page_footer("Time", "Confidential", "Page")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-103: Page footers with one assigned width work as expected.",{
if (dev) {
fp <- file.path(base_path, "rtf2/test103.rtf")
dat <- mtcars[,c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs")]
tbl <- create_table(dat, borders = "outside") %>%
footnotes("This is testing footnote", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
set_margins(top = 1, bottom = 1) %>%
titles("Table 1.0") %>%
add_content(tbl) %>%
page_footer(left = "this is a very long sentence whose length exceeds the limitation of the left part",
center = "Center footer", right = "Right footer",
width = c(5.5))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
}
)
test_that("rtf2-104: Page footers with multiple assigned widths work as expected.",{
if (dev) {
fp <- file.path(base_path, "rtf2/test104.rtf")
dat <- mtcars[,c("mpg", "cyl", "disp", "hp", "drat", "wt", "qsec", "vs")]
tbl <- create_table(dat, borders = "outside") %>%
footnotes("This is testing footnote", blank_row = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
set_margins(top = 1, bottom = 1) %>%
titles("Table 1.0") %>%
add_content(tbl) %>%
page_footer(left = "this is a very long sentence whose length exceeds the limitation of the left part",
center = "", right = "Right Footer",
width = c(5.5, 0 , 2))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
}
)
test_that("rtf2-105: Page by with bold label and value works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test105.rtf")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = "Flower Type: ", bold = TRUE, blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-106: Page by with bold label as expected.", {
if (dev) {
# Label and Value are bold
fp <- file.path(base_path, "rtf2/test106.rtf")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = "Flower Type: ", bold = "label", blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-107: Page by with bold value as expected.", {
if (dev) {
# Label and Value are bold
fp <- file.path(base_path, "rtf2/test107.rtf")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = "Flower Type: ", bold = "value", blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-108: Page by with bold long label and value works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test108.rtf")
dat <- iris
long_string <- "This is long page by value which should take more than one sentence - "
dat$Pgby <- paste0(long_string, dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
long_label <- "This is a long page by label which should take more than one sentence: "
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = long_label, bold = TRUE, blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-109: Page by with bold long label works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test109.rtf")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
long_label <- "This is a long page by label which should take more than one sentence: "
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = long_label, bold = "label", blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-110: Page by with bold long value works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test110.rtf")
dat <- iris
long_string <- "This is long page by value which should take more than one sentence - "
dat$Pgby <- paste0(long_string, dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
long_label <- "This is a long page by label which should take more than one sentence:"
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = "Flower Type:", bold = "value", blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
# Basic Tests 111-120 ------------------------------------------------------
test_that("rtf2-111: Page by with bold long label filling one line works as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test111.rtf")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat <- dat[, c("Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width", "Pgby")]
long_label <- "This is a long page by label which should take more: "
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a Page By") %>%
page_by(Pgby, label = long_label, bold = "label", blank_row = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-112: Group border works as as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test112.rtf")
# Setup
arm <- c(rep("A", 3), rep("B", 2), rep("C", 3), rep("D", 2))
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa \nand more and more", "Schaffer, Ashley", "Laner, Tahma",
"Perry, Sean", "Crews, Deshawn Joseph", "Person, Ladon",
"Smith, Shaileigh")
sex <- c("M", "F", "F", "M", "M", "F", "M", "F", "F", "M")
age <- c(41, 53, 43, 39, 47, 52, 21, 38, 62, 26)
# Create data frame
df <- data.frame(arm, subjid, name, sex, age, stringsAsFactors = FALSE)
df <- rbind(df, df, df, df)
tbl1 <- create_table(df, first_row_blank = FALSE, borders = "outside") %>%
define(subjid, label = "Subject ID for a patient", n = 10, align = "left",
width = 1) %>%
define(name, label = "Subject Name", width = 1) %>%
define(sex, label = "Sex", n = 10, align = "center") %>%
define(age, label = "Age", n = 10) %>%
define(arm, label = "Arm",
dedupe = TRUE,
group_border = TRUE) %>%
footnotes("This is the footnote")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
titles(c("Table 1.0", "This is a table with group border"), align = "center") %>%
add_content(tbl1) %>%
footnotes(c("This is the footnote 1")) %>%
page_header(left = "Test header", right = "Test header") %>%
set_margins(top = 1, bottom = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-113: Group border with blank after works as as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test113.rtf")
# Setup
arm <- c(rep("A", 3), rep("B", 2), rep("C", 3), rep("D", 2))
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa \nand more and more", "Schaffer, Ashley", "Laner, Tahma",
"Perry, Sean", "Crews, Deshawn Joseph", "Person, Ladon",
"Smith, Shaileigh")
sex <- c("M", "F", "F", "M", "M", "F", "M", "F", "F", "M")
age <- c(41, 53, 43, 39, 47, 52, 21, 38, 62, 26)
# Create data frame
df <- data.frame(arm, subjid, name, sex, age, stringsAsFactors = FALSE)
df <- rbind(df, df, df, df)
tbl1 <- create_table(df, first_row_blank = FALSE, borders = "outside") %>%
define(subjid, label = "Subject ID for a patient", n = 10, align = "left",
width = 1) %>%
define(name, label = "Subject Name", width = 1) %>%
define(sex, label = "Sex", n = 10, align = "center") %>%
define(age, label = "Age", n = 10) %>%
define(arm, label = "Arm",
dedupe = TRUE,
blank_after = TRUE,
group_border = TRUE) %>%
footnotes("This is the footnote")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz) %>%
titles(c("Table 1.0", "This is a table with group border"), align = "center") %>%
add_content(tbl1) %>%
footnotes(c("This is the footnote 1")) %>%
page_header(left = "Test header", right = "Test header") %>%
set_margins(top = 1, bottom = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-114: Center page header works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test114.rtf")
dat <- iris[1:50,]
dat <- dat[, c("Species" ,"Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")]
tbl <- create_table(dat, borders = "outside")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with a center header", header = T) %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none") %>%
page_header(left = "", center = "center", right = "right",
width = c(0, 5, 4)) %>%
page_footer(left = "Left", center = "center", right = "right",
width = c(3, 4, 2))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-115: Images in page header/footer work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test115.rtf")
dat <- iris[1:50,]
dat <- dat[, c("Species" ,"Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")]
image_path <- file.path(base_path, "data/logo.png")
image_path2 <- file.path(base_path, "data/logo.jpg")
tbl <- create_table(dat, borders = "outside") %>%
titles("Table 1.0", "My Nice Report with a page header picture")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none") %>%
page_header() %>%
header_image(image_path, height = 0.5, width = 0.8, align = "left") %>%
header_image(image_path, height = 0.6, width = 0.85, align = "right") %>%
header_image(c(image_path, image_path2), height = 0.38, width = 0.7, align = "center") %>%
page_footer() %>%
footer_image(c(image_path2, image_path), height = 0.38, width = 0.7, align = "left") %>%
footer_image(image_path, height = 0.5, width = 0.8, align = "right") %>%
footer_image(image_path, height = 0.6, width = 0.85, align = "center")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-116: Spanned images in page header/footer work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test116.rtf")
dat <- iris[1:50,]
dat <- dat[, c("Species" ,"Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")]
image_path <- file.path(base_path, "data/span_logo.png")
tbl <- create_table(dat, borders = "outside")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with a page header picture", header = T) %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none") %>%
page_header(width = c(0, 9, 0), left = "No display because width is 0") %>%
header_image(image_path, height = 1, width = 7.5, align = "centre") %>%
page_footer(width = c(0, 0, 9), center = "No display because width is 0") %>%
footer_image(image_path, height = 0.8, width = 7, align = "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-117: Return error when header_image/footer_image is used without page_header/page_footer.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test117.rtf")
dat <- iris[1:50,]
dat <- dat[, c("Species" ,"Sepal.Length", "Sepal.Width", "Petal.Length", "Petal.Width")]
image_path <- file.path(base_path, "data/span_logo.png")
tbl <- create_table(dat, borders = "outside")
# page_header is not set
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with a page header picture", header = T) %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none") %>%
header_image(image_path, height = 1, width = 7.5, align = "centre")
expect_error(
res <- write_report(rpt),
"`page_header` must be used when using `header_image`."
)
# page_footer is not set
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with a page header picture", header = T) %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none") %>%
footer_image(image_path, height = 0.8, width = 7, align = "right")
expect_error(
res <- write_report(rpt),
"`page_footer` must be used when using `footer_image`."
)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-118: group_cohesion puts the group in same page as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test118.rtf")
dat <- iris[1:86,]
dat$test_group <- c(
rep("A", 12),
rep("B", 6),
rep("C", 19),
rep("D", 18),
rep("E", 31)
)
dat$test_string <- c(
rep("Flower A\nSubgroup A1", 12), # 24 lines + 1
rep("Flower B\nSubgroup B1", 6), # 12 lines + 1
c(rep("Flower C", 19)), # 19 lines + 1
c(rep("Flower D", 16), rep("Flower D\nSubgroup D1", 2)), # 20 lines + 1
c(rep("Flower E", 31)) # 31 lines + 1
)
dat <- dat[, c("test_group", "test_string", "Sepal.Length",
"Sepal.Width", "Petal.Length","Petal.Width")]
tbl <- create_table(dat, borders = "outside") %>%
define(test_group, group_cohesion = TRUE, label = "Group", blank_after = T)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with Group Cohesion") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none",
blank_row = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-119: group_cohesion with min page proportion works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test119.rtf")
dat <- iris[1:86,]
dat$test_group <- c(
rep("A", 12),
rep("B", 6),
rep("C", 19),
rep("D", 18),
rep("E", 31)
)
dat$test_string <- c(
rep("Flower A\nSubgroup A1", 12), # 24 lines + 1
rep("Flower B\nSubgroup B1", 6), # 12 lines + 1
c(rep("Flower C", 19)), # 19 lines + 1
c(rep("Flower D", 16), rep("Flower D\nSubgroup D1", 2)), # 20 lines + 1
c(rep("Flower E", 31)) # 31 lines + 1
)
dat <- dat[, c("test_group", "test_string", "Sepal.Length",
"Sepal.Width", "Petal.Length","Petal.Width")]
tbl <- create_table(dat, borders = "outside") %>%
define(test_group, group_cohesion = 0.6,
label = "Group", blank_after = T) %>%
define(test_string, label = "Flower")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with Group Cohesion") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none",
blank_row = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-120: group_cohesion/min_page_prop return error properly.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test120.rtf")
dat <- iris[1:86,]
dat$test_group <- c(
rep("A", 12),
rep("B", 6),
rep("C", 19),
rep("D", 18),
rep("E", 31)
)
dat$test_string <- c(
rep("Flower A\nSubgroup A1", 12), # 24 lines + 1
rep("Flower B\nSubgroup B1", 6), # 12 lines + 1
c(rep("Flower C", 19)), # 19 lines + 1
c(rep("Flower D", 16), rep("Flower D\nSubgroup D1", 2)), # 20 lines + 1
c(rep("Flower E", 31)) # 31 lines + 1
)
dat <- dat[, c("test_group", "test_string", "Sepal.Length",
"Sepal.Width", "Petal.Length","Petal.Width")]
# ++++++++++++++++++++++
# group_cohesion is not in right range
# ++++++++++++++++++++++
myfun <- function(dat){
tbl <- create_table(dat, borders = "outside") %>%
define(test_group, group_cohesion = 2,
label = "Group", blank_after = T) %>%
define(test_string, label = "Flower")
}
expect_error(
res <- myfun(dat),
paste0("`group_cohesion` should be TRUE/FALSE or numeric value from 0 to 1 instead of 2.")
)
} else {
expect_equal(TRUE, TRUE)
}
})
# Basic Tests 121-130 ------------------------------------------------------
test_that("rtf2-121: Multiple group_cohesion work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test121.rtf")
dat <- iris[1:86,]
dat$test_group <- c(
rep("A", 12),
rep("B", 6),
rep("C", 19),
rep("D", 18),
rep("E", 31)
)
dat$test_string <- c(
rep("Flower A\nSubgroup A1", 12), # 24 lines + 1
rep("Flower B\nSubgroup B1", 3), # 12 lines + 1
rep("Flower B\nSubgroup B2", 3),
c(rep("Flower C1", 11)), # C1 ends at 24 lines, which is the minimum requirement
c(rep("Flower C2", 8)), # C2 would be moved to next page
c(rep("Flower D", 16), rep("Flower D\nSubgroup D1", 2)), # 20 lines + 1
c(rep("Flower E1", 24), rep("Flower E2", 7)) # E2 would be moved to next page
)
dat <- dat[, c("test_group", "test_string", "Sepal.Length",
"Sepal.Width", "Petal.Length","Petal.Width")]
tbl <- create_table(dat, borders = "outside") %>%
define(test_group, group_cohesion = TRUE, label = "Group", blank_after = T) %>%
define(test_string, group_cohesion = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with Group Cohesion") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none",
blank_row = "none")
res <- write_report(rpt)
# C2 would be moved to next page
# E2 would be moved to next page
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-122: Multiple group_cohesion with different cohesion strengths work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test122.rtf")
dat <- iris[1:92,]
dat$test_group <- c(
rep("A", 12),
rep("B", 6),
rep("C", 19),
rep("D", 18),
rep("E", 37)
)
dat$test_string <- c(
rep("Flower A\nSubgroup A1", 12), # 24 lines + 1
rep("Flower B\nSubgroup B1", 6), # 12 lines + 1
c(rep("Flower C1", 11)), # C1 ends at 24 lines, which is the minimum requirement
c(rep("Flower C2", 8)), # C2 would be not moved to next page
c(rep("Flower D", 16), rep("Flower D\nSubgroup D1", 2)), # 20 lines + 1
c(rep("Flower E1", 33), rep("Flower E2", 4)) # E2 would be moved to next page
)
dat <- dat[, c("test_group", "test_string", "Sepal.Length",
"Sepal.Width", "Petal.Length","Petal.Width")]
tbl <- create_table(dat, borders = "outside") %>%
define(test_group, group_cohesion = TRUE, label = "Group", blank_after = T) %>%
define(test_string, group_cohesion = 0.1)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with Group Cohesion") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none",
blank_row = "none")
res <- write_report(rpt)
# C2 would not be moved to next page because previous lines are only 24
# E2 would be moved to next page because previous lines are 27, which meets 30*0.9
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-123: break_label works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test123.rtf")
dat <- iris[1:86,]
dat$test_group <- c(
rep("A", 12),
rep("B", 6),
rep("C", 19),
rep("D", 18),
rep("E", 31)
)
dat$test_string <- c(
rep("Flower A\nSubgroup A1", 12), # 24 lines + 1
rep("Flower B\nSubgroup B1", 6), # 12 lines + 1
c(rep("Flower C", 19)), # 19 lines + 1
c(rep("Flower D", 16), rep("Flower D\nSubgroup D1", 2)), # 20 lines + 1
c(rep("Flower E", 31)) # 31 lines + 1
)
dat <- dat[, c("test_group", "test_string", "Sepal.Length",
"Sepal.Width", "Petal.Length","Petal.Width")]
tbl <- create_table(dat, borders = "outside") %>%
define(test_group, break_label = "(Continued)", blank_before = T) %>%
define(test_string,
break_label = paste0("(This is a long text which should take more ",
"than one line. It's to test if the package is able to handle this ",
"situation.)"),
indent = 0.16)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "landscape") %>%
titles("Table 1.0", "My Nice Report with Break Label") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none",
blank_row = "none")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-124: Page numbers work every in title, footnote, header, and footer.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test124.rtf")
dat <- iris
tbl <- create_table(dat, borders = "outside") %>%
titles("Table Title: Page [pg] of [tpg]") %>%
footnotes("Table footnote: Page [pg] of [tpg]")
rpt <- create_report(fp, output_type = "rtf", font = fnt,
font_size = fsz, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
add_content(tbl) %>%
titles("Report Title: Page [pg] of [tpg]") %>%
footnotes("Report footnote: Page [pg] of [tpg]", borders = "none") %>%
page_header("Header: Page [pg] of [tpg]") %>%
page_footer("Footer: Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-125: Missing stub row label won't be displayed.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test125.rtf")
df <- read.table(header = TRUE, text = '
var label A B
"A" "Some text 1" "11" "8"
"A" "Some text 2" "10" "7"
"RACE" " White" "6 (54.5)" "4 (50.0)"
"RACE" " Black" "4 (36.4)" "3 (37.5)"
"RACE" " Others" "1 (9.1)" "1 (12.5)"
"B" "Some text 3" "6 (54.5)" "4 (50.0)"
"B" "Some text 4" "4 (36.4)" "3 (37.5)"
')
df$var <- ifelse(df$var == "A", NA, df$var)
df$var <- ifelse(df$var == "B", "", df$var)
tbl <- create_table(df, first_row_blank = FALSE, borders = c("top", "bottom")) %>%
titles("Table 1.0 Demographics", font_size = 10) %>%
stub(vars = c("var", "label"), "", width = 2.5) %>%
define(var, blank_after = TRUE, label_row = TRUE) %>%
define(A, align = "center", width=1.2, label = "Placebo", n=11) %>%
define(B, align = "center", width=1.2, label = "Drug", n=8)
rpt <- create_report(fp, output_type = "rtf", font = "Arial") %>%
add_content(tbl)
# "" will still be row label. Only remove NA
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-126: RTF codes work as expected", {
if (dev) {
fp <- file.path(base_path, "rtf2/test126.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "\\li360 N" "19" "13"
"ampg" "\\li360 Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "\\li360 Median" "16.4" "21.4"
"ampg" "\\li360 Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "\\li360 Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "\\li360 8\\line Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "\\li360 6\\line Cylinder and more perhaps more" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "\\li360 4\\line Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to see if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label"), width = .8) %>%
# stub(c("var", "label"), width = 1.2) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
# define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
# With allow_code = TRUE, line breaking wouldn't consider RTF code, but
# the reporter package wouldn't detect if it's indentation code and wouldn't
# keep the space for indentation. That it to say, users should be responsible
# for doing line wrapping from data set.
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
report_options(allow_code = TRUE) %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
# The output should be the same as rtf2-58
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-127: More RTF codes work as expected", {
if (dev) {
fp <- file.path(base_path, "rtf2/test127.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "\\li360 N" "19" "13"
"ampg" "\\li360 Mean" "18.8" "22.0 (4.9)"
"ampg" "\\li360 Median" "16.4{\\sub mm}" "21.4{\\super 2}"
"ampg" "\\li360 Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "\\li360 Range" "{\\cf12 10.4 - 33.9}" "14.7 - 32.4"
"cyl" "\\li360 8\\line Cylinder" "\\ul 10 ( 52.6%) \\ul0" "4 ( 30.8%)"
"cyl" "\\li360 6\\line {\\cf10 Cylinder and more perhaps more}" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "\\li360 {\\cf6 4}\\line Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "\\i Here is a italic label \\i0."
# Please double the curly braces otherwise the glue will fail.
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label"), width = .8) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "\\ul Under line \\ul0")) %>%
define(A, label = "\\shad {{\\cf3 Group A}} {common::supsc('2')}\\shad0", align = "center", n = 19) %>%
define(B, label = "\\outl Group B \\outl0", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") %>%
report_options(allow_code = TRUE) %>%
page_header(left = "\\strike Strikethrough header \\strike0", right = "Study: Cars") %>%
titles("\\b\\i {{\\highlight7 This is yellow italic highlight}} \\b0\\i0",
"\\fs0\\fs28 {{\\cf2 This is a blue big title}} \\fs18") %>%
add_content(tbl) %>%
footnotes("\\i * Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
# The output should contain bold, italic, strike through, super script,
# sub script, shadow, hollow
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-127b: More RTF codes with \\line code work as expected", {
if (dev) {
fp <- file.path(base_path, "rtf2/test127b.rtf")
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "\\li360 N" "19" "13"
"ampg" "\\li360 Mean" "18.8" "22.0 (4.9)"
"ampg" "\\li360 Median" "16.4{\\sub mm}" "21.4{\\super 2}"
"ampg" "\\li360 {\\cf12 Q1 - Q3}" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "\\li360 Range" "{\\cf2 10.4 - 33.9}" "14.7 - 32.4"
"cyl" "\\li360 8\\line Cylinder" "\\ul 10 ( 52.6%) \\ul0" "4 ( 30.8%)"
"cyl" "\\li360 6\\line {\\cf11 Cylinder and more. \\line When \\line this very long string the body footnote can flow to the next page}" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "\\li0 Sometime this is needed\\line{ }Cylinder" "\\ul\\line 5 ( 26.3%) \\ul0" "\\line 6 ( 46.2%)"')
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders=c("top", "bottom")) |>
stub(c("var", "label"), width = .8) |> # vary the width here to see unpredictable result. width=2.8 looks ok. when 0.8 page footnote overlfow
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = "\\i Here is a italic label \\i0.",
cyl = "\\ul Under line label \\ul0")) |>
define(A, label = "\\shad {{\\cf6 Group A}} {common::supsc('2')}\\shad0", align = "center", n = 19) |>
define(B, label = "\\outl Group B \\outl0", align = "center", n = 13) |>
footnotes("\\i\\fs14 * Italic Small Table Footnote{common::supsc('2')} \\fs18")
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Times") |>
report_options(allow_code = TRUE, title_block = "paragraph", line_break = FALSE) |>
page_header(left = "\\strike Strikethrough header \\strike0", right = "Study: Cars") |>
titles("{{\\b\\i\\highlight7\\cf2 This is yellow italic highlight}}",
"\\fs0\\fs28 {{\\cf2 This is a blue big title{{\\super{{a}}}}}} \\fs18") |>
add_content(tbl) |>
footnotes("\\i\\fs14\\cf6 * Italic Small \\line\\li207\\fi-207 Report Footnote {{\\ul\\super{common::symbol('alpha')}}} OK \\fs18") |>
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-128: Line break can be turned off by report_options as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test128.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder and more perhaps more" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a label\nwith manual line break."
df$sub_title <- "This is a long page by value which would not be inserted any line break characters."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label"), width = .8) %>%
page_by(sub_title, label = "This is a long label which would make multiple lines:",
bold = "label") %>%
define(sub_title, visible = FALSE) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center") %>%
define(B, label = "Group B", align = "center")
# Create report and add content
# !! Please note that `line_break` in `report_options` would affect:
# 1. All the data content of tables
# 2. All the titles and footnotes in both table objects and report objects
# 3. All page headers and footers
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Arial") %>%
report_options(line_break = FALSE) %>%
page_header(left = "This is a long left header which would not be inserted any line break characters.",
right = "This is a long right header which would not be inserted any line break characters.") %>%
titles("Table 1.0",
paste0("This is a title which is turned off the automatically line breaks",
" so it should not contain any line break characters and it should",
" prevent from overflow because the wrapping lines are turned off.")) %>%
add_content(tbl) %>%
footnotes(paste0("This is a long footnote which would not be inserted any line break characters even though it",
" has multiple lines. There should be no overflow because lines have been counted.")) %>%
page_footer(left = "This is a long left footer which would not be inserted any line break characters.",
center = "This is a long center footer which would not be inserted any line break characters.",
right = "This is a long right footer which would not be inserted any line break characters.")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
# Check if there is only one manual line break "\line"
rtf <- readLines(fp, warn = FALSE)
manual_break_count <- 0
for (r in rtf) {
matches <- gregexpr("\\line", r, fixed = TRUE)
count_result <- ifelse(matches[[1]][1] == -1, 0, length(matches[[1]]))
manual_break_count <- manual_break_count + count_result
}
expect_equal(manual_break_count, 1)
# expect_equal(any(grepl("\\\\line", rtf)), FALSE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-129: Page wrap can be turned off as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf2/test129.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
USUBJID STUDYID DOMAIN SUBJID RFSTDTC RFENDTC RFXSTDTC RFXENDTC RFICDTC
"001" "ABC" "DM" "01" "2021-12-01" "2021-12-20" "2021-12-02" "2021-12-20" "2021-12-01"
"002" "ABC" "DM" "02" "2021-12-02" "2021-12-21" "2021-12-03" "2021-12-21" "2021-12-02"
"003" "ABC" "DM" "03" "2021-12-03" "2021-12-22" "2021-12-04" "2021-12-22" "2021-12-03"
"004" "ABC" "DM" "04" "2021-12-04" "2021-12-23" "2021-12-05" "2021-12-23" "2021-12-04"
"005" "ABC" "DM" "05" "2021-12-05" "2021-12-24" "2021-12-06" "2021-12-24" "2021-12-05"
"006" "ABC" "DM" "06" "2021-12-06" "2021-12-25" "2021-12-07" "2021-12-25" "2021-12-06"
"007" "ABC" "DM" "07" "2021-12-07" "2021-12-26" "2021-12-08" "2021-12-26" "2021-12-07"
"008" "ABC" "DM" "08" "2021-12-08" "2021-12-27" "2021-12-09" "2021-12-27" "2021-12-08"')
# Test that any assigned formats are applied
# attr(df$SUBJID, "width") <- 1
# attr(df$SUBJID, "justify") <- "left"
# attr(df$SUBJID, "format") <- "S:%s"
# Define table
tbl <- create_table(df, page_wrap = FALSE) |>
titles("page_wrap = FALSE in create_table()")
tbl2 <- create_table(df) |>
titles("page_wrap = FALSE in report_options()")
tbl3 <- create_table(df, page_wrap = TRUE)
# Define Report
# !! Please note that when `page_wrap` is set in `create_table`. It'll be the top choice
# even though we set TRUE in `report_options`. Therefore, table 1 doesn't have
# the page wrap, but table 2 have the page wrap.
rpt <- create_report(fp, font = "Arial", font_size = 10, units = "cm",
orientation = "portrait") %>%
report_options(page_wrap = FALSE) %>%
titles("Listing 1.0",
"Demographics Dataset") %>%
add_content(tbl, align = "left") %>%
add_content(tbl2, align = "left") %>%
add_content(tbl3, align = "left") %>%
page_header("Sponsor", "Drug") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]") %>%
footnotes("My footnote")
# If page is wrapped, RFICDTC will be in the next page
# Now page is not wrapped, we can see RFICDTC is out of the margin.
res <- write_report(rpt, output_type = "rtf")
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-130: auto_page can be turned off as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test130.rtf")
dat <- iris[1:100, ]
dat$Species <- as.character(dat$Species)
dat$Species[1:25] <- rep("setosa1", 25)
dat$Species[26:50] <- rep("setosa2", 25)
tbl <- create_table(dat, auto_page = FALSE) %>%
footnotes("First Table with auto_page=FALSE in create_table", "My footnote 2", valign = "bottom") %>%
define(Species, page_break = TRUE)
tbl2 <- create_table(dat) %>%
footnotes("Second Table with auto_page=FALSE in report_options", "My footnote 2", valign = "bottom") %>%
define(Species, page_break = TRUE)
tbl3 <- create_table(dat, auto_page = TRUE) %>%
footnotes("Third Table with auto_page=TRUE in create_table", "My footnote 2", valign = "bottom") %>%
define(Species, page_break = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 10, orientation = "landscape") %>%
report_options(auto_page = FALSE) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table") %>%
add_content(tbl) %>%
add_content(tbl2) %>%
add_content(tbl3) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
# If auto_page is still TRUE, setosa1 would have 2 pages because only 24 records
# on first page.
expect_equal(file.exists(fp), TRUE)
# Please note that res$pages would be 3 instead of 4 because versicolor is overflow
} else {
expect_equal(TRUE, TRUE)
}
})
# Basic Tests 131-140 ------------------------------------------------------
test_that("rtf2-131: Titles can be output in paragraph for table as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test131.rtf")
dat <- mtcars[1:15, ]
tbl <- create_table(dat) %>%
column_defaults(width = 1) %>%
titles("This is subtitle", align = "left")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = fsz, orientation = "portrait") %>%
report_options(title_block = "paragraph") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Right3"), blank_row = "below") %>%
titles("Table 1.0", "My Nice Table", font_size = 14) %>%
titles("Title in Header", header = TRUE) %>%
add_content(tbl) %>%
footnotes("My footnote 1", "My footnote 2", valign = "top") %>% # Works!
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-132: Titles can be output in paragraph for figure as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf2/test132.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8, borders = c("top", "bottom", "all")) %>%
titles("This is subtitle", borders = "none") %>%
footnotes("* Motor Trend, 1974", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size =fsz) %>%
report_options(title_block = "paragraph") %>%
titles("Figure 1.0", "My Nice Figure", font_size = 14) %>%
titles("Title in Header", header = TRUE) %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(plt) %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-133: Titles can be output in paragraph for text as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test133.rtf")
txt <- create_text(cnt, width = 6, borders = "outside", align = "right") %>%
titles("Text 1.0", "My Nice Text", borders = "none", font_size = 12) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 10) %>%
report_options(title_block = "paragraph") %>%
titles("Text 1.0", "My Nice Text", font_size = 14) %>%
titles("Title in Header", header = TRUE) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
add_content(txt, align = "right") %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-134: line_count can be set in report_options as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test134.rtf")
dat <- iris[1:100, ]
tbl <- create_table(dat) %>%
footnotes("line_count setting in report_options()", "My footnote 2", valign = "bottom")
rpt <- create_report(fp, output_type = "RTF", font = "Arial",
font_size = 10, orientation = "landscape") %>%
report_options(line_count = 18) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "Table with line_count = 18") %>%
add_content(tbl) %>%
page_footer("Left1", "Center1", "Right1")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-135: Empty page_by works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test135.rtf")
# Prepare data
dat <- mtcars[order(mtcars$cyl), ]
dat <- data.frame(vehicle = rownames(dat), dat)
dat$cyl[1] <- ""
dat$cyl[2] <- NA
# Define table
tbl <- create_table(dat, show_cols = 1:8) %>%
page_by(cyl, label="Cylinders: ")
# Create the report
rpt <- create_report(fp, output_type = "rtf",
font = "Courier", font_size = 12) %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Listing 3.0", "Empty and NA page_by") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer(left = Sys.time(),
center = "Confidential",
right = "Page [pg] of [tpg]")
# Write the report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-136: Numeric page_by works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test136.rtf")
# Prepare data
dat <- mtcars[order(mtcars$cyl), ]
dat <- data.frame(vehicle = rownames(dat), dat)
dat$cyl[1] <- NA
# Define table
tbl <- create_table(dat, show_cols = 1:8) %>%
page_by(cyl, label="Cylinders: ")
# Create the report
rpt <- create_report(fp, output_type = "rtf",
font = "Courier", font_size = 12) %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Listing 3.0", "Numeric and NA page_by") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer(left = Sys.time(),
center = "Confidential",
right = "Page [pg] of [tpg]")
# Write the report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-137: Multiple dedupe works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test137.rtf")
# Setup
subjid <- c(100,100,101,101,101,102,103,103,104,104)
param <- c(rep("Hemoglobin", 3), rep("Triglycerides", 4), rep("Platelets", 3))
result <- c(41, 53, 43, 39, 47, 52, 21, 38, 62, 26)
Lab <- c(NA, NA, "central", "central", "central", NA, "local", "local", NA, NA)
arm <- c(rep("A", 5), rep("B", 5))
df <- data.frame(subjid, arm, param, Lab, result)
tbl1 <- create_table(df, first_row_blank = FALSE) %>%
define(subjid, label = "Subject", align = "left", dedupe = TRUE) %>%
define(param, label = "Lab Test", dedupe = c("subjid", "param")) %>%
define(result, label = "Result") %>%
define(Lab, visible = FALSE) %>%
define(arm, label = "Arm",
blank_after = TRUE,
dedupe = c("Lab", "arm"),
align = "right")
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
page_header(left = "Company", right = c("Study ABC", "Status: Closed")) %>%
titles("Table 1.0", "Multiple Dedupe of subjid, arm, and lab test",
"Lab is non-visible for arm's dedupe", align = "center") %>%
footnotes("Program Name: table1_0.R") %>%
page_footer(left = "Time", center = "Confidential",
right = "Page [pg] of [tpg]") %>%
add_content(tbl1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-138: Courier is displayed as Courier New as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test138.rtf")
txt <- create_text(cnt, width = 6, borders = "outside", align = "right") %>%
titles("Text 1.0", "My Nice Text", borders = "none", font_size = 12) %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = "courier",
font_size = 10) %>%
report_options(title_block = "paragraph") %>%
titles("Text 1.0", "My Nice Text", font_size = 14) %>%
titles("Title in Header", header = TRUE) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", "Right") %>%
add_content(txt, align = "right") %>%
page_footer("Left1", "Center1", "Right1")
# There is no visual difference between Courier and Courier New
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
# Check if there is Courier New
rtf <- readLines(fp, warn = FALSE)
expect_equal(rtf[1],
"{\\rtf1\\ansi\\deff0 {\\fonttbl {\\f0 Courier New;}}")
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-139: Customized small line height works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test139.rtf")
dat <- iris[1:100, ]
dat$row_number <- 1:100
dat <- dat[, c("row_number", "Sepal.Width", "Petal.Length", "Petal.Width", "Species")]
tbl <- create_table(dat) %>%
footnotes("line_height setting in report_options()", "My footnote 2", valign = "bottom") %>%
spanning_header(from = 1, to = 2, label = "First Spanning") %>%
spanning_header(from = 3, to = 5, label = "Second Spanning") %>%
page_by(Species, label = "Page by Label:")
rpt <- create_report(fp, output_type = "rtf", font = "Arial",
font_size = 10, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
# report_options(line_height = 0.12, title_block = "paragraph") %>%
report_options(line_height = 0.12) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "Table with line height adjustment") %>%
# title_header("Table 1.0", "Table with line height adjustment") %>%
add_content(tbl) %>%
page_footer(c("Left1", "Left2"), "Center1", "Right1")
# The text squishing is expected.
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-139b: Customized large line height works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test139b.rtf")
dat <- iris[1:100, ]
dat$row_number <- 1:100
dat <- dat[, c("row_number", "Sepal.Width", "Petal.Length", "Petal.Width", "Species")]
tbl <- create_table(dat) %>%
footnotes("line_height setting in report_options()", "My footnote 2", valign = "bottom") %>%
spanning_header(from = 1, to = 2, label = "First Spanning") %>%
spanning_header(from = 3, to = 5, label = "Second Spanning") %>%
page_by(Species, label = "Page by Label:")
rpt <- create_report(fp, output_type = "rtf", font = "Arial",
font_size = 10, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
report_options(line_height = 0.2) %>%
page_header("Left", c("Right1", "Right2", "Page [pg] of [tpg]"), blank_row = "below") %>%
titles("Table 1.0", "Table with line height adjustment") %>%
# title_header("Table 1.0", "Table with line height adjustment") %>%
add_content(tbl) %>%
page_footer(c("Left1", "Left2"), "Center1", "Right1")
# Large line height should not cause overflow.
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf2-140: Percentage column widths work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test140.rtf")
dat <- iris
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Irises", "Another Title") %>%
define(Sepal.Length, label = "Sepal Length", width = "33.33333%", align = "center") %>%
define(Sepal.Width, label = "Sepal Width", width = "20%", align = "centre") %>%
define(Species, blank_after = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1")) %>%
add_content(tbl, blank_row = "none") %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-140b: Percentage column widths work with 100% as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/test140b.rtf")
dat <- iris
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Irises", "Another Title") %>%
define(Sepal.Length, label = "Sepal Length", width = "20.17%", align = "center") %>%
define(Sepal.Width, label = "Sepal Width", width = "20.17%", align = "centre") %>%
define(Petal.Length, label = "Petal Length", width = "20.17%", align = "centre") %>%
define(Petal.Width, label = "Petal.Width", width = "20.17%", align = "centre") %>%
define(Species, width = "19.32%", blank_after = TRUE)
total_width <- round(9*0.2017, 2) * 4 + round(9*0.1932, 2)
# The total width is 9.02, which is greater than 9
# The algorithm needs to prevent from total width exceeding 9
rpt <- create_report(fp, output_type = "RTF", font = fnt,
font_size = 12, orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Left", c("Right1")) %>%
add_content(tbl, blank_row = "none") %>%
page_footer("Left1", "Center1", "Page [pg] of [tpg]") %>%
footnotes("My footnote 1", "My footnote 2")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2-141: Output Chinese as expected.", {
if (dev == TRUE) {
# Read in prepared data
df <- read.table(header = TRUE, text = '
group1 group2 trt1 trt2 subgroup
"性别" "男" "75 (51.7)" "91 (59.5)" "≥65岁"
"性别" "女" "70 (48.3)" "62 (40.5)" "≥65岁"
"年龄" "例数" "145" "153" "≥65岁"
"年龄" "平均数" "64.7" "65.8" "≥65岁"
"年龄" "中位数" "65.0" "66.0" "≥65岁"
"年龄" "标准差" "9.7" "8.3" "≥65岁"
"年龄" "最小值, 最大值" "40, 83" "43.85" "≥65岁"')
df$trt3 <- df$trt1
df$trt4 <- df$trt2
df$trt5 <- df$trt1
df <- rbind(df, df, df, df)
tbl <- create_table(df, borders = "all") %>%
titles("表 14-2.1. 基线人口学特征", "(安全分析集)", borders = "all") %>%
# stub(c("group1", "group2"), width = 1) %>%
stub(c("group1", "group2")) %>%
page_by(subgroup, label = "亚组 - 这是一段很长的字，预计会占两行以上。用来测试空白行的宽度是否需要缩减。切割文字的函數需 修改，分割不需要用空白：",
borders = "all") %>%
define(group1, label_row = T, blank_after = T) %>%
define(group2, indent = 0.25) %>%
define(trt1, label = "试验药物一") %>%
define(trt2, label = "试验药物二") %>%
define(trt3, label = "试验药物三") %>%
define(trt4, label = "试验药物四") %>%
define(trt5, label = "安慰剂") %>%
define(subgroup, visible = FALSE) %>%
spanning_header(from = "trt1", to = "trt3", label = "高试验药物") %>%
spanning_header(from = "trt4", to = "trt5", label = "低试验药物")
font_lst <- c(8, 9, 10, 11, 12)
for (f in font_lst) {
file_name <- paste0("test141_", f, ".rtf")
fp <- file.path(base_path, "rtf2/", file_name)
rpt <- create_report(fp, output_type = "RTF", font = "SimSun",
font_size = f, orientation = "portrait") %>%
set_margins(top = 1, bottom = 1) %>%
# report_options(line_height = 0.175) %>%
page_header("研究123", "分析数据审阅说明") %>%
add_content(tbl, blank_row = "none") %>%
page_footer("左页尾", "中页尾", "第 [pg] 页, 共 [tpg] 页") %>%
footnotes("用于分析目的。其中包括人口统计学、治疗组和人群标帜。",
"受试者水平分析数据集。", borders = "all")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
}
} else
expect_equal(TRUE, TRUE)
})
# User Tests --------------------------------------------------------------
test_that("user1: demo table works.", {
if (dev) {
library(tidyr)
library(dplyr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "rtf2/user1.rtf")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- subset(data_demo, data_demo$ARM != "SCREEN FAILURE")
sex_decode <- c("M" = "Male",
"F" = "Female")
race_decode <- c("WHITE" = "White",
"BLACK OR AFRICAN AMERICAN" = "Black or African American",
"ASIAN" = "Asian or Pacific Islander",
"NATIVE AMERICAN" = "Native American",
"UNKNOWN" = "Unknown")
arm_pop <- table(data_demo$ARM)
demo_age <-
data_demo %>%
group_by(ARM) %>%
summarise(across(.cols = AGE,
.fns = list(N = ~ fmt_n(.),
Mean = ~ fmt_mean_sd(.),
Median = ~ fmt_median(.),
`Q1 - Q3` = ~ fmt_quantile_range(.),
Range = ~ fmt_range(.)
))) %>%
pivot_longer(-ARM,
names_to = c("var", "label"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = ARM,
values_from = "value")
demo_sex <-
data_demo %>%
add_count(ARM, SEX, name = "n_SEX") %>%
select(ARM, SEX, n_SEX) %>%
distinct() %>%
pivot_longer(cols = c(SEX),
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_SEX,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(sex_decode),
labels = sex_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"]))
demo_race <-
data_demo %>%
add_count(ARM, RACE, name = "n_RACE") %>%
select(ARM, RACE, n_RACE) %>%
distinct() %>%
pivot_longer(cols = RACE,
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_RACE,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(race_decode),
labels = race_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"])) %>%
arrange(var, label)
demo <- bind_rows(demo_age, demo_sex, demo_race)
#View(demo)
# Stub decode
block_fmt <- c(AGE = "Age", SEX = "Sex", RACE = "Race")
# Define table
tbl <- create_table(demo, first_row_blank = TRUE, borders = c("outside")) %>%
column_defaults(from = "ARM A", to = "ARM D", width = 1.25) %>%
define(var, blank_after = TRUE, dedupe = TRUE,
format = block_fmt, label = "") %>%
define(label, label = "") %>%
define(`ARM A`, align = "center", label = "Placebo", n = 36) %>%
define(`ARM B`, align = "center", label = "Drug 10mg", n = 38) %>%
define(`ARM C`, align = "center", label = "Drug 20mg", n = 38) %>%
define(`ARM D`, align = "center", label = "Competitor", n = 38)
# Define Report
rpt <- create_report(fp, output_type = "RTF", font = fnt, font_size = fsz) %>%
set_margins(top = 1, bottom = 1) %>%
options_fixed(font_size = 10) %>%
titles("Table 14.1/4",
"Demographics and Baseline to Characteristics",
"Specify Population Ω µ β ¥ ∑ ≠ ≤ £ ∞ ؈ ლ \Ub8a 鬼") %>%
add_content(tbl) %>%
footnotes("Special symbols \U221e to mess things up: Ω µ β ¥ ∑ ≠ ≤ £ ∞ ؈ ლ \Ub8a 鬼 标题") %>%
footnotes("Special symbols µ Ω £ there to mess things up: ", "Page [pg] of [tpg]",
align = 'right', italics = TRUE) %>%
page_header("Left µ Ω £ ", "Right") %>%
page_footer("Time µ Ω £ ", right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user2: demo table with stub works.", {
if (dev) {
library(tidyr)
library(dplyr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "rtf2/user2.rtf")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- subset(data_demo, data_demo$ARM != "SCREEN FAILURE")
sex_decode <- c("M" = "Male",
"F" = "Female")
race_decode <- c("WHITE" = "White more",
"BLACK OR AFRICAN AMERICAN" = "Black or African American",
"ASIAN" = "Asian or Pacific Islander",
"NATIVE AMERICAN" = "Native American",
"UNKNOWN" = "Unknown")
arm_pop <- table(data_demo$ARM)
demo_age <-
data_demo %>%
group_by(ARM) %>%
summarise(across(.cols = AGE,
.fns = list(N = ~ fmt_n(.),
Mean = ~ fmt_mean_sd(.),
Median = ~ fmt_median(.),
`Q1 - Q3` = ~ fmt_quantile_range(.),
Range = ~ fmt_range(.)
))) %>%
pivot_longer(-ARM,
names_to = c("var", "label"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = ARM,
values_from = "value")
demo_sex <-
data_demo %>%
add_count(ARM, SEX, name = "n_SEX") %>%
select(ARM, SEX, n_SEX) %>%
distinct() %>%
pivot_longer(cols = c(SEX),
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_SEX,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(sex_decode),
labels = sex_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"]))
demo_race <-
data_demo %>%
add_count(ARM, RACE, name = "n_RACE") %>%
select(ARM, RACE, n_RACE) %>%
distinct() %>%
pivot_longer(cols = RACE,
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_RACE,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(race_decode),
labels = race_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"])) %>%
arrange(var, label)
demo <- bind_rows(demo_age, demo_sex, demo_race)
#View(demo)
# Stub decode
block_fmt <- c(AGE = "Age", SEX = "Sex", RACE2 = "Race")
# Define table
tbl <- create_table(demo, first_row_blank = TRUE, borders = "all") %>%
stub(c("var", "label"), width = 1.5) %>%
column_defaults(width = 1) %>%
define(var, blank_after = TRUE, blank_before = TRUE,
format = block_fmt, label = "", label_row = TRUE) %>%
define(label, label = "", indent = .25) %>%
define(`ARM A`, align = "center", label = "Placebo", n = 36) %>%
define(`ARM B`, align = "center", label = "Drug 10mg", n = 38) %>%
define(`ARM C`, align = "center", label = "Drug 20mg", n = 38) %>%
define(`ARM D`, align = "center", label = "Competitor", n = 38) %>%
titles("Table 14.1/4",
"Demographics and Baseline Characteristics",
"Specify Population", borders = "outside", blank_row = "both",
align = "right") %>%
footnotes("Here is a footnote", "Here is another footnote",
borders = "outside", blank_row = "both", align = "right")
# Define Report
rpt <- create_report(fp, output_type = "RTF",
font = "Arial", font_size = 10) %>%
add_content(tbl, align = "right") %>%
page_header("Sponsor", "Drug") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]") #%>%
#page_by(var = "var", label = "Variable: ")
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user3: listings works.", {
if (dev == TRUE) {
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "rtf2/user3.rtf")
# Removing to make last page exactly equal to available rows on page.
# In this case, any added blank rows should be skipped.
fil <- c("ABC-14-124",
"ABC-15-153",
"ABC-15-154",
"ABC-15-155",
"ABC-15-156",
"ABC-16-045",
"ABC-16-046",
"ABC-16-047",
"ABC-16-157",
"ABC-16-158",
"ABC-16-159",
"ABC-16-160")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- data_demo[!data_demo$USUBJID %in% fil, ]
# Test that any assigned formats are applied
attr(data_demo$SUBJID, "width") <- 1
attr(data_demo$SUBJID, "justify") <- "left"
attr(data_demo$SUBJID, "format") <- "S:%s"
#print(widths(data_demo))
names(data_demo)
# Define table
tbl <- create_table(data_demo) %>%
define(USUBJID, id_var = TRUE)
# Define Report
rpt <- create_report(fp, font = "Times", font_size = 8,
orientation = "landscape") %>%
titles("Listing 1.0",
"Demographics Dataset") %>%
add_content(tbl, align = "left") %>%
page_header("Sponsor", "Drug") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]") %>%
footnotes("My footnotes")
#Write out report
res <- write_report(rpt, output_type = "RTF")
expect_equal(file.exists(fp), TRUE)
# pdfpth <- file.path(base_path, "user/user3.pdf")
# write_report(rpt, pdfpth, output_type = "PDF")
# expect_equal(file.exists(pdfpth), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user4: listing in cm and times works.", {
if (dev == TRUE) {
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "rtf2/user4.rtf")
# Removing to make last page exactly equal to available rows on page.
# In this case, any added blank rows should be skipped.
fil <- c("ABC-14-124",
"ABC-15-153",
"ABC-15-154",
"ABC-15-155",
"ABC-15-156",
"ABC-16-045",
"ABC-16-046",
"ABC-16-047",
"ABC-16-157",
"ABC-16-158",
"ABC-16-159",
"ABC-16-160")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- data_demo[!data_demo$USUBJID %in% fil, ]
# Test that any assigned formats are applied
attr(data_demo$SUBJID, "width") <- 2.54
attr(data_demo$SUBJID, "justify") <- "left"
attr(data_demo$SUBJID, "format") <- "S:%s"
#print(widths(data_demo))
# Define table
tbl <- create_table(data_demo) %>%
define(USUBJID, id_var = TRUE)
# Define Report
rpt <- create_report(fp, font = "Arial", font_size = 10, units = "cm",
orientation = "portrait") %>%
titles("Listing 1.0",
"Demographics Dataset") %>%
add_content(tbl, align = "left") %>%
page_header("Sponsor", "Drug") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]") %>%
footnotes("My footnote")
#Write out report
res <- write_report(rpt, output_type = "RTF")
#print(res$column_widths)
expect_equal(file.exists(fp), TRUE)
# pdfpth <- file.path(base_path, "user/user3.pdf")
# write_report(rpt, pdfpth, output_type = "PDF")
# expect_equal(file.exists(pdfpth), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user5: Portrait in 12pt Arial works as expected.", {
if (dev == TRUE) {
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "rtf2/user5.rtf")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
define(var, label = "Variable", blank_after = TRUE, dedupe = TRUE,
format = c(ampg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, label = "") %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "Arial", font_size = 12) %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user6: Borders with spanning headers work as expected.", {
if (dev == TRUE) {
df <- read.table(header = TRUE, text = '
var label A B C
"AGE" "n" "19" "13" "32"
"AGE" "Mean" "18.8 (6.5)" "22.0 (4.9)" "20.0 (5.9)"
"AGE" "Median" "16.4" "21.4" "20.1"
"AGE" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8" "15.2 - 21.8"
"RACE" "White" "10 (52.6)" "4 (30.8)" "14 (43.8)"
"RACE" "Black" "4 (21.1)" "3 (23.1)" "7 (21.9)"
"RACE" "Others\U1D47" "5 (26.3)" "6 (46.2)" "11 (34.4.2)"
')
var_fmt <- c(AGE = "Age (yrs)", RACE = "Race - n (%)")
fp <- file.path(base_path, "rtf2/user6.rtf")
tbl <- create_table(df, first_row_blank = TRUE, borders = c("outside")) %>%
stub(vars = c("var", "label"), " ", width = 2.5) %>%
spanning_header(from = "A", to = "B", label = "Treatments\U1D43") %>%
define(var, blank_after = TRUE, format = var_fmt, label_row = TRUE) %>%
define(label, indent=0.25) %>%
define(A, align = "center", label = "Placebo\n(N = 19)") %>%
define(B, align = "center", label = "Drug\n(N = 13)") %>%
define(C, align = "center", label = "Total\n(N = 32)") %>%
footnotes("\U1D43 study drug", blank_row="none" ) %>%
footnotes("\U1D47 Asian, Japanese and Chinese", blank_row="none")
rpt <- create_report(fp, output_type = "RTF",
font = "Arial") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_footer(left = paste("Date:", "Left"), right = "Page [pg] of [tpg]", blank_row="none") %>%
footnotes("Program: C:/Users/Home/AppData/Local/Temp/tdemo.R", blank_row="above")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
# file.show(fp)
} else
expect_equal(TRUE, TRUE)
})
# This is good
test_that("user7: Check footnotes on page by.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf2/user7")
df <- read.table(header = TRUE, text = '
var stat A B
"Age (yrs)" "n" "19" "13"
" " "Mean" "18.8 (6.5)" "22.0 (4.9)"
" " "Median" "16.4" "21.4"
" " "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
" " " " " " " "
"Race" "White" "10 ( 52.6%)" "4 ( 30.8%)"
" " "Black" "4 ( 21.1%)" "3 ( 23.1%)"
" " "Others\U1D47" "5 ( 26.3%)" "6 ( 46.2%)"')
df1 <- df
df2 <- df
df3 <- df
df1$SEX <- 'Female'
df2$SEX <- 'Male'
df3$SEX <- 'Other'
df <- rbind(df1, df2, df3)
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders=c("top")) %>%
page_by(SEX, "Sex: ", align = "left", blank_row="none") %>%
# stub(c("var", "label")) %>%
column_defaults(width = 1.25) %>%
spanning_header(from = "A", to = "B", label = "Treatments\U1D43") %>%
define(SEX, visible = FALSE) %>%
define(var, label = " ", align = "left") %>%
define(stat,label = " ", align = "left") %>%
define(A, label = "Treament A", align = "center", n = 19) %>%
define(B, label = "Treament B", align = "center", n = 13) %>%
titles("Table 1.1 Demographics", "Randomised Population", font_size = 10) %>%
footnotes("Page [pg] of [tpg]", align = "right", blank_row="none", borders=c("top")) %>%
footnotes("\U1D43 study drug treatments", blank_row="none", borders=c("top") ) %>%
footnotes("\U1D47 Asian, Japanese and Chinese", blank_row="none", borders="bottom")
rpt <- create_report(fp, output_type = "RTF", font = "Arial", font_size = 10) %>%
#This is page header and it goes into the header of the table
page_header("Protocol: 9999") %>%
add_content(tbl) %>%
page_footer(left = paste("Date:", "Left"), right = "Page [pg] of [tpg]", blank_row="none") %>%
footnotes("Program: C:/Users/Home/AppData/Local/Temp/tdemo.R", blank_row="above", valign = "bottom")
res <- write_report(rpt)
expect_equal(file.exists(res$modified_path), TRUE)
expect_equal(res$pages, 3)
} else
expect_equal(TRUE, TRUE)
})
Try the reporter package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.