R/bcat_sum_table.R

In Rbearcat: University of Cincinnati Themes and Utilities for Econometrics and Data Science

#' UC-branded summary statistics table
#'
#' Produce a descriptive statistics table with UC styling.
#' Displays mean, SD, min, median, max, N, and percent missing
#' for numeric columns.
#'
#' @param df A data frame, tibble, or data.table.
#' @param by Character. Column name for grouped summaries. Default is NULL.
#' @param stats Character vector of statistics to compute. Default includes all.
#' @param digits Integer. Number of decimal places. Default is 2.
#' @param caption Character. Table caption.
#' @param footer Character. Table footnote.
#' @param font_size Numeric. Font size. Default is 12.
#' @param header_bg_color Background color for header. Default is UC Red.
#' @param header_txt_color Text color for header. Default is white.
#' @param striped Logical. Zebra striping? Default is TRUE.
#' @param doc_type Character. Force output format. Auto-detected if NULL.
#' @param ... Additional arguments passed to table formatting.
#' @return A formatted table object.
#' @author Saannidhya Rawat
#' @family tables
#' @export
#'
#' @examples
#' bcat_sum_table(mtcars[, c("mpg", "wt", "hp")])
#' bcat_sum_table(mtcars[, c("mpg", "wt", "cyl")], by = "cyl")
bcat_sum_table <- function(df,
                           by = NULL,
                           stats = c("mean", "sd", "min", "median", "max",
                                     "n", "pct_missing"),
                           digits = 2,
                           caption = NULL,
                           footer = NULL,
                           font_size = 12,
                           header_bg_color = palette_UC[["UC Red"]],
                           header_txt_color = palette_UC[["White"]],
                           striped = TRUE,
                           doc_type = NULL,
                           ...) {

  .validate_df(df)
  if (!is.null(by)) .validate_df(df, by)

  dt <- data.table::as.data.table(df)

  # Identify numeric columns (exclude grouping variable)
  num_cols <- setdiff(
    names(dt)[vapply(dt, is.numeric, logical(1))],
    by
  )

  if (length(num_cols) == 0L) {
    stop("No numeric columns found in `df`.", call. = FALSE)
  }

  # Stat functions
  stat_fns <- list(
    mean = function(x) mean(x, na.rm = TRUE),
    sd = function(x) stats::sd(x, na.rm = TRUE),
    min = function(x) min(x, na.rm = TRUE),
    median = function(x) stats::median(x, na.rm = TRUE),
    max = function(x) max(x, na.rm = TRUE),
    n = function(x) sum(!is.na(x)),
    pct_missing = function(x) round(100 * mean(is.na(x)), 1)
  )
  stat_fns <- stat_fns[intersect(stats, names(stat_fns))]

  .compute_stats <- function(sub_dt) {
    result_list <- lapply(num_cols, function(col) {
      vals <- sub_dt[[col]]
      vapply(stat_fns, function(fn) fn(vals), numeric(1))
    })
    result <- as.data.frame(do.call(rbind, result_list))
    result <- cbind(Variable = num_cols, result)
    result
  }

  if (is.null(by)) {
    summary_df <- .compute_stats(dt)
  } else {
    groups <- unique(dt[[by]])
    summary_list <- lapply(groups, function(g) {
      sub <- dt[dt[[by]] == g, ]
      s <- .compute_stats(sub)
      s[[by]] <- g
      s
    })
    summary_df <- do.call(rbind, summary_list)
    summary_df <- summary_df[, c(by, setdiff(names(summary_df), by))]
  }

  # Round
  num_result_cols <- setdiff(names(summary_df), c("Variable", by))
  for (col in num_result_cols) {
    summary_df[[col]] <- round(as.numeric(summary_df[[col]]), digits)
  }

  # Clean column names
  display_names <- names(summary_df)
  display_names <- gsub("pct_missing", "% Missing", display_names)
  display_names <- tools::toTitleCase(display_names)

  effective_doc_type <- doc_type
  if (is.null(effective_doc_type)) {
    effective_doc_type <- knitr::opts_knit$get('rmarkdown.pandoc.to')
  }
  if (is.null(effective_doc_type)) effective_doc_type <- "html"

  bcat_fmt_style_table(summary_df,
                       caption = caption,
                       footer = footer,
                       font_size = font_size,
                       header_bg_color = header_bg_color,
                       header_txt_color = header_txt_color,
                       striped = striped,
                       col_names = display_names,
                       doc_type = effective_doc_type,
                       ...)
}