R/export_supplementary.R

In ltgsmd: Latent True-Score and Target-Population Anchored Geometric SMD

#' Export an LTG-SMD analysis to a supplementary appendix template
#'
#' Bundles the point estimates, confidence intervals, denominator
#' diagnostics, and denominator-sensitivity profile into a list and
#' (optionally) writes them to a Markdown file for inclusion in a
#' supplementary appendix.
#'
#' @param object An "ltg_smd" object.
#' @param ci An optional "ltg_smd_ci" object from [ltg_smd_ci()].
#' @param file Optional path. If supplied, the supplementary appendix is
#'   written there as Markdown. If NULL, only the list is returned.
#' @return Invisibly, a list with elements diagnostics, sensitivity,
#'   estimates, and ci. If `file` is supplied, the Markdown is also
#'   written to disk.
#' @export
export_supplementary <- function(object, ci = NULL, file = NULL) {
  if (!inherits(object, "ltg_smd")) {
    stop("object must be an 'ltg_smd' object.")
  }

  diag <- denominator_diagnostics(object)
  sens <- denominator_sensitivity(object)

  out <- list(
    estimates    = object$estimates,
    ltg_smd      = object$point,
    se_analytic  = object$se_analytic,
    factors      = object$factors,
    diagnostics  = diag,
    sensitivity  = sens,
    ci           = ci,
    study        = object$study,
    reference    = object$reference
  )

  if (!is.null(file)) {
    con <- file(file, open = "wt", encoding = "UTF-8")
    on.exit(close(con))

    cat("# Supplementary report: LTG-SMD analysis\n\n", file = con)
    cat("## Effect-size estimates\n\n", file = con)
    cat("| Estimator | Value |\n|---|---|\n", file = con)
    for (nm in names(object$estimates)) {
      cat("| ", nm, " | ", sprintf("%.4f", object$estimates[[nm]]),
          " |\n", file = con, sep = "")
    }
    cat("\n## Denominator diagnostics (Table F.1 format)\n\n", file = con)
    cat("| Quantity | Focal | Reference | Combined |\n",
        "|---|---|---|---|\n", file = con, sep = "")
    for (i in seq_len(nrow(diag))) {
      cat("| ", diag$Quantity[i], " | ", diag$Group_1_focal[i],
          " | ", diag$Group_0_reference[i],
          " | ", diag$Combined[i], " |\n", file = con, sep = "")
    }
    cat("\n*", attr(diag, "note"), "*\n", file = con, sep = "")

    cat("\n## Denominator-sensitivity profile (six symmetric denominators)\n\n",
        file = con, sep = "")
    cat("| Denominator | D | Estimate |\n|---|---|---|\n", file = con)
    for (i in seq_len(nrow(sens))) {
      cat("| ", sens$denominator[i], " | ",
          sprintf("%.4f", sens$D[i]), " | ",
          sprintf("%.4f", sens$estimate[i]), " |\n", file = con, sep = "")
    }
    cat("\n*", attr(sens, "note"), "*\n", file = con, sep = "")

    if (!is.null(ci)) {
      cat("\n## Confidence intervals\n\n", file = con)
      if (!is.null(ci$analytic)) {
        cat("**Analytic delta-method (rho-fixed):** Estimate = ",
            sprintf("%.4f", ci$analytic[["estimate"]]),
            ", SE = ", sprintf("%.4f", ci$analytic[["se"]]),
            ", ", round(100 * ci$level), "% CI = [",
            sprintf("%.4f", ci$analytic[["lower"]]), ", ",
            sprintf("%.4f", ci$analytic[["upper"]]), "]\n\n",
            file = con, sep = "")
      }
      if (!is.null(ci$bootstrap)) {
        cat("**Bootstrap (", ci$boot_details$type,
            ", B = ", ci$boot_details$B, "):** Estimate = ",
            sprintf("%.4f", ci$bootstrap[["estimate"]]),
            ", SE = ", sprintf("%.4f", ci$bootstrap[["se"]]),
            ", ", round(100 * ci$level), "% CI = [",
            sprintf("%.4f", ci$bootstrap[["lower"]]), ", ",
            sprintf("%.4f", ci$bootstrap[["upper"]]), "]\n",
            file = con, sep = "")
      }
    }
    cat("\n*Generated by ltgsmd::export_supplementary().*\n", file = con)
  }

  invisible(out)
}