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) } })