R/summary.R

In WMAP: Weighted Meta-Analysis with Pseudo-Populations

# ======================================================================================
# WMAP PACKAGE - SUMMARY METHODS
# ======================================================================================

# This file contains summary methods for WMAP objects:
# - summary.balancing_weights: Display weight distribution and ESS
# - summary.causal_estimates: Display mean differences and SD ratios with CIs

# ======================================================================================
# VERSION HISTORY
# ======================================================================================

# Version 1.3 - Refactoring & Bug Fixes
#               * Fixed variable reference bug in summary.balancing_weights() (output1 -> object)
#               * Added diagnostic warnings for low ESS (< 15%)
#               * Added method and bootstrap count to summary.causal_estimates()
#               * Added roxygen2 documentation to all functions
#               * Chnaged all = to <- for assignments
#               * Updated output formatting
#               * Added invisible returns for piping support

# ======================================================================================
# IMPORTS
# ======================================================================================

#' Summary method for objects of class 'balancing_weights'
#'
#' Displays a summary of balancing weights including the numnber of weights.
#' their distribution, and the effective sample size.
#'
#' @param object An object of class 'balancing_weights' returned by \code{balancing.weights()}.
#' @param ... Additional arguments (currently unused, reserved for future extensions).
#'
#' @return No return value, called for side effects (prints summary to console)
#' \itemize{
#'   \item The total number of weights
#'   \item Statistical summary of weight values
#'   \item Percentage sample effective sample size (ESS) for the pseudo-population
#' }
#'
#' @examples
#' \donttest{
#' data(demo)
#' result <- balancing.weights(S, Z, X, method = "IC", naturalGroupProp)
#' summary(result)
#' }
#' 
#' @export
summary.balancing_weights <- function(object, ...) {

  cat("===========================================\n")
  cat("    Summary of WMAP Balancing Weights\n")
  cat("===========================================\n")

  # display basic information & effective sample size
  cat("Method:                     ", object$method, "\n")
  cat("Number of observations:     ", length(object$wt.v), "\n")
  cat("Effective sample size (ESS):", sprintf("%.2f%%", object$percentESS), "\n\n")

  # display weight distribution statistics
  cat("Weight distribution:\n")
  cat(strrep("-", 43), "\n") 
  print(summary(object$wt.v))


  # add interpretive guidance for ESS
  if (object$percentESS < 15) {
    cat("Warning: Low ESS detected (<15%)\n")
    cat("  Estimates may be unstable. Consider:\n")
    cat("  - Using a different weighting method\n")
    cat("  - Investigating positivity violations\n")
  }

  # return invisibly for potential further use
  invisible(object)
}


#' Summary method for objects of class 'causal_estimates'
#'
#' Displays a comprehensive summary of causal estimates including effective sample size,
#' mean differences between groups with confidence intervals, and standard deviation ratios.
#'
#' @param object An object of class 'causal_estimates' returned by \code{causal.estimate()}
#' @param ... Additional arguments (currently unused, reserved for future extensions).
#'
#' @return No return value, called for side effects (prints summary to console):
#' \itemize{
#'   \item Percentage sample effective sample size (ESS) for the pseudo-population
#'   \item The mean differences between two groups with their corresponding 95% confidence intervals
#'   \item The ratios of standard deviations between two groups with their corresponding 95% confidence intervals
#' }
#'
#' @examples
#' \donttest{
#' data(demo)
#'
#' set.seed(1)
#' result <- causal.estimate(S, Z, X, Y, B = 5, method = "IC", naturalGroupProp)
#' summary(result)
#' }
#'
#' @export
summary.causal_estimates <- function(object, ...) {

  cat("===========================================\n")
  cat("     Summary of WMAP Causal Estimates\n")
  cat("===========================================\n")

  # display method, bootstrap information, and effective sample size
  cat("Method:                     ", object$method, "\n")
  cat("Bootstrap samples:          ", length(object$collatedESS), "\n")
  cat("Effective sample size (ESS):", sprintf("%.2f%%", object$percentESS), "\n\n")

  # add ESS warning if needed
  if (object$percentESS < 15) {
    cat("Warning: Low ESS detected (< 15%)\n")
    cat("  Estimates may be unstable.\n\n")
  }

  # display mean differences with 95% confidence intervals
  cat("Mean differences with 95% CI:\n")
  cat(strrep("-", 43), "\n")

  if (!is.null(object$collatedOtherFeatures.mt)) {
    # calculate 95% CIs for mean difference
    ci_mean_diff <- round(
      t(apply(object$collatedOtherFeatures.mt, 1,
              function(x) quantile(x, probs = c(0.025, 0.975)))),
      2
    )

    # format results
    mean_diff_formatted <- write_res(
      round(object$otherFeatures.v, 2),
      ci_mean_diff
    )

    outcome_names <- names(object$otherFeatures.v)
    if (is.null(outcome_names)) {
      outcome_names <- paste0("Outcome ", seq_along(object$otherFeatures.v))
    }

    # print formatted table
    cat(sprintf("%-15s %s\n", "Outcome", "Estimate (95% CI)"))
    cat(strrep("-", 43), "\n")
    for (i in seq_along(mean_diff_formatted)) {
      cat(sprintf("%-15s %s\n", outcome_names[i], mean_diff_formatted[i]))
    }
  } else {
    # no bootstrap
    outcome_names <- names(object$otherFeatures.v)
    if (is.null(outcome_names)) {
      outcome_names <- paste0("Outcome ", seq_along(object$otherFeatures.v))
    }

    cat(sprintf("%-15s %s\n", "Outcome", "Estimate"))
    cat(strrep("-", 43), "\n")
    for (i in seq_along(object$otherFeatures.v)) {
      cat(sprintf("%-15s %.2f\n", outcome_names[i], object$otherFeatures.v[i]))
    }
  }

  # display standard deviation ratios with 95% confidence intervals
  if (!is.null(object$collatedMoments.ar)) {
    cat("\nStandard Deviation Ratios with 95% CI:\n")
    cat(strrep("-", 43), "\n")

    sigma_ratio_formatted <- write_sigma_ratio(object)

    # get outcome names
    outcome_names <- dimnames(object$moments.ar)[[3]]
    if (is.null(outcome_names)) {
      outcome_names <- paste0("Y ", seq_len(dim(object$moments.ar)[3]))
    }

    # print formatted table
    cat(sprintf("%-15s %s\n", "Outcome", "Ratio (95% CI)"))
    cat(strrep("-", 43), "\n") 
    for (i in seq_along(outcome_names)) {
      cat(sprintf("%-15s %s\n", outcome_names[i], sigma_ratio_formatted[i]))
    }
  } 

  # return invisibly for potential further use
  invisible(object)
}