## ----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.
.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)
}

## ---- DOT rendering helper (mirrors graphviz_export.Rmd) ----
## Pipes a DOT string through the system Graphviz binary into SVG, then
## post-processes the SVG to expand Graphviz's single-name font-family
## attribute (Helvetica or Times) to a cross-platform sans-serif chain
## (Helvetica on macOS, Arial on Windows, Liberation Sans / DejaVu Sans
## on Linux), inlining the result at full text-column width. Falls back
## to DiagrammeR::grViz() when the binary is unavailable.
.dot_available <- nzchar(Sys.which("dot"))
.sans_chain    <- "Helvetica, Arial, 'Liberation Sans', 'DejaVu Sans', sans-serif"

render_dot <- function(dot_str, width = "100%", fmt = c("svg", "png"),
                       dpi = 150, sans_serif = TRUE) {
  fmt <- match.arg(fmt)
  if (.dot_available) {
    out <- paste0(knitr::fig_path(paste0(".", fmt)))
    fig_dir <- dirname(out)
    if (!dir.exists(fig_dir)) dir.create(fig_dir, recursive = TRUE)
    dot_in <- tempfile(fileext = ".dot")
    writeLines(dot_str, dot_in)
    args <- c(paste0("-T", fmt))
    if (fmt == "png") args <- c(args, paste0("-Gdpi=", dpi))
    args <- c(args, shQuote(dot_in), "-o", shQuote(out))
    system2("dot", args, stdout = NULL, stderr = NULL)

    if (isTRUE(sans_serif) && fmt == "svg" && file.exists(out)) {
      svg_text <- paste(readLines(out, warn = FALSE), collapse = "\n")
      svg_text <- gsub('font-family="(Helvetica|Times)[^"]*"',
                       sprintf('font-family="%s"', .sans_chain),
                       svg_text, perl = TRUE)
      svg_text <- gsub("font-family='(Helvetica|Times)[^']*'",
                       sprintf("font-family=\"%s\"", .sans_chain),
                       svg_text, perl = TRUE)
      writeLines(svg_text, out)
    }

    knitr::include_graphics(out, dpi = NA)
  } else if (requireNamespace("DiagrammeR", quietly = TRUE)) {
    DiagrammeR::grViz(dot_str, width = width)
  } else {
    cat(dot_str)
  }
}

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

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

## ----eval = FALSE-------------------------------------------------------------
# enroll(n = 480) |>
#   allocate(labels = c("Drug A", "Drug B"), n = c(240, 240)) |>   # factor 1
#   allocate(labels = c("Vaccine", "Placebo"),                     # factor 2
#            n = c(120, 120,        # Drug A: Vaccine, Placebo
#                  120, 120)) |>    # Drug B: Vaccine, Placebo
#   endpoint("Analyzed")

## -----------------------------------------------------------------------------
example1 <- enroll(n = 480, label = "Randomized") |>
    phase("Allocation") |>
    allocate(labels = c("Drug A", "Drug B"), n = c(240, 240),
             label = "Antiviral assignment") |>
    allocate(labels = c("Vaccine", "Placebo"), n = c(120, 120, 120, 120)) |>
    phase("Follow-up") |>
    exclude("Discontinued", n = c(8, 6, 7, 9)) |>
    phase("Analysis") |>
    endpoint("Primary analysis")

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

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

## -----------------------------------------------------------------------------
example2 <- enroll(n = 900, label = "Randomized") |>
    phase("Allocation") |>
    allocate(labels = c("Low", "Medium", "High"), n = c(300, 300, 300),
             label = "Dose tier") |>
    allocate(labels = c("Schedule A", "Schedule B", "Schedule C"),
             n = rep(100L, 9L)) |>
    phase("Analysis") |>
    endpoint("Analyzed")

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

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

## -----------------------------------------------------------------------------
example3 <- enroll(n = 600, label = "Randomized") |>
    phase("Allocation") |>
    allocate(labels = c("Surgical", "Medical"), n = c(300, 300),
             label = "Primary strategy") |>
    allocate(labels = c("Low", "Standard", "Intensive"),
             n = c(100, 100, 100,      # Surgical
                   100, 100, 100)) |>  # Medical
    phase("Analysis") |>
    endpoint("Analyzed")

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

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

## -----------------------------------------------------------------------------
n_cell <- 200L
fac_data <- data.table(
    id           = sprintf("P%04d", seq_len(4L * n_cell)),
    antiviral    = rep(c("Drug A", "Drug B"), each = 2L * n_cell),
    adjuvant     = rep(rep(c("Vaccine", "Placebo"), each = n_cell), times = 2L),
    discontinued = rep(c(rep(TRUE, 8L), rep(FALSE, n_cell - 8L)), times = 4L)
)

example4 <- enroll(fac_data, id = "id", label = "Randomized") |>
    phase("Allocation") |>
    allocate("antiviral", label = "Antiviral assignment") |>
    allocate("adjuvant") |>
    phase("Follow-up") |>
    exclude("Discontinued", criterion = discontinued == TRUE) |>
    phase("Analysis") |>
    endpoint("Primary analysis")

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

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

## -----------------------------------------------------------------------------
example5 <- enroll(n = 360, label = "Randomized") |>
    phase("Allocation") |>
    allocate(labels = c("Concurrent", "Sequential"), n = c(180, 180),
             label = "Timing strategy") |>
    allocate(labels = c("Agent A", "Agent B"), n = c(90, 90, 90, 90)) |>
    phase("Pooling") |>
    combine("Pooled by timing") |>
    combine("Combined analysis cohort",
            sublabel = "Both timing strategies merged") |>
    phase("Analysis") |>
    endpoint("Analyzed")

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

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

## -----------------------------------------------------------------------------
example6 <- flowchart(example1, engine = "dot")

## ----echo = FALSE, out.width = "100%"-----------------------------------------
render_dot(example6)

## -----------------------------------------------------------------------------
example7 <- enroll(n = 1000, label = "Assessed for eligibility") |>
    phase("Screening") |>
    exclude("Excluded", n = 250,
            reasons = list(
                "Did not meet inclusion criteria" = c(
                    "Outside age range"    = 70,
                    "Comorbid condition"   = 55,
                    "Insufficient washout" = 25),
                "Declined to participate" = c(
                    "Time commitment" = 40,
                    "Travel burden"   = 20),
                "Administrative" = 40),
            included_label = "Enrolled") |>
    phase("Analysis") |>
    endpoint("Analysis cohort")

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

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

## -----------------------------------------------------------------------------
review_data <- data.table(
    record_id = sprintf("R%04d", seq_len(1000L)),
    excluded  = c(rep(TRUE, 220L), rep(FALSE, 780L)),
    reason    = c(rep("Ineligible study design", 130L),
                  rep("Insufficient reporting", 90L),
                  rep(NA_character_, 780L)),
    subreason = c(rep("Case report", 70L), rep("Narrative review", 60L),
                  rep("No usable outcome", 50L), rep("No variance estimate", 40L),
                  rep(NA_character_, 780L))
)

example8 <- enroll(review_data, id = "record_id",
                    label = "Records identified") |>
    phase("Screening") |>
    exclude("Records excluded", criterion = excluded == TRUE,
            reasons = c("reason", "subreason"),
            included_label = "Records retained") |>
    phase("Synthesis") |>
    endpoint("Studies in synthesis")

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

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

## -----------------------------------------------------------------------------
example9 <- flowchart(example7, engine = "dot")

## ----echo = FALSE, out.width = "100%"-----------------------------------------
render_dot(example9)

## -----------------------------------------------------------------------------
example10 <- enroll(n = 600, label = "Assessed for eligibility") |>
    phase("Enrollment") |>
    exclude("Excluded", n = 120,
            reasons = c("Did not meet criteria"   = 80,
                        "Declined to participate" = 40),
            included_label = "Randomized") |>
    phase("Allocation") |>
    allocate(labels = c("Intervention", "Control"), n = c(240, 240)) |>
    phase("Follow-up") |>
    exclude("Discontinued", n = c(18, 22)) |>
    phase("Analysis") |>
    endpoint("Analyzed")

## ----echo = FALSE-------------------------------------------------------------
queue_flow(example10, cex = 1.0, cex_side = 0.8, cex_phase = 1.0)

## ----use_rec_dims = TRUE, echo = TRUE-----------------------------------------
flowchart(example10, cex = 1.0, cex_side = 0.8, cex_phase = 1.0)

## ----echo = FALSE-------------------------------------------------------------
queue_flow(example10,
           box_fill       = "#f0f5ff",   # main flow boxes
           side_fill      = "#e8eef9",   # exclusion side boxes
           border_col     = "#1a365d",   # box borders (all)
           arrow_col      = "#2c5282",   # connector arrows
           phase_fill     = "#2c5282",   # vertical phase strips
           phase_text_col = "#ffffff")   # phase strip text

## ----use_rec_dims = TRUE, echo = TRUE-----------------------------------------
flowchart(example10,
          box_fill       = "#f0f5ff",
          side_fill      = "#e8eef9",
          border_col     = "#1a365d",
          arrow_col      = "#2c5282",
          phase_fill     = "#2c5282",
          phase_text_col = "#ffffff")

## ----echo = FALSE-------------------------------------------------------------
queue_flow(example10, font_family = "serif")

## ----use_rec_dims = TRUE, echo = TRUE-----------------------------------------
flowchart(example10, font_family = "serif")

## -----------------------------------------------------------------------------
example13 <- enroll(n = 25840, label = "Patients screened") |>
    phase("Screening") |>
    exclude("Did not meet eligibility criteria", n = 8420,
            reasons = c("Age outside range"     = 3210,
                        "Comorbidity exclusion" = 2840,
                        "Concurrent treatment"  = 2370),
            included_label = "Eligible") |>
    exclude("Declined to participate", n = 1820,
            included_label = "Consented") |>
    phase("Allocation") |>
    allocate(labels = c("Active", "Standard of care"),
             n = c(7800, 7800)) |>
    phase("Follow-up") |>
    exclude("Lost to follow-up", n = c(1240, 1310)) |>
    exclude("Discontinued intervention", n = c(250, 180)) |>
    phase("Analysis") |>
    endpoint("Analyzed")

## ----echo = FALSE-------------------------------------------------------------
queue_flow(example13, number_format = "eu")

## ----use_rec_dims = TRUE, echo = TRUE-----------------------------------------
flowchart(example13, number_format = "eu")

## ----eval = FALSE-------------------------------------------------------------
# options(selecta.number_format = "space")   # SI/ISO thin-space separators
# options(selecta.vpad = 0.35)               # looser vertical spacing (default 0.25)

## -----------------------------------------------------------------------------
example14 <- enroll(n = 1200, label = "Assessed for eligibility") |>
    phase("Enrollment and baseline assessment") |>
    exclude("Excluded", n = 300,
            reasons = c("Not meeting criteria" = 160,
                        "Declined to participate" = 90,
                        "Other reasons" = 50),
            included_label = "Eligible cohort") |>
    phase("Randomized allocation to study arms") |>
    allocate(labels = c("Drug A", "Placebo"), n = c(450, 450)) |>
    phase("Post-randomization follow-up") |>
    exclude("Lost to follow-up", n = c(20, 20)) |>
    phase("Intention-to-treat analysis") |>
    endpoint("Analyzed")

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

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

## -----------------------------------------------------------------------------
example15 <- enroll(n = 1200, label = "Assessed for eligibility") |>
    phase("Enrollment\nand\nbaseline assessment") |>
    exclude("Excluded", n = 300, included_label = "Eligible cohort") |>
    phase("Allocation") |>
    allocate(labels = c("Drug A", "Placebo"), n = c(450, 450)) |>
    phase("Analysis") |>
    endpoint("Analyzed")

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

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

