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