Nothing
tests/testthat/test-system.R
In reporter: Creates Statistical Reports
context("System Tests")
base_path <- "c:/packages/reporter/tests/testthat"
base_path <- tempdir()
options("logr.output" = FALSE)
dev <- FALSE
test_that("test1: Simplest table works as expected.", {
fp <- file.path(base_path, "output/test1.out")
rpt <- create_report(fp) %>%
add_content(create_table(mtcars[1:10, ]), align = "left")
#print(rpt, verbose = TRUE)
res <- write_report(rpt)
res
#print(res, verbose = TRUE)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test2: Simplest table with title works as expected.", {
fp <- file.path(base_path, "output/test2.out")
tbl <- create_table(mtcars[1:10, ]) %>%
define(vs, visible = FALSE)
rpt <- create_report(fp) %>%
titles("MTCARS Data Frame", align = "left") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test3: Simple table with formats works as expected.", {
fp <- file.path(base_path, "output/test3.out")
# 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)
afmt <- value(condition(x == "A", "Placebo"),
condition(x == "B", "Treatment 1"))
sfmt2 <- c(M = "Male", F = "Female")
tbl1 <- create_table(df, first_row_blank = TRUE) %>%
define(subjid, align = "left") %>%
define(sex, width = 1, format = sfmt2) %>%
define(age, width = .5) %>%
define(arm, format = afmt, width = 1.5, align = "right", dedupe = TRUE)
rpt <- create_report(fp) %>%
options_fixed(editor = "notepad++") %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test4: Two page report works as expected.", {
fp <- file.path(base_path, "output/test4.out")
# 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, first_row_blank = TRUE) %>%
define(sex, width = 2, format = sfmt1) %>%
define(age, width = 2)
tbl2 <- create_table(df2) %>%
define(sex, width = .25, format = sfmt2) %>%
define(age, format = "%0d%%") %>%
define(arm, format = afmt, width = 2)
rpt <- create_report(fp, units = "inches", paper_size = "letter") %>%
options_fixed(editor = "notepad++") %>%
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)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test5: Table with break between sections works as expected.", {
fp <- file.path(base_path, "output/test5.out")
# 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", 3), "A", "A")
# 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) %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test6: Table that spans multiple pages breaks as expected.", {
fp <- file.path(base_path, "output/test6.out")
rpt <- create_report(fp) %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test7: Table with long cell and label values wraps as expected.", {
fp <- file.path(base_path, "output/test7.out")
# 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) %>%
titles("Table 1.0", align = "center") %>%
add_content(tbl1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test8: Table with spanning headers works as expected.", {
fp <- file.path(base_path, "output/test8.out")
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) %>%
add_content(tbl) %>%
titles("Table 1.0", "MTCARS Subset Test")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test9: Page wrap works as expected.", {
fp <- file.path(base_path, "output/test9.out")
dat <- mtcars[1:10, ]
df <- data.frame(vehicle = rownames(dat), dat, stringsAsFactors = FALSE)
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("drat","carb", label = "Super Span",
label_align = "center",
level = 2) %>%
define(vehicle, label = "Vehicle", id_var = TRUE) %>%
define(mpg, format = "%.1f") %>%
define(am, visible = FALSE) %>%
define(vs, page_wrap = TRUE)
rpt <- create_report(fp, orientation = "portrait") %>%
titles("Table 1.0", "MTCARS Spanning Header") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test10: Page wrap with spanning header works as expected.", {
fp <- file.path(base_path, "output/test10.out")
df <- data.frame(vehicle = rownames(mtcars), mtcars, stringsAsFactors = FALSE)
rownames(df) = NULL
tbl <- create_table(df) %>%
spanning_header(2, 5,
label = "Span 1", label_align = "center", n = 10) %>%
spanning_header(6, 8,
label = "Span 2", label_align = "center", n = 10) %>%
spanning_header(9, 12,
label = "Span 3", label_align = "center", n = 10) %>%
spanning_header(6, 12, label = "Super Span",
label_align = "center",
level = 2) %>%
define(vehicle, label = "Vehicle", id_var = TRUE) %>%
define(mpg, format = "%.1f") %>%
define(wt, page_wrap = TRUE) %>%
define(vs, page_wrap = TRUE)
rpt <- create_report(fp, orientation = "portrait") %>%
options_fixed(editor = "wordpad") %>%
add_content(tbl) %>%
titles("Table 1.0", "MTCARS Subset Test")
#print(rpt)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test11: Table with break between sections works as expected.", {
fp <- file.path(base_path, "output/test11.out")
# 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) %>%
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)
res2 <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res2$pages * res2$line_count)
expect_equal(nchar(lns[1]), res2$line_size)
})
test_that("test12: Headerless table with title works as expected.", {
fp <- file.path(base_path, "output/test12.out")
tbl <- create_table(mtcars[1:10, ], headerless = TRUE) %>%
define(vs, visible = FALSE)
rpt <- create_report(fp) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test13: Combination with Headerless table works as expected.", {
fp <- file.path(base_path, "output/test13.out")
tbl1 <- create_table(mtcars[1:10, ], headerless = FALSE) %>%
titles("MTCARS Combined Table 1.0")
tbl2 <- create_table(mtcars[11:20, ], headerless = TRUE)
tbl3 <- create_table(mtcars, headerless = TRUE) %>%
footnotes("Full cars table")
txt1 <- create_text("These tables are combined!")
rpt <- create_report(fp) %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
page_footer(center = "Page [pg] of [tpg]") %>%
add_content(tbl1, page_break = FALSE, blank_row = "none") %>%
add_content(tbl2, page_break = FALSE) %>%
add_content(txt1) %>%
add_content(tbl1, page_break = FALSE, blank_row = "none") %>%
add_content(tbl3, page_break = FALSE) %>%
add_content(txt1, page_break = FALSE) # Also test open page at end
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test15: Multi-page table with Titles and Footnotes breaks as expected.", {
fp <- file.path(base_path, "output/test15.out")
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.")
txt <- create_text(cnt, width = 6.25, align = "left") %>%
titles("Introduction to Irises")
tbl <- create_table(iris) %>%
titles("My little Iris Table") %>%
footnotes("* Better Gardening, 1973") %>%
define(Species, blank_after = TRUE, dedupe = TRUE)
rpt <- create_report(fp) %>%
add_content(txt, page_break = FALSE) %>%
add_content(tbl, blank_row = "none")
res2 <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res2$pages * res2$line_count)
})
test_that("test16: Simple regulatory listing works as expected.", {
fp <- file.path(base_path, "output/test16.out")
# Create mtcars listing
rpt <- create_report(fp, orientation = "portrait") %>%
page_header(left = "Client: Motor Trend", right = c("Study: Cars",
"Something else")) %>%
titles("Listing 1.0", "MTCARS Data Listing") %>%
add_content(create_table(mtcars)) %>%
footnotes("* Motor Trend, 1973") %>%
page_footer(left = "Time",
center = "Confidential",
right = "Page [pg] of [tpg]")
rpt
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test17: Simple regulatory table works as expected.", {
library(tidyr)
library(dplyr)
fp <- file.path(base_path, "output/test17.out")
dat <- mtcars
# Hard coded this so report would come out the same every time.
#dat$group <- replicate(nrow(dat), sample(c("A", "B"), 1), simplify = TRUE)
dat$group <- c("B", "B", "B", "B", "B", "B", "A", "A", "B", "A", "A",
"A", "A", "B", "A", "B", "B", "A", "B", "B", "B", "A",
"A", "A", "A", "A", "A", "B", "B", "A", "B", "B")
dat$cyl <- factor(dat$cyl, levels = c(8, 6, 4),
labels = c("8 Cylinder", "6 Cylinder", "4 Cylinder"))
group_pop <- table(dat$group)
dat_mpg <-
dat %>%
group_by(group) %>%
summarise(across(.cols = mpg,
.fns = list(N = ~ fmt_n(.),
Mean = ~ fmt_mean_sd(.),
Median = ~ fmt_median(.),
`Q1 - Q3` = ~ fmt_quantile_range(.),
Range = ~ fmt_range(.)
))) %>%
pivot_longer(-group,
names_to = c("var", "label"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = group,
values_from = "value")
dat_cyl <-
dat %>%
add_count(group, cyl, name = "n_cyl") %>%
select(group, cyl, n_cyl) %>%
distinct() %>%
pivot_longer(cols = c(cyl),
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = group,
values_from = n_cyl,
values_fill = 0) %>%
mutate(A = fmt_cnt_pct(A, group_pop["A"]),
B = fmt_cnt_pct(B, group_pop["B"])) %>%
arrange(label)
final <- bind_rows(dat_mpg, dat_cyl)
#print(final)
tbl <- create_table(final, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(mpg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center") %>%
define(B, label = "Group B", align = "center")
# Create mtcars table
rpt <- create_report(fp, orientation = "portrait") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1973") %>%
page_footer(left = "Time",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test18: Text and table with page breaks works as expected.", {
fp <- file.path(base_path, "output/test18.out")
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.")
# Create text content
txt <- create_text(cnt) %>%
titles("My Analysis of the previous table")
# Prepare data
dat <- mtcars
dat$name <- rownames(dat)
dat <- mtcars[1:10, ]
# Create table content
tbl <- create_table(dat) %>%
titles("Table 1.0", "MTCARS Sample Data") %>%
footnotes("* Motor Trend, 1973")
# Create report and add both table and text content
rpt <- create_report(fp, orientation = "portrait") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
add_content(tbl, page_break = FALSE) %>%
add_content(txt) %>%
add_content(tbl) %>%
add_content(txt) %>%
page_footer(left = "Time",
center = "Confidential",
right = "Page [pg] of [tpg]")
# Write the report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test19: show_cols 'none' parameter on table works as expected.", {
fp <- file.path(base_path, "output/test19.out")
tbl <- create_table(mtcars[1:10, ], show_cols = "none") %>%
define(mpg) %>%
define(cyl) %>%
define(vs) %>%
define(drat, visible = FALSE)
rpt <- create_report(fp) %>%
titles("MTCARS Data Frame", align = "left") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test20: show_cols 'some' parameter on table works as expected.", {
fp <- file.path(base_path, "output/test20.out")
tbl <- create_table(mtcars[1:10, ],
show_cols = c("vs", "mpg", "cyl", "disp", "drat")) %>%
define(mpg, label = "Miles Per Gallon") %>%
define(vs, label = "") %>%
define(drat, visible = FALSE)
rpt <- create_report(fp) %>%
titles("MTCARS Data Frame", align = "left") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test21: Multiple page headers and footers work as expected.", {
fp <- file.path(base_path, "output/test21.out")
tbl <- create_table(mtcars[1:10, ]) %>%
define(vs, visible = FALSE)
rpt <- create_report(fp) %>%
page_header(c("Line 1", "Line 2"), "Right Line") %>%
titles("MTCARS Data Frame", align = "left") %>%
page_footer(c("Footer Line 1", "Footer Line 2"), right = "Footer Right Line",
center = c("A", "B", "C")) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test22: Multiple id_var parameters work as expected.", {
fp <- file.path(base_path, "output/test22.out")
dat <- data.frame(vehicle = rownames(mtcars), mtcars, stringsAsFactors = FALSE)
tbl <- create_table(dat) %>%
define(vehicle, id_var = TRUE, width = 3) %>%
define(mpg, id_var = TRUE, width = 2, align = "left") %>%
define(vs, id_var = TRUE, width = 2, align = "left")
rpt <- create_report(fp) %>%
options_fixed(editor = "word") %>%
page_header(c("Line 1", "Line 2"), "Right Line") %>%
titles("MTCARS Data Frame", align = "left") %>%
page_footer(c("Footer Line 1", "Footer Line 2"),
right = "Footer Right Line") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test23: Blank margins setting works as expected.", {
# Compare output to test1
fp <- file.path(base_path, "output/test23.out")
rpt <- create_report(fp, output_type = "TXT") %>%
options_fixed( blank_margins = TRUE) %>%
set_margins(top = 1) %>%
add_content(create_table(mtcars[1:10, ]), align = "left")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), (res$pages * res$line_count) + res$blank_margin_top)
})
test_that("test24: Table width parameter works as expected for full width.", {
fp <- file.path(base_path, "output/test24.out")
tbl1 <- create_table(mtcars[1:10, 1:6], width = 9)
tbl2 <- create_table(mtcars[11:20, 1:6])
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
add_content(tbl1, align = "left", page_break = FALSE) %>%
add_content(tbl2, align = "left")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), 1 * res$line_count)
})
test_that("test25: page_break parameter simple case works as expected.", {
fp <- file.path(base_path, "output/test25.out")
dat <- mtcars
rownames(dat) <- NULL
dat$pg <- c(rep(1, 16), rep(2, 16))
tbl <- create_table(dat) %>%
define(pg, page_break = TRUE)
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
titles("MTCARS Sample Report") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), 2 * res$line_count)
})
test_that("test26: page_break parameter harder case works as expected.", {
fp <- file.path(base_path, "output/test26.out")
dat <- iris
#dat$pg <- c(rep(1, 16), rep(2, 16))
tbl <- create_table(dat) %>%
define(Species, page_break = TRUE)
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
titles("IRIS Sample Report") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test27: page_break parameter even harder case works as expected.", {
fp <- file.path(base_path, "output/test27.out")
dat <- iris
dat$pg <- c(rep(1, 20), rep(2, 20), rep(3, 20), rep(4, 20), rep(5, 10),
rep(6, 20), rep(7, 20), rep(8, 20))
tbl <- create_table(dat) %>%
define(Species, blank_after = TRUE) %>%
define(pg, page_break = TRUE)
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
titles("IRIS Sample Report") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test28: use_attributes parameter table works as expected.", {
fp1 <- file.path(base_path, "output/test28a.out")
fp2 <- file.path(base_path, "output/test28b.out")
fp3 <- file.path(base_path, "output/test28c.out")
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) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp1), TRUE)
lns <- readLines(fp1)
expect_equal(length(lns), res$pages * res$line_count)
# Test none
tbl <- create_table(dat, use_attributes = "none")
rpt <- create_report(fp2) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp2), TRUE)
lns <- readLines(fp2)
# Test some
tbl <- create_table(dat, use_attributes = c("format", "width"))
rpt <- create_report(fp3) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp3), TRUE)
lns <- readLines(fp3)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test29: column_defaults work as expected.", {
fp <- file.path(base_path, "output/test29.out")
tbl <- create_table(mtcars[1:10, ]) %>%
column_defaults(width = .5, align = "right", format = "%.1f",
n = 5) %>%
define(mpg, width = 2, format = "%.2f", align = "left",
label_align = "right") %>%
define(wt, width = 2, format = "%.4f", align = "left", n = 6,
label_align = "center")
rpt <- create_report(fp) %>%
add_content(tbl, align = "left")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test30: multiple vars on define work as expected.", {
fp <- file.path(base_path, "output/test30.out")
tbl <- create_table(mtcars[1:10, ]) %>%
define(c(mpg, wt), width = 2, format = "%.2f", align = "left",
label_align = "right")
rpt <- create_report(fp) %>%
add_content(tbl, align = "left")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test31: Table width parameter works for less than full width.", {
fp <- file.path(base_path, "output/test31.out")
tbl1 <- create_table(mtcars[1:10, 1:6], width = 7)
tbl2 <- create_table(mtcars[11:20, 1:6])
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
add_content(tbl1, align = "left", page_break = FALSE) %>%
add_content(tbl2, align = "left")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), 1 * res$line_count)
})
test_that("test36: Report with NAs in data works as expected.", {
fp <- file.path(base_path, "output/test36.txt")
# Setup
subjid <- 100:109
name <- c("Quintana, Gabriel", NA, "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", NA, "M", "F", "F", "M")
age <- c(41, 53, 43, NA, 47, 52, 21, 38, 62, 26)
arm <- c(rep("A", 5), rep("B", 4), NA)
# Create data frame
df <- data.frame(subjid, name, sex, age, arm, stringsAsFactors = FALSE)
afmt <- value(condition(x == "A", "Placebo"),
condition(x == "B", "Treatment 1"))
sfmt1 <- value(condition(x == "M", "Male"),
condition(x == "F", "Female"))
tbl1 <- create_table(df, width = 7) %>%
define(sex, width = 1, format = sfmt1) %>%
define(name, width = 2) %>%
define(age)
rpt <- create_report(fp, output_type = "TXT", missing = "-") %>%
options_fixed(font_size = 12) %>%
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)
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
})
test_that("test37: line_size and line_count overrides work as expected.", {
fp <- file.path(base_path, "output/test37.out")
rpt <- create_report(fp) %>%
options_fixed(line_size = 40, line_count = 30) %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris))
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test38: column_defaults works as expected with multiple tables.", {
fp <- file.path(base_path, "output/test38.out")
tbl1 <- create_table(mtcars[1:5, ]) %>%
column_defaults(width = .5)
tbl2 <- create_table(mtcars[6:10, ], headerless=TRUE) %>%
column_defaults(width = .5)
# Create the report object
rpt <- create_report(fp) %>%
titles("MTCARS Sample Data", align = "left") %>%
add_content(tbl1, page_break = FALSE, align = "left", blank_row = "none") %>%
add_content(tbl2, page_break = FALSE, align = "left") %>%
add_content(create_text("* NOTE: Above table is actually two tables stacked."))
# Write the report to the file system
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test39: column_defaults works as expected with column positions.", {
fp <- file.path(base_path, "output/test39.out")
tbl1 <- create_table(mtcars[1:5, ]) %>%
column_defaults(vars = 1:5, width = .5) %>%
column_defaults(6:11, width = .6)
# Create the report object
rpt <- create_report(fp) %>%
titles("MTCARS Sample Data", align = "left") %>%
add_content(tbl1, align = "left", blank_row = "none")
# Write the report to the file system
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
#
# test_that("test28: Table width parameter more than sum of columns works.", {
#
#
# fp <- file.path(base_path, "output/test28.out")
#
# if (file.exists(fp))
# file.remove(fp)
#
# tbl1 <- create_table(mtcars[1:10, ], width = 9) %>%
# define(mpg, width = 2) %>%
# define(cyl, width = 2) %>%
# define(disp, width = 2) %>%
# define(hp, width = 2) %>%
# define(am, width = 2) %>%
# define(carb, width = 2)
#
# rpt <- create_report(fp) %>%
# page_header("Client", "Study") %>%
# add_content(tbl1, align = "left")
#
#
#
# res <- write_report(rpt)
#
# expect_equal(file.exists(fp), TRUE)
#
# lns <- readLines(fp)
#
# expect_equal(length(lns), res$pages * res$line_count)
#
# })
test_that("test40: Report with units in cm works as expected.", {
fp <- file.path(base_path, "output/test40.out")
rpt <- create_report(fp, units = "cm") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test41: Title header on report works as expected.", {
fp <- file.path(base_path, "output/test41.out")
rpt <- create_report(fp) %>%
title_header("Table 1.0", "IRIS Data Frame",
right = c("Study ABC", "Client A", "Page [pg] of [tpg]")) %>%
add_content(create_table(iris)) %>%
page_footer("DateTime", right = "Page")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test42: Title header on table works as expected.", {
fp <- file.path(base_path, "output/test42.out")
tbl <- create_table(iris) %>%
title_header("Table 1.0", "IRIS Data Frame",
right = c("Study ABC", "Client A", "Page [pg] of [tpg]"),
blank_row = "below")
rpt <- create_report(fp) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test43: Page by on table works as expected.", {
fp <- file.path(base_path, "output/test43.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "IRIS Data Frame") %>%
page_by(Species, "Species: ", align = "left") %>%
define(Species, visible = FALSE) %>%
footnotes("Here is a footnote")
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
add_content(tbl) %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test44: Page by on report works as expected.", {
fp <- file.path(base_path, "output/test44.out")
tbl <- create_table(iris) %>%
define(Species, visible = FALSE)
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
titles("Table 1.0", "IRIS Data Frame") %>%
page_by(Species, "Species: ") %>%
footnotes("Here is a footnote") %>%
page_footer("Time", right = "Page [pg] of [tpg]") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test45: Report without page by works as expected.", {
fp <- file.path(base_path, "output/test45.out")
tbl <- create_table(iris) %>%
define(Species, page_break = TRUE)
rpt <- create_report(fp, orientation = "portrait", units = "inches") %>%
options_fixed(editor = "word", uchar = "-") %>%
set_margins(top = 1, bottom = 1, left = 1, right = 1) %>%
# 2.54 1.27
page_header("Client", "Study") %>%
titles("Table 1.0", "IRIS Data Frame") %>%
footnotes("Here is a footnote") %>%
page_footer("Time", right = "Page [pg] of [tpg]") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test46: Another title_header test to check alignment.", {
# Create a temporary file
fp <- file.path(base_path, "output/test46.out")
# Prepare data
dat <- data.frame(category = rownames(USPersonalExpenditure),
USPersonalExpenditure, stringsAsFactors = FALSE)
# Define table
tbl <- create_table(dat) %>%
title_header("Table 1.0", "US Personal Expenditures from 1940 - 1960",
right = c("Page [pg] of [tpg]", "World Almanac")) %>%
column_defaults(from = X1940, to = X1960, format = "$%.2f") %>%
define(category, label = "Category", width = 2) %>%
define(X1940, label = "1940") %>%
define(X1945, label = "1945") %>%
define(X1950, label = "1950") %>%
define(X1955, label = "1955") %>%
define(X1960, label = "1960") %>%
footnotes("* In billions of dollars")
# Define report
rpt <- create_report(fp, orientation="portrait") %>%
add_content(tbl)
# Write the report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
# Alignment is off on this one.
test_that("test47: CM Table with long cell and label values wraps as expected.", {
fp <- file.path(base_path, "output/test47.out")
# Setup
arm <- c(rep("A", 5), rep("B", 5))
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa and more and more and more and more and 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 = 2) %>%
define(name, label = "Subject Name") %>%
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, units = "cm") %>%
page_header("Sponsor", "Study") %>%
titles("Table 1.0", align = "right") %>%
add_content(tbl1, align = "right") %>%
page_footer("Time", "Confidential", "Page")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test48: Three level stub works as expected.", {
fp <- file.path(base_path, "output/test48.out")
# 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 = 2.5) %>%
define(cat, label_row = TRUE, blank_after = TRUE) %>%
define(grp, indent = .25) %>%
define(ci, indent = .5) %>%
define(values, label = "Values")
rpt <- create_report(fp) %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test49: Stub and width settings works as expected.", {
fp <- file.path(base_path, "output/test49.out")
# 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")
values1 <- c(41, 53, 43, 39, 47, 52, 38, 25, 37, 23, 78, 21)
values2 <- c(32, 28, 94, 32, 09, 42, 67, 65, 56, 12, 91, 32)
values3 <- c(41, 53, 43, 39, 47, 52, 38, 25, 37, 23, 78, 21)
values4 <- c(32, 28, 94, 32, 09, 42, 67, 65, 56, 12, 91, 32)
# Create data frame
df <- data.frame(cat, grp, ci, values1, values2, values3, values4,
stringsAsFactors = FALSE)
tbl1 <- create_table(df, width = 9) %>%
stub(c(cat, grp, ci), "Estimates", width = 3) %>%
define(cat, label_row = TRUE, blank_after = TRUE) %>%
define(grp, indent = .25) %>%
define(ci, indent = .5) %>%
define(values1, label = "Values1", width = .70) %>%
define(values2, label = "Values2") %>%
define(values3, label = "Values3") %>%
define(values4, label = "Values4")
rpt <- create_report(fp) %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
# This is still messed up, but not going to fix it for now.
test_that("test50: Table with long numeric values sizes as expected.", {
fp <- file.path(base_path, "output/test50.out")
# Setup
arm <- c(rep("A", 5), rep("B", 5))
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa and 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)
rnd <- c(0.7077520, 0.3180838, 0.9174493, 0.4395207, 0.5307518,
0.8501806, 0.4584808, 0.1016370, 0.7061505, 0.7819369)
#rnd <- runif(10)
calc <- age * rnd
# Create data frame
df <- data.frame(arm, subjid, name, sex, age, rnd, calc,
stringsAsFactors = FALSE)
tbl1 <- create_table(df, first_row_blank = TRUE) %>%
define(subjid, label = "Subject ID for a patient", n = 10) %>%
define(name, label = "Subject Name", width = 1) %>%
define(sex, label = "Sex", n = 10, align = "left") %>%
define(age, label = "Age", n = 10) %>%
define(arm, label = "Arm",
blank_after = TRUE,
dedupe = TRUE) %>%
define(rnd, width = .5) %>%
define(calc, width = .6)
rpt <- create_report(fp) %>%
titles("Table 1.0", align = "center") %>%
add_content(tbl1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test51: Page break on invisible columns works as expected.", {
fp <- file.path(base_path, "output/test51.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
define(Species, visible = FALSE, page_break = TRUE)
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test52: Column default values for label and n work as expected.", {
fp <- file.path(base_path, "output/test52.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(label = "Data", n = "100") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test53: Multiple Column defaults work as expected for quoted vars.", {
fp <- file.path(base_path, "output/test53.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(vars = c("Sepal.Length", "Petal.Length"), label = "Length") %>%
column_defaults(vars = c("Sepal.Width", "Petal.Width"), label = "Width") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test54: Multiple Column defaults work as expected for positions.", {
fp <- file.path(base_path, "output/test54.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(vars = c(1, 3), label = "Length") %>%
column_defaults(vars = c(2, 4), label = "Width") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test55: Multiple Column defaults work as expected for unquoted vars.", {
fp <- file.path(base_path, "output/test55.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(vars = c(Sepal.Length, Petal.Length), label = "Length") %>%
column_defaults(vars = c(Sepal.Width, Petal.Width), label = "Width") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test56: Multiple Column defaults work as expected for quoted from/to", {
fp <- file.path(base_path, "output/test56.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(from = "Sepal.Length", to = "Sepal.Width", label = "Sepal") %>%
column_defaults(from = "Petal.Length", to = "Petal.Width", label = "Petal") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test57: Multiple Column defaults work as expected for unquoted from/to", {
fp <- file.path(base_path, "output/test57.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(from = Sepal.Length, to = Sepal.Width, label = "Sepal") %>%
column_defaults(from = Petal.Length, to = Petal.Width, label = "Petal") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test58: Multiple Column defaults work as expected for positional from/to", {
fp <- file.path(base_path, "output/test58.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(from = 1, to = 2, label = "Sepal") %>%
column_defaults(from = 3, to = 4, label = "Petal") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test59: Formatting Attributes on data frame work as expected.", {
fp <- file.path(base_path, "output/test59.out")
dat <- mtcars
attr(dat$mpg, "label") <- "Miles per gallon"
dat$mpg <- fattr(dat$mpg, format = "%.2f", width = 2, justify = "left")
attr(dat$cyl, "label") <- "Cylinders"
dat$cyl <- fattr(dat$cyl, format = "%.1f", width = 1, justify = "center")
attr(dat$disp, "label") <- "Displacement"
dat$disp <- fattr(dat$disp, format = "%.2f", width = 1, justify = "right")
tbl <- create_table(dat, show_cols = c(1:3))
rpt <- create_report(fp) %>% add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test60: Attributes on data frame are overridden by column defaults.", {
fp <- file.path(base_path, "output/test60.out")
dat <- mtcars
attr(dat$mpg, "label") <- "Miles per gallon"
dat$mpg <- fattr(dat$mpg, format = "%.2f", width = 2, justify = "left")
attr(dat$cyl, "label") <- "Cylinders"
dat$cyl <- fattr(dat$cyl, format = "%.1f", width = 1, justify = "center")
attr(dat$disp, "label") <- "Displacement"
dat$disp <- fattr(dat$disp, format = "%.2f", width = 1, justify = "right")
tbl <- create_table(dat, show_cols = c(1:3)) %>%
column_defaults(width = .75, align = "left", label = "Data", format = "%.0f")
rpt <- create_report(fp) %>% add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test61: Parameters on column defaults are overridden by define vector.", {
fp <- file.path(base_path, "output/test61.out")
dat <- mtcars
attr(dat$mpg, "label") <- "Miles per gallon"
dat$mpg <- fattr(dat$mpg, format = "%.2f", width = 2, justify = "left")
attr(dat$cyl, "label") <- "Cylinders"
dat$cyl <- fattr(dat$cyl, format = "%.1f", width = 1, justify = "center")
attr(dat$disp, "label") <- "Displacement"
dat$disp <- fattr(dat$disp, format = "%.2f", width = 1, justify = "right")
tbl <- create_table(dat, show_cols = c(1:3)) %>%
column_defaults(width = .75, align = "left", label = "Data",
format = "%.0f") %>%
define(c(mpg, cyl, disp), label = "Data1", width = 2,
align = "right", format = "%.2f")
rpt <- create_report(fp) %>% add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test62: Parameters on column defaults are overridden by single defines.", {
fp <- file.path(base_path, "output/test62.out")
dat <- mtcars
attr(dat$mpg, "label") <- "Miles per gallon"
dat$mpg <- fattr(dat$mpg, format = "%.2f", width = 2, justify = "left")
attr(dat$cyl, "label") <- "Cylinders"
dat$cyl <- fattr(dat$cyl, format = "%.1f", width = 1, justify = "center")
attr(dat$disp, "label") <- "Displacement"
dat$disp <- fattr(dat$disp, format = "%.2f", width = 1, justify = "right")
tbl <- create_table(dat, show_cols = c(1:3)) %>%
column_defaults(width = .75, align = "left", label = "Data",
format = "%.0f") %>%
define(mpg, label = "Data1", width = 2,
align = "right", format = "%.4f") %>%
define(cyl, label = "Data2", width = 1,
align = "left", format = "%.3f") %>%
define(disp, label = "Data3", width = .75,
align = "center", format = "%.1f")
rpt <- create_report(fp) %>% add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test63: Simple regulatory table with borders works as expected.", {
library(tidyr)
library(dplyr)
fp <- file.path(base_path, "output/test63.out")
dat <- mtcars
# Hard coded this so report would come out the same every time.
#dat$group <- replicate(nrow(dat), sample(c("A", "B"), 1), simplify = TRUE)
dat$group <- c("B", "B", "B", "B", "B", "B", "A", "A", "B", "A", "A",
"A", "A", "B", "A", "B", "B", "A", "B", "B", "B", "A",
"A", "A", "A", "A", "A", "B", "B", "A", "B", "B")
dat$cyl <- factor(dat$cyl, levels = c(8, 6, 4),
labels = c("8 Cylinder", "6 Cylinder", "4 Cylinder"))
group_pop <- table(dat$group)
dat_mpg <-
dat %>%
group_by(group) %>%
summarise(across(.cols = mpg,
.fns = list(N = ~ fmt_n(.),
Mean = ~ fmt_mean_sd(.),
Median = ~ fmt_median(.),
`Q1 - Q3` = ~ fmt_quantile_range(.),
Range = ~ fmt_range(.)
))) %>%
pivot_longer(-group,
names_to = c("var", "label"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = group,
values_from = "value")
dat_cyl <-
dat %>%
add_count(group, cyl, name = "n_cyl") %>%
select(group, cyl, n_cyl) %>%
distinct() %>%
pivot_longer(cols = c(cyl),
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = group,
values_from = n_cyl,
values_fill = 0) %>%
mutate(A = fmt_cnt_pct(A, group_pop["A"]),
B = fmt_cnt_pct(B, group_pop["B"])) %>%
arrange(label)
final <- bind_rows(dat_mpg, dat_cyl)
#print(final)
tbl <- create_table(final, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(mpg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center") %>%
define(B, label = "Group B", align = "center")
# Create mtcars table
rpt <- create_report(fp, orientation = "portrait") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table", borders = "all") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1973", borders = "all") %>%
page_footer(left = "Time",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test64: Title header with border on report works as expected.", {
fp <- file.path(base_path, "output/test64.out")
rpt <- create_report(fp) %>%
title_header("Table 1.0", "IRIS Data Frame",
right = c("Study ABC", "Client A", "Page [pg] of [tpg]"),
borders = "all") %>%
add_content(create_table(iris)) %>%
page_footer("DateTime", right = "Page")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test65: Title header with borders on table works as expected.", {
fp <- file.path(base_path, "output/test65.out")
tbl <- create_table(iris) %>%
title_header("Table 1.0", "IRIS Data Frame",
right = c("Study ABC", "Client A", "Page [pg] of [tpg]"),
blank_row = "below", borders = "all")
rpt <- create_report(fp) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test66: Titles and footnotes with border on table works as expected.", {
fp <- file.path(base_path, "output/test66.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below", borders = "all") %>%
footnotes("Here is a footnote", "And another",
borders = "all")
rpt <- create_report(fp) %>%
page_header("Left", "Right") %>%
add_content(tbl) %>%
page_footer("left", "", "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test67: Title header with border on report works as expected.", {
fp <- file.path(base_path, "output/test67.out")
rpt <- create_report(fp) %>%
page_header("Left", "Right") %>%
titles("Table 1.0", "IRIS Data Frame",
borders = "all") %>%
add_content(create_table(iris)) %>%
footnotes("Something", borders = "all") %>%
page_footer("DateTime", right = "Page")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test68: show_cols 'some' parameter and label works as expected.", {
fp <- file.path(base_path, "output/test68.out")
mycols <- c("vs", "mpg", "cyl", "disp")
myvar1 = "vs"
myvar2 = "mpg"
tbl <- create_table(mtcars[1:10, ],
show_cols = mycols, use_attributes = "none") %>%
define({{myvar2}}, label = "n", width = 1.5) %>%
define({{myvar1}}, label = "(%)", width = 1.5)
rpt <- create_report(fp, missing = NULL) %>%
titles("MTCARS Data Frame", align = "center") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test69: Table with spanning headers no underline works as expected.", {
fp <- file.path(base_path, "output/test69.out")
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,
underline = FALSE) %>%
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) %>%
add_content(tbl) %>%
titles("Table 1.0", "MTCARS Subset Test")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test70: Column widths work as expected.", {
fp <- file.path(base_path, "output/test70.out")
dat <- unlist(rep("AAAAAAAAA B", 10))
df <- data.frame(col1 = dat, col2 = dat, col3 = dat, col4 = dat, col5 = dat,
col6 = dat, col7 = dat, col8 = dat, col9 = dat,
stringsAsFactors = FALSE)
tbl <- create_table(df) %>%
spanning_header(1, 2, "Span 1") %>%
spanning_header(3, 5, "Span 2") %>%
spanning_header(1, 5, "Super Span", level = 2) %>%
column_defaults(width = 1) %>%
footnotes("Here is a really long footnote that will need a few columns to contain.")
rpt <- create_report(fp, output_type = "TXT") %>%
set_margins(left = 1, right = 1) %>%
add_content(tbl, align = "left")
res <- write_report(rpt)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
expect_equal(res$pages, 1)
})
test_that("test71: Column widths work as expected with fractional widths.", {
fp <- file.path(base_path, "output/test71.out")
dat <- unlist(rep("AAA", 10))
df <- data.frame(col1 = dat, col2 = dat, col3 = dat, col4 = dat, col5 = dat,
col6 = dat, col7 = dat, col8 = dat, col9 = dat,
stringsAsFactors = FALSE)
tbl <- create_table(df) %>%
spanning_header(1, 2, "Span 1") %>%
spanning_header(3, 5, "Span 2") %>%
spanning_header(1, 5, "Super Span", level = 2) %>%
column_defaults(width = .5) %>%
define(col1, width = 3.5) %>%
define(col2, width = 1) %>%
define(col7, width = .7) %>%
define(col8, width = 1.3) %>%
footnotes("Here is a really long footnote that will need a few columns to contain.")
rpt <- create_report(fp, output_type = "TXT") %>%
set_margins(left = 1, right = 1) %>%
add_content(tbl, align = "left")
res <- write_report(rpt)
# print(res, verbose = TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
expect_equal(res$pages, 1)
})
test_that("test72: Check column alignment", {
fp <- file.path(base_path, "output/test72.out")
# Sample data
df <- read.table(header = TRUE, text = '
Country N1 Mean1 SD1 N2 Mean2 SD2
Bangladesh 52 25.03 0.02 43 22.31 0.08
Germany 42 95.01 1.02 53 9.31 0.09
Italy 2 20.22 0.00 11 8.09 1.11')
tbl <- create_table(df) %>%
column_defaults(width = .5) %>%
spanning_header(N1, SD1, label = "Treatment A") %>%
spanning_header(N2, SD2, label = "Treatment B") %>%
define(Country, width = 1) %>%
titles("Table 1.0", "Treatments by Country") %>%
footnotes("* Country of Site")
rpt <- create_report(fp) %>%
options_fixed(uchar = "-") %>%
add_content(tbl)
res <- write_report(rpt)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
expect_equal(res$pages, 1)
})
test_that("test73: Table Borders with ttls/fnts on table works as expected.", {
fp <- file.path(base_path, "output/test73.out")
tbl <- create_table(iris, borders = "all") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below") %>%
footnotes("Here is a footnote", "And another")
rpt <- create_report(fp) %>%
page_header("Left", "Right") %>%
add_content(tbl) %>%
page_footer("left", "", "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test74: Table Borders with ttls/fnts on report works as expected.", {
fp <- file.path(base_path, "output/test74.out")
tbl <- create_table(iris, borders = "all")
rpt <- create_report(fp) %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test75: Label row is one cell.", {
fp <- file.path(base_path, "output/test75.out")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to see if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", width = 1.25, align = "center", n = 19) %>%
define(B, label = "Group B", width = 1.25, align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "landscape", output_type = "TXT") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("test76: Page break on invisible column.", {
fp <- file.path(base_path, "output/test76.out")
dat <- iris
dat$Sequence <- seq(1, nrow(iris))
tbl <- create_table(dat, borders = "all") %>%
define(Species, page_break = TRUE, visible = FALSE)
rpt <- create_report(fp) %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test77: Blank after on invisible column.", {
fp <- file.path(base_path, "output/test77.out")
tbl <- create_table(iris, borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp) %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test78: Blank nested stub works as expected.", {
fp <- file.path(base_path, "output/test78.out")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "Stats" "19" "13"
"ampg" "Stats" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Stats" "16.4" "21.4"
"ampg" "Stats" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Stats" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to see if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25, dedupe = TRUE) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("test79: Page header width works.", {
fp <- file.path(base_path, "output/test79.out")
tbl <- create_table(iris[1:10, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp) %>%
page_header(paste0("Left and here is a really long left ",
"cell text to put it and more and more"),
"Right", width = 8) %>%
add_content(tbl) %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test80: Carriage return in label row works.", {
fp <- file.path(base_path, "output/test80.out")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - \n21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to \nsee if it can span\nthe entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("test81: Glue feature works.", {
if (dev) {
library(common)
fp <- file.path(base_path, "output/test81.out")
tbl <- create_table(mtcars[1:10, ], borders = "all") %>%
spanning_header(1, 4, label = "My span{subsc('4')}") %>%
define(mpg, label = "Mpg{subsc('3')}")
myvar <- "23"
rpt <- create_report(fp) %>%
page_header(c("Left {supsc('2')}really long left ",
"cell text to put it{supsc('3')} and more and more"),
"Right{supsc('x')}") %>%
add_content(tbl) %>%
page_footer(c("left1{supsc('5')}", "left2{supsc('6')}"), "",
"right{supsc('7')}") %>%
titles("Table 1.0{supsc('1')}", "IRIS Data Frame{{myvar}}",
blank_row = "below") %>%
footnotes("Here is a footnote{subsc('a')}", "And another{subsc('9')}")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("test82: Title columns work 1 column.", {
fp <- file.path(base_path, "output/test82.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
titles("Table 1.0 second row", "IRIS Data Frame3",
blank_row = "both", columns = 1, align = "center",
borders = c("outside"))
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test83: Title columns work 2 columns.", {
fp <- file.path(base_path, "output/test83.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
titles("Table 1.0", "IRIS Data Frame", "Left", "Right",
blank_row = c("below"), columns = 2, borders = "none")
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test84: Title columns work 3 columns.", {
fp <- file.path(base_path, "output/test84.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rght <- paste("Here")
rpt <- create_report(fp, output_type = "TXT",
font_size = 10) %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
"My right thing", "", "Center", rght,
blank_row = "below", columns = 3, borders = "top") %>%
footnotes("Here is a footnote", "And another", "A",
"Here is a longer footnote to see if I can figure out the alignment pattern.",
align = "right")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("test85: Multiple title blocks work as expected.", {
fp <- file.path(base_path, "output/test85.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
titles("Table 2.0", "IRIS Data Frame2", "Left", "Right",
blank_row = "below", columns = 2, borders = "all") %>%
titles("Table 3.0", "IRIS Data Frame3", "My right thing", "", "Center",
blank_row = "below", columns = 3, borders = "all") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test86: Titles can be passed as a vector.", {
fp <- file.path(base_path, "output/test86.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
ttl <- c("Title1", "Title2", "Title3")
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles(ttl,
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "none") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test87: Custom page size works as expected.", {
fp <- file.path(base_path, "output/test87.out")
tbl <- create_table(iris[1:15, ]) %>%
define(Species, visible = FALSE)
ttl <- c("Title1", "Title2", "Title3")
rpt <- create_report(fp, output_type = "TXT", paper_size = c(6.5, 7.5),
orientation = "portrait") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles(ttl,
blank_row = "below", columns = 1, align = "center",
borders = "none") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test88: Footnotes columns work 1 column.", {
fp <- file.path(base_path, "output/test88.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
titles("Table 1.0 second row", "IRIS Data Frame3",
blank_row = "both", columns = 1, align = "center",
borders = c("outside"))
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Here is a footnote", "And another", columns = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test89: Footnotes columns work 2 columns.", {
fp <- file.path(base_path, "output/test89.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
titles("Table 1.0", "IRIS Data Frame", "Left", "Right",
blank_row = c("below"), columns = 2, borders = "none") %>%
footnotes("Table left", "Table right", columns = 2)
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Here is a footnote", "And another", columns = 2)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test90: Footnotes columns work 3 columns.", {
fp <- file.path(base_path, "output/test90.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rght <- paste("Here")
rpt <- create_report(fp, output_type = "TXT",
font_size = 10) %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
"My right thing", "", "Center", rght,
blank_row = "below", columns = 3, borders = "top") %>%
footnotes("Here is a footnote", "And another", "A",
"Here is a longer footnote", "to see if I can figure out", "the alignment pattern",
align = "right", columns = 3)
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("test91: Multiple footnotes blocks work as expected.", {
fp <- file.path(base_path, "output/test91.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE) %>%
footnotes("Left", "right", columns = 2)
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Footnote1", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
footnotes("Footnotes2", "IRIS Data Frame2", "Left", "Right",
blank_row = "below", columns = 2, borders = "all") %>%
footnotes("Footnotes3", "IRIS Data Frame3", "My right thing", "", "Center",
blank_row = "below", columns = 3, borders = "all") %>%
titles("Table 1.0", "My little title")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test92: Page by with wrap works as expected.", {
fp <- file.path(base_path, "output/test92.out")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat$Pgby <- paste0("Flower Type\n", dat$Pgby)
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Report with a Page By", borders = "none") %>%
page_by(Pgby, align = "left", label = "", borders = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "TXT",
orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_header("Left", "Right") %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 6)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("test93: Page by with wrap works as expected.", {
fp <- file.path(base_path, "output/test93.out")
fmt1 <- c(setosa = 1, versicolor = 2, virginica = 3)
fmt2 <- value(condition(x == 1, "Setosa"),
condition(x == 2, "Versicolor"),
condition(x == 3, "Virginica"))
dat <- iris
fmtval <- fmt1[dat$Species]
names(fmtval) <- NULL
dat$Pgby <- fmtval
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Report with a Page By", borders = "none") %>%
page_by(Pgby, align = "left", label = "Flower:", borders = "none", format = fmt2) %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "TXT",
orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_header("Left", "Right") %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 6)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("test94: Label with invisible column works as expected.", {
fp <- file.path(base_path, "output/test94.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE, label = "Fork") %>%
footnotes("Left", "right", columns = 2)
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Footnote1", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
titles("Table 1.0", "My little title")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test95: Page break with blank row after works as expected.", {
fp <- file.path(base_path, "output/test95.out")
dat <- sort(iris, by = c("Species", "Petal.Width"))
tbl <- create_table(dat, borders = "all") %>%
define(Petal.Width, blank_after = TRUE) %>%
define(Species, page_break = TRUE, visible = TRUE) %>%
footnotes("Left", "right", columns = 2)
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Footnote1", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
titles("Table 1.0", "My little title")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
Try the reporter package in your browser
Any scripts or data that you put into this service are public.
reporter documentation built on May 29, 2024, 4:43 a.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("System Tests")
base_path <- "c:/packages/reporter/tests/testthat"
base_path <- tempdir()
options("logr.output" = FALSE)
dev <- FALSE
test_that("test1: Simplest table works as expected.", {
fp <- file.path(base_path, "output/test1.out")
rpt <- create_report(fp) %>%
add_content(create_table(mtcars[1:10, ]), align = "left")
#print(rpt, verbose = TRUE)
res <- write_report(rpt)
res
#print(res, verbose = TRUE)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test2: Simplest table with title works as expected.", {
fp <- file.path(base_path, "output/test2.out")
tbl <- create_table(mtcars[1:10, ]) %>%
define(vs, visible = FALSE)
rpt <- create_report(fp) %>%
titles("MTCARS Data Frame", align = "left") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test3: Simple table with formats works as expected.", {
fp <- file.path(base_path, "output/test3.out")
# 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)
afmt <- value(condition(x == "A", "Placebo"),
condition(x == "B", "Treatment 1"))
sfmt2 <- c(M = "Male", F = "Female")
tbl1 <- create_table(df, first_row_blank = TRUE) %>%
define(subjid, align = "left") %>%
define(sex, width = 1, format = sfmt2) %>%
define(age, width = .5) %>%
define(arm, format = afmt, width = 1.5, align = "right", dedupe = TRUE)
rpt <- create_report(fp) %>%
options_fixed(editor = "notepad++") %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test4: Two page report works as expected.", {
fp <- file.path(base_path, "output/test4.out")
# 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, first_row_blank = TRUE) %>%
define(sex, width = 2, format = sfmt1) %>%
define(age, width = 2)
tbl2 <- create_table(df2) %>%
define(sex, width = .25, format = sfmt2) %>%
define(age, format = "%0d%%") %>%
define(arm, format = afmt, width = 2)
rpt <- create_report(fp, units = "inches", paper_size = "letter") %>%
options_fixed(editor = "notepad++") %>%
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)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test5: Table with break between sections works as expected.", {
fp <- file.path(base_path, "output/test5.out")
# 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", 3), "A", "A")
# 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) %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test6: Table that spans multiple pages breaks as expected.", {
fp <- file.path(base_path, "output/test6.out")
rpt <- create_report(fp) %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test7: Table with long cell and label values wraps as expected.", {
fp <- file.path(base_path, "output/test7.out")
# 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) %>%
titles("Table 1.0", align = "center") %>%
add_content(tbl1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test8: Table with spanning headers works as expected.", {
fp <- file.path(base_path, "output/test8.out")
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) %>%
add_content(tbl) %>%
titles("Table 1.0", "MTCARS Subset Test")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test9: Page wrap works as expected.", {
fp <- file.path(base_path, "output/test9.out")
dat <- mtcars[1:10, ]
df <- data.frame(vehicle = rownames(dat), dat, stringsAsFactors = FALSE)
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("drat","carb", label = "Super Span",
label_align = "center",
level = 2) %>%
define(vehicle, label = "Vehicle", id_var = TRUE) %>%
define(mpg, format = "%.1f") %>%
define(am, visible = FALSE) %>%
define(vs, page_wrap = TRUE)
rpt <- create_report(fp, orientation = "portrait") %>%
titles("Table 1.0", "MTCARS Spanning Header") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test10: Page wrap with spanning header works as expected.", {
fp <- file.path(base_path, "output/test10.out")
df <- data.frame(vehicle = rownames(mtcars), mtcars, stringsAsFactors = FALSE)
rownames(df) = NULL
tbl <- create_table(df) %>%
spanning_header(2, 5,
label = "Span 1", label_align = "center", n = 10) %>%
spanning_header(6, 8,
label = "Span 2", label_align = "center", n = 10) %>%
spanning_header(9, 12,
label = "Span 3", label_align = "center", n = 10) %>%
spanning_header(6, 12, label = "Super Span",
label_align = "center",
level = 2) %>%
define(vehicle, label = "Vehicle", id_var = TRUE) %>%
define(mpg, format = "%.1f") %>%
define(wt, page_wrap = TRUE) %>%
define(vs, page_wrap = TRUE)
rpt <- create_report(fp, orientation = "portrait") %>%
options_fixed(editor = "wordpad") %>%
add_content(tbl) %>%
titles("Table 1.0", "MTCARS Subset Test")
#print(rpt)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test11: Table with break between sections works as expected.", {
fp <- file.path(base_path, "output/test11.out")
# 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) %>%
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)
res2 <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res2$pages * res2$line_count)
expect_equal(nchar(lns[1]), res2$line_size)
})
test_that("test12: Headerless table with title works as expected.", {
fp <- file.path(base_path, "output/test12.out")
tbl <- create_table(mtcars[1:10, ], headerless = TRUE) %>%
define(vs, visible = FALSE)
rpt <- create_report(fp) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test13: Combination with Headerless table works as expected.", {
fp <- file.path(base_path, "output/test13.out")
tbl1 <- create_table(mtcars[1:10, ], headerless = FALSE) %>%
titles("MTCARS Combined Table 1.0")
tbl2 <- create_table(mtcars[11:20, ], headerless = TRUE)
tbl3 <- create_table(mtcars, headerless = TRUE) %>%
footnotes("Full cars table")
txt1 <- create_text("These tables are combined!")
rpt <- create_report(fp) %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
page_footer(center = "Page [pg] of [tpg]") %>%
add_content(tbl1, page_break = FALSE, blank_row = "none") %>%
add_content(tbl2, page_break = FALSE) %>%
add_content(txt1) %>%
add_content(tbl1, page_break = FALSE, blank_row = "none") %>%
add_content(tbl3, page_break = FALSE) %>%
add_content(txt1, page_break = FALSE) # Also test open page at end
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test15: Multi-page table with Titles and Footnotes breaks as expected.", {
fp <- file.path(base_path, "output/test15.out")
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.")
txt <- create_text(cnt, width = 6.25, align = "left") %>%
titles("Introduction to Irises")
tbl <- create_table(iris) %>%
titles("My little Iris Table") %>%
footnotes("* Better Gardening, 1973") %>%
define(Species, blank_after = TRUE, dedupe = TRUE)
rpt <- create_report(fp) %>%
add_content(txt, page_break = FALSE) %>%
add_content(tbl, blank_row = "none")
res2 <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res2$pages * res2$line_count)
})
test_that("test16: Simple regulatory listing works as expected.", {
fp <- file.path(base_path, "output/test16.out")
# Create mtcars listing
rpt <- create_report(fp, orientation = "portrait") %>%
page_header(left = "Client: Motor Trend", right = c("Study: Cars",
"Something else")) %>%
titles("Listing 1.0", "MTCARS Data Listing") %>%
add_content(create_table(mtcars)) %>%
footnotes("* Motor Trend, 1973") %>%
page_footer(left = "Time",
center = "Confidential",
right = "Page [pg] of [tpg]")
rpt
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test17: Simple regulatory table works as expected.", {
library(tidyr)
library(dplyr)
fp <- file.path(base_path, "output/test17.out")
dat <- mtcars
# Hard coded this so report would come out the same every time.
#dat$group <- replicate(nrow(dat), sample(c("A", "B"), 1), simplify = TRUE)
dat$group <- c("B", "B", "B", "B", "B", "B", "A", "A", "B", "A", "A",
"A", "A", "B", "A", "B", "B", "A", "B", "B", "B", "A",
"A", "A", "A", "A", "A", "B", "B", "A", "B", "B")
dat$cyl <- factor(dat$cyl, levels = c(8, 6, 4),
labels = c("8 Cylinder", "6 Cylinder", "4 Cylinder"))
group_pop <- table(dat$group)
dat_mpg <-
dat %>%
group_by(group) %>%
summarise(across(.cols = mpg,
.fns = list(N = ~ fmt_n(.),
Mean = ~ fmt_mean_sd(.),
Median = ~ fmt_median(.),
`Q1 - Q3` = ~ fmt_quantile_range(.),
Range = ~ fmt_range(.)
))) %>%
pivot_longer(-group,
names_to = c("var", "label"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = group,
values_from = "value")
dat_cyl <-
dat %>%
add_count(group, cyl, name = "n_cyl") %>%
select(group, cyl, n_cyl) %>%
distinct() %>%
pivot_longer(cols = c(cyl),
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = group,
values_from = n_cyl,
values_fill = 0) %>%
mutate(A = fmt_cnt_pct(A, group_pop["A"]),
B = fmt_cnt_pct(B, group_pop["B"])) %>%
arrange(label)
final <- bind_rows(dat_mpg, dat_cyl)
#print(final)
tbl <- create_table(final, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(mpg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center") %>%
define(B, label = "Group B", align = "center")
# Create mtcars table
rpt <- create_report(fp, orientation = "portrait") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1973") %>%
page_footer(left = "Time",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test18: Text and table with page breaks works as expected.", {
fp <- file.path(base_path, "output/test18.out")
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.")
# Create text content
txt <- create_text(cnt) %>%
titles("My Analysis of the previous table")
# Prepare data
dat <- mtcars
dat$name <- rownames(dat)
dat <- mtcars[1:10, ]
# Create table content
tbl <- create_table(dat) %>%
titles("Table 1.0", "MTCARS Sample Data") %>%
footnotes("* Motor Trend, 1973")
# Create report and add both table and text content
rpt <- create_report(fp, orientation = "portrait") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
add_content(tbl, page_break = FALSE) %>%
add_content(txt) %>%
add_content(tbl) %>%
add_content(txt) %>%
page_footer(left = "Time",
center = "Confidential",
right = "Page [pg] of [tpg]")
# Write the report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test19: show_cols 'none' parameter on table works as expected.", {
fp <- file.path(base_path, "output/test19.out")
tbl <- create_table(mtcars[1:10, ], show_cols = "none") %>%
define(mpg) %>%
define(cyl) %>%
define(vs) %>%
define(drat, visible = FALSE)
rpt <- create_report(fp) %>%
titles("MTCARS Data Frame", align = "left") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test20: show_cols 'some' parameter on table works as expected.", {
fp <- file.path(base_path, "output/test20.out")
tbl <- create_table(mtcars[1:10, ],
show_cols = c("vs", "mpg", "cyl", "disp", "drat")) %>%
define(mpg, label = "Miles Per Gallon") %>%
define(vs, label = "") %>%
define(drat, visible = FALSE)
rpt <- create_report(fp) %>%
titles("MTCARS Data Frame", align = "left") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test21: Multiple page headers and footers work as expected.", {
fp <- file.path(base_path, "output/test21.out")
tbl <- create_table(mtcars[1:10, ]) %>%
define(vs, visible = FALSE)
rpt <- create_report(fp) %>%
page_header(c("Line 1", "Line 2"), "Right Line") %>%
titles("MTCARS Data Frame", align = "left") %>%
page_footer(c("Footer Line 1", "Footer Line 2"), right = "Footer Right Line",
center = c("A", "B", "C")) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test22: Multiple id_var parameters work as expected.", {
fp <- file.path(base_path, "output/test22.out")
dat <- data.frame(vehicle = rownames(mtcars), mtcars, stringsAsFactors = FALSE)
tbl <- create_table(dat) %>%
define(vehicle, id_var = TRUE, width = 3) %>%
define(mpg, id_var = TRUE, width = 2, align = "left") %>%
define(vs, id_var = TRUE, width = 2, align = "left")
rpt <- create_report(fp) %>%
options_fixed(editor = "word") %>%
page_header(c("Line 1", "Line 2"), "Right Line") %>%
titles("MTCARS Data Frame", align = "left") %>%
page_footer(c("Footer Line 1", "Footer Line 2"),
right = "Footer Right Line") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test23: Blank margins setting works as expected.", {
# Compare output to test1
fp <- file.path(base_path, "output/test23.out")
rpt <- create_report(fp, output_type = "TXT") %>%
options_fixed( blank_margins = TRUE) %>%
set_margins(top = 1) %>%
add_content(create_table(mtcars[1:10, ]), align = "left")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), (res$pages * res$line_count) + res$blank_margin_top)
})
test_that("test24: Table width parameter works as expected for full width.", {
fp <- file.path(base_path, "output/test24.out")
tbl1 <- create_table(mtcars[1:10, 1:6], width = 9)
tbl2 <- create_table(mtcars[11:20, 1:6])
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
add_content(tbl1, align = "left", page_break = FALSE) %>%
add_content(tbl2, align = "left")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), 1 * res$line_count)
})
test_that("test25: page_break parameter simple case works as expected.", {
fp <- file.path(base_path, "output/test25.out")
dat <- mtcars
rownames(dat) <- NULL
dat$pg <- c(rep(1, 16), rep(2, 16))
tbl <- create_table(dat) %>%
define(pg, page_break = TRUE)
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
titles("MTCARS Sample Report") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), 2 * res$line_count)
})
test_that("test26: page_break parameter harder case works as expected.", {
fp <- file.path(base_path, "output/test26.out")
dat <- iris
#dat$pg <- c(rep(1, 16), rep(2, 16))
tbl <- create_table(dat) %>%
define(Species, page_break = TRUE)
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
titles("IRIS Sample Report") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test27: page_break parameter even harder case works as expected.", {
fp <- file.path(base_path, "output/test27.out")
dat <- iris
dat$pg <- c(rep(1, 20), rep(2, 20), rep(3, 20), rep(4, 20), rep(5, 10),
rep(6, 20), rep(7, 20), rep(8, 20))
tbl <- create_table(dat) %>%
define(Species, blank_after = TRUE) %>%
define(pg, page_break = TRUE)
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
titles("IRIS Sample Report") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test28: use_attributes parameter table works as expected.", {
fp1 <- file.path(base_path, "output/test28a.out")
fp2 <- file.path(base_path, "output/test28b.out")
fp3 <- file.path(base_path, "output/test28c.out")
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) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp1), TRUE)
lns <- readLines(fp1)
expect_equal(length(lns), res$pages * res$line_count)
# Test none
tbl <- create_table(dat, use_attributes = "none")
rpt <- create_report(fp2) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp2), TRUE)
lns <- readLines(fp2)
# Test some
tbl <- create_table(dat, use_attributes = c("format", "width"))
rpt <- create_report(fp3) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp3), TRUE)
lns <- readLines(fp3)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test29: column_defaults work as expected.", {
fp <- file.path(base_path, "output/test29.out")
tbl <- create_table(mtcars[1:10, ]) %>%
column_defaults(width = .5, align = "right", format = "%.1f",
n = 5) %>%
define(mpg, width = 2, format = "%.2f", align = "left",
label_align = "right") %>%
define(wt, width = 2, format = "%.4f", align = "left", n = 6,
label_align = "center")
rpt <- create_report(fp) %>%
add_content(tbl, align = "left")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test30: multiple vars on define work as expected.", {
fp <- file.path(base_path, "output/test30.out")
tbl <- create_table(mtcars[1:10, ]) %>%
define(c(mpg, wt), width = 2, format = "%.2f", align = "left",
label_align = "right")
rpt <- create_report(fp) %>%
add_content(tbl, align = "left")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test31: Table width parameter works for less than full width.", {
fp <- file.path(base_path, "output/test31.out")
tbl1 <- create_table(mtcars[1:10, 1:6], width = 7)
tbl2 <- create_table(mtcars[11:20, 1:6])
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
add_content(tbl1, align = "left", page_break = FALSE) %>%
add_content(tbl2, align = "left")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), 1 * res$line_count)
})
test_that("test36: Report with NAs in data works as expected.", {
fp <- file.path(base_path, "output/test36.txt")
# Setup
subjid <- 100:109
name <- c("Quintana, Gabriel", NA, "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", NA, "M", "F", "F", "M")
age <- c(41, 53, 43, NA, 47, 52, 21, 38, 62, 26)
arm <- c(rep("A", 5), rep("B", 4), NA)
# Create data frame
df <- data.frame(subjid, name, sex, age, arm, stringsAsFactors = FALSE)
afmt <- value(condition(x == "A", "Placebo"),
condition(x == "B", "Treatment 1"))
sfmt1 <- value(condition(x == "M", "Male"),
condition(x == "F", "Female"))
tbl1 <- create_table(df, width = 7) %>%
define(sex, width = 1, format = sfmt1) %>%
define(name, width = 2) %>%
define(age)
rpt <- create_report(fp, output_type = "TXT", missing = "-") %>%
options_fixed(font_size = 12) %>%
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)
res <- write_report(rpt)
#print(res)
expect_equal(file.exists(fp), TRUE)
})
test_that("test37: line_size and line_count overrides work as expected.", {
fp <- file.path(base_path, "output/test37.out")
rpt <- create_report(fp) %>%
options_fixed(line_size = 40, line_count = 30) %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris))
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test38: column_defaults works as expected with multiple tables.", {
fp <- file.path(base_path, "output/test38.out")
tbl1 <- create_table(mtcars[1:5, ]) %>%
column_defaults(width = .5)
tbl2 <- create_table(mtcars[6:10, ], headerless=TRUE) %>%
column_defaults(width = .5)
# Create the report object
rpt <- create_report(fp) %>%
titles("MTCARS Sample Data", align = "left") %>%
add_content(tbl1, page_break = FALSE, align = "left", blank_row = "none") %>%
add_content(tbl2, page_break = FALSE, align = "left") %>%
add_content(create_text("* NOTE: Above table is actually two tables stacked."))
# Write the report to the file system
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test39: column_defaults works as expected with column positions.", {
fp <- file.path(base_path, "output/test39.out")
tbl1 <- create_table(mtcars[1:5, ]) %>%
column_defaults(vars = 1:5, width = .5) %>%
column_defaults(6:11, width = .6)
# Create the report object
rpt <- create_report(fp) %>%
titles("MTCARS Sample Data", align = "left") %>%
add_content(tbl1, align = "left", blank_row = "none")
# Write the report to the file system
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
#
# test_that("test28: Table width parameter more than sum of columns works.", {
#
#
# fp <- file.path(base_path, "output/test28.out")
#
# if (file.exists(fp))
# file.remove(fp)
#
# tbl1 <- create_table(mtcars[1:10, ], width = 9) %>%
# define(mpg, width = 2) %>%
# define(cyl, width = 2) %>%
# define(disp, width = 2) %>%
# define(hp, width = 2) %>%
# define(am, width = 2) %>%
# define(carb, width = 2)
#
# rpt <- create_report(fp) %>%
# page_header("Client", "Study") %>%
# add_content(tbl1, align = "left")
#
#
#
# res <- write_report(rpt)
#
# expect_equal(file.exists(fp), TRUE)
#
# lns <- readLines(fp)
#
# expect_equal(length(lns), res$pages * res$line_count)
#
# })
test_that("test40: Report with units in cm works as expected.", {
fp <- file.path(base_path, "output/test40.out")
rpt <- create_report(fp, units = "cm") %>%
titles("IRIS Data Frame") %>%
add_content(create_table(iris))
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test41: Title header on report works as expected.", {
fp <- file.path(base_path, "output/test41.out")
rpt <- create_report(fp) %>%
title_header("Table 1.0", "IRIS Data Frame",
right = c("Study ABC", "Client A", "Page [pg] of [tpg]")) %>%
add_content(create_table(iris)) %>%
page_footer("DateTime", right = "Page")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test42: Title header on table works as expected.", {
fp <- file.path(base_path, "output/test42.out")
tbl <- create_table(iris) %>%
title_header("Table 1.0", "IRIS Data Frame",
right = c("Study ABC", "Client A", "Page [pg] of [tpg]"),
blank_row = "below")
rpt <- create_report(fp) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test43: Page by on table works as expected.", {
fp <- file.path(base_path, "output/test43.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "IRIS Data Frame") %>%
page_by(Species, "Species: ", align = "left") %>%
define(Species, visible = FALSE) %>%
footnotes("Here is a footnote")
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
add_content(tbl) %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test44: Page by on report works as expected.", {
fp <- file.path(base_path, "output/test44.out")
tbl <- create_table(iris) %>%
define(Species, visible = FALSE)
rpt <- create_report(fp) %>%
page_header("Client", "Study") %>%
titles("Table 1.0", "IRIS Data Frame") %>%
page_by(Species, "Species: ") %>%
footnotes("Here is a footnote") %>%
page_footer("Time", right = "Page [pg] of [tpg]") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test45: Report without page by works as expected.", {
fp <- file.path(base_path, "output/test45.out")
tbl <- create_table(iris) %>%
define(Species, page_break = TRUE)
rpt <- create_report(fp, orientation = "portrait", units = "inches") %>%
options_fixed(editor = "word", uchar = "-") %>%
set_margins(top = 1, bottom = 1, left = 1, right = 1) %>%
# 2.54 1.27
page_header("Client", "Study") %>%
titles("Table 1.0", "IRIS Data Frame") %>%
footnotes("Here is a footnote") %>%
page_footer("Time", right = "Page [pg] of [tpg]") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test46: Another title_header test to check alignment.", {
# Create a temporary file
fp <- file.path(base_path, "output/test46.out")
# Prepare data
dat <- data.frame(category = rownames(USPersonalExpenditure),
USPersonalExpenditure, stringsAsFactors = FALSE)
# Define table
tbl <- create_table(dat) %>%
title_header("Table 1.0", "US Personal Expenditures from 1940 - 1960",
right = c("Page [pg] of [tpg]", "World Almanac")) %>%
column_defaults(from = X1940, to = X1960, format = "$%.2f") %>%
define(category, label = "Category", width = 2) %>%
define(X1940, label = "1940") %>%
define(X1945, label = "1945") %>%
define(X1950, label = "1950") %>%
define(X1955, label = "1955") %>%
define(X1960, label = "1960") %>%
footnotes("* In billions of dollars")
# Define report
rpt <- create_report(fp, orientation="portrait") %>%
add_content(tbl)
# Write the report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
# Alignment is off on this one.
test_that("test47: CM Table with long cell and label values wraps as expected.", {
fp <- file.path(base_path, "output/test47.out")
# Setup
arm <- c(rep("A", 5), rep("B", 5))
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa and more and more and more and more and 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 = 2) %>%
define(name, label = "Subject Name") %>%
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, units = "cm") %>%
page_header("Sponsor", "Study") %>%
titles("Table 1.0", align = "right") %>%
add_content(tbl1, align = "right") %>%
page_footer("Time", "Confidential", "Page")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test48: Three level stub works as expected.", {
fp <- file.path(base_path, "output/test48.out")
# 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 = 2.5) %>%
define(cat, label_row = TRUE, blank_after = TRUE) %>%
define(grp, indent = .25) %>%
define(ci, indent = .5) %>%
define(values, label = "Values")
rpt <- create_report(fp) %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test49: Stub and width settings works as expected.", {
fp <- file.path(base_path, "output/test49.out")
# 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")
values1 <- c(41, 53, 43, 39, 47, 52, 38, 25, 37, 23, 78, 21)
values2 <- c(32, 28, 94, 32, 09, 42, 67, 65, 56, 12, 91, 32)
values3 <- c(41, 53, 43, 39, 47, 52, 38, 25, 37, 23, 78, 21)
values4 <- c(32, 28, 94, 32, 09, 42, 67, 65, 56, 12, 91, 32)
# Create data frame
df <- data.frame(cat, grp, ci, values1, values2, values3, values4,
stringsAsFactors = FALSE)
tbl1 <- create_table(df, width = 9) %>%
stub(c(cat, grp, ci), "Estimates", width = 3) %>%
define(cat, label_row = TRUE, blank_after = TRUE) %>%
define(grp, indent = .25) %>%
define(ci, indent = .5) %>%
define(values1, label = "Values1", width = .70) %>%
define(values2, label = "Values2") %>%
define(values3, label = "Values3") %>%
define(values4, label = "Values4")
rpt <- create_report(fp) %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
# This is still messed up, but not going to fix it for now.
test_that("test50: Table with long numeric values sizes as expected.", {
fp <- file.path(base_path, "output/test50.out")
# Setup
arm <- c(rep("A", 5), rep("B", 5))
subjid <- 100:109
name <- c("Quintana, Gabriel", "Allison, Blas", "Minniear, Presley",
"al-Kazemi, Najwa and 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)
rnd <- c(0.7077520, 0.3180838, 0.9174493, 0.4395207, 0.5307518,
0.8501806, 0.4584808, 0.1016370, 0.7061505, 0.7819369)
#rnd <- runif(10)
calc <- age * rnd
# Create data frame
df <- data.frame(arm, subjid, name, sex, age, rnd, calc,
stringsAsFactors = FALSE)
tbl1 <- create_table(df, first_row_blank = TRUE) %>%
define(subjid, label = "Subject ID for a patient", n = 10) %>%
define(name, label = "Subject Name", width = 1) %>%
define(sex, label = "Sex", n = 10, align = "left") %>%
define(age, label = "Age", n = 10) %>%
define(arm, label = "Arm",
blank_after = TRUE,
dedupe = TRUE) %>%
define(rnd, width = .5) %>%
define(calc, width = .6)
rpt <- create_report(fp) %>%
titles("Table 1.0", align = "center") %>%
add_content(tbl1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test51: Page break on invisible columns works as expected.", {
fp <- file.path(base_path, "output/test51.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
define(Species, visible = FALSE, page_break = TRUE)
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test52: Column default values for label and n work as expected.", {
fp <- file.path(base_path, "output/test52.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(label = "Data", n = "100") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test53: Multiple Column defaults work as expected for quoted vars.", {
fp <- file.path(base_path, "output/test53.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(vars = c("Sepal.Length", "Petal.Length"), label = "Length") %>%
column_defaults(vars = c("Sepal.Width", "Petal.Width"), label = "Width") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test54: Multiple Column defaults work as expected for positions.", {
fp <- file.path(base_path, "output/test54.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(vars = c(1, 3), label = "Length") %>%
column_defaults(vars = c(2, 4), label = "Width") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test55: Multiple Column defaults work as expected for unquoted vars.", {
fp <- file.path(base_path, "output/test55.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(vars = c(Sepal.Length, Petal.Length), label = "Length") %>%
column_defaults(vars = c(Sepal.Width, Petal.Width), label = "Width") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test56: Multiple Column defaults work as expected for quoted from/to", {
fp <- file.path(base_path, "output/test56.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(from = "Sepal.Length", to = "Sepal.Width", label = "Sepal") %>%
column_defaults(from = "Petal.Length", to = "Petal.Width", label = "Petal") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test57: Multiple Column defaults work as expected for unquoted from/to", {
fp <- file.path(base_path, "output/test57.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(from = Sepal.Length, to = Sepal.Width, label = "Sepal") %>%
column_defaults(from = Petal.Length, to = Petal.Width, label = "Petal") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test58: Multiple Column defaults work as expected for positional from/to", {
fp <- file.path(base_path, "output/test58.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "My Irises Data Sample") %>%
column_defaults(from = 1, to = 2, label = "Sepal") %>%
column_defaults(from = 3, to = 4, label = "Petal") %>%
define("Species", label = "Species")
rpt <- create_report(fp) %>%
add_content(tbl) %>%
page_header("Client", "Study") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test59: Formatting Attributes on data frame work as expected.", {
fp <- file.path(base_path, "output/test59.out")
dat <- mtcars
attr(dat$mpg, "label") <- "Miles per gallon"
dat$mpg <- fattr(dat$mpg, format = "%.2f", width = 2, justify = "left")
attr(dat$cyl, "label") <- "Cylinders"
dat$cyl <- fattr(dat$cyl, format = "%.1f", width = 1, justify = "center")
attr(dat$disp, "label") <- "Displacement"
dat$disp <- fattr(dat$disp, format = "%.2f", width = 1, justify = "right")
tbl <- create_table(dat, show_cols = c(1:3))
rpt <- create_report(fp) %>% add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test60: Attributes on data frame are overridden by column defaults.", {
fp <- file.path(base_path, "output/test60.out")
dat <- mtcars
attr(dat$mpg, "label") <- "Miles per gallon"
dat$mpg <- fattr(dat$mpg, format = "%.2f", width = 2, justify = "left")
attr(dat$cyl, "label") <- "Cylinders"
dat$cyl <- fattr(dat$cyl, format = "%.1f", width = 1, justify = "center")
attr(dat$disp, "label") <- "Displacement"
dat$disp <- fattr(dat$disp, format = "%.2f", width = 1, justify = "right")
tbl <- create_table(dat, show_cols = c(1:3)) %>%
column_defaults(width = .75, align = "left", label = "Data", format = "%.0f")
rpt <- create_report(fp) %>% add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test61: Parameters on column defaults are overridden by define vector.", {
fp <- file.path(base_path, "output/test61.out")
dat <- mtcars
attr(dat$mpg, "label") <- "Miles per gallon"
dat$mpg <- fattr(dat$mpg, format = "%.2f", width = 2, justify = "left")
attr(dat$cyl, "label") <- "Cylinders"
dat$cyl <- fattr(dat$cyl, format = "%.1f", width = 1, justify = "center")
attr(dat$disp, "label") <- "Displacement"
dat$disp <- fattr(dat$disp, format = "%.2f", width = 1, justify = "right")
tbl <- create_table(dat, show_cols = c(1:3)) %>%
column_defaults(width = .75, align = "left", label = "Data",
format = "%.0f") %>%
define(c(mpg, cyl, disp), label = "Data1", width = 2,
align = "right", format = "%.2f")
rpt <- create_report(fp) %>% add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test62: Parameters on column defaults are overridden by single defines.", {
fp <- file.path(base_path, "output/test62.out")
dat <- mtcars
attr(dat$mpg, "label") <- "Miles per gallon"
dat$mpg <- fattr(dat$mpg, format = "%.2f", width = 2, justify = "left")
attr(dat$cyl, "label") <- "Cylinders"
dat$cyl <- fattr(dat$cyl, format = "%.1f", width = 1, justify = "center")
attr(dat$disp, "label") <- "Displacement"
dat$disp <- fattr(dat$disp, format = "%.2f", width = 1, justify = "right")
tbl <- create_table(dat, show_cols = c(1:3)) %>%
column_defaults(width = .75, align = "left", label = "Data",
format = "%.0f") %>%
define(mpg, label = "Data1", width = 2,
align = "right", format = "%.4f") %>%
define(cyl, label = "Data2", width = 1,
align = "left", format = "%.3f") %>%
define(disp, label = "Data3", width = .75,
align = "center", format = "%.1f")
rpt <- create_report(fp) %>% add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test63: Simple regulatory table with borders works as expected.", {
library(tidyr)
library(dplyr)
fp <- file.path(base_path, "output/test63.out")
dat <- mtcars
# Hard coded this so report would come out the same every time.
#dat$group <- replicate(nrow(dat), sample(c("A", "B"), 1), simplify = TRUE)
dat$group <- c("B", "B", "B", "B", "B", "B", "A", "A", "B", "A", "A",
"A", "A", "B", "A", "B", "B", "A", "B", "B", "B", "A",
"A", "A", "A", "A", "A", "B", "B", "A", "B", "B")
dat$cyl <- factor(dat$cyl, levels = c(8, 6, 4),
labels = c("8 Cylinder", "6 Cylinder", "4 Cylinder"))
group_pop <- table(dat$group)
dat_mpg <-
dat %>%
group_by(group) %>%
summarise(across(.cols = mpg,
.fns = list(N = ~ fmt_n(.),
Mean = ~ fmt_mean_sd(.),
Median = ~ fmt_median(.),
`Q1 - Q3` = ~ fmt_quantile_range(.),
Range = ~ fmt_range(.)
))) %>%
pivot_longer(-group,
names_to = c("var", "label"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = group,
values_from = "value")
dat_cyl <-
dat %>%
add_count(group, cyl, name = "n_cyl") %>%
select(group, cyl, n_cyl) %>%
distinct() %>%
pivot_longer(cols = c(cyl),
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = group,
values_from = n_cyl,
values_fill = 0) %>%
mutate(A = fmt_cnt_pct(A, group_pop["A"]),
B = fmt_cnt_pct(B, group_pop["B"])) %>%
arrange(label)
final <- bind_rows(dat_mpg, dat_cyl)
#print(final)
tbl <- create_table(final, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(mpg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center") %>%
define(B, label = "Group B", align = "center")
# Create mtcars table
rpt <- create_report(fp, orientation = "portrait") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table", borders = "all") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1973", borders = "all") %>%
page_footer(left = "Time",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test64: Title header with border on report works as expected.", {
fp <- file.path(base_path, "output/test64.out")
rpt <- create_report(fp) %>%
title_header("Table 1.0", "IRIS Data Frame",
right = c("Study ABC", "Client A", "Page [pg] of [tpg]"),
borders = "all") %>%
add_content(create_table(iris)) %>%
page_footer("DateTime", right = "Page")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test65: Title header with borders on table works as expected.", {
fp <- file.path(base_path, "output/test65.out")
tbl <- create_table(iris) %>%
title_header("Table 1.0", "IRIS Data Frame",
right = c("Study ABC", "Client A", "Page [pg] of [tpg]"),
blank_row = "below", borders = "all")
rpt <- create_report(fp) %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test66: Titles and footnotes with border on table works as expected.", {
fp <- file.path(base_path, "output/test66.out")
tbl <- create_table(iris) %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below", borders = "all") %>%
footnotes("Here is a footnote", "And another",
borders = "all")
rpt <- create_report(fp) %>%
page_header("Left", "Right") %>%
add_content(tbl) %>%
page_footer("left", "", "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test67: Title header with border on report works as expected.", {
fp <- file.path(base_path, "output/test67.out")
rpt <- create_report(fp) %>%
page_header("Left", "Right") %>%
titles("Table 1.0", "IRIS Data Frame",
borders = "all") %>%
add_content(create_table(iris)) %>%
footnotes("Something", borders = "all") %>%
page_footer("DateTime", right = "Page")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test68: show_cols 'some' parameter and label works as expected.", {
fp <- file.path(base_path, "output/test68.out")
mycols <- c("vs", "mpg", "cyl", "disp")
myvar1 = "vs"
myvar2 = "mpg"
tbl <- create_table(mtcars[1:10, ],
show_cols = mycols, use_attributes = "none") %>%
define({{myvar2}}, label = "n", width = 1.5) %>%
define({{myvar1}}, label = "(%)", width = 1.5)
rpt <- create_report(fp, missing = NULL) %>%
titles("MTCARS Data Frame", align = "center") %>%
add_content(tbl)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test69: Table with spanning headers no underline works as expected.", {
fp <- file.path(base_path, "output/test69.out")
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,
underline = FALSE) %>%
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) %>%
add_content(tbl) %>%
titles("Table 1.0", "MTCARS Subset Test")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test70: Column widths work as expected.", {
fp <- file.path(base_path, "output/test70.out")
dat <- unlist(rep("AAAAAAAAA B", 10))
df <- data.frame(col1 = dat, col2 = dat, col3 = dat, col4 = dat, col5 = dat,
col6 = dat, col7 = dat, col8 = dat, col9 = dat,
stringsAsFactors = FALSE)
tbl <- create_table(df) %>%
spanning_header(1, 2, "Span 1") %>%
spanning_header(3, 5, "Span 2") %>%
spanning_header(1, 5, "Super Span", level = 2) %>%
column_defaults(width = 1) %>%
footnotes("Here is a really long footnote that will need a few columns to contain.")
rpt <- create_report(fp, output_type = "TXT") %>%
set_margins(left = 1, right = 1) %>%
add_content(tbl, align = "left")
res <- write_report(rpt)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
expect_equal(res$pages, 1)
})
test_that("test71: Column widths work as expected with fractional widths.", {
fp <- file.path(base_path, "output/test71.out")
dat <- unlist(rep("AAA", 10))
df <- data.frame(col1 = dat, col2 = dat, col3 = dat, col4 = dat, col5 = dat,
col6 = dat, col7 = dat, col8 = dat, col9 = dat,
stringsAsFactors = FALSE)
tbl <- create_table(df) %>%
spanning_header(1, 2, "Span 1") %>%
spanning_header(3, 5, "Span 2") %>%
spanning_header(1, 5, "Super Span", level = 2) %>%
column_defaults(width = .5) %>%
define(col1, width = 3.5) %>%
define(col2, width = 1) %>%
define(col7, width = .7) %>%
define(col8, width = 1.3) %>%
footnotes("Here is a really long footnote that will need a few columns to contain.")
rpt <- create_report(fp, output_type = "TXT") %>%
set_margins(left = 1, right = 1) %>%
add_content(tbl, align = "left")
res <- write_report(rpt)
# print(res, verbose = TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
expect_equal(res$pages, 1)
})
test_that("test72: Check column alignment", {
fp <- file.path(base_path, "output/test72.out")
# Sample data
df <- read.table(header = TRUE, text = '
Country N1 Mean1 SD1 N2 Mean2 SD2
Bangladesh 52 25.03 0.02 43 22.31 0.08
Germany 42 95.01 1.02 53 9.31 0.09
Italy 2 20.22 0.00 11 8.09 1.11')
tbl <- create_table(df) %>%
column_defaults(width = .5) %>%
spanning_header(N1, SD1, label = "Treatment A") %>%
spanning_header(N2, SD2, label = "Treatment B") %>%
define(Country, width = 1) %>%
titles("Table 1.0", "Treatments by Country") %>%
footnotes("* Country of Site")
rpt <- create_report(fp) %>%
options_fixed(uchar = "-") %>%
add_content(tbl)
res <- write_report(rpt)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
expect_equal(res$pages, 1)
})
test_that("test73: Table Borders with ttls/fnts on table works as expected.", {
fp <- file.path(base_path, "output/test73.out")
tbl <- create_table(iris, borders = "all") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below") %>%
footnotes("Here is a footnote", "And another")
rpt <- create_report(fp) %>%
page_header("Left", "Right") %>%
add_content(tbl) %>%
page_footer("left", "", "right")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test74: Table Borders with ttls/fnts on report works as expected.", {
fp <- file.path(base_path, "output/test74.out")
tbl <- create_table(iris, borders = "all")
rpt <- create_report(fp) %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test75: Label row is one cell.", {
fp <- file.path(base_path, "output/test75.out")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to see if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", width = 1.25, align = "center", n = 19) %>%
define(B, label = "Group B", width = 1.25, align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "landscape", output_type = "TXT") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("test76: Page break on invisible column.", {
fp <- file.path(base_path, "output/test76.out")
dat <- iris
dat$Sequence <- seq(1, nrow(iris))
tbl <- create_table(dat, borders = "all") %>%
define(Species, page_break = TRUE, visible = FALSE)
rpt <- create_report(fp) %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test77: Blank after on invisible column.", {
fp <- file.path(base_path, "output/test77.out")
tbl <- create_table(iris, borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp) %>%
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)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
})
test_that("test78: Blank nested stub works as expected.", {
fp <- file.path(base_path, "output/test78.out")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "Stats" "19" "13"
"ampg" "Stats" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Stats" "16.4" "21.4"
"ampg" "Stats" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Stats" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to see if it can span the entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25, dedupe = TRUE) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("test79: Page header width works.", {
fp <- file.path(base_path, "output/test79.out")
tbl <- create_table(iris[1:10, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp) %>%
page_header(paste0("Left and here is a really long left ",
"cell text to put it and more and more"),
"Right", width = 8) %>%
add_content(tbl) %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test80: Carriage return in label row works.", {
fp <- file.path(base_path, "output/test80.out")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - \n21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
ll <- "Here is a super long label to \nsee if it can span\nthe entire table."
# Create table
tbl <- create_table(df, first_row_blank = TRUE, borders = c("all")) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = ll, cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, orientation = "portrait") %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Table 1.0", "MTCARS Summary Table") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974") %>%
page_footer(left = "Left",
center = "Confidential",
right = "Page [pg] of [tpg]")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("test81: Glue feature works.", {
if (dev) {
library(common)
fp <- file.path(base_path, "output/test81.out")
tbl <- create_table(mtcars[1:10, ], borders = "all") %>%
spanning_header(1, 4, label = "My span{subsc('4')}") %>%
define(mpg, label = "Mpg{subsc('3')}")
myvar <- "23"
rpt <- create_report(fp) %>%
page_header(c("Left {supsc('2')}really long left ",
"cell text to put it{supsc('3')} and more and more"),
"Right{supsc('x')}") %>%
add_content(tbl) %>%
page_footer(c("left1{supsc('5')}", "left2{supsc('6')}"), "",
"right{supsc('7')}") %>%
titles("Table 1.0{supsc('1')}", "IRIS Data Frame{{myvar}}",
blank_row = "below") %>%
footnotes("Here is a footnote{subsc('a')}", "And another{subsc('9')}")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("test82: Title columns work 1 column.", {
fp <- file.path(base_path, "output/test82.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
titles("Table 1.0 second row", "IRIS Data Frame3",
blank_row = "both", columns = 1, align = "center",
borders = c("outside"))
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test83: Title columns work 2 columns.", {
fp <- file.path(base_path, "output/test83.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
titles("Table 1.0", "IRIS Data Frame", "Left", "Right",
blank_row = c("below"), columns = 2, borders = "none")
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test84: Title columns work 3 columns.", {
fp <- file.path(base_path, "output/test84.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rght <- paste("Here")
rpt <- create_report(fp, output_type = "TXT",
font_size = 10) %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
"My right thing", "", "Center", rght,
blank_row = "below", columns = 3, borders = "top") %>%
footnotes("Here is a footnote", "And another", "A",
"Here is a longer footnote to see if I can figure out the alignment pattern.",
align = "right")
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("test85: Multiple title blocks work as expected.", {
fp <- file.path(base_path, "output/test85.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
titles("Table 2.0", "IRIS Data Frame2", "Left", "Right",
blank_row = "below", columns = 2, borders = "all") %>%
titles("Table 3.0", "IRIS Data Frame3", "My right thing", "", "Center",
blank_row = "below", columns = 3, borders = "all") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test86: Titles can be passed as a vector.", {
fp <- file.path(base_path, "output/test86.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
ttl <- c("Title1", "Title2", "Title3")
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles(ttl,
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "none") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test87: Custom page size works as expected.", {
fp <- file.path(base_path, "output/test87.out")
tbl <- create_table(iris[1:15, ]) %>%
define(Species, visible = FALSE)
ttl <- c("Title1", "Title2", "Title3")
rpt <- create_report(fp, output_type = "TXT", paper_size = c(6.5, 7.5),
orientation = "portrait") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles(ttl,
blank_row = "below", columns = 1, align = "center",
borders = "none") %>%
footnotes("Here is a footnote", "And another")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test88: Footnotes columns work 1 column.", {
fp <- file.path(base_path, "output/test88.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
titles("Table 1.0 second row", "IRIS Data Frame3",
blank_row = "both", columns = 1, align = "center",
borders = c("outside"))
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Here is a footnote", "And another", columns = 1)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test89: Footnotes columns work 2 columns.", {
fp <- file.path(base_path, "output/test89.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
titles("Table 1.0", "IRIS Data Frame", "Left", "Right",
blank_row = c("below"), columns = 2, borders = "none") %>%
footnotes("Table left", "Table right", columns = 2)
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Here is a footnote", "And another", columns = 2)
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test90: Footnotes columns work 3 columns.", {
fp <- file.path(base_path, "output/test90.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE)
rght <- paste("Here")
rpt <- create_report(fp, output_type = "TXT",
font_size = 10) %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
titles("Table 1.0", "IRIS Data Frame",
"My right thing", "", "Center", rght,
blank_row = "below", columns = 3, borders = "top") %>%
footnotes("Here is a footnote", "And another", "A",
"Here is a longer footnote", "to see if I can figure out", "the alignment pattern",
align = "right", columns = 3)
res <- write_report(rpt)
res
expect_equal(file.exists(fp), TRUE)
})
test_that("test91: Multiple footnotes blocks work as expected.", {
fp <- file.path(base_path, "output/test91.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE) %>%
footnotes("Left", "right", columns = 2)
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Footnote1", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
footnotes("Footnotes2", "IRIS Data Frame2", "Left", "Right",
blank_row = "below", columns = 2, borders = "all") %>%
footnotes("Footnotes3", "IRIS Data Frame3", "My right thing", "", "Center",
blank_row = "below", columns = 3, borders = "all") %>%
titles("Table 1.0", "My little title")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test92: Page by with wrap works as expected.", {
fp <- file.path(base_path, "output/test92.out")
dat <- iris
dat$Pgby <- as.character(dat$Species)
dat$Pgby <- paste0("Flower Type\n", dat$Pgby)
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Report with a Page By", borders = "none") %>%
page_by(Pgby, align = "left", label = "", borders = "none") %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "TXT",
orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_header("Left", "Right") %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 6)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("test93: Page by with wrap works as expected.", {
fp <- file.path(base_path, "output/test93.out")
fmt1 <- c(setosa = 1, versicolor = 2, virginica = 3)
fmt2 <- value(condition(x == 1, "Setosa"),
condition(x == 2, "Versicolor"),
condition(x == 3, "Virginica"))
dat <- iris
fmtval <- fmt1[dat$Species]
names(fmtval) <- NULL
dat$Pgby <- fmtval
tbl <- create_table(dat, borders = "none") %>%
titles("Table 1.0", "My Nice Report with a Page By", borders = "none") %>%
page_by(Pgby, align = "left", label = "Flower:", borders = "none", format = fmt2) %>%
define(Pgby, visible = FALSE)
rpt <- create_report(fp, output_type = "TXT",
orientation = "landscape") %>%
set_margins(top = 1, bottom = 1) %>%
add_content(tbl) %>%
page_header("Left", "Right") %>%
page_footer("Left1", "Center1", "Right1") %>%
footnotes("My footnote 1", "My footnote 2", borders = "none")
res <- write_report(rpt)
res
res$column_widths
expect_equal(file.exists(fp), TRUE)
expect_equal(res$pages, 6)
expect_equal(length(res$column_widths[[1]]), 5)
})
test_that("test94: Label with invisible column works as expected.", {
fp <- file.path(base_path, "output/test94.out")
tbl <- create_table(iris[1:15, ], borders = "all") %>%
define(Species, blank_after = TRUE, visible = FALSE, label = "Fork") %>%
footnotes("Left", "right", columns = 2)
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Footnote1", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
titles("Table 1.0", "My little title")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
test_that("test95: Page break with blank row after works as expected.", {
fp <- file.path(base_path, "output/test95.out")
dat <- sort(iris, by = c("Species", "Petal.Width"))
tbl <- create_table(dat, borders = "all") %>%
define(Petal.Width, blank_after = TRUE) %>%
define(Species, page_break = TRUE, visible = TRUE) %>%
footnotes("Left", "right", columns = 2)
rpt <- create_report(fp, output_type = "TXT") %>%
add_content(tbl) %>%
page_header("left", "right") %>%
page_footer("left", "", "right") %>%
footnotes("Footnote1", "IRIS Data Frame",
blank_row = "below", columns = 1, align = "center", width = 7,
borders = "all") %>%
titles("Table 1.0", "My little title")
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
})
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.