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

## DOT rendering helper
.dot_available <- nzchar(Sys.which("dot"))

## CSS font-family chain ordered for cross-platform Helvetica-likeness:
## Helvetica resolves on macOS and Adobe-installed environments; Arial
## is Microsoft's metric-equivalent of Helvetica and resolves on Windows;
## Liberation Sans and DejaVu Sans cover Linux distributions; sans-serif
## is the universal CSS generic family that browsers always resolve.
.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)

    ## Post-process SVG
    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)
  }
}

## ----setup--------------------------------------------------------------------
library(selecta)

## ----eval = FALSE-------------------------------------------------------------
# library(DiagrammeR)

## -----------------------------------------------------------------------------
example1 <- enroll(n = 500) |>
    phase("Enrollment") |>
    exclude("Ineligible", n = 65,
            reasons = c("Age < 18" = 30, "No consent" = 35),
            included_label = "Eligible") |>
    phase("Analysis") |>
    endpoint("Final cohort")

dot_str <- flowchart(example1, engine = "dot")
dot_str

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

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

dot_2arm <- flowchart(example2, engine = "dot")
cat(dot_2arm)

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

## -----------------------------------------------------------------------------
example3 <- sources(
    previous  = c("Previous review" = 12, "Previous reports" = 15),
    databases = c("PubMed" = 1234, "Embase" = 567, "CENTRAL" = 89),
    other     = c("Citation search" = 55, "Websites" = 34),
    headers   = c(previous  = "Previous studies",
                  databases = "Databases and registers",
                  other     = "Other methods")
) |>
    combine("Records identified", n = 2006) |>
    exclude("Duplicates removed", n = 352,
            included_label = "Records screened") |>
    exclude("Records excluded", n = 1100) |>
    endpoint("Studies included in review")

dot_prisma <- flowchart(example3, engine = "dot")
cat(dot_prisma)

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

## -----------------------------------------------------------------------------
dot_palette <- flowchart(example3, engine = "dot",
                         box_fill           = "#fffbe6",  # warm cream
                         side_fill          = "#ffe0e0",  # light pink
                         source_fill        = "#fff5cc",  # pale yellow
                         source_header_fill = "#1f5b3a",  # dark green
                         source_header_text = "#ffffff",  # white text
                         border_col         = "#5a3a1a",  # warm brown
                         arrow_col          = "#5a3a1a")

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

## -----------------------------------------------------------------------------
dot_cf <- flowchart(example1, engine = "dot", count_first = TRUE)

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

## -----------------------------------------------------------------------------
dot_rich <- flowchart(example1, engine = "dot", formatting = "rich")

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

## -----------------------------------------------------------------------------
dot_times <- flowchart(example1, engine = "dot",
                       font_family = "Times-Roman")

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

## -----------------------------------------------------------------------------
dot_lr <- gsub("rankdir=TB", "rankdir=LR", dot_str)

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

## -----------------------------------------------------------------------------
dot_via_plot <- plot(example1, engine = "dot")
identical(dot_via_plot, dot_str)

## ----eval = FALSE-------------------------------------------------------------
# # SVG with cross-platform sans-serif rendering (default)
# flowsave(example1, "consort.svg", engine = "dot")
# 
# # PDF output (Helvetica baked into the file at render time)
# flowsave(example1, "consort.pdf", engine = "dot")
# 
# # PNG output at a requested DPI
# flowsave(example1, "consort.png", engine = "dot", dpi = 300)
# 
# # Raw DOT source for downstream editing or external tools
# flowsave(example1, "consort.dot", engine = "dot")

## ----eval = FALSE-------------------------------------------------------------
# flowsave(example1, "consort.svg", engine = "dot",
#          font_family = "Times-Roman", sans_serif = FALSE)

## ----eval = FALSE-------------------------------------------------------------
# library(DiagrammeR)
# 
# grViz(dot_str)

## ----eval = FALSE-------------------------------------------------------------
# widget <- DiagrammeR::grViz(dot_str)
# htmlwidgets::saveWidget(widget, "consort_diagram.html", selfcontained = TRUE)

## ----eval = FALSE-------------------------------------------------------------
# tmp <- tempfile(fileext = ".html")
# htmlwidgets::saveWidget(DiagrammeR::grViz(dot_str), tmp, selfcontained = TRUE)
# webshot2::webshot(tmp, file = "consort_diagram.png",
#                   vwidth = 800, vheight = 1000, delay = 0.5)