R/zzz.R

In Tplyr: A Traceability Focused Grammar of Clinical Data Summary

#' @importFrom rlang env enquo enquos caller_env abort inform is_quosure quo_get_expr quo_is_null env_get env_bind env_has quo_is_missing quos enexprs
#' @importFrom rlang call_modify call_name call_args is_call current_env quo_name trace_back is_function list2
#' @importFrom rlang expr exprs enexprs enexpr is_named env_parent env_label is_logical is_empty is_quosures quo_is_symbol sym syms := as_name
#' @importFrom rlang quos quo env_names env_bind_active as_label eval_tidy warn quo_is_call
#' @importFrom stringr str_split str_extract_all regex str_detect str_replace_all str_replace str_locate_all fixed str_count str_trim str_wrap str_count
#' @importFrom purrr flatten map map_lgl pmap_chr imap reduce map_chr map_int map_dbl map_dfr pmap_dfr walk2 map2 map2_dfr map2_chr walk
#' @importFrom stringr str_sub str_sub<- str_extract str_pad str_starts str_remove_all str_match_all str_match
#' @importFrom tidyr pivot_longer pivot_wider replace_na
#' @importFrom magrittr %>% extract extract2
#' @importFrom assertthat assert_that
#' @importFrom stats IQR median sd quantile var setNames
#' @importFrom dplyr n summarize filter vars tally ungroup group_by mutate lag select bind_rows full_join add_tally distinct rowwise
#' @importFrom dplyr everything rename mutate_at mutate_all as_tibble bind_cols do case_when arrange left_join inner_join row_number between mutate_if
#' @importFrom dplyr across anti_join n_distinct if_else group_keys cur_group cur_column pull matches slice_head where desc count group_modify
#' @importFrom tidyr complete nesting pivot_wider pivot_longer replace_na starts_with fill
#' @importFrom utils str head tail
#' @importFrom tidyselect all_of vars_select any_of
#' @importFrom tibble tibble rownames_to_column add_column
#' @importFrom lifecycle deprecate_soft deprecate_stop
#' @importFrom stats var
#' @importFrom forcats fct_expand fct_collapse fct_na_value_to_level fct_drop
#' @importFrom utils capture.output
NULL

#' A grammar of summary data for clinical reports
#'
#' `r lifecycle::badge("experimental")`
#'
#' 'Tplyr' is a package dedicated to simplifying the data manipulation necessary
#' to create clinical reports. Clinical data summaries can often be broken down
#' into two factors - counting discrete variables (or counting shifts in state),
#' and descriptive statistics around a continuous variable. Many of the reports
#' that go into a clinical report are made up of these two scenarios. By
#' abstracting this process away, 'Tplyr' allows you to rapidly build these
#' tables without worrying about the underlying data manipulation.
#'
#' 'Tplyr' takes this process a few steps further by abstracting away most of
#' the programming that goes into proper presentation, which is where a great
#' deal of programming time is spent. For example, 'Tplyr' allows you to easily
#' control:
#'
#' \describe{ \item{\strong{String formatting}}{Different reports warrant
#' different presentation of your strings. Programming this can get tedious, as
#' you typically want to make sure that your decimals properly align. 'Tplyr'
#' abstracts this process away and provides you with a simple interface to
#' specify how you want your data presented} \item{\strong{Treatment
#' groups}}{Need a total column? Need to group summaries of multiple treatments?
#' 'Tplyr' makes it simple to add additional treatment groups into your report}
#' \item{\strong{Denominators}}{n (\%) counts often vary based on the summary
#' being performed. 'Tplyr' allows you to easily control what denominators are
#' used based on a few common scenarios} \item{\strong{Sorting}}{Summarizing
#' data is one thing, but ordering it for presentation. Tplyr automatically
#' derives sorting variable to give you the data you need to order your table
#' properly. This process is flexible so you can easily get what you want by
#' leveraging your data or characteristics of R.} }
#'
#' Another powerful aspect of 'Tplyr' are the objects themselves. 'Tplyr' does
#' more than format your data. Metadata about your table is kept under the hood,
#' and functions allow you to access information that you need. For example,
#' 'Tplyr' allows you to calculate and access the raw numeric data of
#' calculations as well, and easily pick out just the pieces of information that
#' you need.
#'
#' Lastly, 'Tplyr' was built to be flexible, yet intuitive. A common pitfall of
#' building tools like this is over automation. By doing to much, you end up not
#' doing enough. 'Tplyr' aims to hit the sweet spot in between. Additionally, we
#' designed our function interfaces to be clean. Modifier functions offer you
#' flexibility when you need it, but defaults can be set to keep the code
#' concise. This allows you to quickly assemble your table, and easily make
#' changes where necessary.
#'
#' @examples
#' # Load in pipe
#' library(magrittr)
#'
#' # Use just the defaults
#' tplyr_table(mtcars, gear) %>%
#'   add_layer(
#'     group_desc(mpg, by=cyl)
#'   ) %>%
#'   add_layer(
#'     group_count(carb, by=cyl)
#'   ) %>%
#'   build()
#'
#' # Customize and modify
#' tplyr_table(mtcars, gear) %>%
#'   add_layer(
#'     group_desc(mpg, by=cyl) %>%
#'       set_format_strings(
#'         "n"         = f_str("xx", n),
#'         "Mean (SD)" = f_str("a.a+1 (a.a+2)", mean, sd, empty='NA'),
#'         "Median"    = f_str("a.a+1", median),
#'         "Q1, Q3"    = f_str("a, a", q1, q3, empty=c(.overall='NA')),
#'         "Min, Max"  = f_str("a, a", min, max),
#'         "Missing"   = f_str("xx", missing)
#'       )
#'   ) %>%
#'   add_layer(
#'     group_count(carb, by=cyl) %>%
#'       add_risk_diff(
#'         c('5', '3'),
#'         c('4', '3')
#'       ) %>%
#'       set_format_strings(
#'         n_counts = f_str('xx (xx%)', n, pct),
#'         riskdiff = f_str('xx.xxx (xx.xxx, xx.xxx)', dif, low, high)
#'       ) %>%
#'       set_order_count_method("bycount") %>%
#'       set_ordering_cols('4') %>%
#'       set_result_order_var(pct)
#'   ) %>%
#'   build()
#'
#' # A Shift Table
#' tplyr_table(mtcars, am) %>%
#'   add_layer(
#'     group_shift(vars(row=gear, column=carb), by=cyl) %>%
#'     set_format_strings(f_str("xxx (xx.xx%)", n, pct))
#'   ) %>%
#'   build()
#'
#' @docType package
#' @name Tplyr
"_PACKAGE"

# Default options ----
tplyr_default_options <- list(

  # Count layer defaults
  tplyr.count_layer_default_formats =
    list(n_counts = f_str("a (xxx.x%)", distinct_n, distinct_pct),
         riskdiff = f_str('xx.xxx (xx.xxx, xx.xxx)', dif, low, high)
         ),

  # Desc layer defaults
  tplyr.desc_layer_default_formats =
    list("n"         = f_str("xxx", n),
         "Mean (SD)" = f_str("a.a+1 (a.a+2)", mean, sd),
         "Median"    = f_str("a.a+1", median),
         "Q1, Q3"    = f_str("a.a+1, a.a+1", q1, q3),
         "Min, Max"  = f_str("a.a, a.a", min, max),
         "Missing"   = f_str("xxx", missing)
         ),

  # Shift layer defaults
  tplyr.shift_layer_default_formats = list(f_str("a", n)),

  # Precision caps for decimal and integer precision
  tplyr.precision_cap = c('int' = 99, 'dec' = 99),

  # Overall maximum precision, applied after auto-precision formats resolve
  tplyr.max_precision = c('int' = 99, 'dec' = 99),

  # Custom summaries
  tplyr.custom_summaries = NULL,

  # Set to avoid printing in scientific notation
  tplyr.scipen = 1000,

  # Quantile algorithm setting
  tplyr.quantile_type = 7,

  # Rounding option default
  tplyr.IBMRounding = FALSE,

  # Layer templates
  tplyr.layer_templates = list()
)

# Carry out process on load ----
.onLoad <- function(libname, pkgname) {
  # store existing options
  op <- options()

  # Set any options that haven't been set
  toset <- !(names(tplyr_default_options) %in% names(op))
  if (any(toset)) options(tplyr_default_options[toset])

  invisible()
}

# Declare global variables to avoid R CMD check notes
# These are variables used in non-standard evaluation contexts (e.g., dplyr, tidyr)
utils::globalVariables(c(
  "i", "target_var", "target", "where", "pop_where", "layers", "layer_output",
  "mask", "row_label", "value", "cols", "empty", "pct", "numeric_data",
  "format_strings", "max_layer_length", "max_n_width", "total", "display_string",
  "built_target", "table_where", "distinct_by", "summary_vars", "trans_vars",
  "stat", "summary_var", "spanner_locs", "spanned_sects", "op", "cl", "q1", "q3",
  ".var", "total_stat", "distinct_n", "summary_stat", "total_row_label",
  "distinct_total", ".distinct_total", "count_row_prefix", "inner_count_layer_prefix",
  "ordering_cols", "order_count_method", "result_order_var", "nest_sort_index",
  ".data", ".", "built_pop_data", "factor_index", "formatted_data", "dots",
  "stats", "nest_count", "dif", "comparisons", "n", "low", "high", "row_label1",
  "comp_numeric_data", "indentation", "max_int", "max_dec", "need_prec_table",
  "precision_by", "precision_on", "cap", "..index", "denoms_by", ".distinct_n",
  "count_layer_formats", "desc_layer_formats", "denoms_df", "by_saved",
  "target_var_saved", "indentation_length", "missing_count_string", "missing_string",
  "denom_ignore", "denoms_distinct_df", "outer_inf", "shift_layer_formats",
  ".tmp_name", "include_total_row", "ord_layer_index", "ord_break",
  "missing_vars_ord", "total_vars_ord", "string_m", "string_t", "total_count_format",
  "missing_count_list", "total_denom_ignore", "total_row_sort_value",
  "missing_sort_value", "missing_index", "total_index", "denom_where",
  "built_target_pre_where", "count_fmt", "count_missings", "levels_to_keep",
  "break_ties", "prec_error", "comp_distinct", "numeric_cutoff",
  "numeric_cutoff_stat", "numeric_cutoff_column", "meta", "meta_sum",
  "num_sums_raw", "row_labels", "row_id", "USUBJID", "trans_sums", "l", "w", "s",
  "out", "og_row", "desc", "id", "stub_sort", "include_missing_subjects_row",
  "missing_subjects_row_label", "missing_subjects_stat", "missing_subjects_count_format",
  "missing_subject_rows", "missing_subject_vars_ord", "string_ms",
  "missing_subjects_sort_value", "limit_data_by", "n_present", "header_tots",
  "tot_fill", "..outer_order", "..outer_val", "..inner_order", "..is_outer",
  "sort_val", "valid_summary_var", "distinct_pct"
))

# Default values for specific variables
is_built_nest <- FALSE
has_missing_count <- FALSE
process_distinct_total <- FALSE
stats_as_columns <- FALSE
kept_levels <- expr(TRUE)