Nothing
tests/testthat/test-rtf.R
In reporter: Creates Statistical Reports
context("RTF Tests")
base_path <- paste0(getwd(),"/tests/testthat")
base_path <- tempdir()
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.")
dev <- FALSE
test_that("rtf1: Simplest table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test1.rtf")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
add_content(create_table(mtcars[1:10, ]), align = "left")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2: Simplest table with title works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test2.rtf")
tbl <- create_table(mtcars[1:10, ]) %>%
define(vs, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
options_fixed(font_size = 10) %>%
titles("MTCARS Data Frame", align = "left") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf3: Table with break between sections works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test3.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, stringsAsFactors = FALSE)
tbl1 <- create_table(df, first_row_blank = TRUE) %>%
define(subjid, label = "Subject ID", align = "left") %>%
define(name, label = "Subject Name") %>%
define(sex, label = "Sex") %>%
define(age, label = "Age") %>%
define(arm, label = "Arm",
blank_after = TRUE,
dedupe = TRUE,
align = "right")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
options_fixed(font_size = 10) %>%
page_header(left = "Experis", right = c("Study ABC", "Status: Closed")) %>%
titles("Table 1.0", "Analysis Data Subject Listing",
"Safety Population", 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)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf4: Table that spans multiple pages breaks as expected.", {
fp <- file.path(base_path, "rtf/test4.rtf")
rpt <- create_report(fp, output_type = "RTF") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
#write_registration_file(file.path(base_path,"./rtf/reg.txt"))
})
test_that("rtf5: Table with long cell and label values wraps as expected.", {
fp <- file.path(base_path, "rtf/test5.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 = "fixed") %>%
titles("Table 1.0", align = "center") %>%
add_content(tbl1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf6: Table with spanning headers works as expected.", {
fp <- file.path(base_path, "rtf/test6.rtf")
df <- data.frame(vehicle = rownames(mtcars), mtcars, stringsAsFactors = FALSE)
rownames(df) = NULL
df$qsec <- fattr(df$qsec, format = "%.1f")
df$wt <- fattr(df$wt, justify = "center", width = .75)
tbl <- create_table(df) %>%
spanning_header("mpg", "hp",
label = "Span 1", label_align = "center", n = 10) %>%
spanning_header("drat", "qsec",
label = "Span 2", label_align = "center", n = 10) %>%
spanning_header("vs", "carb",
label = "Span 3", label_align = "center", n = 10) %>%
spanning_header(from = "drat", to = "carb", label = "Super Span",
label_align = "center",
level = 2) %>%
define(vehicle, label = "Vehicle") %>%
define(mpg, format = "%.1f")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
add_content(tbl) %>%
titles("Table 1.0", "MTCARS Subset Test")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf7: Simplest RTF report with 1 in margins works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test7.rtf")
tbl <- create_table(mtcars[1:10, ]) %>%
column_defaults(width = .5) %>%
define(vs, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
page_header("Client", "Study") %>%
titles("MTCARS Data Frame") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl, align = "left") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf8: Two page RTF report works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test8.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, stringsAsFactors = FALSE)
df1 <- df[df$arm == "A", ]
df2 <- df[df$arm == "B", ]
afmt <- value(condition(x == "A", "Placebo"),
condition(x == "B", "Treatment 1"))
sfmt1 <- value(condition(x == "M", "Male"),
condition(x == "F", "Female"),
condition(TRUE, "Other"))
sfmt2 <- c(M = "Male", F = "Female")
tbl1 <- create_table(df1, width = 7) %>%
define(sex, width = 1, format = sfmt1) %>%
define(name, width = 2) %>%
define(age, width = 1, align = "left")
tbl2 <- create_table(df2, width = 7) %>%
define(sex, width = 1, format = sfmt2) %>%
define(age, format = "%0d%%", align = "left") %>%
define(name, width = 2) %>%
define(arm, format = afmt, width = 2, align = "right")
rpt <- create_report(fp, output_type = "RTF") %>%
options_fixed(font_size = 10) %>%
set_margins(top = 1, bottom = 1) %>%
page_header(left = "Experis", right = c("Study ABC", "Status: Closed")) %>%
titles("Table 1.0", "Analysis Data Subject Listing",
"Safety Population", align = "center") %>%
footnotes("Program Name: table1_0.R") %>%
page_footer(left = "Time", center = "Confidential",
right = "Page [pg] of [tpg]") %>%
add_content(tbl1) %>%
add_content(tbl2)
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf9: Simplest RTF Plot works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf/test9.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 = "fixed") %>%
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("rtf10: RTF Table with Plot works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf/test10.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8)
tbl <- create_table(mtcars[1:10, ])
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
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, 2)
})
test_that("rtf11: RTF Table with Plot on same page works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf/test11.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 = "fixed") %>%
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("rtf12: Table and Text output works as expected.", {
fp <- file.path(base_path, "rtf/test12.rtf")
tbl1 <- mtcars[1:10, ]
tbl2 <- mtcars[11:20, ]
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "fixed") %>%
titles("Report 5.0", "Table and Text Report") %>%
page_header(left = "Client: ABC", right = "Study: 123") %>%
add_content(create_table(tbl1), page_break = FALSE) %>%
add_content(create_text("* NOTE: Car information from 1971."),
align = "left") %>%
add_content(create_table(tbl2), page_break = FALSE) %>%
add_content(create_text("* NOTE: Car information from 1972."),
align = "left") %>%
page_footer(left = "Time",
center = "Confidential",
right ="Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
})
test_that("rtf13: Very Long text output works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test13.rtf")
l <- paste(rep(cnt, 1000), collapse = "\n\n")
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "fixed") %>%
titles("Report 6.0", "Very long Text Report") %>%
page_header(left = "Client: ABC", right = "Study: 123") %>%
add_content(create_text(l)) %>%
page_footer(left = "Time",
center = "Confidential",
right ="Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 123)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf14: Simplest portrait table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test14.rtf")
rpt <- create_report(fp, output_type = "RTF", orientation = "portrait",
font = "fixed") %>%
page_header("left", "right") %>%
titles("Table 1.0", "MTCARS Data Frame", borders = "all") %>%
add_content(create_table(mtcars)) %>%
page_footer("Left", right = "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf15: Simplest landscape table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test15.rtf")
rpt <- create_report(fp, output_type = "RTF", orientation = "landscape",
font = "fixed") %>%
page_header("left", "right") %>%
titles("Table 1.0", "MTCARS Data Frame", borders = "all") %>%
add_content(create_table(mtcars)) %>%
page_footer("Left", right = "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("test16: 10 pt report with units in cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test16.rtf")
rpt <- create_report(fp, units = "cm", output_type = "RTF",
font = "fixed") %>%
page_header("Client: Experis", "Study: ABC") %>%
titles("IRIS Data Frame") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]") %>%
add_content(create_table(iris))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
} else
expect_equal(TRUE, TRUE)
})
test_that("test17: 12 pt report with units in cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test17.rtf")
rpt <- create_report(fp, units = "cm", output_type = "RTF",
font = "fixed") %>%
options_fixed(font_size = 12) %>%
page_header("Client: Experis", "Study: ABC") %>%
titles("IRIS Data Frame") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]") %>%
add_content(create_table(iris))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 5)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf18: Plot with page by on report works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf/test18.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 = "fixed") %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot",
blank_row = "none", borders = "all") %>%
set_margins(top = 1, bottom = 1) %>%
page_by(cyl, "Cylinders: ") %>%
add_content(plt) %>%
footnotes("* Motor Trend, 1974", borders = "all") %>%
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("rtf19: Plot with page by on plot works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf/test19.rtf")
dat <- mtcars[order(mtcars$cyl), ]
fmt <- value(condition(x == 4, "4 Cylinder"),
condition(x == 6, "6 Cylinder"),
condition(x == 8, "8 Cylinder"))
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 = "fixed") %>%
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("test20: Title Header on Plot works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test20.rtf")
p <- ggplot(mtcars, aes(x=disp, y=mpg)) + geom_point()
plt <- create_plot(p, height = 5, width = 7) %>%
title_header("Figure 1.0", "MTCARS Plot",
right = c("Client", "Page", "More"), borders = "all") %>%
footnotes("* Motor Trend, 1974", borders = "all")
rpt <- create_report(fp, units = "inches", output_type = "RTF",
font = "fixed") %>%
options_fixed(font_size = 12) %>%
add_content(plt)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
#
# test_that("rtf19: Plot and table with page by works as expected.", {
#
# library(ggplot2)
#
# fp <- file.path(base_path, "rtf/test19.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") %>%
# page_header("Client", "Study: XYZ") %>%
# titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", blank_row = "none") %>%
# set_margins(top = 1, bottom = 1) %>%
# #page_by(grp, "Mileage Category: ") %>%
# add_content(plt) %>%
# # 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)
#
#
#
# })
test_that("test21: 8 pt report with units in inches works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test21.rtf")
tbl <- create_table(iris)
rpt <- create_report(fp, units = "inches", output_type = "RTF",
font = "fixed") %>%
page_header("Client: Experis", "Study: ABC") %>%
titles("IRIS Data Frame") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]") %>%
options_fixed(font_size = 8) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 3)
} else
expect_equal(TRUE, TRUE)
})
test_that("test22: 8 pt report with units in cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test22.rtf")
rpt <- create_report(fp, units = "cm", output_type = "RTF",
font = "fixed") %>%
page_header("Client: Experis", "Study: ABC") %>%
titles("IRIS Data Frame") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]") %>%
options_fixed(font_size = 8) %>%
add_content(create_table(iris))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 3)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf23: RTF Table with Plot and borders works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf/test23.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8)
tbl <- create_table(mtcars[1:10, ])
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", borders = "all") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
add_content(plt, align = "center") %>%
footnotes("* Motor Trend, 1974", borders = "all") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf24: RTF Table with Plot and borders works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf/test24.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8) %>%
titles("My plot", borders = "all") %>%
footnotes("My plot footnotes", borders = "all")
tbl <- create_table(mtcars[1:10, ]) %>%
titles("My table", borders = "all") %>%
footnotes("My table footnotes", borders = "all", align = "right")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
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, 2)
})
test_that("rtf25: RTF Table with custom options works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test25.rtf")
tbl <- create_table(mtcars[1:10, ]) %>%
titles("My table", borders = "all") %>%
footnotes("My table footnotes", borders = "all", align = "right")
tbl2 <- create_table(mtcars[11:20, ]) %>%
titles("My table", borders = "all") %>%
footnotes("My table footnotes", borders = "all", align = "right")
rpt <- create_report(fp, font = "fixed") %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
add_content(tbl2, align = "center") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]") %>%
options_fixed(font_size = 12, line_size = 80, line_count = 30,
uchar = "-")
res <- write_report(rpt, output_type = "RTF")
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf26: line_size and line_count overrides work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test26.rtf")
rpt <- create_report(fp, font = "fixed") %>%
options_fixed(line_size = 40, line_count = 30) %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris))
res <- write_report(rpt, output_type = "RTF")
res
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf27: Plot Borders work as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf/test27.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8, borders = "all") %>%
titles("My plot", borders = "none") %>%
footnotes("My plot footnotes", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
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("rtf28: Table Borders that spans multiple pages work as expected.", {
fp <- file.path(base_path, "rtf/test28.rtf")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris, borders = "all")) %>%
footnotes("Here is a footnote")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
#write_registration_file(file.path(base_path,"./rtf/reg.txt"))
})
test_that("rtf29: Simplest RTF Plot with valign top works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf/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 = "fixed") %>%
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("rtf30: Simplest RTF Plot with valign bottom works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf/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 = "fixed") %>%
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)
})
test_that("rtf31: Simplest RTF Text with valign top works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test31.rtf")
txt <- create_text(cnt, width = 6)
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
page_header("Client", "Study: XYZ") %>%
titles("Text 1.0", "MTCARS Miles per Cylinder Text") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(txt, 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("rtf32: Simplest RTF Text with valign bottom works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test32.rtf")
txt <- create_text(cnt, width = 6) %>%
footnotes("* Motor Trend, 1974", valign = "bottom")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
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("rtf33: use_attributes parameter table works as expected.", {
if (dev == TRUE) {
fp1 <- file.path(base_path, "rtf/test33a.rtf")
fp2 <- file.path(base_path, "rtf/test33b.rtf")
fp3 <- file.path(base_path, "rtf/test33c.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 = "fixed") %>%
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 = "fixed") %>%
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 = "fixed") %>%
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("rtf34: 9 pt font inches works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test34.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 9,
orientation = "portrait", font = "fixed") %>%
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("rtf35: 9 pt font cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test35.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 9,
orientation = "portrait", font = "fixed") %>%
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("rtf36: 11 pt font inches works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test36.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 11,
orientation = "portrait", font = "fixed") %>%
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("rtf37: 11 pt font cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test37.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 11,
orientation = "portrait", font = "fixed") %>%
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("rtf38: RTF Image file works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf/test38.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
pltpath <- file.path(base_path, "rtf/test38.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 = "fixed") %>%
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("rtf39: Blank after on invisible column.", {
fp <- file.path(base_path, "rtf/test39.rtf")
tbl <- create_table(iris, borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
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("rtf40: Page header width works as expected.", {
fp <- file.path(base_path, "rtf/test40.rtf")
tbl <- create_table(iris[1:10, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
page_header("Left here is some stuff and more stuff trying to get out in the middle",
"Right", width = 8) %>%
add_content(tbl) %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below", header = TRUE) %>%
footnotes("Here is a footnote", "And another", footer = TRUE)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf41: Custom page size works as expected.", {
fp <- file.path(base_path, "rtf/test41.rtf")
tbl <- create_table(iris[1:15, ]) %>%
define(Species, visible = FALSE)
ttl <- c("Title1", "Title2", "Title3")
rpt <- create_report(fp, output_type = "RTF",
paper_size = c(6.5, 7.5),
orientation = "portrait", font = "fixed") %>%
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("rtf42: Symbols are proper orientation on portrait.", {
if (dev) {
fp <- file.path(base_path, "rtf/test42.rtf")
dat <- mtcars[1:10, ]
tbl <- create_table(dat) %>%
titles("My Table{symbol('dagger')}")
rpt <- create_report(fp, output_type = "RTF",
orientation = "portrait", font = "fixed") %>%
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("rtf43: Symbols are proper orientation on landscape.", {
if (dev) {
fp <- file.path(base_path, "rtf/test43.rtf")
dat <- mtcars[1:10, ]
tbl <- create_table(dat) %>%
titles("My Table{symbol('dagger')}")
rpt <- create_report(fp, output_type = "RTF",
orientation = "landscape", font = "fixed") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf44: Table with blank_before works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test44.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, stringsAsFactors = FALSE)
tbl1 <- create_table(df, first_row_blank = FALSE) %>%
define(subjid, label = "Subject ID", align = "left") %>%
define(name, label = "Subject Name") %>%
define(sex, label = "Sex") %>%
define(age, label = "Age") %>%
define(arm, label = "Arm",
blank_before = TRUE,
dedupe = TRUE,
align = "right")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
options_fixed(font_size = 10) %>%
page_header(left = "Experis", right = c("Study ABC", "Status: Closed")) %>%
titles("Table 1.0", "Analysis Data Subject Listing",
"Safety Population", 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)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf45: Three level stub and indentation work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test45.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 = "fixed",
font_size = 10) %>%
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("rtf46: Path variable is returned properly from write_report().", {
if (dev) {
fp <- file.path(base_path, "rtf/test46")
dat <- mtcars[1:10, ]
tbl <- create_table(dat) %>%
titles("My Table{symbol('dagger')}")
rpt <- create_report(fp, output_type = "RTF",
orientation = "landscape", font = "fixed") %>%
add_content(tbl)
res <- write_report(rpt)
# file.show(res$path)
expect_equal(file.exists(res$modified_path), TRUE)
expect_equal(is.null(res$path), FALSE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf47: Page numbers work every in title, footnote, header, and footer.", {
if (dev) {
fp <- file.path(base_path, "rtf/test47.rtf")
dat <- iris
tbl <- create_table(dat, borders = "outside") %>%
titles("Table Title: Page [pg] of [tpg]") %>%
titles("Second table title") %>%
footnotes("Table footnote: Page [pg] of [tpg]") %>%
footnotes("Second table footnote")
rpt <- create_report(fp, output_type = "RTF", font = "fixed",
orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
add_content(tbl) %>%
titles("Report Title: Page [pg] of [tpg]") %>%
titles("Second report title") %>%
footnotes("Report footnote: Page [pg] of [tpg]", borders = "none") %>%
footnotes("Second report footnote") %>%
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("rtf48: Page wrap can be turned off as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf/test48.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)
tbl2 <- create_table(df)
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 = "fixed", output_type = "RTF",
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)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf49: auto_page can be turned off as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test49.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 = "fixed",
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)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf50: line_count can be set in report_options as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test50.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 = "fixed",
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("rtf51: Wrapping of footnote, header, title, footer, and page_by work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf/test51.rtf")
dat <- iris[1:50, ]
dat$pageby_var <- paste0("This is ", dat$Species, " which will take more than one line to see wrapping works.")
tbl <- create_table(dat, borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE) %>%
page_by(pageby_var, label = "Label: ") %>%
define(pageby_var, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = "fixed") %>%
add_content(tbl) %>%
page_header("This is a long left header which will take more than one line. It is to see if the header can be wrapped.",
"This is a right header which will take more than one line. It is to see if the header can be wrapped.") %>%
page_footer("This is a long left footer which will take more than one line. It is to see if the footer can be wrapped.",
"Center Footer",
"This is a right footer which will take more than one line. It is to see if the footer can be wrapped.") %>%
titles("This is a very long title which will take more than one line. It is to see if the title can be wrapped properly.",
blank_row = "both", columns = 1, align = "center",
borders = "none") %>%
footnotes("Here is a very long footnote which will take more than one line. It is to see if the footnote can be wrapped properly.")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf52: Footnote and title can be wrapped with multiple columns.", {
if (dev) {
fp <- file.path(base_path, "rtf/test52.rtf")
tbl <- create_table(iris[1:100, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = "fixed") %>%
add_content(tbl) %>%
page_header("Left header", "Right header") %>%
page_footer("left", "", "right") %>%
titles("Left title",
"This is a very long title which will take more than one line. It is to see if the title can be wrapped properly.",
"Right title will also take two lines. It should be wrapped.",
blank_row = "both", columns = 3, align = "center",
borders = "none") %>%
footnotes("Here is a very long footnote which will take more than one line. It is to see if the footnote can be wrapped properly.",
"The center footnote also take more than one lines.",
"column 3 footnote", columns = 3)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf53: Title header can be wrapped.", {
if (dev) {
fp <- file.path(base_path, "rtf/test53.rtf")
tbl <- create_table(iris[1:50, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = "fixed") %>%
add_content(tbl) %>%
title_header("This is a first title header which will take more than one line to see if they can be wrapped properly.",
"This is a second title header which will take more than one line to see if they can be wrapped properly.",
right = c("Client",
"Right",
"More"),
borders = "all") %>%
page_footer("Client",
"Page",
"More") %>%
footnotes("Here is a very long footnote which will take more than one line. It is to see if the footnote can be wrapped properly.")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf54: Multiple dedupe works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test54.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 = "fixed") %>%
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("rtf55: Empty page_by works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test55.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 = "fixed") %>%
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("rtf56: Numeric page_by works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test56.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 = "fixed") %>%
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("rtf57: Courier is displayed as Courier New as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test57.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 = "fixed") %>%
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("rtf58 Percentage column widths work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test58.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 = 1, align = "centre") %>%
define(Species, blank_after = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = "fixed",
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)
})
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("RTF Tests")
base_path <- paste0(getwd(),"/tests/testthat")
base_path <- tempdir()
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.")
dev <- FALSE
test_that("rtf1: Simplest table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test1.rtf")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
add_content(create_table(mtcars[1:10, ]), align = "left")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf2: Simplest table with title works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test2.rtf")
tbl <- create_table(mtcars[1:10, ]) %>%
define(vs, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
options_fixed(font_size = 10) %>%
titles("MTCARS Data Frame", align = "left") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf3: Table with break between sections works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test3.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, stringsAsFactors = FALSE)
tbl1 <- create_table(df, first_row_blank = TRUE) %>%
define(subjid, label = "Subject ID", align = "left") %>%
define(name, label = "Subject Name") %>%
define(sex, label = "Sex") %>%
define(age, label = "Age") %>%
define(arm, label = "Arm",
blank_after = TRUE,
dedupe = TRUE,
align = "right")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
options_fixed(font_size = 10) %>%
page_header(left = "Experis", right = c("Study ABC", "Status: Closed")) %>%
titles("Table 1.0", "Analysis Data Subject Listing",
"Safety Population", 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)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf4: Table that spans multiple pages breaks as expected.", {
fp <- file.path(base_path, "rtf/test4.rtf")
rpt <- create_report(fp, output_type = "RTF") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
#write_registration_file(file.path(base_path,"./rtf/reg.txt"))
})
test_that("rtf5: Table with long cell and label values wraps as expected.", {
fp <- file.path(base_path, "rtf/test5.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 = "fixed") %>%
titles("Table 1.0", align = "center") %>%
add_content(tbl1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf6: Table with spanning headers works as expected.", {
fp <- file.path(base_path, "rtf/test6.rtf")
df <- data.frame(vehicle = rownames(mtcars), mtcars, stringsAsFactors = FALSE)
rownames(df) = NULL
df$qsec <- fattr(df$qsec, format = "%.1f")
df$wt <- fattr(df$wt, justify = "center", width = .75)
tbl <- create_table(df) %>%
spanning_header("mpg", "hp",
label = "Span 1", label_align = "center", n = 10) %>%
spanning_header("drat", "qsec",
label = "Span 2", label_align = "center", n = 10) %>%
spanning_header("vs", "carb",
label = "Span 3", label_align = "center", n = 10) %>%
spanning_header(from = "drat", to = "carb", label = "Super Span",
label_align = "center",
level = 2) %>%
define(vehicle, label = "Vehicle") %>%
define(mpg, format = "%.1f")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
add_content(tbl) %>%
titles("Table 1.0", "MTCARS Subset Test")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
})
test_that("rtf7: Simplest RTF report with 1 in margins works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test7.rtf")
tbl <- create_table(mtcars[1:10, ]) %>%
column_defaults(width = .5) %>%
define(vs, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
page_header("Client", "Study") %>%
titles("MTCARS Data Frame") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl, align = "left") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf8: Two page RTF report works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test8.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, stringsAsFactors = FALSE)
df1 <- df[df$arm == "A", ]
df2 <- df[df$arm == "B", ]
afmt <- value(condition(x == "A", "Placebo"),
condition(x == "B", "Treatment 1"))
sfmt1 <- value(condition(x == "M", "Male"),
condition(x == "F", "Female"),
condition(TRUE, "Other"))
sfmt2 <- c(M = "Male", F = "Female")
tbl1 <- create_table(df1, width = 7) %>%
define(sex, width = 1, format = sfmt1) %>%
define(name, width = 2) %>%
define(age, width = 1, align = "left")
tbl2 <- create_table(df2, width = 7) %>%
define(sex, width = 1, format = sfmt2) %>%
define(age, format = "%0d%%", align = "left") %>%
define(name, width = 2) %>%
define(arm, format = afmt, width = 2, align = "right")
rpt <- create_report(fp, output_type = "RTF") %>%
options_fixed(font_size = 10) %>%
set_margins(top = 1, bottom = 1) %>%
page_header(left = "Experis", right = c("Study ABC", "Status: Closed")) %>%
titles("Table 1.0", "Analysis Data Subject Listing",
"Safety Population", align = "center") %>%
footnotes("Program Name: table1_0.R") %>%
page_footer(left = "Time", center = "Confidential",
right = "Page [pg] of [tpg]") %>%
add_content(tbl1) %>%
add_content(tbl2)
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf9: Simplest RTF Plot works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf/test9.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 = "fixed") %>%
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("rtf10: RTF Table with Plot works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf/test10.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8)
tbl <- create_table(mtcars[1:10, ])
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
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, 2)
})
test_that("rtf11: RTF Table with Plot on same page works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf/test11.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 = "fixed") %>%
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("rtf12: Table and Text output works as expected.", {
fp <- file.path(base_path, "rtf/test12.rtf")
tbl1 <- mtcars[1:10, ]
tbl2 <- mtcars[11:20, ]
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "fixed") %>%
titles("Report 5.0", "Table and Text Report") %>%
page_header(left = "Client: ABC", right = "Study: 123") %>%
add_content(create_table(tbl1), page_break = FALSE) %>%
add_content(create_text("* NOTE: Car information from 1971."),
align = "left") %>%
add_content(create_table(tbl2), page_break = FALSE) %>%
add_content(create_text("* NOTE: Car information from 1972."),
align = "left") %>%
page_footer(left = "Time",
center = "Confidential",
right ="Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
})
test_that("rtf13: Very Long text output works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test13.rtf")
l <- paste(rep(cnt, 1000), collapse = "\n\n")
rpt <- create_report(fp, orientation = "portrait", output_type = "RTF",
font = "fixed") %>%
titles("Report 6.0", "Very long Text Report") %>%
page_header(left = "Client: ABC", right = "Study: 123") %>%
add_content(create_text(l)) %>%
page_footer(left = "Time",
center = "Confidential",
right ="Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 123)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf14: Simplest portrait table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test14.rtf")
rpt <- create_report(fp, output_type = "RTF", orientation = "portrait",
font = "fixed") %>%
page_header("left", "right") %>%
titles("Table 1.0", "MTCARS Data Frame", borders = "all") %>%
add_content(create_table(mtcars)) %>%
page_footer("Left", right = "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf15: Simplest landscape table works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test15.rtf")
rpt <- create_report(fp, output_type = "RTF", orientation = "landscape",
font = "fixed") %>%
page_header("left", "right") %>%
titles("Table 1.0", "MTCARS Data Frame", borders = "all") %>%
add_content(create_table(mtcars)) %>%
page_footer("Left", right = "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("test16: 10 pt report with units in cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test16.rtf")
rpt <- create_report(fp, units = "cm", output_type = "RTF",
font = "fixed") %>%
page_header("Client: Experis", "Study: ABC") %>%
titles("IRIS Data Frame") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]") %>%
add_content(create_table(iris))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
} else
expect_equal(TRUE, TRUE)
})
test_that("test17: 12 pt report with units in cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test17.rtf")
rpt <- create_report(fp, units = "cm", output_type = "RTF",
font = "fixed") %>%
options_fixed(font_size = 12) %>%
page_header("Client: Experis", "Study: ABC") %>%
titles("IRIS Data Frame") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]") %>%
add_content(create_table(iris))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 5)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf18: Plot with page by on report works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf/test18.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 = "fixed") %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot",
blank_row = "none", borders = "all") %>%
set_margins(top = 1, bottom = 1) %>%
page_by(cyl, "Cylinders: ") %>%
add_content(plt) %>%
footnotes("* Motor Trend, 1974", borders = "all") %>%
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("rtf19: Plot with page by on plot works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf/test19.rtf")
dat <- mtcars[order(mtcars$cyl), ]
fmt <- value(condition(x == 4, "4 Cylinder"),
condition(x == 6, "6 Cylinder"),
condition(x == 8, "8 Cylinder"))
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 = "fixed") %>%
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("test20: Title Header on Plot works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test20.rtf")
p <- ggplot(mtcars, aes(x=disp, y=mpg)) + geom_point()
plt <- create_plot(p, height = 5, width = 7) %>%
title_header("Figure 1.0", "MTCARS Plot",
right = c("Client", "Page", "More"), borders = "all") %>%
footnotes("* Motor Trend, 1974", borders = "all")
rpt <- create_report(fp, units = "inches", output_type = "RTF",
font = "fixed") %>%
options_fixed(font_size = 12) %>%
add_content(plt)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
#
# test_that("rtf19: Plot and table with page by works as expected.", {
#
# library(ggplot2)
#
# fp <- file.path(base_path, "rtf/test19.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") %>%
# page_header("Client", "Study: XYZ") %>%
# titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", blank_row = "none") %>%
# set_margins(top = 1, bottom = 1) %>%
# #page_by(grp, "Mileage Category: ") %>%
# add_content(plt) %>%
# # 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)
#
#
#
# })
test_that("test21: 8 pt report with units in inches works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test21.rtf")
tbl <- create_table(iris)
rpt <- create_report(fp, units = "inches", output_type = "RTF",
font = "fixed") %>%
page_header("Client: Experis", "Study: ABC") %>%
titles("IRIS Data Frame") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]") %>%
options_fixed(font_size = 8) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 3)
} else
expect_equal(TRUE, TRUE)
})
test_that("test22: 8 pt report with units in cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test22.rtf")
rpt <- create_report(fp, units = "cm", output_type = "RTF",
font = "fixed") %>%
page_header("Client: Experis", "Study: ABC") %>%
titles("IRIS Data Frame") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]") %>%
options_fixed(font_size = 8) %>%
add_content(create_table(iris))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 3)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf23: RTF Table with Plot and borders works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf/test23.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8)
tbl <- create_table(mtcars[1:10, ])
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
page_header("Client", "Study: XYZ") %>%
titles("Figure 1.0", "MTCARS Miles per Cylinder Plot", borders = "all") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
add_content(plt, align = "center") %>%
footnotes("* Motor Trend, 1974", borders = "all") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]")
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf24: RTF Table with Plot and borders works as expected.", {
library(ggplot2)
fp <- file.path(base_path, "rtf/test24.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8) %>%
titles("My plot", borders = "all") %>%
footnotes("My plot footnotes", borders = "all")
tbl <- create_table(mtcars[1:10, ]) %>%
titles("My table", borders = "all") %>%
footnotes("My table footnotes", borders = "all", align = "right")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
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, 2)
})
test_that("rtf25: RTF Table with custom options works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test25.rtf")
tbl <- create_table(mtcars[1:10, ]) %>%
titles("My table", borders = "all") %>%
footnotes("My table footnotes", borders = "all", align = "right")
tbl2 <- create_table(mtcars[11:20, ]) %>%
titles("My table", borders = "all") %>%
footnotes("My table footnotes", borders = "all", align = "right")
rpt <- create_report(fp, font = "fixed") %>%
page_header("Client", "Study: XYZ") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
add_content(tbl2, align = "center") %>%
page_footer("Time", "Confidential", "Page [pg] of [tpg]") %>%
options_fixed(font_size = 12, line_size = 80, line_count = 30,
uchar = "-")
res <- write_report(rpt, output_type = "RTF")
#print(res)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 2)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf26: line_size and line_count overrides work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test26.rtf")
rpt <- create_report(fp, font = "fixed") %>%
options_fixed(line_size = 40, line_count = 30) %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris))
res <- write_report(rpt, output_type = "RTF")
res
expect_equal(file.exists(fp), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf27: Plot Borders work as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf/test27.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
plt <- create_plot(p, height = 4, width = 8, borders = "all") %>%
titles("My plot", borders = "none") %>%
footnotes("My plot footnotes", borders = "none")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
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("rtf28: Table Borders that spans multiple pages work as expected.", {
fp <- file.path(base_path, "rtf/test28.rtf")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris, borders = "all")) %>%
footnotes("Here is a footnote")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 4)
#write_registration_file(file.path(base_path,"./rtf/reg.txt"))
})
test_that("rtf29: Simplest RTF Plot with valign top works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf/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 = "fixed") %>%
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("rtf30: Simplest RTF Plot with valign bottom works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf/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 = "fixed") %>%
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)
})
test_that("rtf31: Simplest RTF Text with valign top works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test31.rtf")
txt <- create_text(cnt, width = 6)
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
page_header("Client", "Study: XYZ") %>%
titles("Text 1.0", "MTCARS Miles per Cylinder Text") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(txt, 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("rtf32: Simplest RTF Text with valign bottom works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test32.rtf")
txt <- create_text(cnt, width = 6) %>%
footnotes("* Motor Trend, 1974", valign = "bottom")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
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("rtf33: use_attributes parameter table works as expected.", {
if (dev == TRUE) {
fp1 <- file.path(base_path, "rtf/test33a.rtf")
fp2 <- file.path(base_path, "rtf/test33b.rtf")
fp3 <- file.path(base_path, "rtf/test33c.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 = "fixed") %>%
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 = "fixed") %>%
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 = "fixed") %>%
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("rtf34: 9 pt font inches works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test34.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 9,
orientation = "portrait", font = "fixed") %>%
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("rtf35: 9 pt font cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test35.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 9,
orientation = "portrait", font = "fixed") %>%
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("rtf36: 11 pt font inches works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test36.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 11,
orientation = "portrait", font = "fixed") %>%
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("rtf37: 11 pt font cm works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test37.rtf")
rpt <- create_report(fp, output_type = "RTF", font_size = 11,
orientation = "portrait", font = "fixed") %>%
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("rtf38: RTF Image file works as expected.", {
if (dev == TRUE) {
library(ggplot2)
fp <- file.path(base_path, "rtf/test38.rtf")
p <- ggplot(mtcars, aes(x=cyl, y=mpg)) + geom_point()
pltpath <- file.path(base_path, "rtf/test38.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 = "fixed") %>%
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("rtf39: Blank after on invisible column.", {
fp <- file.path(base_path, "rtf/test39.rtf")
tbl <- create_table(iris, borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
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("rtf40: Page header width works as expected.", {
fp <- file.path(base_path, "rtf/test40.rtf")
tbl <- create_table(iris[1:10, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
page_header("Left here is some stuff and more stuff trying to get out in the middle",
"Right", width = 8) %>%
add_content(tbl) %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below", header = TRUE) %>%
footnotes("Here is a footnote", "And another", footer = TRUE)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("rtf41: Custom page size works as expected.", {
fp <- file.path(base_path, "rtf/test41.rtf")
tbl <- create_table(iris[1:15, ]) %>%
define(Species, visible = FALSE)
ttl <- c("Title1", "Title2", "Title3")
rpt <- create_report(fp, output_type = "RTF",
paper_size = c(6.5, 7.5),
orientation = "portrait", font = "fixed") %>%
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("rtf42: Symbols are proper orientation on portrait.", {
if (dev) {
fp <- file.path(base_path, "rtf/test42.rtf")
dat <- mtcars[1:10, ]
tbl <- create_table(dat) %>%
titles("My Table{symbol('dagger')}")
rpt <- create_report(fp, output_type = "RTF",
orientation = "portrait", font = "fixed") %>%
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("rtf43: Symbols are proper orientation on landscape.", {
if (dev) {
fp <- file.path(base_path, "rtf/test43.rtf")
dat <- mtcars[1:10, ]
tbl <- create_table(dat) %>%
titles("My Table{symbol('dagger')}")
rpt <- create_report(fp, output_type = "RTF",
orientation = "landscape", font = "fixed") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf44: Table with blank_before works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test44.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, stringsAsFactors = FALSE)
tbl1 <- create_table(df, first_row_blank = FALSE) %>%
define(subjid, label = "Subject ID", align = "left") %>%
define(name, label = "Subject Name") %>%
define(sex, label = "Sex") %>%
define(age, label = "Age") %>%
define(arm, label = "Arm",
blank_before = TRUE,
dedupe = TRUE,
align = "right")
rpt <- create_report(fp, output_type = "RTF", font = "fixed") %>%
options_fixed(font_size = 10) %>%
page_header(left = "Experis", right = c("Study ABC", "Status: Closed")) %>%
titles("Table 1.0", "Analysis Data Subject Listing",
"Safety Population", 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)
expect_equal(res$pages, 1)
} else
expect_equal(TRUE, TRUE)
})
test_that("rtf45: Three level stub and indentation work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test45.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 = "fixed",
font_size = 10) %>%
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("rtf46: Path variable is returned properly from write_report().", {
if (dev) {
fp <- file.path(base_path, "rtf/test46")
dat <- mtcars[1:10, ]
tbl <- create_table(dat) %>%
titles("My Table{symbol('dagger')}")
rpt <- create_report(fp, output_type = "RTF",
orientation = "landscape", font = "fixed") %>%
add_content(tbl)
res <- write_report(rpt)
# file.show(res$path)
expect_equal(file.exists(res$modified_path), TRUE)
expect_equal(is.null(res$path), FALSE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf47: Page numbers work every in title, footnote, header, and footer.", {
if (dev) {
fp <- file.path(base_path, "rtf/test47.rtf")
dat <- iris
tbl <- create_table(dat, borders = "outside") %>%
titles("Table Title: Page [pg] of [tpg]") %>%
titles("Second table title") %>%
footnotes("Table footnote: Page [pg] of [tpg]") %>%
footnotes("Second table footnote")
rpt <- create_report(fp, output_type = "RTF", font = "fixed",
orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
add_content(tbl) %>%
titles("Report Title: Page [pg] of [tpg]") %>%
titles("Second report title") %>%
footnotes("Report footnote: Page [pg] of [tpg]", borders = "none") %>%
footnotes("Second report footnote") %>%
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("rtf48: Page wrap can be turned off as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf/test48.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)
tbl2 <- create_table(df)
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 = "fixed", output_type = "RTF",
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)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf49: auto_page can be turned off as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test49.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 = "fixed",
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)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf50: line_count can be set in report_options as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test50.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 = "fixed",
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("rtf51: Wrapping of footnote, header, title, footer, and page_by work as expected.", {
if (dev) {
fp <- file.path(base_path, "rtf/test51.rtf")
dat <- iris[1:50, ]
dat$pageby_var <- paste0("This is ", dat$Species, " which will take more than one line to see wrapping works.")
tbl <- create_table(dat, borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE) %>%
page_by(pageby_var, label = "Label: ") %>%
define(pageby_var, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = "fixed") %>%
add_content(tbl) %>%
page_header("This is a long left header which will take more than one line. It is to see if the header can be wrapped.",
"This is a right header which will take more than one line. It is to see if the header can be wrapped.") %>%
page_footer("This is a long left footer which will take more than one line. It is to see if the footer can be wrapped.",
"Center Footer",
"This is a right footer which will take more than one line. It is to see if the footer can be wrapped.") %>%
titles("This is a very long title which will take more than one line. It is to see if the title can be wrapped properly.",
blank_row = "both", columns = 1, align = "center",
borders = "none") %>%
footnotes("Here is a very long footnote which will take more than one line. It is to see if the footnote can be wrapped properly.")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf52: Footnote and title can be wrapped with multiple columns.", {
if (dev) {
fp <- file.path(base_path, "rtf/test52.rtf")
tbl <- create_table(iris[1:100, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = "fixed") %>%
add_content(tbl) %>%
page_header("Left header", "Right header") %>%
page_footer("left", "", "right") %>%
titles("Left title",
"This is a very long title which will take more than one line. It is to see if the title can be wrapped properly.",
"Right title will also take two lines. It should be wrapped.",
blank_row = "both", columns = 3, align = "center",
borders = "none") %>%
footnotes("Here is a very long footnote which will take more than one line. It is to see if the footnote can be wrapped properly.",
"The center footnote also take more than one lines.",
"column 3 footnote", columns = 3)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf53: Title header can be wrapped.", {
if (dev) {
fp <- file.path(base_path, "rtf/test53.rtf")
tbl <- create_table(iris[1:50, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "rtf", font = "fixed") %>%
add_content(tbl) %>%
title_header("This is a first title header which will take more than one line to see if they can be wrapped properly.",
"This is a second title header which will take more than one line to see if they can be wrapped properly.",
right = c("Client",
"Right",
"More"),
borders = "all") %>%
page_footer("Client",
"Page",
"More") %>%
footnotes("Here is a very long footnote which will take more than one line. It is to see if the footnote can be wrapped properly.")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("rtf54: Multiple dedupe works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test54.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 = "fixed") %>%
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("rtf55: Empty page_by works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test55.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 = "fixed") %>%
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("rtf56: Numeric page_by works as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test56.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 = "fixed") %>%
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("rtf57: Courier is displayed as Courier New as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test57.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 = "fixed") %>%
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("rtf58 Percentage column widths work as expected.", {
if (dev == TRUE) {
fp <- file.path(base_path, "rtf/test58.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 = 1, align = "centre") %>%
define(Species, blank_after = TRUE)
rpt <- create_report(fp, output_type = "RTF", font = "fixed",
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)
})
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.