## ----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 (see enrollment_diagrams vignette for details)
.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
})

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(...) |>
#   exclude(...) |>
#   stratify(labels, n, label) |>
#   exclude(...) |>
#   combine(label, sublabel) |>
#   exclude(...) |>
#   endpoint(label) |>
#   flowchart()

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

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

data(selectaex2)

## -----------------------------------------------------------------------------
example1 <- enroll(n = 160,
                         label = "High-risk participants") |>
    phase("Enrollment") |>
    exclude("Concurrent enrollment in another study", n = 2,
            included_label = "Total cohort") |>
    phase("Screening Status") |>
    stratify(
        labels = c("Unscreened", "Screened"),
        n = c(82, 76),
        label = "Annual screening status"
    ) |>
    exclude("Without confirmed outcome", n = c(44, 66)) |>
    combine("Outcome cohort",
            sublabel = "Participants with confirmed outcome") |>
    phase("Outcome Verification") |>
    exclude("Without available adjudication", n = 7) |>
    exclude("Without available imaging", n = 23) |>
    endpoint("Participants with available imaging")

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

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

## -----------------------------------------------------------------------------
example2 <- enroll(n = 5000, label = "Patients in registry") |>
    phase("Enrollment") |>
    exclude("Ineligible", n = 800,
            reasons = c("Age < 18" = 200,
                        "Prior diagnosis" = 350,
                        "Missing baseline data" = 250),
            included_label = "Eligible cohort") |>
    phase("Exposure Classification") |>
    stratify(
        labels = c("Statin users", "Non-users"),
        n = c(1800, 2400),
        label = "Classified by statin exposure"
    ) |>
    exclude("Lost to follow-up", n = c(120, 180),
            reasons = list(
                c("Moved" = 50, "Withdrew consent" = 30, "Deceased" = 20, "Inconsistent usage" = 20),
                c("Moved" = 80, "Withdrew consent" = 60, "Deceased" = 40)
            )) |>
    combine("Analysis cohort",
            sublabel = "Patients with complete follow-up") |>
    phase("Analysis") |>
    endpoint("Included in primary analysis")

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

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

## -----------------------------------------------------------------------------
example3 <- 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") |>
    stratify("treatment", label = "Treatment assignment") |>
    phase("Follow-up") |>
    exclude("Discontinued", criterion = discontinued == TRUE,
            reasons = "discontinuation_reason") |>
    combine("Completers") |>
    phase("Analysis") |>
    endpoint("Analysis cohort")

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

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

## -----------------------------------------------------------------------------
final <- cohort(example3)
dim(final)

## -----------------------------------------------------------------------------
stages <- cohorts(example3)
names(stages)

## -----------------------------------------------------------------------------
nrow(stages[["Completers"]]$included)

## -----------------------------------------------------------------------------
disc <- stages[["Discontinued"]]
vapply(disc$included, nrow, integer(1L))
vapply(disc$excluded, nrow, integer(1L))

## -----------------------------------------------------------------------------
example4 <- enroll(n = 2000, label = "Screened") |>
    phase("Screening") |>
    exclude("Ineligible", n = 400,
            reasons = c("No consent" = 180, "Prior treatment" = 120,
                        "ECOG >= 3" = 100)) |>
    phase("Risk Stratification") |>
    stratify(
        labels = c("High risk", "Low risk"),
        n = c(700, 900),
        label = "Risk classification"
    ) |>
    exclude("Declined participation", n = c(50, 80)) |>
    combine("Eligible cohort") |>
    phase("Allocation") |>
    allocate(labels = c("Intervention", "Control"),
             n = c(735, 735)) |>
    phase("Follow-up") |>
    exclude("Lost to follow-up", n = c(30, 35),
            reasons = list(
                c("Withdrew consent" = 18, "Relocated" = 12),
                c("Withdrew consent" = 20, "Relocated" = 15)
            )) |>
    phase("Analysis") |>
    endpoint("Analyzed")

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

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

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

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

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