## ----include = FALSE----------------------------------------------------------
derrick_examples_available <- requireNamespace("derrick", quietly = TRUE) &&
  requireNamespace("dplyr", quietly = TRUE) &&
  requireNamespace("gtsummary", quietly = TRUE) &&
  requireNamespace("reporter", quietly = TRUE)

knitr::opts_chunk$set(
  collapse = TRUE,
  comment = "#>",
  message = FALSE,
  warning = FALSE,
  eval = derrick_examples_available
)

output_dir <- file.path(tempdir(), "derrick-vignette-outputs")
dir.create(output_dir, showWarnings = FALSE, recursive = TRUE)

path_for_ext <- function(paths, ext) {
  hit <- paths[tolower(tools::file_ext(paths)) == tolower(ext)]
  if (length(hit) == 0L) return(NA_character_)
  unname(hit[[1]])
}

escape_html_attr <- function(x) {
  x <- gsub("&", "&amp;", x, fixed = TRUE)
  x <- gsub("<", "&lt;", x, fixed = TRUE)
  x <- gsub(">", "&gt;", x, fixed = TRUE)
  x <- gsub("\"", "&quot;", x, fixed = TRUE)
  x
}

print_text_output <- function(path) {
  if (is.na(path) || !file.exists(path)) {
    cat("TXT output was not generated in this environment.\n")
    return(invisible(NULL))
  }

  text <- readChar(path, nchars = file.info(path)$size[[1]], useBytes = TRUE)
  text <- gsub("\r\n", "\n", text, fixed = TRUE)
  text <- gsub("\r", "\n", text, fixed = TRUE)
  cat(text)
}

embed_html_output <- function(path, height = 420) {
  if (is.na(path) || !file.exists(path)) {
    cat("> HTML output was not generated in this environment.\n")
    return(invisible(NULL))
  }

  html_doc <- paste(readLines(path, warn = FALSE), collapse = "\n")
  cat(
    '<iframe title="derrick HTML output preview" srcdoc="',
    escape_html_attr(html_doc),
    '" style="width:100%; height:',
    height,
    'px; border:1px solid #d0d7de;"></iframe>',
    sep = ""
  )
}

output_manifest <- function(paths) {
  data.frame(
    format = toupper(tools::file_ext(paths)),
    file = basename(paths),
    bytes = unname(file.info(paths)$size),
    row.names = NULL
  )
}

## ----availability-note, echo = FALSE, results = "asis", eval = !derrick_examples_available----
# cat(
#   "> The executable examples in this vignette require derrick, dplyr, ",
#   "gtsummary, and reporter. Install the suggested packages to run the ",
#   "workflow end to end.\n",
#   sep = ""
# )

## ----setup--------------------------------------------------------------------
library(dplyr)
library(gtsummary)
library(derrick)

## ----demog-table--------------------------------------------------------------
demog_tbl <- gtsummary::trial |>
  dplyr::select(trt, age, grade) |>
  gtsummary::tbl_summary(by = trt) |>
  gtsummary::add_p() |>
  gtsummary::modify_spanning_header(
    gtsummary::all_stat_cols() ~ "**Treatment Group**"
  )

demog_tbl

## ----demog-source-preview-----------------------------------------------------
preview_cols <- intersect(
  c("label", "stat_1", "stat_2", "p.value"),
  names(demog_tbl$table_body)
)

utils::head(demog_tbl$table_body[preview_cols])

## ----demog-metadata-----------------------------------------------------------
title1 <- "Table 14.1.1 Summary of Demographics"
title2 <- "Safety Population"
footnote1 <- "Percentages are based on subjects in each treatment group."
progname <- "programs/t-demog.R"

## ----demog-export-------------------------------------------------------------
demog_paths <- gtsummary_reporter(
  gts_obj = demog_tbl,
  file_path = file.path(output_dir, "t-demog.rtf"),
  output_types = c("TXT", "HTML"),
  save_rds = TRUE
)

output_manifest(demog_paths)

## ----demog-txt-preview, echo = FALSE, comment = ""----------------------------
demog_txt <- path_for_ext(demog_paths, "txt")
print_text_output(demog_txt)

## ----demog-html-preview, echo = FALSE, results = "asis"-----------------------
demog_html <- path_for_ext(demog_paths, "html")
embed_html_output(demog_html, height = 500)

## ----cross-table--------------------------------------------------------------
cross_tbl <- gtsummary::trial |>
  dplyr::select(trt, grade) |>
  gtsummary::tbl_cross(
    row = grade,
    col = trt,
    percent = "row"
  ) |>
  gtsummary::modify_spanning_header(
    gtsummary::all_stat_cols() ~ "**Treatment Group**"
  )

cross_tbl

## ----cross-export-------------------------------------------------------------
title1 <- "Table 14.1.2 Grade by Treatment"
title2 <- "Safety Population"
footnote1 <- "Percentages are row percentages."
progname <- "programs/t-grade-cross.R"

cross_paths <- gtsummary_reporter(
  gts_obj = cross_tbl,
  file_path = file.path(output_dir, "t-grade-cross.rtf"),
  output_types = c("TXT", "HTML"),
  save_rds = FALSE
)

output_manifest(cross_paths)

## ----cross-txt-preview, echo = FALSE, comment = ""----------------------------
cross_txt <- path_for_ext(cross_paths, "txt")
print_text_output(cross_txt)

## ----cross-html-preview, echo = FALSE, results = "asis"-----------------------
cross_html <- path_for_ext(cross_paths, "html")
embed_html_output(cross_html, height = 420)

## ----ae-data-frame------------------------------------------------------------
ae_tbl <- data.frame(
  label = c(
    "Serious adverse events",
    "  Subjects with at least one event",
    "  Events leading to study drug interruption",
    "Treatment-emergent adverse events",
    "  Headache",
    "  Nausea",
    "  Alanine aminotransferase increased"
  ),
  placebo = c("", "2 (10.0%)", "1 (5.0%)", "", "6 (30.0%)", "4 (20.0%)", "1 (5.0%)"),
  active_low = c("", "1 (5.0%)", "0", "", "5 (25.0%)", "3 (15.0%)", "2 (10.0%)"),
  active_high = c("", "3 (15.0%)", "2 (10.0%)", "", "7 (35.0%)", "5 (25.0%)", "3 (15.0%)"),
  total = c("", "6 (10.0%)", "3 (5.0%)", "", "18 (30.0%)", "12 (20.0%)", "6 (10.0%)"),
  stringsAsFactors = FALSE
)

ae_tbl

## ----ae-export----------------------------------------------------------------
title1 <- "Table 14.3.1 Overview of Adverse Events"
title2 <- "Safety Population"
footnote1 <- "Events are counted once per subject within each row."
progname <- "programs/t-ae-overview.R"

ae_paths <- gtsummary_reporter(
  gts_obj = ae_tbl,
  file_path = file.path(output_dir, "t-ae-overview.rtf"),
  column_labels = c(
    label = "System Organ Class / Preferred Term",
    placebo = "Placebo",
    active_low = "Active Low",
    active_high = "Active High",
    total = "Total"
  ),
  spanning_headers = data.frame(
    from = "placebo",
    to = "total",
    label = "Treatment Group"
  ),
  output_types = c("TXT", "HTML"),
  save_rds = FALSE
)

output_manifest(ae_paths)

## ----ae-txt-preview, echo = FALSE, comment = ""-------------------------------
ae_txt <- path_for_ext(ae_paths, "txt")
print_text_output(ae_txt)

## ----ae-html-preview, echo = FALSE, results = "asis"--------------------------
ae_html <- path_for_ext(ae_paths, "html")
embed_html_output(ae_html, height = 440)

## ----ae-width-auto------------------------------------------------------------
title1 <- "Table 14.3.1 Overview of Adverse Events"
title2 <- "Automatic column widths"
footnote1 <- "This version lets reporter estimate the width of each column."
progname <- "programs/t-ae-overview.R"

ae_auto_paths <- gtsummary_reporter(
  gts_obj = ae_tbl,
  file_path = file.path(output_dir, "t-ae-auto.rtf"),
  column_labels = c(
    label = "System Organ Class / Preferred Term",
    placebo = "Placebo",
    active_low = "Active Low",
    active_high = "Active High",
    total = "Total"
  ),
  spanning_headers = data.frame(
    from = "placebo",
    to = "total",
    label = "Treatment Group"
  ),
  output_types = "TXT",
  save_rds = FALSE
)

basename(ae_auto_paths)

## ----ae-width-auto-preview, echo = FALSE, comment = ""------------------------
print_text_output(path_for_ext(ae_auto_paths, "txt"))

## ----ae-width-narrow----------------------------------------------------------
title1 <- "Table 14.3.1 Overview of Adverse Events"
title2 <- "Narrow table width"
footnote1 <- "This version caps the total table width at 5.5 inches."
progname <- "programs/t-ae-overview.R"

ae_narrow_paths <- gtsummary_reporter(
  gts_obj = ae_tbl,
  file_path = file.path(output_dir, "t-ae-narrow.rtf"),
  column_labels = c(
    label = "System Organ Class / Preferred Term",
    placebo = "Placebo",
    active_low = "Active Low",
    active_high = "Active High",
    total = "Total"
  ),
  spanning_headers = data.frame(
    from = "placebo",
    to = "total",
    label = "Treatment Group"
  ),
  max_table_width = 5.5,
  output_types = "TXT",
  save_rds = FALSE
)

basename(ae_narrow_paths)

## ----ae-width-narrow-preview, echo = FALSE, comment = ""----------------------
print_text_output(path_for_ext(ae_narrow_paths, "txt"))

## ----ae-width-manual----------------------------------------------------------
title1 <- "Table 14.3.1 Overview of Adverse Events"
title2 <- "Manual column widths"
footnote1 <- "This version gives more room to the label column."
progname <- "programs/t-ae-overview.R"

ae_manual_paths <- gtsummary_reporter(
  gts_obj = ae_tbl,
  file_path = file.path(output_dir, "t-ae-manual.rtf"),
  column_labels = c(
    label = "System Organ Class / Preferred Term",
    placebo = "Placebo",
    active_low = "Active Low",
    active_high = "Active High",
    total = "Total"
  ),
  spanning_headers = data.frame(
    from = "placebo",
    to = "total",
    label = "Treatment Group"
  ),
  column_widths = "3.8|1.1|1.3|1.3|1.1",
  output_types = "TXT",
  save_rds = FALSE
)

basename(ae_manual_paths)

## ----ae-width-manual-preview, echo = FALSE, comment = ""----------------------
print_text_output(path_for_ext(ae_manual_paths, "txt"))

## ----ae-pagination-data-------------------------------------------------------
paged_ae_tbl <- rbind(
  ae_tbl,
  data.frame(
    label = c(
      "Skin and subcutaneous tissue disorders",
      "  Rash",
      "  Pruritus",
      "Respiratory, thoracic and mediastinal disorders",
      "  Cough",
      "  Oropharyngeal pain",
      "Gastrointestinal disorders",
      "  Diarrhea",
      "  Abdominal pain",
      "Investigations",
      "  Blood creatine phosphokinase increased"
    ),
    placebo = c(
      "", "2 (10.0%)", "1 (5.0%)", "", "3 (15.0%)", "1 (5.0%)",
      "", "2 (10.0%)", "1 (5.0%)", "", "1 (5.0%)"
    ),
    active_low = c(
      "", "3 (15.0%)", "1 (5.0%)", "", "2 (10.0%)", "2 (10.0%)",
      "", "4 (20.0%)", "2 (10.0%)", "", "2 (10.0%)"
    ),
    active_high = c(
      "", "4 (20.0%)", "2 (10.0%)", "", "5 (25.0%)", "2 (10.0%)",
      "", "5 (25.0%)", "3 (15.0%)", "", "4 (20.0%)"
    ),
    total = c(
      "", "9 (15.0%)", "4 (6.7%)", "", "10 (16.7%)", "5 (8.3%)",
      "", "11 (18.3%)", "6 (10.0%)", "", "7 (11.7%)"
    ),
    stringsAsFactors = FALSE
  )
)

nrow(paged_ae_tbl)

## ----ae-pagination-export-----------------------------------------------------
title1 <- "Table 14.3.2 Adverse Events by Body System"
title2 <- "Manual pagination"
footnote1 <- "This version starts a new report page after every seven data rows."
progname <- "programs/t-ae-paged.R"

paged_paths <- gtsummary_reporter(
  gts_obj = paged_ae_tbl,
  file_path = file.path(output_dir, "t-ae-paged.rtf"),
  column_labels = c(
    label = "System Organ Class / Preferred Term",
    placebo = "Placebo",
    active_low = "Active Low",
    active_high = "Active High",
    total = "Total"
  ),
  spanning_headers = data.frame(
    from = "placebo",
    to = "total",
    label = "Treatment Group"
  ),
  rows_per_page = 7,
  output_types = c("TXT", "HTML"),
  save_rds = FALSE
)

output_manifest(paged_paths)

## ----ae-pagination-txt-preview, echo = FALSE, comment = ""--------------------
print_text_output(path_for_ext(paged_paths, "txt"))

## ----ae-pagination-html-preview, echo = FALSE, results = "asis"---------------
paged_html <- path_for_ext(paged_paths, "html")
embed_html_output(paged_html, height = 520)

## ----layout-template, eval = FALSE--------------------------------------------
# gtsummary_reporter(
#   gts_obj = ae_tbl,
#   file_path = file.path(output_dir, "t-ae-final.rtf"),
#   column_labels = c(
#     label = "System Organ Class / Preferred Term",
#     placebo = "Placebo",
#     active_low = "Active Low",
#     active_high = "Active High",
#     total = "Total"
#   ),
#   spanning_headers = data.frame(
#     from = "placebo",
#     to = "total",
#     label = "Treatment Group"
#   ),
#   column_widths = "3.8|1.1|1.3|1.3|1.1",
#   max_chars_per_line = 132,
#   rows_per_page = 24,
#   output_types = c("RTF", "TXT", "HTML")
# )