## ----setup, include = FALSE--------------------------------------------------- knitr::opts_chunk$set( collapse = TRUE, comment = "#>" ) ## ----eval=FALSE, echo=TRUE---------------------------------------------------- # library(sassy) # library(ggplot2) # library(patchwork) # # options("logr.notes" = FALSE, # "logr.autolog" = TRUE, # "procs.print" = FALSE) # # # Get temp location for log and report output # tmp <- tempdir() # # lf <- log_open(file.path(tmp, "example13.log")) # # # Get data ---------------------------------------------------------------- # # sep("Get data") # # # Get sample data path # pth <- system.file("extdata", package = "sassy") # # put("Open data library") # libname(sdtm, pth, "csv") # # # Create Formats ---------------------------------------------------------- # # sep("Create Formats") # # put("Format for visits") # vfmt <- value(condition(x == "DAY 1", "Day 1"), # condition(x == "WEEK 2", "Week 2"), # condition(x == "WEEK 4", "Week 4"), # condition(x == "WEEK 6", "Week 6"), # condition(x == "WEEK 12", "Week 12"), # as.factor = TRUE) # # put("Format for ARMs") # afmt <- value(condition(x == "ARM A", "Placebo"), # condition(x == "ARM B", "Drug (10mg)"), # condition(x == "ARM C", "Drug (20mg)"), # condition(x == "ARM D", "Competitor"), # as.factor = TRUE) # # # # Prepare data ------------------------------------------------------------ # # sep("Prepare data") # # put("Pull out needed visits and columns") # lbsub1 <- subset(sdtm$LB, VISIT %in% toupper(levels(vfmt)), # v(USUBJID, VISIT, VISITNUM, LBORRES, LBCAT, LBORRESU, LBTEST, # LBTESTCD, LBBLFL)) |> put() # # put("Pull out baseline subset") # lbsub2 <- subset(lbsub1, LBBLFL == 'Y', # v(USUBJID, VISIT, LBORRES, LBCAT, LBTESTCD)) |> put() # # put("Merge and calculate change from baseline") # datastep(lbsub1, merge = lbsub2, merge_by = v(USUBJID, LBCAT, LBTESTCD), # rename = v(LBORRES.1 = LBORRES, LBORRES.2 = BLBORES, VISIT.1 = VISIT), # drop = VISIT.2, { # # # Convert to double # LBORRES.1 <- suppressWarnings(as.double(LBORRES.1)) # # # Convert to double # LBORRES.2 <- suppressWarnings(as.double(LBORRES.2)) # # # Calculate Change from baseline # if (!(is.na(LBORRES.1) | is.na(LBORRES.2))) { # LBCHG <- LBORRES.1 - LBORRES.2 # } else { # LBCHG <- NA # } # # }) -> lbsub # # put("Pull needed ARMs and columns for DM") # dmsub <- subset(sdtm$DM, ARM != "SCREEN FAILURE", v(USUBJID, ARMCD, ARM)) |> put() # # put("Merge DM with LB to get subject treatments") # datastep(lbsub, merge = dmsub, merge_by = USUBJID, # where = expression(toupper(VISIT) != 'SCREENING'), # { # VISIT <- fapply(VISIT, vfmt) # }) -> lbdat # # # # Prepare lab test labels ------------------------------------------------- # # sep("Lab test labels") # # put("Get lookup data for lab tests") # proc_sort(lbdat, by = v(LBTESTCD, LBTEST, LBORRESU), # keep = v(LBTESTCD, LBTEST, LBORRESU), # options = nodupkey) -> tcodes # # put("Create test label with units") # datastep(tcodes, where = expression(is.na(LBORRESU) == FALSE), # keep = v(LBTESTCD, LABEL), # { # # LABEL <- paste0(LBTEST, " (", LBORRESU, ")") # # }) -> tfmtdat # # put("Create lab value lookup") # tfmt <- tfmtdat$LABEL # names(tfmt) <- tfmtdat$LBTESTCD # # put("Apply superscripts as needed") # tfmt <- sub("(9)", supsc('9'), tfmt, fixed = TRUE) # tfmt <- sub("(12)", supsc('12'), tfmt, fixed = TRUE) # # # # Calculate statistics ---------------------------------------------------- # # sep("Calculate statistics") # # put("Get statistics for change from baseline") # proc_means(lbdat, by = LBTESTCD, # class = v(ARM, VISIT), # var = LBCHG, # stats = v(n, mean, std, clm), # options = nway) -> datcl # # put("Get statistics for mean lab value") # proc_means(lbdat, by = LBTESTCD, # class = v(ARM, VISIT), # var = LBORRES, # stats = v(n, mean), # options = nway) -> datmn # # put("Add mean lab values to change from baseline") # datcl$MEANV <- datmn$MEAN # # put("Apply formats") # datcl$BY <- fapply(datcl$BY, tfmt) # datcl$CLASS1 <- fapply(datcl$CLASS1, afmt) # # # # Create report ----------------------------------------------------------- # # sep("Create report") # # put("Create output path") # pth <- file.path(tmp, "output/example13.rtf") |> put() # # put("Create report first so content can be added dynamically") # rpt <- create_report(pth, output_type = "RTF", # font = "Arial", font_size = 10) |> # page_header("Sponsor: Archytas", right = "Study: ABC") |> # titles("Figure 1.0", "Mean Change From Baseline (HEMATOLOGY)", "Safety Population", # bold = TRUE, blank_row = "none") |> # page_footer("Date: " %p% fapply(Sys.time(), "%d%b%Y %H:%M:%S"), # "Confidential", "Page [pg] of [tpg]") # # put("Loop through lab tests") # for (tst in unique(datcl$BY)) { # # put("**** Lab Test: " %p% tst %p% " ****") # # put("Apply subset") # dat <- subset(datcl, BY == tst) # # put("Create plot") # p <- ggplot(data = dat, aes(x = CLASS2, y = MEAN, group = CLASS1)) + # geom_point(aes(color = CLASS1), size = 1.5, position = position_dodge(width = 0.5)) + # geom_line(aes(color = CLASS1, linetype = CLASS1), position = position_dodge(width = 0.5)) + # geom_errorbar(aes(x = CLASS2, ymin = LCLM, ymax = UCLM, color = CLASS1), # position = position_dodge(width = 0.5)) + # theme_light() + # scale_linetype(guide = "none") + # scale_color_manual(values = c("blue", "red", "green", "purple")) + # theme(legend.position = "bottom", plot.title = element_text(size = 11, hjust = 0)) + # guides(color = guide_legend(title = "Treatment")) + # labs(x = 'Visit', y = '\n\nMean Change from Baseline (95% CI)') + # geom_hline(yintercept = 0, linetype = 'dashed') # # put("Create table for mean change/mean value") # t1 <- ggplot(data = dat) + # geom_text(aes(CLASS1, x = CLASS2, label = fapply2(MEAN, MEANV, "%4.2f", "%.2f", sep = "/"), # hjust = 0.5, vjust = 0.5), size = 8 / .pt) + # ggtitle("Mean Change from Baseline/Mean Value") + # scale_y_discrete(limits = rev) + # theme_bw() + # theme( # axis.line = element_blank(), # panel.grid = element_blank(), # axis.ticks = element_blank(), # axis.title.y = element_blank(), # axis.title.x = element_blank(), # axis.text.x = element_text(color = "white"), # plot.title = element_text(size =10, hjust = 0, face = "bold") # ) # # put("Create table for patient counts") # t2 <- ggplot(data = dat) + # geom_text(aes(CLASS1, x = CLASS2, label = as.character(N), # hjust = 0.5, vjust = 0.5), size = 8 / .pt) + # ggtitle("Number of Patients") + # scale_y_discrete(limits = rev) + # theme_bw() + # theme( # axis.line = element_blank(), # panel.grid = element_blank(), # axis.ticks = element_blank(), # axis.title.y = element_blank(), # axis.title.x = element_blank(), # axis.text.x = element_text(color = "white"), # plot.title = element_text(size = 10, hjust = 0, face = "bold") # ) # # put("Patch together plot and tables") # plts <- p + t1 + t2 + plot_layout(ncol = 1, nrow = 3, # widths = c(1, 2, 2), heights = c(8, 2, 2)) # # put("Create plot content") # plt1 <- create_plot(plts, height = 6, width = 9) |> # titles("Laboratory Test: " %p% tst, align = "left", blank_row = "below") # # put("Add content to report") # rpt <- rpt |> # add_content(plt1, page_break = TRUE, blank_row = "none") # # } # # put("Write out report to file system") # res <- write_report(rpt) # # # # Clean Up ---------------------------------------------------------------- # # sep("Clean Up") # # log_close() # # # View report # # file.show(res$modified_path) # # # View log # # file.show(lf)