sassy-plisting.R
In sassy: Makes 'R' Easier for Everyone

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>"
)

## ----eval=FALSE, echo=TRUE----------------------------------------------------
#  library(sassy)
#  
#  # Prepare Log -------------------------------------------------------------
#  
#  options("logr.autolog" = TRUE,
#          "logr.on" = TRUE,
#          "logr.notes" = FALSE)
#  
#  # Get path to temp directory
#  tmp <- tempdir()
#  
#  # Get sample data directory
#  dir <- system.file("extdata", package = "sassy")
#  
#  # Open log
#  lf <- log_open(file.path(tmp, "example11.log"))
#  
#  
#  # Prepare formats ---------------------------------------------------------
#  
#  sep("Prepare formats")
#  
#  fc <- fcat(SEX = c("M" = "Male", "F" = "Female"),
#             AGE = "%d Years",
#             RACE = value(condition(x == "WHITE", "White"),
#                          condition(x == "BLACK OR AFRICAN AMERICAN", "Black or African American"),
#                          condition(x == "ASIAN OR PACIFIC ISLANDER", "Asian or Pacific Islander"),
#                          condition(TRUE, "Other")),
#             WEIGHT = "%6.2f kg",
#             EAR = c("L" = "Left", "R" = "Right"),
#             DOSE = "%4.2fug",
#             ETHNIC = value(condition(x == "NOT HISPANIC OR LATINO", "Not Hispanic or Latino"),
#                            condition(x == "HISPANIC OR LATINO", "Hispanic or Latino"),
#                            condition(TRUE, "Unknown")),
#             ARMT = value(condition(x == "ARM A", "Placebo"),
#                          condition(x == "ARM B", "Drug 50mg"),
#                          condition(x == "ARM C", "Drug 100mg"),
#                          condition(x == "ARM D", "Competitor"),
#                          condition(TRUE, "Not Treated/Screen Failure")),
#             UNITS = value(condition(x ==  "BEATS/MIN", "bpm"),
#                           condition(x == "BREATHS/MIN", "brths/min"),
#                           condition(x == "C", symbol("degC")),
#                           condition(x == "mmHg", "")),
#             VISIT = 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 8", "Week 8"),
#                           condition(x == "WEEK 12", "Week 12"),
#                           condition(x == "WEEK 16", "Week 16"),
#                           condition(TRUE, "Early Termination"))
#  )
#  
#  # Prepare Data ------------------------------------------------------------
#  
#  sep("Prepare Data")
#  
#  libname(sdtm, dir, "csv")
#  
#  lib_load(sdtm)
#  
#  put("Format desired vital signs")
#  datastep(sdtm.VS,
#           keep = v(USUBJID, VSTESTCD, VSCOMB, VISITNUM, VISIT),
#           where = expression(VSTESTCD != 'HEIGHT' & VISITNUM > 0),
#           {
#  
#             if (VSORRESU == "C")
#               VSCOMB <- paste0(VSORRES, fapply(VSORRESU, fc$UNITS))
#             else
#               VSCOMB <- paste(VSORRES, fapply(VSORRESU, fc$UNITS))
#           }) -> vso
#  
#  put("Pivot vitals signs")
#  proc_transpose(vso, id = VSTESTCD, var = VSCOMB,
#                 by = v(USUBJID, VISITNUM, VISIT)) |>
#    proc_sort(by = v(USUBJID, VISITNUM)) -> vsot
#  
#  
#  put("Assign and apply formats")
#  formats(sdtm.DM) <- fc
#  dmf <- fdata(sdtm.DM) |> put()
#  
#  put("Prepare final data for reporting")
#  datastep(dmf, format = fc,
#           by = USUBJID,
#           retain = list(PTCNT = 0, PG = 1),
#           merge = vsot, merge_by = USUBJID,
#           {
#  
#             # Combine subject info into label row
#             BASELINE <- paste0(USUBJID, ", Site=", SITEID,
#                                ", Age=", AGE, ", Sex=", SEX, ", Race=", RACE,
#                                ", Ethnic=", ETHNIC)
#  
#             # Deal with non-recorded blood pressure
#             if (is.na(DIABP))
#               DIABP <- "-"
#  
#             if (is.na(SYSBP))
#               SYSBP <- "-"
#  
#             # Combine distolic and systolic in one column
#             BP <- paste0(trimws(DIABP), "/", trimws(SYSBP), " mmHg")
#  
#             # Format treatment group
#             if (first.)
#               TREATMENT <- fapply(ARM, fc$ARMT)
#             else
#               TREATMENT <- ""
#  
#             # Count up patients
#             if (first.) {
#               PTCNT <- PTCNT + 1
#             }
#  
#             # Create paging variable with 3 patients per page
#             if (PTCNT == 4) {
#  
#               PTCNT <- 1
#               PG <- PG + 1
#             }
#  
#           }) -> final
#  
#  
#  # Create report -----------------------------------------------------------
#  
#  sep("Create and Print Report")
#  
#  tbl <- create_table(final, show_cols = "none",
#                      width = 9, first_row_blank = FALSE,
#                      header_bold = TRUE) |>
#    column_defaults(from = "VISIT", to = "BP", width = 1.25) |>
#    stub(v(BASELINE, TREATMENT), label = "Subject/Treatment") |>
#    define(BASELINE, label_row = TRUE) |>
#    define(TREATMENT) |>
#    define(VISIT, label = "Visit") |>
#    define(TEMP, label = "Temperature") |>
#    define(PULSE, label = "Pulse") |>
#    define(RESP, label = "Respirations") |>
#    define(BP, label = "Blood Pressure") |>
#    define(USUBJID, blank_after = TRUE, visible = FALSE) |>
#    define(PG, page_break = TRUE, visible = FALSE)
#  
#  rpt <- create_report(file.path(tmp, "example11"), 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: ABC", "Appendix 10.2.6.1.2.1", "Source: DM, VS",
#            columns = 3, header = TRUE, blank_row = "none") |>
#    titles("Subject Listing with Vital Signs by Visit{supsc('1')}",
#           "All Randomized Patients", align = "center", header = TRUE, blank_row = "below") |>
#    footnotes("{supsc('1')} Baseline through completion of study or early termination.",
#              "Values flagged with {symbol('dagger')} 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")),
#                "Archytas", "Page [pg] of [tpg]")
#  
#  # Generate both RTF and PDF with same report object
#  res1 <- write_report(rpt, output_type = "RTF")
#  res2 <- write_report(rpt, output_type = "PDF")
#  
#  
#  # Uncomment to show reports
#  # file.show(res1$modified_path)
#  # file.show(res2$modified_path)
#  
#  # Uncomment to show log
#  # file.show(lf)
#  
#  
#  # Clean Up ----------------------------------------------------------------
#  
#  lib_unload(sdtm)
#  
#  log_close()
#