R/tlgsetup.R

In tidytlg: Create TLGs using the 'tidyverse'

#' Setup data to support the specified column type
#'
#' tlgsetup is useful for pre-processing total columns and columns composed of
#' other columns. tlgsetup is called internally by `generate_results()` and can
#' be run manually for custom tables.
#'
#' @param df dataframe of records for analysis
#' @param var character vector that identifies the numeric column/treatment
#'   variable
#' @param column_metadata_file A file containing the column metadata. Read in
#'   with `readxl::read_excel()`. If a `column_metadata` dataframe is passed in
#'   too, this is ignored.
#' @param column_metadata A dataframe containing the column metadata. This will
#'   be used in place of `column_metadata_file`.
#' @param tbltype A value used to subset the `column_metadata`, both this and the
#'   file requirements are needed to bind the data to the table.
#'
#' @return dataframe with observations added to support the column type as well
#'   as the factor variable `colnbr` which is used as our new column summary
#'   variable. Regardless of if a `coldef` exists in data, the column will exist in
#'   the table.
#' @export
#'
#' @examples
#' df <-
#'   tibble::tribble(
#'   ~TRT01AN, ~USUBJID,
#'   0,        "A",
#'  54,       "B",
#'  81,       "C"
#' )
#'
#' tlgsetup(df, "TRT01AN", column_metadata = column_metadata)
#'
#' # Using a dataframe of column metadata
#' column_metadata <-
#'   tibble::tribble(
#'     ~tbltype, ~coldef, ~decode,                ~span1,
#'     "type1",  "0",     "Placebo",              "",
#'     "type1",  "54",    "Low Dose",             "Xanomeline",
#'     "type1",  "81",    "High Dose",            "Xanomeline",
#'     "type1",  "54+81", "Total Xanomeline",     ""
#'   )
#'
#' tlgsetup(df, "TRT01AN", column_metadata = column_metadata)
tlgsetup <-
  function(df,
           var,
           column_metadata_file = NULL,
           column_metadata = NULL,
           tbltype = NULL) {

  arglist <- list()
  args_to_chk <- names(formals())[names(formals()) != "..."]
  purrr::walk(
    args_to_chk,
    .f = function(x) {
      arglist[[x]] <<- eval(rlang::sym(x))
    }
  )
  check_tlgsetup(arglist)

  if ("colnbr" %in% names(df)) {
    message("tidytlg seems to have been run more than once. Remove 'colnbr'
            column and rerun if chnages to column_metadata.")
    return(df)
  }

  if (is.null(c(column_metadata_file, column_metadata))) {
    return(df)
  } else if (is.null(column_metadata)) {
    column_metadata <- readxl::read_excel(column_metadata_file, sheet = 1)
  }

  if (!is.null(tbltype)) {
    column_metadata <- column_metadata %>%
# Per JCEV-16: Any non breaking space(utf8 160) should be collapsed into space
# (utf8 32)
      mutate(
        tbltype = gsub("\u00A0", " ", tbltype)
      ) %>%
      filter(tbltype == !!tbltype)
  }

  rlang::check_required(df)
  rlang::check_required(var)
  rlang::check_required(column_metadata)

  if (inherits(df, "survfit")) {
    return(df)
  } else {
    # add rows to df based off column metadata
    split <- column_metadata %>%
      dplyr::mutate(colnbr = forcats::fct_reorder(paste0("col",
                              dplyr::row_number()), dplyr::row_number())) %>%
      tidyr::separate_rows(coldef, sep = "\\+")

    if (!is.factor(df[[var]]))
      df[[var]] <- as.character(df[[var]])


    # temp fix to align attributes and prevent warning
    attr(split$coldef, "label") <- attr(df[[var]], "label")

    split %>%
      inner_join(df, by = c("coldef" = var), keep = TRUE, relationship = "many-to-many") %>%
      select(-coldef, -decode, -dplyr::starts_with("span")) %>%
      mutate(
        colnbr = fct_expand(colnbr, unique(as.character(split$colnbr)))
      )

  }
}