fmtr: Easily Apply Formats to Data

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

options(rmarkdown.html_vignette.check_title = FALSE)


## ----eval=FALSE, echo=TRUE----------------------------------------------------
#  library(tidyverse)
#  library(sassy)
#  
#  
#  # Prepare Log -------------------------------------------------------------
#  
#  
#  options("logr.autolog" = TRUE,
#          "logr.notes" = FALSE)
#  
#  # Get temp location for log and report output
#  tmp <- tempdir()
#  
#  # Open log
#  lf <- log_open(file.path(tmp, "example1.log"))
#  
#  
#  # Load and Prepare Data ---------------------------------------------------
#  
#  sep("Prepare Data")
#  
#  # Get path to sample data
#  pkg <- system.file("extdata", package = "fmtr")
#  
#  # Define data library
#  libname(sdtm, pkg, "csv")
#  
#  # Prepare data
#  dm_mod <- sdtm$DM %>%
#    select(USUBJID, SEX, AGE, ARM) %>%
#    filter(ARM != "SCREEN FAILURE") %>%
#    put()
#  
#  
#  put("Get ARM population counts")
#  arm_pop <- count(dm_mod, ARM) %>% deframe() %>% put()
#  
#  # Create Format Catalog --------------------------------------------------
#  sep("Create format catalog")
#  
#  fmts <- fcat(AGECAT = value(condition(x >= 18 & x <= 24, "18 to 24"),
#                              condition(x >= 25 & x <= 44, "25 to 44"),
#                              condition(x >= 45 & x <= 64, "45 to 64"),
#                              condition(x >= 65, ">= 65"),
#                              condition(TRUE, "Other")),
#               SEX = value(condition(is.na(x), "Missing"),
#                           condition(x == "M", "Male"),
#                           condition(x == "F", "Female"),
#                           condition(TRUE, "Other")),
#               VAR = c("AGE" = "Age",
#                       "AGECAT" = "Age Group",
#                       "SEX" = "Sex"))
#  put(fmts)
#  
#  # Age Summary Block -------------------------------------------------------
#  
#  sep("Create summary statistics for age")
#  
#  age_block <-
#    dm_mod %>%
#    group_by(ARM) %>%
#    summarise( N = fmt_n(AGE),
#               `Mean (SD)` = fmt_mean_sd(AGE),
#               Median = fmt_median(AGE),
#               `Q1 - Q3` = fmt_quantile_range(AGE),
#               Range  = fmt_range(AGE)) %>%
#    pivot_longer(-ARM,
#                 names_to  = "label",
#                 values_to = "value") %>%
#    pivot_wider(names_from = ARM,
#                values_from = "value") %>%
#    add_column(var = "AGE", .before = "label") %>%
#    put()
#  
#  
#  # Age Group Block ----------------------------------------------------------
#  
#  sep("Create frequency counts for Age Group")
#  
#  
#  put("Create age group frequency counts")
#  ageg_block <-
#    dm_mod %>%
#    mutate(AGECAT = fapply(AGE, fmts$AGECAT)) %>%
#    select(ARM, AGECAT) %>%
#    group_by(ARM, AGECAT) %>%
#    summarize(n = n()) %>%
#    pivot_wider(names_from = ARM,
#                values_from = n,
#                values_fill = 0) %>%
#    transmute(var = "AGECAT",
#              label =  factor(AGECAT, levels = c("18 to 24",
#                                                 "25 to 44",
#                                                 "45 to 64",
#                                                 ">= 65")),
#              `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(label) %>%
#    put()
#  
#  
#  # Sex Block ---------------------------------------------------------------
#  
#  sep("Create frequency counts for SEX")
#  
#  
#  # Create sex frequency counts
#  sex_block <-
#    dm_mod %>%
#    select(ARM, SEX) %>%
#    group_by(ARM, SEX) %>%
#    summarize(n = n()) %>%
#    pivot_wider(names_from = ARM,
#                values_from = n,
#                values_fill = 0) %>%
#    transmute(var = "SEX",
#              label =   fct_relevel(SEX, "M", "F"),
#              `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(label) %>%
#    mutate(label = fapply(label, fmts$SEX)) %>%
#    put()
#  
#  put("Combine blocks into final data frame")
#  final <- bind_rows(age_block, ageg_block, sex_block) %>% put()
#  
#  # Report ------------------------------------------------------------------
#  
#  
#  sep("Create and print report")
#  
#  
#  # Create Table
#  tbl <- create_table(final, first_row_blank = TRUE, borders = c("top", "bottom")) %>%
#    column_defaults(from = `ARM A`, to = `ARM D`, align = "center", width = 1.25) %>%
#    stub(vars = c("var", "label"), "Variable", width = 2.5) %>%
#    define(var, blank_after = TRUE, dedupe = TRUE, label = "Variable",
#           format = fmts$VAR,label_row = TRUE) %>%
#    define(label, indent = .25, label = "Demographic Category") %>%
#    define(`ARM A`,  label = "Treatment Group 1", n = arm_pop["ARM A"]) %>%
#    define(`ARM B`,  label = "Treatment Group 2", n = arm_pop["ARM B"]) %>%
#    define(`ARM C`,  label = "Treatment Group 3", n = arm_pop["ARM C"]) %>%
#    define(`ARM D`,  label = "Treatment Group 4", n = arm_pop["ARM D"])
#  
#  rpt <- create_report(file.path(tmp, "output/example1.rtf"),
#                       output_type = "RTF", font = "Arial") %>%
#    set_margins(top = 1, bottom = 1) %>%
#    page_header("Sponsor: Company", "Study: ABC") %>%
#    titles("Table 1.0", bold = TRUE, blank_row = "none") %>%
#    titles("Analysis of Demographic Characteristics",
#           "Safety Population") %>%
#    add_content(tbl) %>%
#    footnotes("Program: DM_Table.R",
#              "NOTE: Denominator based on number of non-missing responses.") %>%
#    page_footer(paste0("Date Produced: ", fapply(Sys.time(), "%d%b%y %H:%M")),
#                right = "Page [pg] of [tpg]")
#  
#  res <- write_report(rpt)
#  
#  
#  # Clean Up ----------------------------------------------------------------
#  sep("Clean Up")
#  
#  # Close log
#  log_close()
#  
#  # View report
#  # file.show(res$modified_path)
#  
#  # View Log
#  # file.show(lf)
#  
#  
#