tests/testthat/test-user.R
In dbosak01/rptr: Creates Statistical Reports
context("User Tests")
base_path <- "c:/packages/reporter/tests/testthat"
data_dir <- base_path
base_path <- tempdir()
data_dir <- "."
dev <- FALSE
test_that("user1: demo table works.", {
if (dev) {
library(tidyr)
library(dplyr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "user/user1.out")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- subset(data_demo, data_demo$ARM != "SCREEN FAILURE")
sex_decode <- c("M" = "Male",
"F" = "Female")
race_decode <- c("WHITE" = "White",
"BLACK OR AFRICAN AMERICAN" = "Black or African American",
"ASIAN" = "Asian or Pacific Islander",
"NATIVE AMERICAN" = "Native American",
"UNKNOWN" = "Unknown")
arm_pop <- table(data_demo$ARM)
demo_age <-
data_demo %>%
group_by(ARM) %>%
summarise(across(.cols = AGE,
.fns = list(N = ~ fmt_n(.),
Mean = ~ fmt_mean_sd(.),
Median = ~ fmt_median(.),
`Q1 - Q3` = ~ fmt_quantile_range(.),
Range = ~ fmt_range(.)
))) %>%
pivot_longer(-ARM,
names_to = c("var", "label"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = ARM,
values_from = "value")
demo_sex <-
data_demo %>%
add_count(ARM, SEX, name = "n_SEX") %>%
select(ARM, SEX, n_SEX) %>%
distinct() %>%
pivot_longer(cols = c(SEX),
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_SEX,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(sex_decode),
labels = sex_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"]))
demo_race <-
data_demo %>%
add_count(ARM, RACE, name = "n_RACE") %>%
select(ARM, RACE, n_RACE) %>%
distinct() %>%
pivot_longer(cols = RACE,
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_RACE,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(race_decode),
labels = race_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"])) %>%
arrange(var, label)
demo <- bind_rows(demo_age, demo_sex, demo_race)
#View(demo)
# Stub decode
block_fmt <- c(AGE = "Age", SEX = "Sex", RACE = "Race")
# Define table
tbl <- create_table(demo, first_row_blank = TRUE) %>%
column_defaults(from = "ARM A", to = "ARM D", width = 1) %>%
define(var, blank_after = TRUE, dedupe = TRUE,
format = block_fmt, label = "") %>%
define(label, label = "") %>%
define(`ARM A`, align = "center", label = "Placebo", n = 36) %>%
define(`ARM B`, align = "center", label = "Drug 10mg", n = 38) %>%
define(`ARM C`, align = "center", label = "Drug 20mg", n = 38) %>%
define(`ARM D`, align = "center", label = "Competitor", n = 38)
# Define Report
rpt <- create_report(fp) %>%
set_margins(top = 1, bottom = 1) %>%
options_fixed(font_size = 10) %>%
titles("Table 14.1/4",
"Demographics and Baseline to Characteristics",
"Specify Population") %>%
add_content(tbl) %>%
#footnotes("Special symbols \U221e to mess things up: Ω µ β ¥ ∑ ≠ ≤ £ ∞ ؈ ლ \Ub8a 鬼") %>%
footnotes("Special symbols µ Ω £ there to mess things up: ") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp, encoding = "native.enc")
expect_equal(length(lns), res$pages * res$line_count)
if (TRUE) {
rtfpth <- file.path(base_path, "user/user1.rtf")
write_report(rpt, rtfpth, output_type = "RTF")
expect_equal(file.exists(rtfpth), TRUE)
pdfpth <- file.path(base_path, "user/user1.pdf")
write_report(rpt, pdfpth, output_type = "PDF")
expect_equal(file.exists(pdfpth), TRUE)
docxpth <- file.path(base_path, "user/user1.docx")
write_report(rpt, docxpth, output_type = "DOCX")
expect_equal(file.exists(docxpth), TRUE)
}
} else
expect_equal(TRUE, TRUE)
})
test_that("user2: demo table with stub works.", {
if (dev) {
library(tidyr)
library(dplyr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "user/user2.out")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- subset(data_demo, data_demo$ARM != "SCREEN FAILURE")
sex_decode <- c("M" = "Male",
"F" = "Female")
race_decode <- c("WHITE" = "White",
"BLACK OR AFRICAN AMERICAN" = "Black or African American",
"ASIAN" = "Asian or Pacific Islander",
"NATIVE AMERICAN" = "Native American",
"UNKNOWN" = "Unknown")
arm_pop <- table(data_demo$ARM)
demo_age <-
data_demo %>%
group_by(ARM) %>%
summarise(across(.cols = AGE,
.fns = list(N = ~ fmt_n(.),
Mean = ~ fmt_mean_sd(.),
Median = ~ fmt_median(.),
`Q1 - Q3` = ~ fmt_quantile_range(.),
Range = ~ fmt_range(.)
))) %>%
pivot_longer(-ARM,
names_to = c("var", "label"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = ARM,
values_from = "value")
demo_sex <-
data_demo %>%
add_count(ARM, SEX, name = "n_SEX") %>%
select(ARM, SEX, n_SEX) %>%
distinct() %>%
pivot_longer(cols = c(SEX),
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_SEX,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(sex_decode),
labels = sex_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"]))
demo_race <-
data_demo %>%
add_count(ARM, RACE, name = "n_RACE") %>%
select(ARM, RACE, n_RACE) %>%
distinct() %>%
pivot_longer(cols = RACE,
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_RACE,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(race_decode),
labels = race_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"])) %>%
arrange(var, label)
demo <- bind_rows(demo_age, demo_sex, demo_race)
#View(demo)
# Stub decode
block_fmt <- c(AGE = "Age", SEX = "Sex", RACE2 = "Race")
# Define table
tbl <- create_table(demo, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE,
format = block_fmt, label = "", label_row = TRUE) %>%
define(label, label = "", indent = .25) %>%
define(`ARM A`, align = "center", label = "Placebo", n = 36) %>%
define(`ARM B`, align = "center", label = "Drug 10mg", n = 38) %>%
define(`ARM C`, align = "center", label = "Drug 20mg", n = 38) %>%
define(`ARM D`, align = "center", label = "Competitor", n = 38)
# Define Report
rpt <- create_report(fp) %>%
titles("Table 14.1/4",
"Demographics and Baseline Characteristics",
"Specify Population") %>%
add_content(tbl)
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
rtfpth <- file.path(base_path, "user/user2.rtf")
write_report(rpt, rtfpth, output_type = "RTF")
expect_equal(file.exists(rtfpth), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user3: listings works.", {
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "user/user3.out")
# Removing to make last page exactly equal to available rows on page.
# In this case, any added blank rows should be skipped.
fil <- c("ABC-14-124",
"ABC-15-153",
"ABC-15-154",
"ABC-15-155",
"ABC-15-156",
"ABC-16-045",
"ABC-16-046",
"ABC-16-047",
"ABC-16-157",
"ABC-16-158",
"ABC-16-159",
"ABC-16-160")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- data_demo[!data_demo$USUBJID %in% fil, ]
# Test that any assigned formats are applied
attr(data_demo$SUBJID, "width") <- 1
attr(data_demo$SUBJID, "justify") <- "left"
attr(data_demo$SUBJID, "format") <- "S:%s"
#print(widths(data_demo))
# Define table
tbl <- create_table(data_demo) %>%
define(USUBJID, id_var = TRUE)
# Define Report
rpt <- create_report(fp) %>%
options_fixed(editor = "notepad", font_size = 10) %>%
titles("Listing 1.0",
"Demographics Dataset") %>%
add_content(tbl, align = "left") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]")
#Write out report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
rtfpth <- file.path(base_path, "user/user3.rtf")
write_report(rpt, file_path = rtfpth, output_type = "RTF")
expect_equal(file.exists(rtfpth), TRUE)
pdfpth <- file.path(base_path, "user/user3.pdf")
write_report(rpt, pdfpth, output_type = "PDF")
expect_equal(file.exists(pdfpth), TRUE)
})
test_that("user4: Adverse Events table works.", {
if (dev) {
#devtools::install_github("https://github.com/dbosak01/fmtr")
library(dplyr)
library(tidyr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "user/user4.out")
dp <- file.path(dir_data, "ADAE.csv")
dat <- read.csv(dp)
# Get population counts
arm_pop <- table(dat$TRTA)
# Subset ADSL for needed rows and columns
df_sub <- dat %>%
select(TRTA, AESEV, AESEVN, AEREL, AESOC, AEDECOD)
# Get counts and percents
df1 <- df_sub %>%
select(-AESEV, -AEREL) %>%
group_by(TRTA, AESOC, AEDECOD, AESEVN) %>%
summarize(cnt = n()) %>%
pivot_wider(names_from = c(TRTA, AESEVN),
values_from = cnt,
values_fill = 0) %>%
transmute(AESOC = AESOC,
AEDECOD = stri_trans_totitle(AEDECOD),
`ARM A_1` = fmt_cnt_pct(`ARM A_1`, arm_pop["ARM A"]),
`ARM A_2` = fmt_cnt_pct(`ARM A_2`, arm_pop["ARM A"]),
`ARM A_3` = fmt_cnt_pct(0, arm_pop["ARM A"]),
`ARM B_1` = fmt_cnt_pct(`ARM B_1`, arm_pop["ARM B"]),
`ARM B_2` = fmt_cnt_pct(`ARM B_2`, arm_pop["ARM B"]),
`ARM B_3` = fmt_cnt_pct(0, arm_pop["ARM B"]),
`ARM C_1` = fmt_cnt_pct(`ARM C_1`, arm_pop["ARM C"]),
`ARM C_2` = fmt_cnt_pct(`ARM C_2`, arm_pop["ARM C"]),
`ARM C_3` = fmt_cnt_pct(0, arm_pop["ARM C"]),
`ARM D_1` = fmt_cnt_pct(`ARM D_1`, arm_pop["ARM D"]),
`ARM D_2` = fmt_cnt_pct(`ARM D_2`, arm_pop["ARM D"]),
`ARM D_3` = fmt_cnt_pct(`ARM D_3`, arm_pop["ARM D"])) %>%
ungroup()
# Get counts and percents for All Adverse Events
df2 <- df_sub %>%
select(-AESEV, -AEREL,-AESOC, -AEDECOD,) %>%
group_by(TRTA, AESEVN) %>%
summarize(cnt = n()) %>%
pivot_wider(names_from = c(TRTA, AESEVN),
values_from = cnt,
values_fill = 0) %>%
ungroup()
col_template <- paste0(c(rep("ARM A_", 3), rep("ARM B_", 3), rep("ARM C_", 3),
rep("ARM D_", 3)), rep(c(1, 2, 3), 3))
for (nm in col_template) {
if (!nm %in% names(df2))
df2[[nm]] <- 0
}
df2 <- df2 %>%
transmute(AESOC = "All System Organ Classes",
AEDECOD = "All Adverse Events",
`ARM A_1` = fmt_cnt_pct(`ARM A_1`, arm_pop["ARM A"]),
`ARM A_2` = fmt_cnt_pct(`ARM A_2`, arm_pop["ARM A"]),
`ARM A_3` = fmt_cnt_pct(`ARM A_3`, arm_pop["ARM A"]),
`ARM B_1` = fmt_cnt_pct(`ARM B_1`, arm_pop["ARM B"]),
`ARM B_2` = fmt_cnt_pct(`ARM B_2`, arm_pop["ARM B"]),
`ARM B_3` = fmt_cnt_pct(`ARM B_3`, arm_pop["ARM B"]),
`ARM C_1` = fmt_cnt_pct(`ARM C_1`, arm_pop["ARM C"]),
`ARM C_2` = fmt_cnt_pct(`ARM C_2`, arm_pop["ARM C"]),
`ARM C_3` = fmt_cnt_pct(`ARM C_3`, arm_pop["ARM C"]),
`ARM D_1` = fmt_cnt_pct(`ARM D_1`, arm_pop["ARM D"]),
`ARM D_2` = fmt_cnt_pct(`ARM D_2`, arm_pop["ARM D"]),
`ARM D_3` = fmt_cnt_pct(`ARM D_3`, arm_pop["ARM D"]))
final <- bind_rows(df2, df1) %>% arrange(AESOC, AEDECOD)
tbl <- create_table(final, first_row_blank = TRUE) %>%
column_defaults(from = `ARM A_1`, to = `ARM D_3`, width = 1) %>%
spanning_header("ARM A_1", "ARM A_3", label = "ARM A", n = arm_pop["ARM A"]) %>%
spanning_header("ARM B_1", "ARM B_3", label = "ARM B", n = arm_pop["ARM B"]) %>%
spanning_header("ARM C_1", "ARM C_3", label = "ARM C", n = arm_pop["ARM C"]) %>%
spanning_header("ARM D_1", "ARM D_3", label = "ARM D", n = arm_pop["ARM D"]) %>%
stub(vars = c("AESOC", "AEDECOD"), label = "System Organ Class\n Preferred Term", width = 5) %>%
define(AESOC, blank_after = TRUE, label_row = TRUE) %>%
define(AEDECOD, indent = .25) %>%
define(`ARM A_1`, align = "center", label = "Mild") %>%
define(`ARM A_2`, align = "center", label = "Mod**") %>%
define(`ARM A_3`, align = "center", label = "Severe") %>%
define(`ARM B_1`, align = "center", label = "Mild", page_wrap = TRUE) %>%
define(`ARM B_2`, align = "center", label = "Mod**") %>%
define(`ARM B_3`, align = "center", label = "Severe") %>%
define(`ARM C_1`, align = "center", label = "Mild", page_wrap = TRUE) %>%
define(`ARM C_2`, align = "center", label = "Mod**") %>%
define(`ARM C_3`, align = "center", label = "Severe") %>%
define(`ARM D_1`, align = "center", label = "Mild", page_wrap = TRUE) %>%
define(`ARM D_2`, align = "center", label = "Mod**") %>%
define(`ARM D_3`, align = "center", label = "Severe")
rpt <- create_report(fp) %>%
options_fixed(font_size = 10) %>%
page_header("Client: Experis", "Study: BBC") %>%
titles("Table 1.0", "Adverse Events by Severity", "Safety Population < 25") %>%
add_content(tbl) %>%
footnotes(paste("Date Produced:", "Time", "; Program: Table3_0.R"),
paste("* Total Reporting is defined as number of subjects",
"who reported at least one adverse event."),
"** Mod = Moderate",
paste("# Episodes is defined as the total number of occurances",
"of adverse events"),
paste("% is defined as Number of Subjects divided by Total Reporting"),
"Note: Adverse events were coded using MedDRA Version 9.1") %>%
page_footer("Time", "Confidential", "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)
rtfpth <- file.path(base_path, "user/user4.rtf")
res <- write_report(rpt, file_path = rtfpth, output_type = "RTF")
rtfpth <- file.path(base_path, "user/user4.rtf")
res <- write_report(rpt, rtfpth, output_type = "RTF")
expect_equal(file.exists(rtfpth), TRUE)
#print(res)
pdfpth <- file.path(base_path, "user/user4.pdf")
res <- write_report(rpt, pdfpth, output_type = "PDF")
expect_equal(file.exists(pdfpth), TRUE)
docxpth <- file.path(base_path, "user/user4.docx")
res <- write_report(rpt, docxpth, output_type = "DOCX")
expect_equal(file.exists(docxpth), TRUE)
#print(res)
} else
expect_equal(TRUE, TRUE)
})
test_that("user5: large listing works.", {
test <- FALSE
# Skip except for special testing because it takes too long (+ 5 minutes)
if (test) {
startTime <- Sys.time()
# Data Filepath
dir_data <- file.path(base_path, "data")
fp <- file.path(base_path, "user/user5.out")
# Load Data
data_lb <- file.path(dir_data, "ADLB.csv") %>%
read.csv()
# Define table
tbl <- create_table(data_lb) %>%
define(USUBJID, id_var = TRUE)
# Define Report
rpt <- create_report(fp) %>%
options_fixed(font_size = 10) %>%
titles("Listing 2.0",
"Analysis Dataset Labs") %>%
add_content(tbl, align = "left") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
endTime <- Sys.time()
print(endTime - startTime)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
rtfpth <- file.path(base_path, "user/user5.rtf")
write_report(rpt, rtfpth, output_type = "RTF")
expect_equal(file.exists(rtfpth), TRUE)
# Very special testing case.
if (FALSE) {
pdfpth <- file.path(base_path, "user/user5.pdf")
write_report(rpt, pdfpth, output_type = "PDF")
expect_equal(file.exists(pdfpth), TRUE)
}
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("user6: listings with page break works as expected.", {
if (dev) {
# Data Filepath
dir_data <- file.path(data_dir, "data")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- data_demo[order(data_demo$ARMCD), ]
# Define table
tbl <- create_table(data_demo) %>%
define(USUBJID, id_var = TRUE) %>%
define(ARMCD, page_break = TRUE, id_var = TRUE) %>%
define(ARM, id_var = TRUE)
fp <- file.path(base_path, "user/user6")
# Define Report
rpt <- create_report(fp) %>%
options_fixed(editor = "notepad") %>%
titles("Listing 1.0",
"Demographics Dataset") %>%
add_content(tbl, align = "left") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(res$modified_path), TRUE)
lns <- readLines(res$modified_path)
expect_equal(length(lns), res$pages * res$line_count)
res <- write_report(rpt, output_type = "RTF")
expect_equal(file.exists(res$modified_path), TRUE)
res <- write_report(rpt, output_type = "PDF")
expect_equal(file.exists(res$modified_path), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user7: listings with NA values works.", {
if (dev) {
library(readr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "user/user7")
# Load Data
dat <- file.path(dir_data, "ADSL.csv") %>%
read_csv()
# Define table
tbl <- create_table(dat) %>%
define(USUBJID, id_var = TRUE)
# Define Report
rpt <- create_report(fp) %>%
titles("Listing 1.0",
"ADSL Dataset") %>%
add_content(tbl, align = "left") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(res$modified_path), TRUE)
lns <- readLines(res$modified_path)
expect_equal(length(lns), res$pages * res$line_count)
res <- write_report(rpt, output_type = "RTF")
expect_equal(file.exists(res$modified_path), TRUE)
} else
expect_equal(TRUE, TRUE)
})
# This is a special case, and I don't want to test it every time.
# One reason is to not create a dependancy on > R 3.5 just because
# of the .rds test file. The .rds test file has been appended with
# a .txt extension to fool the checker. Turn back to .rds if needed.
# test_that("user8: table with spaces in column names works.", {
#
# fp <- file.path(base_path, "user/user8.out")
#
# dat <- readRDS(file.path(base_path, "./data/dm_final.rds"))
#
# tbl <- create_table(dat)
#
# rpt <- create_report(fp) %>%
# add_content(tbl)
#
# res <- write_report(rpt)
#
# expect_equal(file.exists(fp), TRUE)
#
# })
# Also a special case
# test_that("user9: table with stub and page by works as expected.", {
#
# # Data Filepath
# dir_data <- file.path(base_path, "data")
#
# fp <- file.path(base_path, "user/user9")
#
# # Load Data
# dat <- file.path(dir_data, "final.rds") %>% readRDS()
#
# dat <- subset(dat, dat$label != "Q1 - Q3")
#
# arm_pop <- c("ARM A" = 20, "ARM B" = 21, "ARM C" = 19, "ARM D" = 22)
#
# # Create Table
# tbl <- create_table(dat, width = 9) %>%
# column_defaults(from = `ARM A`, to = `ARM D`, align = "center", width = 1.2) %>%
# page_by(AVISIT, label = "Visit: ", blank_row = "none") %>%
# stub(vars = c(PARAM, label), label = "Parameter", width = 2) %>%
# define(AVISIT, visible = FALSE) %>%
# define(PARAMCD, visible = FALSE) %>%
# define(PARAM, label_row = TRUE, blank_after = TRUE) %>%
# define(label, label = "Statistic", indent = .25) %>%
# define(`ARM A`, n = arm_pop["ARM A"]) %>%
# define(`ARM B`, n = arm_pop["ARM B"]) %>%
# define(`ARM C`, n = arm_pop["ARM C"]) %>%
# define(`ARM D`, n = arm_pop["ARM D"])
#
#
# rpt <- create_report(fp, output_type = "RTF") %>%
# set_margins(top = 1, bottom = .9) %>%
# page_header("Sponsor: Experis", "Study: ABC") %>%
# titles("Table 3.0", "Summary of Vital Sign Parameters by Visit",
# "Safety Population") %>%
# add_content(tbl) %>%
# footnotes("R Program: VA_Table.R") %>%
# page_footer(paste0("Date Produced: ", fapply(Sys.time(), "%d%b%y %H:%M")),
# right = "Page [pg] of [tpg]")
#
# res <- write_report(rpt)
#
# expect_equal(file.exists(res$modified_path), TRUE)
#
# })
# Another special case
# test_that("user10: Combined report works as expected", {
#
#
# dm_table <- readRDS(file.path(base_path, "data/DM_Table.rds"))
# ae_table <- readRDS(file.path(base_path, "data/AE_Table.rds"))
# lb_table <- readRDS(file.path(base_path, "data/LB_Table.rds"))
# vs_table <- readRDS(file.path(base_path, "data/VS_Table.rds"))
#
#
# rpt <- create_report("rtf/Combined_Table", output_type = "RTF") %>%
# set_margins(top = 1, bottom = .9) %>%
# page_header("Sponsor: Experis", "Study: ABC") %>%
# add_content(dm_table) %>%
# add_content(ae_table) %>%
# add_content(vs_table) %>%
# add_content(lb_table) %>%
# page_footer(paste0("Date Produced: ", fapply(Sys.time(), "%d%b%y %H:%M")),
# right = "Page [pg] of [tpg]")
#
#
# res <- write_report(rpt)
#
#
#
# })
# Special Case
# test_that("mismatched format works as expected.", {
#
#
# fp <- file.path(base_path, "data/final.rds")
#
# final <- readRDS(fp)
#
# var_fmt <- c("AGE" = "Age", "AGEGR1" = "Age Group", "SEX" = "Sex", "RACE" = "Race")
#
# arm_pop <- c("ARM A" = 20, "ARM B" = 21, "ARM C" = 21, "ARM D" = 23)
#
# # Create Table
# tbl <- create_table(final, first_row_blank = TRUE, width = 9) %>%
# column_defaults(from = `ARM A`, to = `ARM D`, align = "center", width = 1) %>%
# stub(vars = c("var", "label"), "Variable", width = 2.5) %>%
# define(var, blank_after = TRUE, dedupe = TRUE, label = "Variable",
# format = var_fmt,label_row = TRUE) %>%
# define(label, indent = .25, label = "Demographic Category") %>%
# define(`ARM A`, n = arm_pop["ARM A"]) %>%
# define(`ARM B`, n = arm_pop["ARM B"]) %>%
# define(`ARM C`, n = arm_pop["ARM C"]) %>%
# define(`ARM D`, n = arm_pop["ARM D"]) %>%
# define(stat, label = "Tests of Association*\nValue (P-value)",
# width = 2, dedupe = TRUE, align = "center") %>%
# titles("Table 1.0", "Analysis of Demographic Characteristics",
# "Safety Population") %>%
# footnotes("R Program: Table1_0.R",
# "NOTE: Denominator based on number of non-missing responses.",
# "*Pearsons's Chi-Square tests will be used for categorical variables",
# " and ANOVA tests for continuous variables.")
#
#
#
# rpt <- create_report("output/DM_Table2.rtf", output_type = "RTF") %>%
# set_margins(top = 1, bottom = 1) %>%
# page_header("Sponsor: Experis", "Study: ABC") %>%
# add_content(tbl) %>%
# page_footer(paste0("Date Produced: ", fapply(Sys.time(), "%d%b%y %H:%M")),
# right = "Page [pg] of [tpg]")
#
# write_report(rpt)
#
#
# })
test_that("user12: Complex table works as expected.", {
if (dev) {
library(readr)
library(fmtr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "user/user12")
# Load Data
dat <- file.path(dir_data, "kk.csv") %>%
read_csv()
mfmt <- value(condition(is.na(x), "-"),
condition(x == 0, "%d"),
condition(TRUE, "%5.3f"))
nfmt <- value(condition(is.na(x), " "),
condition(TRUE, "%2d"))
pfmt <- value(condition(is.na(x), " "),
condition(TRUE, "(%4.1f)"))
# Define table
tbl <- create_table(dat, width = 9) %>%
spanning_header(COL1, COL2, "LLY10", n = 70, underline = FALSE, label_align = "center") %>%
spanning_header(COL3, COL4, "LLY20", n = 49, underline = FALSE, label_align = "center") %>%
spanning_header(COL5, COL6, "LLY75", n = 19, underline = FALSE, label_align = "center") %>%
spanning_header(COL8, COL10, "Pairwise p-values*b") %>%
spanning_header(COL11, COL11, "Odds\nratios*c") %>%
column_defaults(from = COL1, to = COL11, align = "center", width = .45) %>%
stub(c(CATEGORY, LABEL), width = 3.25) %>%
define(CATEGORY, label_row = TRUE) %>%
define(LABEL, indent = .25) %>%
define(COL1, label = "n") %>%
define(COL2, label = "(%)", format = pfmt) %>%
define(COL3, label = "n") %>%
define(COL4, label = "(%)", format = pfmt) %>%
define(COL5, label = "n") %>%
define(COL6, label = "(%)", format = pfmt) %>%
define(COL7, label = "Overall\np-value*a", format = mfmt, width = .7) %>%
define(COL8, label = "LLY20\nvs\nLLY10", format = mfmt) %>%
define(COL9, label = "LLY75\nvs\nLLY10", format = mfmt) %>%
define(COL10, label = "LLY75\nvs\nLLY20", format = mfmt) %>%
define(COL11, label = "LLY75/\nLLY20", width = .6, format = mfmt) %>%
titles("Testing Odds, Pairwise and Overall with 3 Trts",
"SAMPLE TEXT FOR title5", align = "left", borders = "bottom", blank_row = "none") %>%
footnotes("Abbreviations: N = number of subjects in population; n = number of subjects within category.",
"LLY10=LILLY_DRUG_10_mg; LLY20=LILLY_DRUG_20_mg; LLY75=LILLY_DRUG_75_mg.",
"*a - p-value for overall treatment effect were computed using Fisher's Exact test.",
"*b - p-values for pairwise treatment comparisons were computed using Chi-Square test.",
"*c - odds ratios based on comparator LILLY_DRUG_20_mg as denominator.",
"Program Location: /lillyce/qa/vct/common/rums/taffy_rums/dev_r/c_ds_dispsum/c_ds_dispsum_4.R",
"Output Location: /lillyce/qa/vct/common/rums/taffy_rums/dev_r/c_ds_dispsum/validation/output/odds_pair_overall_h_test.docx",
"Data Set Location: /lillyce/qa/vct/common/rums/taffy_rums/data/multi arms",
borders = "top", blank_row = "none")
# Define Report
rpt <- create_report(fp, output_type = "RTF") %>%
options_fixed(font_size = 8) %>%
set_margins(top = 1, bottom = .5, left = 1, right = 1) %>%
page_header(right = c("Page [pg] of [tpg]",
format(Sys.time(), "%H:%M %d-%b-%Y"),
"DDDL"
)) %>%
add_content(tbl, align = "left")
# Write out report
res <- write_report(rpt)
res
#file.show(res$modified_path)
expect_equal(file.exists(res$modified_path), TRUE)
} else
expect_equal(TRUE, TRUE)
})
# Also testing alignments and line lengths
test_that("user13: Simple demographic report with 12 pt font wraps as expected.", {
# Create temporary path
fp <- file.path(base_path, "user/user13")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, output_type = "RTF", units = "inches") %>%
set_margins(top = 1, bottom = 1) %>%
options_fixed(font_size = 12) %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Test Title Right Aligned", align = "right") %>%
titles("Table 1.0", "MTCARS Summary Table",
"----------------------------------------", borders = "all",
align = "center") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974",
"----------------------------------------",
borders = "all", align = "right") %>%
page_footer(left = Sys.time(),
center = "Confidential",
right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
# View report
# file.show(fp)
expect_equal(file.exists(res$modified_path), TRUE)
})
# Also testing alignments and line lengths
test_that("user14: Title header alignment works as expected.", {
# Create temporary path
fp <- file.path(base_path, "user/user14")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, output_type = "RTF", units = "inches") %>%
set_margins(top = 1, bottom = 1) %>%
options_fixed(font_size = 12) %>%
title_header("Test Title Left Aligned", right = "Testme",
borders = "all") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974",
borders = "all", align = "right") %>%
page_footer(left = Sys.time(),
center = "Confidential",
right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
# View report
# file.show(fp)
expect_equal(file.exists(res$modified_path), TRUE)
})
test_that("user15: Titles and footnotes only on first last page.", {
# Create temporary path
fp <- file.path(base_path, "user/user15")
ttls <- create_text(" ") %>%
titles("My Title Only on First Page", blank_row = "none")
tbl <- create_table(iris)
ftnts <- create_text(" ") %>%
footnotes("My Footnote Only on Last Page",
"Here is another footnote")
rpt <- create_report(fp, font = "Arial", output_type = "RTF") %>%
add_content(ttls, page_break = FALSE, blank_row = "none") %>%
add_content(tbl, page_break = FALSE, blank_row = "none") %>%
add_content(ftnts, page_break = FALSE, blank_row = "none")
res <- write_report(rpt)
expect_equal(file.exists(res$modified_path), TRUE)
})
test_that("user16: Label row does not create extra blank spaces.", {
library(libr)
library(fmtr)
# Create temporary path
fp <- file.path(base_path, "user/user16")
adsl <- read.table(header = TRUE, text = '
SITEID SITENAME USUBJID AGE SEX RACE WEIGHT
10003 "Advance ENT" 1000310001 22 M "WHITE" 74.843827
10003 "Advance ENT" 1000310002 56 F "ASIAN" 60.312484')
adsl
adot <- read.table(header = TRUE, text = '
USUBJID COHORT TREATMENT DOSE DOSENUM DOSEDATE EAR VISDAY VISDATE ANAVISIT OBSRESP IMPRESP
1000310001 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" L 2 "2020-09-30" "Day 2" No NA
1000310001 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" L 4 "2020-10-03" "Day 3" No NA
1000310001 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" L 8 "2020-10-06" "Week 1" No NA
1000310001 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" L 14 "2020-10-12" "Week 2" No NA
1000310001 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" L 28 "2020-10-26" "Week 4" No NA
1000310001 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" L 57 "2020-11-24" "Week 8" No No
1000310002 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" R 2 "2020-09-30" "Day 2" No NA
1000310002 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" R 4 "2020-10-03" "Day 3" No NA
1000310002 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" R 8 "2020-10-06" "Week 1" No NA
1000310002 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" R 14 "2020-10-12" "Week 2" No NA
1000310002 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" R 28 "2020-10-26" "Week 4" Yes NA
1000310002 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" R 57 "2020-11-24" "Week 8" Yes NA
')
adot
fc <- fcat(SEX = c("M" = "Male", "F" = "Female"),
AGE = "%d Years",
RACE = value(condition(x == "WHITE", "White"),
condition(x == "BLACK", "Black or African American"),
condition(x == "ASIAN", "Asian or Pacific Islander"),
condition(TRUE, "Other")),
WEIGHT = "%6.2f kg",
EAR = c("L" = "Left", "R" = "Right"),
DOSE = "%4.2fug")
# Merge and assign formats
acomb <-
datastep(adsl, format = fc,
merge = adot, merge_by = USUBJID, {})
# Apply formats
acombf <- fdata(acomb)
acombf
# Prepare final data for reporting
final <-
datastep(acombf, by = USUBJID,
{
BASELINE <- paste0("Investigator Site = ", SITEID,
" - ", SITENAME, ",\nSubject ID=", USUBJID,
",Age=", AGE, ",Sex=", SEX, ",Race=", RACE,
",Weight=", WEIGHT)
if (first.) {
GROUP <- paste0(COHORT, " - ", TREATMENT, " - ", DOSE)
DOSELBL <- paste0(DOSENUM, "/\n", DOSEDATE, "/\n", EAR)
} else {
GROUP <- ""
}
VSTLBL <- paste0(VISDAY, "/", VISDATE)
})
final
tbl <- create_table(final, show_cols = "none",
width = 9, first_row_blank = TRUE) %>%
stub(v(BASELINE, GROUP), label = "Cohort") %>%
define(BASELINE, label_row = TRUE) %>%
define(GROUP) %>%
define(DOSELBL, label = "Dose\nDay/\nDate/\nTreated Ear", width = 1.5) %>%
define(VSTLBL, label = "Visit\nDay/Date", width = 1.5) %>%
define(ANAVISIT, label = "Analysis\nVisit", width = .75) %>%
define(OBSRESP, label = "Observed\nResponse", width = .75) %>%
define(IMPRESP, label = "Imputed\nResponse", width = .75) %>%
define(USUBJID, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, font = "Courier", font_size = 9) %>%
add_content(tbl) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Program:" %p% Sys.path(),
right = "Draft", width = 7) %>%
titles("Study: 0598-CL-0101", "Appendix 10.2.6.1.2.1",
"Source: ADAE, ADOT", columns = 3, header = TRUE, blank_row = "none") %>%
titles( "TMP Complete Closure Response - Single Ascending Dose (SAD)",
"All Randomized Patients", align = "center", header = TRUE, blank_row = "below") %>%
footnotes("# Time to First Complete Closure of TMP.",
"Values flagged with '@' were excluded from the by-visit " %p%
"analysis in tables showing the qualitative test results.",
blank_row = "none", footer = TRUE) %>%
page_footer("Date: " %p% toupper(fapply(Sys.time(), "%d%b%Y %H:%M:%S")),
"Astellas", "Page [pg] of [tpg]")
res1 <- write_report(rpt, output_type = "RTF")
res2 <- write_report(rpt, output_type = "PDF")
#file.show(res1$modified_path)
#file.show(res2$modified_path)
expect_equal(file.exists(res1$modified_path), TRUE)
expect_equal(file.exists(res2$modified_path), TRUE)
})
test_that("user17: Dedupe works as expected on hemo table", {
if (dev) {
# Sample Data
hemo <- read.table(header = TRUE, sep = ",", text = '
labtest,tmtnc,tmtn,swmgrade,variable,c0,c1,c2,c3,c4,c7,pagebrk
HEMO-HIGH,ARM A,1,7,NG,76 98.7%,75 98.7%,0,0,0,1 1.3%,1
HEMO-HIGH,ARM A,1,8,Missing,1 1.3%,1 100.0%,0,0,0,0,1
HEMO-HIGH,ARM A,1,9,Total,77 100.0%,76 98.7%,0,0,0,1 1.3%,1
HEMO-HIGH,ARM B,2,7,NG,84 96.6%,82 97.6%,0,0,0,2 2.4%,1
HEMO-HIGH,ARM B,2,8,Missing,3 3.4%,3 100.0%,0,0,0,0,1
HEMO-HIGH,ARM B,2,9,Total,87 100.0%,85 97.7%,0,0,0,2 2.3%,1
HEMO-HIGH,ARM C,3,7,NG,45 100.0%,41 91.1%,0,0,0,4 8.9%,2
HEMO-HIGH,ARM C,3,8,Missing,0,0,0,0,0,0,2
HEMO-HIGH,ARM C,3,9,Total,45 100.0%,41 91.1%,0,0,0,4 8.9%,2
HEMO-LOW,ARM A,1,1,Grade 0,22 28.6%,2 9.1%,7 31.8%,6 27.3%,7 31.8%,0,1
HEMO-LOW,ARM A,1,3,Grade 1,38 49.4%,0,14 36.8%,14 36.8%,10 26.3%,0,1
HEMO-LOW,ARM A,1,4,Grade 2,13 16.9%,0,1 7.7%,0,11 84.6%,1 7.7%,1
HEMO-LOW,ARM A,1,5,Grade 3,3 3.9%,0,0,1 33.3%,2 66.7%,0,1
HEMO-LOW,ARM A,1,8,Missing,1 1.3%,0,0,1 100.0%,0,0,1
HEMO-LOW,ARM A,1,9,Total,77 100.0%,2 2.6%,22 28.6%,22 28.6%,30 39.0%,1 1.3%,1
HEMO-LOW,ARM B,2,1,Grade 0,23 26.4%,2 8.7%,3 13.0%,11 47.8%,7 30.4%,0,1
HEMO-LOW,ARM B,2,3,Grade 1,41 47.1%,0,4 9.8%,18 43.9%,18 43.9%,1 2.4%,1
HEMO-LOW,ARM B,2,4,Grade 2,17 19.5%,0,1 5.9%,2 11.8%,13 76.5%,1 5.9%,1
HEMO-LOW,ARM B,2,5,Grade 3,3 3.4%,0,0,0,3 100.0%,0,1
HEMO-LOW,ARM B,2,8,Missing,3 3.4%,0,1 33.3%,0,2 66.7%,0,1
HEMO-LOW,ARM B,2,9,Total,87 100.0%,2 2.3%,9 10.3%,31 35.6%,43 49.4%,2 2.3%,1
HEMO-LOW,ARM C,3,1,Grade 0,14 31.1%,2 14.3%,4 28.6%,4 28.6%,2 14.3%,2 14.3%,2
HEMO-LOW,ARM C,3,3,Grade 1,21 46.7%,1 4.8%,5 23.8%,4 19.0%,10 47.6%,1 4.8%,2
HEMO-LOW,ARM C,3,4,Grade 2,6 13.3%,0,0,1 16.7%,4 66.7%,1 16.7%,2
HEMO-LOW,ARM C,3,5,Grade 3,4 8.9%,0,0,1 25.0%,3 75.0%,0,2
HEMO-LOW,ARM C,3,8,Missing,0,0,0,0,0,0,2
HEMO-LOW,ARM C,3,9,Total,45 100.0%,3 6.7%,9 20.0%,10 22.2%,19 42.2%,4 8.9%,2')
library(dplyr)
library(fmtr)
# Set variables
program.name <- "t_ctcshift_hem"
program.output <- "user17"
program.timestamp <- "2001-01-01 12:00"
program.dir <- base_path
# Change column names to lower case
colnames(hemo) <- tolower(colnames(hemo))
fmt1 <- value(condition(x == "HEMO-HIGH", "Hemoglobin (G/L) - HIGH DIRECTION"),
condition(x == "HEMO-LOW", "Hemoglobin (g/L) - LOW DIRECTION"),
condition(x == "LEUK-HIGH", "Leukocytes (GI/L) - HIGH DIRECTION"),
condition(x == "LEUK-LOW", "Leukocytes (GI/L) - LOW DIRECTION"))
fmt2 <- value(condition(x == "ARM A", "Ruxolitinib 15 mg BID (N=77)"),
condition(x == "ARM B", "Ruxolitinib 5 mg BID (N=87)"),
condition(x == "ARM C", "Placebo (N=45)"))
ftnts <- list()
base_ftnt <-
c("[1] The percentages were calculated using the baseline total as the denominator.",
paste("[2] For each row, the percentages were calculated using the number of participants",
"with given grade at baseline as the denominator; worst value on study is the worst",
"grade observed post-baseline for a given participant."))
ftnts[["HEMO-HIGH"]] <-
c(base_ftnt,
"- Grade 0 = Below Grade 1 and any grade in the other direction.",
"- For baseline NG means that grade does not apply at baseline.",
"- Grade 1 = Greater than ULN and increase from baseline of >0 - 2 g/dL;",
"Grade 2 = Greater than ULN and increase from baseline of >2 - 4 g/dL;",
"Grade 3 = Greater than ULN and increase from baseline of >4 g/dL. ")
ftnts[["HEMO-LOW"]] <-
c(base_ftnt,
"- Grade 0 = Below Grade 1 and any grade in the other direction.")
pth <- file.path(program.dir, "user", program.output)
rpt <- create_report(pth, font = "Courier", font_size = 9) %>%
set_margins(top = 1.0, left = 1, right = 1, bottom = .5) %>%
options_fixed(line_count = 51) %>%
titles("Table 3.3.3.1",
paste("Shift Summary of Hematology Laboratory Values",
"in CTC Grade - to the Worst Abnormal Value"),
"(Safety Population)", bold = TRUE, font_size = 9) %>%
page_header(left = c("PROTOCOL: DIDA 00001-123",
"DRUG/INDICATION: DIDA00001/COMPOUND-ASSOCIATED STUDY",
"TLF Version: Final Database Lock (21APR2021)"),
right = c("Page [pg] of [tpg]", "DATABASE VERSION: 10MAY2023",
"TASK: Primary Analysis")) %>%
footnotes(paste0("Program: ", program.name, sep=""),
"DATE(TIME): 2001-12-01",
blank_row = "none", borders = "top", columns = 2, footer = TRUE) %>%
footnotes("Laboratory grading is based on CTCAE Version 5.",
"Reference: Listing 2.8.1.1, 2.8.1.2", footer = TRUE )
labtests <- names(table(hemo$labtest))
for (i in seq_len(length(labtests))) {
lb <- labtests[i]
ftnt <- ftnts[[lb]]
table_hemo <- hemo %>%
dplyr::filter(labtest==lb) %>%
mutate(labtest = fapply(labtest, fmt1),
tmtnc = fapply(tmtnc, fmt2)) %>%
select(labtest, tmtnc, tmtn, swmgrade,variable, c0,c1,c2,c3,c4,c7, pagebrk) %>%
arrange(labtest, tmtn, swmgrade)
tbl <- create_table(table_hemo,
show_cols = c("none"),
borders = "top",
width = 9) %>%
# page_by(labtest, label = "Laboratory Test (unit):", borders = "none",
# blank_row = "none") %>%
# footnotes (ftnt, blank_row ="above" ) %>%
column_defaults(width=.1) %>%
# spanning_header(variable, c0, label="Baseline [1]") %>%
# spanning_header(c1, c7, label="Worst Post-Baseline Value [2]") %>%
define(tmtnc, dedupe = TRUE, align = "left", label = "Treatment Group",
width=3) %>%
define(tmtn, blank_after = TRUE, visible = FALSE) %>%
define(variable, align="left", label="Grade", width=.8) %>%
define(c0, align="left", label="n (%)", width=1)# %>%
#define(c1, align = "left", label = "Grade 0\n n (%)", width=1) %>%
# define(c2, align = "left", label = "Grade 1\n n (%)", width=1) # %>%
# define(c3, align = "left", label = "Grade 2\n n (%)", width=1) # %>%
#define(c4, align = "left", label = "Grade 3\n n (%)", width=1) # %>%
#define(c7, align = "left", label = "Missing\n n (%)", width=1)
rpt <- rpt |> add_content(tbl, blank_row = "none", page_break = TRUE)
}
res <- write_report(rpt, output_type = "TXT")
expect_equal(file.exists(res$modified_path), TRUE)
# View the report
# file.show(res$modified_path)
# file.show(logpth)
} else {
expect_equal(TRUE, TRUE)
}
})
dbosak01/rptr documentation built on March 21, 2024, 12:54 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("User Tests")
base_path <- "c:/packages/reporter/tests/testthat"
data_dir <- base_path
base_path <- tempdir()
data_dir <- "."
dev <- FALSE
test_that("user1: demo table works.", {
if (dev) {
library(tidyr)
library(dplyr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "user/user1.out")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- subset(data_demo, data_demo$ARM != "SCREEN FAILURE")
sex_decode <- c("M" = "Male",
"F" = "Female")
race_decode <- c("WHITE" = "White",
"BLACK OR AFRICAN AMERICAN" = "Black or African American",
"ASIAN" = "Asian or Pacific Islander",
"NATIVE AMERICAN" = "Native American",
"UNKNOWN" = "Unknown")
arm_pop <- table(data_demo$ARM)
demo_age <-
data_demo %>%
group_by(ARM) %>%
summarise(across(.cols = AGE,
.fns = list(N = ~ fmt_n(.),
Mean = ~ fmt_mean_sd(.),
Median = ~ fmt_median(.),
`Q1 - Q3` = ~ fmt_quantile_range(.),
Range = ~ fmt_range(.)
))) %>%
pivot_longer(-ARM,
names_to = c("var", "label"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = ARM,
values_from = "value")
demo_sex <-
data_demo %>%
add_count(ARM, SEX, name = "n_SEX") %>%
select(ARM, SEX, n_SEX) %>%
distinct() %>%
pivot_longer(cols = c(SEX),
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_SEX,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(sex_decode),
labels = sex_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"]))
demo_race <-
data_demo %>%
add_count(ARM, RACE, name = "n_RACE") %>%
select(ARM, RACE, n_RACE) %>%
distinct() %>%
pivot_longer(cols = RACE,
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_RACE,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(race_decode),
labels = race_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"])) %>%
arrange(var, label)
demo <- bind_rows(demo_age, demo_sex, demo_race)
#View(demo)
# Stub decode
block_fmt <- c(AGE = "Age", SEX = "Sex", RACE = "Race")
# Define table
tbl <- create_table(demo, first_row_blank = TRUE) %>%
column_defaults(from = "ARM A", to = "ARM D", width = 1) %>%
define(var, blank_after = TRUE, dedupe = TRUE,
format = block_fmt, label = "") %>%
define(label, label = "") %>%
define(`ARM A`, align = "center", label = "Placebo", n = 36) %>%
define(`ARM B`, align = "center", label = "Drug 10mg", n = 38) %>%
define(`ARM C`, align = "center", label = "Drug 20mg", n = 38) %>%
define(`ARM D`, align = "center", label = "Competitor", n = 38)
# Define Report
rpt <- create_report(fp) %>%
set_margins(top = 1, bottom = 1) %>%
options_fixed(font_size = 10) %>%
titles("Table 14.1/4",
"Demographics and Baseline to Characteristics",
"Specify Population") %>%
add_content(tbl) %>%
#footnotes("Special symbols \U221e to mess things up: Ω µ β ¥ ∑ ≠ ≤ £ ∞ ؈ ლ \Ub8a 鬼") %>%
footnotes("Special symbols µ Ω £ there to mess things up: ") %>%
page_footer("Time", right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp, encoding = "native.enc")
expect_equal(length(lns), res$pages * res$line_count)
if (TRUE) {
rtfpth <- file.path(base_path, "user/user1.rtf")
write_report(rpt, rtfpth, output_type = "RTF")
expect_equal(file.exists(rtfpth), TRUE)
pdfpth <- file.path(base_path, "user/user1.pdf")
write_report(rpt, pdfpth, output_type = "PDF")
expect_equal(file.exists(pdfpth), TRUE)
docxpth <- file.path(base_path, "user/user1.docx")
write_report(rpt, docxpth, output_type = "DOCX")
expect_equal(file.exists(docxpth), TRUE)
}
} else
expect_equal(TRUE, TRUE)
})
test_that("user2: demo table with stub works.", {
if (dev) {
library(tidyr)
library(dplyr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "user/user2.out")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- subset(data_demo, data_demo$ARM != "SCREEN FAILURE")
sex_decode <- c("M" = "Male",
"F" = "Female")
race_decode <- c("WHITE" = "White",
"BLACK OR AFRICAN AMERICAN" = "Black or African American",
"ASIAN" = "Asian or Pacific Islander",
"NATIVE AMERICAN" = "Native American",
"UNKNOWN" = "Unknown")
arm_pop <- table(data_demo$ARM)
demo_age <-
data_demo %>%
group_by(ARM) %>%
summarise(across(.cols = AGE,
.fns = list(N = ~ fmt_n(.),
Mean = ~ fmt_mean_sd(.),
Median = ~ fmt_median(.),
`Q1 - Q3` = ~ fmt_quantile_range(.),
Range = ~ fmt_range(.)
))) %>%
pivot_longer(-ARM,
names_to = c("var", "label"),
names_sep = "_",
values_to = "value") %>%
pivot_wider(names_from = ARM,
values_from = "value")
demo_sex <-
data_demo %>%
add_count(ARM, SEX, name = "n_SEX") %>%
select(ARM, SEX, n_SEX) %>%
distinct() %>%
pivot_longer(cols = c(SEX),
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_SEX,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(sex_decode),
labels = sex_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"]))
demo_race <-
data_demo %>%
add_count(ARM, RACE, name = "n_RACE") %>%
select(ARM, RACE, n_RACE) %>%
distinct() %>%
pivot_longer(cols = RACE,
names_to = "var",
values_to = "label") %>%
pivot_wider(names_from = ARM,
values_from = n_RACE,
values_fill = 0) %>%
mutate(label = factor(label, levels = names(race_decode),
labels = race_decode),
`ARM A` = fmt_cnt_pct(`ARM A`, arm_pop["ARM A"]),
`ARM B` = fmt_cnt_pct(`ARM B`, arm_pop["ARM B"]),
`ARM C` = fmt_cnt_pct(`ARM C`, arm_pop["ARM C"]),
`ARM D` = fmt_cnt_pct(`ARM D`, arm_pop["ARM D"])) %>%
arrange(var, label)
demo <- bind_rows(demo_age, demo_sex, demo_race)
#View(demo)
# Stub decode
block_fmt <- c(AGE = "Age", SEX = "Sex", RACE2 = "Race")
# Define table
tbl <- create_table(demo, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE,
format = block_fmt, label = "", label_row = TRUE) %>%
define(label, label = "", indent = .25) %>%
define(`ARM A`, align = "center", label = "Placebo", n = 36) %>%
define(`ARM B`, align = "center", label = "Drug 10mg", n = 38) %>%
define(`ARM C`, align = "center", label = "Drug 20mg", n = 38) %>%
define(`ARM D`, align = "center", label = "Competitor", n = 38)
# Define Report
rpt <- create_report(fp) %>%
titles("Table 14.1/4",
"Demographics and Baseline Characteristics",
"Specify Population") %>%
add_content(tbl)
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
rtfpth <- file.path(base_path, "user/user2.rtf")
write_report(rpt, rtfpth, output_type = "RTF")
expect_equal(file.exists(rtfpth), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user3: listings works.", {
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "user/user3.out")
# Removing to make last page exactly equal to available rows on page.
# In this case, any added blank rows should be skipped.
fil <- c("ABC-14-124",
"ABC-15-153",
"ABC-15-154",
"ABC-15-155",
"ABC-15-156",
"ABC-16-045",
"ABC-16-046",
"ABC-16-047",
"ABC-16-157",
"ABC-16-158",
"ABC-16-159",
"ABC-16-160")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- data_demo[!data_demo$USUBJID %in% fil, ]
# Test that any assigned formats are applied
attr(data_demo$SUBJID, "width") <- 1
attr(data_demo$SUBJID, "justify") <- "left"
attr(data_demo$SUBJID, "format") <- "S:%s"
#print(widths(data_demo))
# Define table
tbl <- create_table(data_demo) %>%
define(USUBJID, id_var = TRUE)
# Define Report
rpt <- create_report(fp) %>%
options_fixed(editor = "notepad", font_size = 10) %>%
titles("Listing 1.0",
"Demographics Dataset") %>%
add_content(tbl, align = "left") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]")
#Write out report
res <- write_report(rpt)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
rtfpth <- file.path(base_path, "user/user3.rtf")
write_report(rpt, file_path = rtfpth, output_type = "RTF")
expect_equal(file.exists(rtfpth), TRUE)
pdfpth <- file.path(base_path, "user/user3.pdf")
write_report(rpt, pdfpth, output_type = "PDF")
expect_equal(file.exists(pdfpth), TRUE)
})
test_that("user4: Adverse Events table works.", {
if (dev) {
#devtools::install_github("https://github.com/dbosak01/fmtr")
library(dplyr)
library(tidyr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "user/user4.out")
dp <- file.path(dir_data, "ADAE.csv")
dat <- read.csv(dp)
# Get population counts
arm_pop <- table(dat$TRTA)
# Subset ADSL for needed rows and columns
df_sub <- dat %>%
select(TRTA, AESEV, AESEVN, AEREL, AESOC, AEDECOD)
# Get counts and percents
df1 <- df_sub %>%
select(-AESEV, -AEREL) %>%
group_by(TRTA, AESOC, AEDECOD, AESEVN) %>%
summarize(cnt = n()) %>%
pivot_wider(names_from = c(TRTA, AESEVN),
values_from = cnt,
values_fill = 0) %>%
transmute(AESOC = AESOC,
AEDECOD = stri_trans_totitle(AEDECOD),
`ARM A_1` = fmt_cnt_pct(`ARM A_1`, arm_pop["ARM A"]),
`ARM A_2` = fmt_cnt_pct(`ARM A_2`, arm_pop["ARM A"]),
`ARM A_3` = fmt_cnt_pct(0, arm_pop["ARM A"]),
`ARM B_1` = fmt_cnt_pct(`ARM B_1`, arm_pop["ARM B"]),
`ARM B_2` = fmt_cnt_pct(`ARM B_2`, arm_pop["ARM B"]),
`ARM B_3` = fmt_cnt_pct(0, arm_pop["ARM B"]),
`ARM C_1` = fmt_cnt_pct(`ARM C_1`, arm_pop["ARM C"]),
`ARM C_2` = fmt_cnt_pct(`ARM C_2`, arm_pop["ARM C"]),
`ARM C_3` = fmt_cnt_pct(0, arm_pop["ARM C"]),
`ARM D_1` = fmt_cnt_pct(`ARM D_1`, arm_pop["ARM D"]),
`ARM D_2` = fmt_cnt_pct(`ARM D_2`, arm_pop["ARM D"]),
`ARM D_3` = fmt_cnt_pct(`ARM D_3`, arm_pop["ARM D"])) %>%
ungroup()
# Get counts and percents for All Adverse Events
df2 <- df_sub %>%
select(-AESEV, -AEREL,-AESOC, -AEDECOD,) %>%
group_by(TRTA, AESEVN) %>%
summarize(cnt = n()) %>%
pivot_wider(names_from = c(TRTA, AESEVN),
values_from = cnt,
values_fill = 0) %>%
ungroup()
col_template <- paste0(c(rep("ARM A_", 3), rep("ARM B_", 3), rep("ARM C_", 3),
rep("ARM D_", 3)), rep(c(1, 2, 3), 3))
for (nm in col_template) {
if (!nm %in% names(df2))
df2[[nm]] <- 0
}
df2 <- df2 %>%
transmute(AESOC = "All System Organ Classes",
AEDECOD = "All Adverse Events",
`ARM A_1` = fmt_cnt_pct(`ARM A_1`, arm_pop["ARM A"]),
`ARM A_2` = fmt_cnt_pct(`ARM A_2`, arm_pop["ARM A"]),
`ARM A_3` = fmt_cnt_pct(`ARM A_3`, arm_pop["ARM A"]),
`ARM B_1` = fmt_cnt_pct(`ARM B_1`, arm_pop["ARM B"]),
`ARM B_2` = fmt_cnt_pct(`ARM B_2`, arm_pop["ARM B"]),
`ARM B_3` = fmt_cnt_pct(`ARM B_3`, arm_pop["ARM B"]),
`ARM C_1` = fmt_cnt_pct(`ARM C_1`, arm_pop["ARM C"]),
`ARM C_2` = fmt_cnt_pct(`ARM C_2`, arm_pop["ARM C"]),
`ARM C_3` = fmt_cnt_pct(`ARM C_3`, arm_pop["ARM C"]),
`ARM D_1` = fmt_cnt_pct(`ARM D_1`, arm_pop["ARM D"]),
`ARM D_2` = fmt_cnt_pct(`ARM D_2`, arm_pop["ARM D"]),
`ARM D_3` = fmt_cnt_pct(`ARM D_3`, arm_pop["ARM D"]))
final <- bind_rows(df2, df1) %>% arrange(AESOC, AEDECOD)
tbl <- create_table(final, first_row_blank = TRUE) %>%
column_defaults(from = `ARM A_1`, to = `ARM D_3`, width = 1) %>%
spanning_header("ARM A_1", "ARM A_3", label = "ARM A", n = arm_pop["ARM A"]) %>%
spanning_header("ARM B_1", "ARM B_3", label = "ARM B", n = arm_pop["ARM B"]) %>%
spanning_header("ARM C_1", "ARM C_3", label = "ARM C", n = arm_pop["ARM C"]) %>%
spanning_header("ARM D_1", "ARM D_3", label = "ARM D", n = arm_pop["ARM D"]) %>%
stub(vars = c("AESOC", "AEDECOD"), label = "System Organ Class\n Preferred Term", width = 5) %>%
define(AESOC, blank_after = TRUE, label_row = TRUE) %>%
define(AEDECOD, indent = .25) %>%
define(`ARM A_1`, align = "center", label = "Mild") %>%
define(`ARM A_2`, align = "center", label = "Mod**") %>%
define(`ARM A_3`, align = "center", label = "Severe") %>%
define(`ARM B_1`, align = "center", label = "Mild", page_wrap = TRUE) %>%
define(`ARM B_2`, align = "center", label = "Mod**") %>%
define(`ARM B_3`, align = "center", label = "Severe") %>%
define(`ARM C_1`, align = "center", label = "Mild", page_wrap = TRUE) %>%
define(`ARM C_2`, align = "center", label = "Mod**") %>%
define(`ARM C_3`, align = "center", label = "Severe") %>%
define(`ARM D_1`, align = "center", label = "Mild", page_wrap = TRUE) %>%
define(`ARM D_2`, align = "center", label = "Mod**") %>%
define(`ARM D_3`, align = "center", label = "Severe")
rpt <- create_report(fp) %>%
options_fixed(font_size = 10) %>%
page_header("Client: Experis", "Study: BBC") %>%
titles("Table 1.0", "Adverse Events by Severity", "Safety Population < 25") %>%
add_content(tbl) %>%
footnotes(paste("Date Produced:", "Time", "; Program: Table3_0.R"),
paste("* Total Reporting is defined as number of subjects",
"who reported at least one adverse event."),
"** Mod = Moderate",
paste("# Episodes is defined as the total number of occurances",
"of adverse events"),
paste("% is defined as Number of Subjects divided by Total Reporting"),
"Note: Adverse events were coded using MedDRA Version 9.1") %>%
page_footer("Time", "Confidential", "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)
rtfpth <- file.path(base_path, "user/user4.rtf")
res <- write_report(rpt, file_path = rtfpth, output_type = "RTF")
rtfpth <- file.path(base_path, "user/user4.rtf")
res <- write_report(rpt, rtfpth, output_type = "RTF")
expect_equal(file.exists(rtfpth), TRUE)
#print(res)
pdfpth <- file.path(base_path, "user/user4.pdf")
res <- write_report(rpt, pdfpth, output_type = "PDF")
expect_equal(file.exists(pdfpth), TRUE)
docxpth <- file.path(base_path, "user/user4.docx")
res <- write_report(rpt, docxpth, output_type = "DOCX")
expect_equal(file.exists(docxpth), TRUE)
#print(res)
} else
expect_equal(TRUE, TRUE)
})
test_that("user5: large listing works.", {
test <- FALSE
# Skip except for special testing because it takes too long (+ 5 minutes)
if (test) {
startTime <- Sys.time()
# Data Filepath
dir_data <- file.path(base_path, "data")
fp <- file.path(base_path, "user/user5.out")
# Load Data
data_lb <- file.path(dir_data, "ADLB.csv") %>%
read.csv()
# Define table
tbl <- create_table(data_lb) %>%
define(USUBJID, id_var = TRUE)
# Define Report
rpt <- create_report(fp) %>%
options_fixed(font_size = 10) %>%
titles("Listing 2.0",
"Analysis Dataset Labs") %>%
add_content(tbl, align = "left") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
endTime <- Sys.time()
print(endTime - startTime)
expect_equal(file.exists(fp), TRUE)
lns <- readLines(fp)
expect_equal(length(lns), res$pages * res$line_count)
rtfpth <- file.path(base_path, "user/user5.rtf")
write_report(rpt, rtfpth, output_type = "RTF")
expect_equal(file.exists(rtfpth), TRUE)
# Very special testing case.
if (FALSE) {
pdfpth <- file.path(base_path, "user/user5.pdf")
write_report(rpt, pdfpth, output_type = "PDF")
expect_equal(file.exists(pdfpth), TRUE)
}
} else {
expect_equal(TRUE, TRUE)
}
})
test_that("user6: listings with page break works as expected.", {
if (dev) {
# Data Filepath
dir_data <- file.path(data_dir, "data")
# Load Data
data_demo <- file.path(dir_data, "dm.csv") %>%
read.csv()
data_demo <- data_demo[order(data_demo$ARMCD), ]
# Define table
tbl <- create_table(data_demo) %>%
define(USUBJID, id_var = TRUE) %>%
define(ARMCD, page_break = TRUE, id_var = TRUE) %>%
define(ARM, id_var = TRUE)
fp <- file.path(base_path, "user/user6")
# Define Report
rpt <- create_report(fp) %>%
options_fixed(editor = "notepad") %>%
titles("Listing 1.0",
"Demographics Dataset") %>%
add_content(tbl, align = "left") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(res$modified_path), TRUE)
lns <- readLines(res$modified_path)
expect_equal(length(lns), res$pages * res$line_count)
res <- write_report(rpt, output_type = "RTF")
expect_equal(file.exists(res$modified_path), TRUE)
res <- write_report(rpt, output_type = "PDF")
expect_equal(file.exists(res$modified_path), TRUE)
} else
expect_equal(TRUE, TRUE)
})
test_that("user7: listings with NA values works.", {
if (dev) {
library(readr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "user/user7")
# Load Data
dat <- file.path(dir_data, "ADSL.csv") %>%
read_csv()
# Define table
tbl <- create_table(dat) %>%
define(USUBJID, id_var = TRUE)
# Define Report
rpt <- create_report(fp) %>%
titles("Listing 1.0",
"ADSL Dataset") %>%
add_content(tbl, align = "left") %>%
page_footer(left = "Time", right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
expect_equal(file.exists(res$modified_path), TRUE)
lns <- readLines(res$modified_path)
expect_equal(length(lns), res$pages * res$line_count)
res <- write_report(rpt, output_type = "RTF")
expect_equal(file.exists(res$modified_path), TRUE)
} else
expect_equal(TRUE, TRUE)
})
# This is a special case, and I don't want to test it every time.
# One reason is to not create a dependancy on > R 3.5 just because
# of the .rds test file. The .rds test file has been appended with
# a .txt extension to fool the checker. Turn back to .rds if needed.
# test_that("user8: table with spaces in column names works.", {
#
# fp <- file.path(base_path, "user/user8.out")
#
# dat <- readRDS(file.path(base_path, "./data/dm_final.rds"))
#
# tbl <- create_table(dat)
#
# rpt <- create_report(fp) %>%
# add_content(tbl)
#
# res <- write_report(rpt)
#
# expect_equal(file.exists(fp), TRUE)
#
# })
# Also a special case
# test_that("user9: table with stub and page by works as expected.", {
#
# # Data Filepath
# dir_data <- file.path(base_path, "data")
#
# fp <- file.path(base_path, "user/user9")
#
# # Load Data
# dat <- file.path(dir_data, "final.rds") %>% readRDS()
#
# dat <- subset(dat, dat$label != "Q1 - Q3")
#
# arm_pop <- c("ARM A" = 20, "ARM B" = 21, "ARM C" = 19, "ARM D" = 22)
#
# # Create Table
# tbl <- create_table(dat, width = 9) %>%
# column_defaults(from = `ARM A`, to = `ARM D`, align = "center", width = 1.2) %>%
# page_by(AVISIT, label = "Visit: ", blank_row = "none") %>%
# stub(vars = c(PARAM, label), label = "Parameter", width = 2) %>%
# define(AVISIT, visible = FALSE) %>%
# define(PARAMCD, visible = FALSE) %>%
# define(PARAM, label_row = TRUE, blank_after = TRUE) %>%
# define(label, label = "Statistic", indent = .25) %>%
# define(`ARM A`, n = arm_pop["ARM A"]) %>%
# define(`ARM B`, n = arm_pop["ARM B"]) %>%
# define(`ARM C`, n = arm_pop["ARM C"]) %>%
# define(`ARM D`, n = arm_pop["ARM D"])
#
#
# rpt <- create_report(fp, output_type = "RTF") %>%
# set_margins(top = 1, bottom = .9) %>%
# page_header("Sponsor: Experis", "Study: ABC") %>%
# titles("Table 3.0", "Summary of Vital Sign Parameters by Visit",
# "Safety Population") %>%
# add_content(tbl) %>%
# footnotes("R Program: VA_Table.R") %>%
# page_footer(paste0("Date Produced: ", fapply(Sys.time(), "%d%b%y %H:%M")),
# right = "Page [pg] of [tpg]")
#
# res <- write_report(rpt)
#
# expect_equal(file.exists(res$modified_path), TRUE)
#
# })
# Another special case
# test_that("user10: Combined report works as expected", {
#
#
# dm_table <- readRDS(file.path(base_path, "data/DM_Table.rds"))
# ae_table <- readRDS(file.path(base_path, "data/AE_Table.rds"))
# lb_table <- readRDS(file.path(base_path, "data/LB_Table.rds"))
# vs_table <- readRDS(file.path(base_path, "data/VS_Table.rds"))
#
#
# rpt <- create_report("rtf/Combined_Table", output_type = "RTF") %>%
# set_margins(top = 1, bottom = .9) %>%
# page_header("Sponsor: Experis", "Study: ABC") %>%
# add_content(dm_table) %>%
# add_content(ae_table) %>%
# add_content(vs_table) %>%
# add_content(lb_table) %>%
# page_footer(paste0("Date Produced: ", fapply(Sys.time(), "%d%b%y %H:%M")),
# right = "Page [pg] of [tpg]")
#
#
# res <- write_report(rpt)
#
#
#
# })
# Special Case
# test_that("mismatched format works as expected.", {
#
#
# fp <- file.path(base_path, "data/final.rds")
#
# final <- readRDS(fp)
#
# var_fmt <- c("AGE" = "Age", "AGEGR1" = "Age Group", "SEX" = "Sex", "RACE" = "Race")
#
# arm_pop <- c("ARM A" = 20, "ARM B" = 21, "ARM C" = 21, "ARM D" = 23)
#
# # Create Table
# tbl <- create_table(final, first_row_blank = TRUE, width = 9) %>%
# column_defaults(from = `ARM A`, to = `ARM D`, align = "center", width = 1) %>%
# stub(vars = c("var", "label"), "Variable", width = 2.5) %>%
# define(var, blank_after = TRUE, dedupe = TRUE, label = "Variable",
# format = var_fmt,label_row = TRUE) %>%
# define(label, indent = .25, label = "Demographic Category") %>%
# define(`ARM A`, n = arm_pop["ARM A"]) %>%
# define(`ARM B`, n = arm_pop["ARM B"]) %>%
# define(`ARM C`, n = arm_pop["ARM C"]) %>%
# define(`ARM D`, n = arm_pop["ARM D"]) %>%
# define(stat, label = "Tests of Association*\nValue (P-value)",
# width = 2, dedupe = TRUE, align = "center") %>%
# titles("Table 1.0", "Analysis of Demographic Characteristics",
# "Safety Population") %>%
# footnotes("R Program: Table1_0.R",
# "NOTE: Denominator based on number of non-missing responses.",
# "*Pearsons's Chi-Square tests will be used for categorical variables",
# " and ANOVA tests for continuous variables.")
#
#
#
# rpt <- create_report("output/DM_Table2.rtf", output_type = "RTF") %>%
# set_margins(top = 1, bottom = 1) %>%
# page_header("Sponsor: Experis", "Study: ABC") %>%
# add_content(tbl) %>%
# page_footer(paste0("Date Produced: ", fapply(Sys.time(), "%d%b%y %H:%M")),
# right = "Page [pg] of [tpg]")
#
# write_report(rpt)
#
#
# })
test_that("user12: Complex table works as expected.", {
if (dev) {
library(readr)
library(fmtr)
# Data Filepath
dir_data <- file.path(data_dir, "data")
fp <- file.path(base_path, "user/user12")
# Load Data
dat <- file.path(dir_data, "kk.csv") %>%
read_csv()
mfmt <- value(condition(is.na(x), "-"),
condition(x == 0, "%d"),
condition(TRUE, "%5.3f"))
nfmt <- value(condition(is.na(x), " "),
condition(TRUE, "%2d"))
pfmt <- value(condition(is.na(x), " "),
condition(TRUE, "(%4.1f)"))
# Define table
tbl <- create_table(dat, width = 9) %>%
spanning_header(COL1, COL2, "LLY10", n = 70, underline = FALSE, label_align = "center") %>%
spanning_header(COL3, COL4, "LLY20", n = 49, underline = FALSE, label_align = "center") %>%
spanning_header(COL5, COL6, "LLY75", n = 19, underline = FALSE, label_align = "center") %>%
spanning_header(COL8, COL10, "Pairwise p-values*b") %>%
spanning_header(COL11, COL11, "Odds\nratios*c") %>%
column_defaults(from = COL1, to = COL11, align = "center", width = .45) %>%
stub(c(CATEGORY, LABEL), width = 3.25) %>%
define(CATEGORY, label_row = TRUE) %>%
define(LABEL, indent = .25) %>%
define(COL1, label = "n") %>%
define(COL2, label = "(%)", format = pfmt) %>%
define(COL3, label = "n") %>%
define(COL4, label = "(%)", format = pfmt) %>%
define(COL5, label = "n") %>%
define(COL6, label = "(%)", format = pfmt) %>%
define(COL7, label = "Overall\np-value*a", format = mfmt, width = .7) %>%
define(COL8, label = "LLY20\nvs\nLLY10", format = mfmt) %>%
define(COL9, label = "LLY75\nvs\nLLY10", format = mfmt) %>%
define(COL10, label = "LLY75\nvs\nLLY20", format = mfmt) %>%
define(COL11, label = "LLY75/\nLLY20", width = .6, format = mfmt) %>%
titles("Testing Odds, Pairwise and Overall with 3 Trts",
"SAMPLE TEXT FOR title5", align = "left", borders = "bottom", blank_row = "none") %>%
footnotes("Abbreviations: N = number of subjects in population; n = number of subjects within category.",
"LLY10=LILLY_DRUG_10_mg; LLY20=LILLY_DRUG_20_mg; LLY75=LILLY_DRUG_75_mg.",
"*a - p-value for overall treatment effect were computed using Fisher's Exact test.",
"*b - p-values for pairwise treatment comparisons were computed using Chi-Square test.",
"*c - odds ratios based on comparator LILLY_DRUG_20_mg as denominator.",
"Program Location: /lillyce/qa/vct/common/rums/taffy_rums/dev_r/c_ds_dispsum/c_ds_dispsum_4.R",
"Output Location: /lillyce/qa/vct/common/rums/taffy_rums/dev_r/c_ds_dispsum/validation/output/odds_pair_overall_h_test.docx",
"Data Set Location: /lillyce/qa/vct/common/rums/taffy_rums/data/multi arms",
borders = "top", blank_row = "none")
# Define Report
rpt <- create_report(fp, output_type = "RTF") %>%
options_fixed(font_size = 8) %>%
set_margins(top = 1, bottom = .5, left = 1, right = 1) %>%
page_header(right = c("Page [pg] of [tpg]",
format(Sys.time(), "%H:%M %d-%b-%Y"),
"DDDL"
)) %>%
add_content(tbl, align = "left")
# Write out report
res <- write_report(rpt)
res
#file.show(res$modified_path)
expect_equal(file.exists(res$modified_path), TRUE)
} else
expect_equal(TRUE, TRUE)
})
# Also testing alignments and line lengths
test_that("user13: Simple demographic report with 12 pt font wraps as expected.", {
# Create temporary path
fp <- file.path(base_path, "user/user13")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, output_type = "RTF", units = "inches") %>%
set_margins(top = 1, bottom = 1) %>%
options_fixed(font_size = 12) %>%
page_header(left = "Client: Motor Trend", right = "Study: Cars") %>%
titles("Test Title Right Aligned", align = "right") %>%
titles("Table 1.0", "MTCARS Summary Table",
"----------------------------------------", borders = "all",
align = "center") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974",
"----------------------------------------",
borders = "all", align = "right") %>%
page_footer(left = Sys.time(),
center = "Confidential",
right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
# View report
# file.show(fp)
expect_equal(file.exists(res$modified_path), TRUE)
})
# Also testing alignments and line lengths
test_that("user14: Title header alignment works as expected.", {
# Create temporary path
fp <- file.path(base_path, "user/user14")
# Read in prepared data
df <- read.table(header = TRUE, text = '
var label A B
"ampg" "N" "19" "13"
"ampg" "Mean" "18.8 (6.5)" "22.0 (4.9)"
"ampg" "Median" "16.4" "21.4"
"ampg" "Q1 - Q3" "15.1 - 21.2" "19.2 - 22.8"
"ampg" "Range" "10.4 - 33.9" "14.7 - 32.4"
"cyl" "8 Cylinder" "10 ( 52.6%)" "4 ( 30.8%)"
"cyl" "6 Cylinder" "4 ( 21.1%)" "3 ( 23.1%)"
"cyl" "4 Cylinder" "5 ( 26.3%)" "6 ( 46.2%)"')
# Create table
tbl <- create_table(df, first_row_blank = TRUE) %>%
stub(c("var", "label")) %>%
define(var, blank_after = TRUE, label_row = TRUE,
format = c(ampg = "Miles Per Gallon", cyl = "Cylinders")) %>%
define(label, indent = .25) %>%
define(A, label = "Group A", align = "center", n = 19) %>%
define(B, label = "Group B", align = "center", n = 13)
# Create report and add content
rpt <- create_report(fp, output_type = "RTF", units = "inches") %>%
set_margins(top = 1, bottom = 1) %>%
options_fixed(font_size = 12) %>%
title_header("Test Title Left Aligned", right = "Testme",
borders = "all") %>%
add_content(tbl) %>%
footnotes("* Motor Trend, 1974",
borders = "all", align = "right") %>%
page_footer(left = Sys.time(),
center = "Confidential",
right = "Page [pg] of [tpg]")
# Write out report
res <- write_report(rpt)
# View report
# file.show(fp)
expect_equal(file.exists(res$modified_path), TRUE)
})
test_that("user15: Titles and footnotes only on first last page.", {
# Create temporary path
fp <- file.path(base_path, "user/user15")
ttls <- create_text(" ") %>%
titles("My Title Only on First Page", blank_row = "none")
tbl <- create_table(iris)
ftnts <- create_text(" ") %>%
footnotes("My Footnote Only on Last Page",
"Here is another footnote")
rpt <- create_report(fp, font = "Arial", output_type = "RTF") %>%
add_content(ttls, page_break = FALSE, blank_row = "none") %>%
add_content(tbl, page_break = FALSE, blank_row = "none") %>%
add_content(ftnts, page_break = FALSE, blank_row = "none")
res <- write_report(rpt)
expect_equal(file.exists(res$modified_path), TRUE)
})
test_that("user16: Label row does not create extra blank spaces.", {
library(libr)
library(fmtr)
# Create temporary path
fp <- file.path(base_path, "user/user16")
adsl <- read.table(header = TRUE, text = '
SITEID SITENAME USUBJID AGE SEX RACE WEIGHT
10003 "Advance ENT" 1000310001 22 M "WHITE" 74.843827
10003 "Advance ENT" 1000310002 56 F "ASIAN" 60.312484')
adsl
adot <- read.table(header = TRUE, text = '
USUBJID COHORT TREATMENT DOSE DOSENUM DOSEDATE EAR VISDAY VISDATE ANAVISIT OBSRESP IMPRESP
1000310001 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" L 2 "2020-09-30" "Day 2" No NA
1000310001 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" L 4 "2020-10-03" "Day 3" No NA
1000310001 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" L 8 "2020-10-06" "Week 1" No NA
1000310001 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" L 14 "2020-10-12" "Week 2" No NA
1000310001 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" L 28 "2020-10-26" "Week 4" No NA
1000310001 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" L 57 "2020-11-24" "Week 8" No No
1000310002 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" R 2 "2020-09-30" "Day 2" No NA
1000310002 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" R 4 "2020-10-03" "Day 3" No NA
1000310002 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" R 8 "2020-10-06" "Week 1" No NA
1000310002 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" R 14 "2020-10-12" "Week 2" No NA
1000310002 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" R 28 "2020-10-26" "Week 4" Yes NA
1000310002 "COHORT 1" "Single Dose Escalation" 0.03 1 "2020-09-29" R 57 "2020-11-24" "Week 8" Yes NA
')
adot
fc <- fcat(SEX = c("M" = "Male", "F" = "Female"),
AGE = "%d Years",
RACE = value(condition(x == "WHITE", "White"),
condition(x == "BLACK", "Black or African American"),
condition(x == "ASIAN", "Asian or Pacific Islander"),
condition(TRUE, "Other")),
WEIGHT = "%6.2f kg",
EAR = c("L" = "Left", "R" = "Right"),
DOSE = "%4.2fug")
# Merge and assign formats
acomb <-
datastep(adsl, format = fc,
merge = adot, merge_by = USUBJID, {})
# Apply formats
acombf <- fdata(acomb)
acombf
# Prepare final data for reporting
final <-
datastep(acombf, by = USUBJID,
{
BASELINE <- paste0("Investigator Site = ", SITEID,
" - ", SITENAME, ",\nSubject ID=", USUBJID,
",Age=", AGE, ",Sex=", SEX, ",Race=", RACE,
",Weight=", WEIGHT)
if (first.) {
GROUP <- paste0(COHORT, " - ", TREATMENT, " - ", DOSE)
DOSELBL <- paste0(DOSENUM, "/\n", DOSEDATE, "/\n", EAR)
} else {
GROUP <- ""
}
VSTLBL <- paste0(VISDAY, "/", VISDATE)
})
final
tbl <- create_table(final, show_cols = "none",
width = 9, first_row_blank = TRUE) %>%
stub(v(BASELINE, GROUP), label = "Cohort") %>%
define(BASELINE, label_row = TRUE) %>%
define(GROUP) %>%
define(DOSELBL, label = "Dose\nDay/\nDate/\nTreated Ear", width = 1.5) %>%
define(VSTLBL, label = "Visit\nDay/Date", width = 1.5) %>%
define(ANAVISIT, label = "Analysis\nVisit", width = .75) %>%
define(OBSRESP, label = "Observed\nResponse", width = .75) %>%
define(IMPRESP, label = "Imputed\nResponse", width = .75) %>%
define(USUBJID, blank_after = TRUE, visible = FALSE)
rpt <- create_report(fp, font = "Courier", font_size = 9) %>%
add_content(tbl) %>%
set_margins(top = 1, bottom = 1) %>%
page_header("Program:" %p% Sys.path(),
right = "Draft", width = 7) %>%
titles("Study: 0598-CL-0101", "Appendix 10.2.6.1.2.1",
"Source: ADAE, ADOT", columns = 3, header = TRUE, blank_row = "none") %>%
titles( "TMP Complete Closure Response - Single Ascending Dose (SAD)",
"All Randomized Patients", align = "center", header = TRUE, blank_row = "below") %>%
footnotes("# Time to First Complete Closure of TMP.",
"Values flagged with '@' were excluded from the by-visit " %p%
"analysis in tables showing the qualitative test results.",
blank_row = "none", footer = TRUE) %>%
page_footer("Date: " %p% toupper(fapply(Sys.time(), "%d%b%Y %H:%M:%S")),
"Astellas", "Page [pg] of [tpg]")
res1 <- write_report(rpt, output_type = "RTF")
res2 <- write_report(rpt, output_type = "PDF")
#file.show(res1$modified_path)
#file.show(res2$modified_path)
expect_equal(file.exists(res1$modified_path), TRUE)
expect_equal(file.exists(res2$modified_path), TRUE)
})
test_that("user17: Dedupe works as expected on hemo table", {
if (dev) {
# Sample Data
hemo <- read.table(header = TRUE, sep = ",", text = '
labtest,tmtnc,tmtn,swmgrade,variable,c0,c1,c2,c3,c4,c7,pagebrk
HEMO-HIGH,ARM A,1,7,NG,76 98.7%,75 98.7%,0,0,0,1 1.3%,1
HEMO-HIGH,ARM A,1,8,Missing,1 1.3%,1 100.0%,0,0,0,0,1
HEMO-HIGH,ARM A,1,9,Total,77 100.0%,76 98.7%,0,0,0,1 1.3%,1
HEMO-HIGH,ARM B,2,7,NG,84 96.6%,82 97.6%,0,0,0,2 2.4%,1
HEMO-HIGH,ARM B,2,8,Missing,3 3.4%,3 100.0%,0,0,0,0,1
HEMO-HIGH,ARM B,2,9,Total,87 100.0%,85 97.7%,0,0,0,2 2.3%,1
HEMO-HIGH,ARM C,3,7,NG,45 100.0%,41 91.1%,0,0,0,4 8.9%,2
HEMO-HIGH,ARM C,3,8,Missing,0,0,0,0,0,0,2
HEMO-HIGH,ARM C,3,9,Total,45 100.0%,41 91.1%,0,0,0,4 8.9%,2
HEMO-LOW,ARM A,1,1,Grade 0,22 28.6%,2 9.1%,7 31.8%,6 27.3%,7 31.8%,0,1
HEMO-LOW,ARM A,1,3,Grade 1,38 49.4%,0,14 36.8%,14 36.8%,10 26.3%,0,1
HEMO-LOW,ARM A,1,4,Grade 2,13 16.9%,0,1 7.7%,0,11 84.6%,1 7.7%,1
HEMO-LOW,ARM A,1,5,Grade 3,3 3.9%,0,0,1 33.3%,2 66.7%,0,1
HEMO-LOW,ARM A,1,8,Missing,1 1.3%,0,0,1 100.0%,0,0,1
HEMO-LOW,ARM A,1,9,Total,77 100.0%,2 2.6%,22 28.6%,22 28.6%,30 39.0%,1 1.3%,1
HEMO-LOW,ARM B,2,1,Grade 0,23 26.4%,2 8.7%,3 13.0%,11 47.8%,7 30.4%,0,1
HEMO-LOW,ARM B,2,3,Grade 1,41 47.1%,0,4 9.8%,18 43.9%,18 43.9%,1 2.4%,1
HEMO-LOW,ARM B,2,4,Grade 2,17 19.5%,0,1 5.9%,2 11.8%,13 76.5%,1 5.9%,1
HEMO-LOW,ARM B,2,5,Grade 3,3 3.4%,0,0,0,3 100.0%,0,1
HEMO-LOW,ARM B,2,8,Missing,3 3.4%,0,1 33.3%,0,2 66.7%,0,1
HEMO-LOW,ARM B,2,9,Total,87 100.0%,2 2.3%,9 10.3%,31 35.6%,43 49.4%,2 2.3%,1
HEMO-LOW,ARM C,3,1,Grade 0,14 31.1%,2 14.3%,4 28.6%,4 28.6%,2 14.3%,2 14.3%,2
HEMO-LOW,ARM C,3,3,Grade 1,21 46.7%,1 4.8%,5 23.8%,4 19.0%,10 47.6%,1 4.8%,2
HEMO-LOW,ARM C,3,4,Grade 2,6 13.3%,0,0,1 16.7%,4 66.7%,1 16.7%,2
HEMO-LOW,ARM C,3,5,Grade 3,4 8.9%,0,0,1 25.0%,3 75.0%,0,2
HEMO-LOW,ARM C,3,8,Missing,0,0,0,0,0,0,2
HEMO-LOW,ARM C,3,9,Total,45 100.0%,3 6.7%,9 20.0%,10 22.2%,19 42.2%,4 8.9%,2')
library(dplyr)
library(fmtr)
# Set variables
program.name <- "t_ctcshift_hem"
program.output <- "user17"
program.timestamp <- "2001-01-01 12:00"
program.dir <- base_path
# Change column names to lower case
colnames(hemo) <- tolower(colnames(hemo))
fmt1 <- value(condition(x == "HEMO-HIGH", "Hemoglobin (G/L) - HIGH DIRECTION"),
condition(x == "HEMO-LOW", "Hemoglobin (g/L) - LOW DIRECTION"),
condition(x == "LEUK-HIGH", "Leukocytes (GI/L) - HIGH DIRECTION"),
condition(x == "LEUK-LOW", "Leukocytes (GI/L) - LOW DIRECTION"))
fmt2 <- value(condition(x == "ARM A", "Ruxolitinib 15 mg BID (N=77)"),
condition(x == "ARM B", "Ruxolitinib 5 mg BID (N=87)"),
condition(x == "ARM C", "Placebo (N=45)"))
ftnts <- list()
base_ftnt <-
c("[1] The percentages were calculated using the baseline total as the denominator.",
paste("[2] For each row, the percentages were calculated using the number of participants",
"with given grade at baseline as the denominator; worst value on study is the worst",
"grade observed post-baseline for a given participant."))
ftnts[["HEMO-HIGH"]] <-
c(base_ftnt,
"- Grade 0 = Below Grade 1 and any grade in the other direction.",
"- For baseline NG means that grade does not apply at baseline.",
"- Grade 1 = Greater than ULN and increase from baseline of >0 - 2 g/dL;",
"Grade 2 = Greater than ULN and increase from baseline of >2 - 4 g/dL;",
"Grade 3 = Greater than ULN and increase from baseline of >4 g/dL. ")
ftnts[["HEMO-LOW"]] <-
c(base_ftnt,
"- Grade 0 = Below Grade 1 and any grade in the other direction.")
pth <- file.path(program.dir, "user", program.output)
rpt <- create_report(pth, font = "Courier", font_size = 9) %>%
set_margins(top = 1.0, left = 1, right = 1, bottom = .5) %>%
options_fixed(line_count = 51) %>%
titles("Table 3.3.3.1",
paste("Shift Summary of Hematology Laboratory Values",
"in CTC Grade - to the Worst Abnormal Value"),
"(Safety Population)", bold = TRUE, font_size = 9) %>%
page_header(left = c("PROTOCOL: DIDA 00001-123",
"DRUG/INDICATION: DIDA00001/COMPOUND-ASSOCIATED STUDY",
"TLF Version: Final Database Lock (21APR2021)"),
right = c("Page [pg] of [tpg]", "DATABASE VERSION: 10MAY2023",
"TASK: Primary Analysis")) %>%
footnotes(paste0("Program: ", program.name, sep=""),
"DATE(TIME): 2001-12-01",
blank_row = "none", borders = "top", columns = 2, footer = TRUE) %>%
footnotes("Laboratory grading is based on CTCAE Version 5.",
"Reference: Listing 2.8.1.1, 2.8.1.2", footer = TRUE )
labtests <- names(table(hemo$labtest))
for (i in seq_len(length(labtests))) {
lb <- labtests[i]
ftnt <- ftnts[[lb]]
table_hemo <- hemo %>%
dplyr::filter(labtest==lb) %>%
mutate(labtest = fapply(labtest, fmt1),
tmtnc = fapply(tmtnc, fmt2)) %>%
select(labtest, tmtnc, tmtn, swmgrade,variable, c0,c1,c2,c3,c4,c7, pagebrk) %>%
arrange(labtest, tmtn, swmgrade)
tbl <- create_table(table_hemo,
show_cols = c("none"),
borders = "top",
width = 9) %>%
# page_by(labtest, label = "Laboratory Test (unit):", borders = "none",
# blank_row = "none") %>%
# footnotes (ftnt, blank_row ="above" ) %>%
column_defaults(width=.1) %>%
# spanning_header(variable, c0, label="Baseline [1]") %>%
# spanning_header(c1, c7, label="Worst Post-Baseline Value [2]") %>%
define(tmtnc, dedupe = TRUE, align = "left", label = "Treatment Group",
width=3) %>%
define(tmtn, blank_after = TRUE, visible = FALSE) %>%
define(variable, align="left", label="Grade", width=.8) %>%
define(c0, align="left", label="n (%)", width=1)# %>%
#define(c1, align = "left", label = "Grade 0\n n (%)", width=1) %>%
# define(c2, align = "left", label = "Grade 1\n n (%)", width=1) # %>%
# define(c3, align = "left", label = "Grade 2\n n (%)", width=1) # %>%
#define(c4, align = "left", label = "Grade 3\n n (%)", width=1) # %>%
#define(c7, align = "left", label = "Missing\n n (%)", width=1)
rpt <- rpt |> add_content(tbl, blank_row = "none", page_break = TRUE)
}
res <- write_report(rpt, output_type = "TXT")
expect_equal(file.exists(res$modified_path), TRUE)
# View the report
# file.show(res$modified_path)
# file.show(logpth)
} else {
expect_equal(TRUE, TRUE)
}
})
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.