inst/doc/v8_reporting_cif.R

In cifmodeling: Visualization and Polytomous Modeling of Survival and Competing Risks

## ----setup, include=FALSE-----------------------------------------------------
reporting_ready <- requireNamespace("gtsummary", quietly = TRUE) &&
  utils::packageVersion("gtsummary") >= "2.6.1"
knitr::opts_chunk$set(collapse = TRUE, comment = "#>", eval = reporting_ready)

## ----optional-packages, echo=FALSE, results='asis', eval=!reporting_ready-----
# cat("Install gtsummary version 2.6.1 or later to run these reporting examples. Estimation with cifmodeling does not require gtsummary.")

## ----first-table--------------------------------------------------------------
library(cifmodeling)
library(gtsummary)
data(diabetes.complications)
report_data <- diabetes.complications
report_data$fruitq1 <- factor(report_data$fruitq1, levels = c(0, 1),
                            labels = c("Other intake", "Low intake"))

curve <- cifcurve(Event(t, epsilon) ~ fruitq1, data = report_data,
                  outcome.type = "competing-risk")
cif_table <- tbl_survfit(curve, times = c(4, 8), type = "risk",
                         label_header = "**{time}-year CIF**")
cif_table

## ----student-intervals--------------------------------------------------------
student_curve <- cifcurve(Event(t, epsilon) ~ fruitq1, data = report_data,
  outcome.type = "competing-risk", error = "if", conf.dist = "t",
  conf.type = "log-log")
student_table <- tbl_survfit(student_curve, times = c(4, 8), type = "risk",
  label_header = "**{time}-year CIF**") |>
  modify_footnote_header(columns = all_stat_cols(),
    footnote = "95% pointwise IF-t intervals; log-log transformation of 1 - CIF; deletion allocation for degrees of freedom.")
student_table

## ----inference-diagnostics----------------------------------------------------
s <- summary(student_curve, times = c(4, 8), extend = TRUE)
data.frame(group = s$strata, time = s$time, df = s$df,
           interval_status = s$conf.status)

## ----curve-tests--------------------------------------------------------------
tests <- list(
  gray = ciftest(Event(t, epsilon) ~ fruitq1, report_data,
                 test = "gray", tau = 8),
  early = ciftest(Event(t, epsilon) ~ fruitq1, report_data,
                  test = "score", rho = 1, gamma = 0, tau = 8),
  late = ciftest(Event(t, epsilon) ~ fruitq1, report_data,
                 test = "score", rho = 0, gamma = 1, tau = 8)
)
test_results <- do.call(rbind, lapply(tests, function(fit) {
  x <- generics::tidy(fit)
  data.frame(method = paste(x$method, x$weight), p.value = x$p.value)
}))
test_table <- as_gtsummary(test_results) |>
  modify_header(method = "**Curve comparison through 8 years**",
                p.value = "**p-value**") |>
  modify_fmt_fun(p.value = label_style_pvalue(digits = 3))
test_table

## ----export-cif---------------------------------------------------------------
html_file <- tempfile(fileext = ".html")
gt::gtsave(as_gt(student_table), filename = html_file)

## ----export-cif-word, eval=reporting_ready && requireNamespace('flextable', quietly=TRUE)----
word_file <- tempfile(fileext = ".docx")
flextable::save_as_docx(as_flex_table(student_table), path = word_file)