## ----include = FALSE----------------------------------------------------------
## Use ragg for better font rendering if available
if (requireNamespace("ragg", quietly = TRUE)) {
  knitr::opts_chunk$set(
    dev = "ragg_png",
    fig.retina = 1,
    collapse = TRUE,
    comment = "#>",
    message = FALSE,
    warning = FALSE,
    out.width = "100%",
    dpi = 150
  )
} else {
  knitr::opts_chunk$set(
    collapse = TRUE,
    comment = "#>",
    message = FALSE,
    warning = FALSE,
    out.width = "100%",
    dpi = 150
  )
}

## Dynamic figure sizing: queue_flow() stashes recommended dimensions from
## recdims(), and the opts_hook on the NEXT chunk (with use_rec_dims = TRUE)
## applies them before knitr opens the graphics device. Plots render via ragg
## (dev = "ragg_png" set above) and knitr captures them natively.
.flow_dims <- new.env(parent = emptyenv())
.flow_dims$width <- NULL
.flow_dims$height <- NULL

knitr::opts_hooks$set(use_rec_dims = function(options) {
  if (isTRUE(options$use_rec_dims)) {
    if (!is.null(.flow_dims$width))  options$fig.width  <- .flow_dims$width
    if (!is.null(.flow_dims$height)) options$fig.height <- .flow_dims$height
    .flow_dims$width <- NULL
    .flow_dims$height <- NULL
  }
  options
})

## Call at the end of a flow-creation chunk to stash dimensions for the next chunk.
queue_flow <- function(flow, ...) {
  ## Measure on the same device family that renders the figures (ragg, set
  ## via dev = "ragg_png" above) so that non-default fonts---whose metrics
  ## differ between devices---are sized consistently and the canvas is not
  ## cropped. Falls back to recdims()'s default pdf measurement otherwise.
  md <- if (requireNamespace("ragg", quietly = TRUE)) {
    function() {
      tf <- tempfile(fileext = ".png")
      ragg::agg_png(tf, width = 10, height = 10, units = "in", res = 150)
      tf
    }
  } else NULL
  dims <- selecta::recdims(flow, ..., .measure_dev = md)
  .flow_dims$width  <- dims["width"]
  .flow_dims$height <- dims["height"]
  invisible(flow)
}

## ----eval = FALSE-------------------------------------------------------------
# enroll(data, id) |>
#   phase("Enrollment") |>
#   exclude(label, criterion, reasons) |>
#   phase("Allocation") |>
#   allocate(column) |>
#   endpoint(label) |>
#   flowchart()

## ----eval = FALSE-------------------------------------------------------------
# flowsave(flow, "consort.pdf")
# flowsave(flow, "consort.png", dpi = 300)

## ----setup--------------------------------------------------------------------
library(selecta)
library(data.table)

data(selectaex0)
data(selectaex2)
data(selectaex3)
data(selectaex6)

## -----------------------------------------------------------------------------
example1 <- enroll(selectaex2, id = "patient_id") |>
    phase("Screening") |>
    exclude("Duplicate records", criterion = is_duplicate == TRUE,
            included_label = "Unique records") |>
    exclude("Failed eligibility", criterion = eligible == FALSE,
            reasons = "exclusion_reason",
            included_label = "Eligible cohort") |>
    phase("Allocation") |>
    allocate("treatment") |>
    phase("Follow-up") |>
    exclude("Discontinued", criterion = discontinued == TRUE,
            reasons = "discontinuation_reason") |>
    phase("Analysis") |>
    endpoint("Analysis cohort")

## ----echo = FALSE-------------------------------------------------------------
queue_flow(example1)

## ----use_rec_dims = TRUE, echo = TRUE-----------------------------------------
flowchart(example1)

## -----------------------------------------------------------------------------
example2 <- enroll(selectaex3, id = "patient_id") |>
    phase("Screening") |>
    exclude("Duplicate records", criterion = is_duplicate == TRUE,
            included_label = "Unique records") |>
    exclude("Failed eligibility", criterion = eligible == FALSE,
            reasons = "exclusion_reason",
            included_label = "Eligible cohort") |>
    phase("Allocation") |>
    allocate("treatment") |>
    phase("Follow-up") |>
    exclude("Discontinued", criterion = discontinued == TRUE,
            reasons = "discontinuation_reason") |>
    phase("Analysis") |>
    endpoint("Analysis cohort")

## ----echo = FALSE-------------------------------------------------------------
queue_flow(example2)

## ----use_rec_dims = TRUE, echo = TRUE-----------------------------------------
flowchart(example2)

## -----------------------------------------------------------------------------
example3 <- enroll(n = 1200, label = "Assessed for eligibility") |>
    phase("Enrollment") |>
    exclude("Excluded", n = 300,
            reasons = c("Not meeting criteria" = 160,
                        "Declined to participate" = 90,
                        "Other reasons" = 50),
            included_label = "Eligible cohort") |>
    phase("Allocation") |>
    allocate(labels = c("Drug A", "Placebo"), n = c(450, 450)) |>
    phase("Follow-up") |>
    exclude("Lost to follow-up", n = c(20, 20)) |>
    exclude("Discontinued intervention", n = c(15, 15)) |>
    phase("Analysis") |>
    endpoint("Analyzed")


## ----echo = FALSE-------------------------------------------------------------
queue_flow(example3)

## ----use_rec_dims = TRUE, echo = TRUE-----------------------------------------
flowchart(example3)

## ----echo = FALSE-------------------------------------------------------------
queue_flow(example3, count_first = TRUE)

## ----use_rec_dims = TRUE, echo = TRUE-----------------------------------------
flowchart(example3, count_first = TRUE)

## -----------------------------------------------------------------------------
example5 <- enroll(selectaex0, id = "patient_id") |>
    phase("Enrollment") |>
    exclude("Ineligible", criterion = eligible == FALSE,
            reasons = "exclusion_reason",
            included_label = "Eligible cohort") |>
    phase("Follow-up") |>
    exclude("Lost to follow-up", criterion = lost_to_followup == TRUE,
            reasons = "followup_loss_reason") |>
    phase("Analysis") |>
    endpoint("Analysis cohort")

## ----echo = FALSE-------------------------------------------------------------
queue_flow(example5)

## ----use_rec_dims = TRUE, echo = TRUE-----------------------------------------
flowchart(example5)

## -----------------------------------------------------------------------------
example6 <- enroll(n = 3860, label = "Registry patients") |>
    phase("Enrollment") |>
    exclude("Excluded", n = 420,
            reasons = c("Missing exposure data" = 210,
                        "Prior treatment" = 130,
                        "Withdrew consent" = 80),
            included_label = "Eligible cohort") |>
    phase("Stratification") |>
    stratify(labels = c("Low exposure", "Medium exposure", "High exposure"),
             n = c(1200, 1300, 940),
             label = "Exposure level") |>
    phase("Follow-up") |>
    exclude("Lost to follow-up", n = c(60, 75, 45)) |>
    exclude("Discontinued intervention", n = c(20, 15, 30)) |>
    phase("Analysis") |>
    endpoint("Analysis cohort")

## ----echo = FALSE-------------------------------------------------------------
queue_flow(example6)

## ----use_rec_dims = TRUE, echo = TRUE-----------------------------------------
flowchart(example6)

## -----------------------------------------------------------------------------
example7 <- enroll(n = 500, label = "Potentially eligible patients") |>
    phase("Enrollment") |>
    exclude("Excluded", n = 40,
            reasons = c("Refused" = 25,
                        "Not meeting criteria" = 15)) |>
    phase("Index") |>
    assess("Index test", not_received = 22,
           reasons = c("Refused" = 12,
                       "Contraindicated" = 10)) |>
    phase("Reference") |>
    assess("Reference standard", not_received = 18,
           reasons = c("Lost to follow-up" = 10,
                       "Inconclusive" = 8)) |>
    phase("Results") |>
    stratify(labels = c("Index test positive", "Index test negative"),
             n = c(180, 240),
             label = "Index test result") |>
    endpoint("Final diagnosis",
             breakdown = list(
                 c("Target condition +" = 160, "Target condition -" = 20),
                 c("Target condition +" = 15, "Target condition -" = 225)
             ))

## ----echo = FALSE-------------------------------------------------------------
queue_flow(example7)

## ----use_rec_dims = TRUE, echo = TRUE-----------------------------------------
flowchart(example7)

## -----------------------------------------------------------------------------
final_data <- cohort(example1)
dim(final_data)

## -----------------------------------------------------------------------------
arm_data <- cohort(example1, split = TRUE)
vapply(arm_data, nrow, integer(1L))

## -----------------------------------------------------------------------------
snapshots <- cohorts(example1)
names(snapshots)

## -----------------------------------------------------------------------------
snapshots[["Failed eligibility"]]$n_included
snapshots[["Failed eligibility"]]$n_excluded

## -----------------------------------------------------------------------------
print(example1)

## -----------------------------------------------------------------------------
summary(example1)

## -----------------------------------------------------------------------------
recdims(example1)

## ----eval = FALSE-------------------------------------------------------------
# flowsave(example1, "consort_2arm.pdf")
# flowsave(example1, "consort_2arm.png", dpi = 300)

## ----eval = FALSE-------------------------------------------------------------
# flowsave(example1, "consort_2arm.pdf", width = 10, height = 12)

## ----eval = FALSE-------------------------------------------------------------
# flowsave(example1, "consort_2arm_cf.pdf",
#          count_first = TRUE, cex = 1.0, cex_side = 0.8)