## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(echo = TRUE)

library(Gmisc, quietly = TRUE)
library(glue)
library(htmlTable)
library(grid)

## ----flowchart-example, fig.height = 7, fig.width = 8-------------------------
# Shared styling
main_box_gp <- gpar(fill = "#ddeeff", col = "#336699", lwd = 1.5)
group_box_gp <- gpar(fill = "#e8f4e8", col = "#2e7d32", lwd = 1.5)
excl_box_gp  <- gpar(fill = "#fff8e1", col = "#cc8800", lwd = 1.2)
main_con_gp  <- gpar(col = "#336699", lwd = 1.5, fill = "#336699")
excl_con_gp  <- gpar(col = "#cc8800", lwd = 1.2, fill = "#cc8800")

grid.newpage()
flowchart(
  source = boxGrob(glue("Stockholm population\nn = {pop}", pop = txtInt(1632798)),
                   box_gp = main_box_gp),
  eligible = boxGrob(glue("Eligible\nn = {pop}", pop = txtInt(10032)),
                     box_gp = main_box_gp),
  included = boxGrob(glue("Randomized\nn = {incl}", incl = txtInt(122)),
                     box_gp = main_box_gp),
  groups = list(
    boxGrob(glue("Treatment A\nn = {n}", n = txtInt(43)),        box_gp = group_box_gp),
    boxGrob(glue("Treatment B\nn = {n}", n = txtInt(122-43-30)), box_gp = group_box_gp)
  )) |>
  spread(axis = "y") |>
  spread(subelement = "groups", axis = "x") |>
  equalizeWidths(subelement = list("source", "eligible", "included")) |>
  equalizeWidths(subelement = "groups") |>
  insert(list(excluded = boxHeaderGrob(
                header = glue("Excluded (n = {tot}):", tot = 30),
                body   = glue(" - not interested: {n1}\n - contra-indicated: {n2}",
                              n1 = 12, n2 = 18),
                bjust      = "left",
                box_gp     = excl_box_gp,
                header_gp  = gpar(col = "#cc8800", cex = 1))),
         after = "eligible",
         name  = "excluded") |>
  move(subelement = "excluded", x = .8) |>
  connect("eligible", "excluded", type = "L",    lty_gp = excl_con_gp, arrow_size = 3,
          label = "Excluded") |>
  connect("source",   "eligible", type = "vert", lty_gp = main_con_gp, arrow_size = 3,
          smooth = TRUE) |>
  connect("eligible", "included", type = "vert", lty_gp = main_con_gp, arrow_size = 3,
          smooth = TRUE) |>
  connect("included", "groups",   type = "N",    lty_gp = main_con_gp, arrow_size = 3,
          smooth = TRUE)

## ----consort-stage-headings, fig.height = 7, fig.width = 8--------------------
old_opts <- options(boxGrobTxtPadding = unit(2, "mm"))

main_box_gp <- gpar(fill = "white", col = "black", lwd = 1)
heading_gp  <- gpar(fill = "#c8daf7", col = "#2f5f9f", lwd = 1)
con_gp      <- gpar(col = "#4f86c6", fill = "#4f86c6", lwd = 1.8)
side_width  <- unit(70, "mm")

flowchart(
  rando = boxGrob("Randomised\nN = 100", box_gp = main_box_gp),
  groups = list(
    boxGrob("Allocated to intervention\nn = 50",
            width = side_width, box_gp = main_box_gp),
    boxGrob("Allocated to control\nn = 50",
            width = side_width, box_gp = main_box_gp)
  ),
  followup = list(
    boxGrob("Lost to follow-up\nn = 1",
            width = side_width, box_gp = main_box_gp),
    boxGrob("Lost to follow-up\nn = 2",
            width = side_width, box_gp = main_box_gp)
  ),
  analysis = list(
    boxGrob("Analysed\nn = 49",
            width = side_width, box_gp = main_box_gp),
    boxGrob("Analysed\nn = 48",
            width = side_width, box_gp = main_box_gp)
  )
) |>
  spread(axis = "y", margin = unit(0.04, "npc")) |>
  # Spread each stage's arms within the viewport, leaving an outer margin —
  # this gives the two arms a clear central gap for the labels to sit in
  spread(subelement = "groups",   axis = "x", margin = unit(0.05, "npc")) |>
  spread(subelement = "followup", axis = "x", margin = unit(0.05, "npc")) |>
  spread(subelement = "analysis", axis = "x", margin = unit(0.05, "npc")) |>
  # One call per stage: centred between the arms, slightly above, drawn on top
  phaseLabel("groups",   "Allocation", box_gp = heading_gp) |>
  phaseLabel("followup", "Follow-up",  box_gp = heading_gp) |>
  phaseLabel("analysis", "Analysis",   box_gp = heading_gp) |>
  connect("rando",    "groups",   type = "N", lty_gp = con_gp, arrow_size = 3,
          smooth = TRUE) |>
  connect("groups",   "followup", type = "v", lty_gp = con_gp, arrow_size = 3) |>
  connect("followup", "analysis", type = "v", lty_gp = con_gp, arrow_size = 3)

options(old_opts)

## ----consort_example, fig.width = 9, fig.height = 6---------------------------
old_opts <- options(boxGrobTxtPadding = unit(3, "mm"))

box_fill     <- gpar(fill = "#ddeeff", col = "#336699", lwd = 1.5)
con_gp       <- gpar(col = "#336699", lwd = 1.5, fill = "#336699")
side_gp      <- gpar(col = "#cc8800", lwd = 1.2, fill = "#cc8800")
excl_fill    <- gpar(fill = "#fff8e1", col = "#cc8800", lwd = 1.2)
badge_gp     <- gpar(fill = "#336699", col = NA)
badge_txt_gp <- gpar(col = "white", cex = 0.65)

# Main arms use an inner horizontal span; exclusions use the outer span.
main_arm_margin  <- 0.28
exclusion_margin <- 0.05
main_x           <- 0.5
exclusion_to     <- 1 - exclusion_margin

grid.newpage()
flowchart(
  assessed = boxGrob(
    "Patients assessed for eligibility",
    x = main_x, box_gp = box_fill,
    badge_label = "840", badge_gp = badge_gp, badge_txt_gp = badge_txt_gp
  ),
  randomised = boxGrob(
    "Randomised",
    x = main_x, box_gp = box_fill,
    badge_label = "126", badge_gp = badge_gp, badge_txt_gp = badge_txt_gp
  ),
  arms = list(
    cast     = boxGrob("Randomised to\ncast immobilisation",
                       box_gp = box_fill,
                       badge_label = "62",
                       badge_gp = badge_gp, badge_txt_gp = badge_txt_gp),
    surgical = boxGrob("Randomised to\nsurgery",
                       box_gp = box_fill,
                       badge_label = "64",
                       badge_gp = badge_gp, badge_txt_gp = badge_txt_gp)
  ),
  # Lost-to-follow-up: one per arm, placed on the outer exclusion span
  # and centred vertically between allocation and analysis.
  lost = list(
    lost_cast     = boxGrob("Lost to follow-up (n = 2)\n  1 No response\n  1 Other surgery",
                            just = "left", box_gp = excl_fill),
    lost_surgical = boxGrob("Lost to follow-up (n = 3)\n  2 No response\n  1 Other surgery",
                            just = "left", box_gp = excl_fill)
  ),
  analysis = list(
    analysis_cast     = boxGrob("Included in\nprimary analysis",
                                box_gp = box_fill,
                                badge_label = "60",
                                badge_gp = badge_gp, badge_txt_gp = badge_txt_gp),
    analysis_surgical = boxGrob("Included in\nprimary analysis",
                                box_gp = box_fill,
                                badge_label = "61",
                                badge_gp = badge_gp, badge_txt_gp = badge_txt_gp)
  )
) |>
  # Vertical spacing — lost boxes are side branches, not main pathway rows
  spread(axis = "y", margin = unit(5, "mm"), exclude = "lost") |>
  align(axis = "y", subelement = "lost",
        references = list("arms", "analysis")) |>
  # Make arms and analysis boxes the same width so the same from/to spread
  # places their centres at matching x positions (otherwise the wider arm text
  # shifts centres relative to the narrower analysis text).
  # Alternative: skip equalizeWidths() and explicitly align x-centres,
  # e.g. with `align(axis = "x", reference = "analysis", subelement = "arms")`
  # (equivalent to `alignHorizontal(reference = "analysis", subelement = "arms")`).
  equalizeWidths(subelement = list("arms", "analysis")) |>
  # Arms and analysis in the inner span; lost boxes use the outer span
  # so that lost_cast lands left of cast and lost_surgical right of surgical
  spread(axis = "x", subelement = "arms",     margin = main_arm_margin) |>
  spread(axis = "x", subelement = "analysis", margin = main_arm_margin) |>
  spread(axis = "x", subelement = "lost",     margin = exclusion_margin) |>
  # Exclusion box: right edge on the outer span, vertically centred between rows
  insert(list(excluded = boxGrob(
    "Excluded (n = 714)\n  477 Stable ankle mortise\n   64 Incongruent ankle mortise\n   30 Previous serious trauma\n  143 Other reasons",
    just = "left", box_gp = excl_fill
  )), after = "assessed") |>
  move(subelement = "excluded", x = exclusion_to, just = "right") |>
  align(axis = "y", subelement = "excluded",
        references = list("assessed", "randomised"))  |>
  # type = "L": exits assessed's *bottom* then turns right — the "down then right" branch
  connect("assessed", "excluded", type = "L", lty_gp = side_gp, arrow_size = 3, smooth = TRUE) |>
  # Pairwise arm -> lost: sharp corners (smooth = FALSE) avoid a colour-transition
  # artefact where the orange arc would diverge from the shared blue vertical path
  # a few mm above the junction, making the line appear doubled.
  connect("arms", "lost", type = "L", lty_gp = side_gp, arrow_size = 3, smooth = TRUE) |>
  # Main-flow connectors, put last so that the main lines end up on top of the exclusion/lost lines
  connect("assessed",   "randomised", type = "v", lty_gp = con_gp,  arrow_size = 3, smooth = TRUE) |>
  connect("randomised", "arms",       type = "N", lty_gp = con_gp,  arrow_size = 3, smooth = TRUE) |>
  connect("arms",       "analysis",   type = "v", lty_gp = con_gp,  arrow_size = 3)

options(old_opts)

## ----consort_dotted_return_arrows, fig.width = 10, fig.height = 9-------------
old_opts <- options(boxGrobTxtPadding = unit(1, "mm"))

main_gp <- gpar(fill = "white", col = "black")
main_con_gp <- gpar(col = "black", fill = "black")
dotted_gp <- gpar(col = "black", fill = "black", lty = 2)
arm_from <- .05
arm_to <- .75
box_width <- unit(56, "mm")
ex_width <- unit(36, "mm")
ex_gap <- unit(5, "mm")
ex_offset <- box_width / 2 + ex_width / 2 + ex_gap

grid.newpage()
flowchart(
  rando = boxGrob("Randomised\nN = 197", box_gp = main_gp),
  groups = list(
    boxGrob("96 assigned to\ndecompressive craniectomy\nplus best medical treatment\n95 received allocated\nintervention",
            box_gp = main_gp),
    boxGrob("101 assigned to best medical\ntreatment alone\n93 received allocated\nintervention",
            box_gp = main_gp)
  ),
  ex1 = list(
    boxGrob("8 died\n1 withdrew\nconsent", just = "left", box_gp = main_gp),
    boxGrob("18 died\n1 withdrew\nconsent", just = "left", box_gp = main_gp)
  ),
  groups1 = list(
    boxGrob("87 completed day 30\nfollow-up", box_gp = main_gp),
    boxGrob("79 completed day 30\nfollow-up", box_gp = main_gp)
  ),
  ex2 = list(
    boxGrob("8 died", just = "left", box_gp = main_gp),
    boxGrob("9 died\n1 withdrew\nconsent\n2 lost to follow-up",
            just = "left", box_gp = main_gp)
  ),
  groups2 = list(
    boxGrob("79 completed day 180\nfollow-up", box_gp = main_gp),
    boxGrob("68 completed day 180\nfollow-up", box_gp = main_gp)
  ),
  ex3 = list(
    boxGrob("5 died\n2 lost to\nfollow-up", just = "left", box_gp = main_gp),
    boxGrob("3 died\n2 withdrew\nconsent\n6 lost to follow-up",
            just = "left", box_gp = main_gp)
  ),
  groups3 = list(
    boxGrob("95 included in the primary\noutcome analysis\n1 withdrew consent",
            box_gp = main_gp),
    boxGrob("95 included in the primary\noutcome analysis\n2 withdrew consent\n2 lost to follow-up",
            box_gp = main_gp)
  )
) |>
  spread(axis = "y", margin = unit(0.02, "npc")) |>
  equalizeWidths(subelement = stringr::regex("^groups"), width = box_width) |>
  equalizeHeights(subelement = stringr::regex("^groups")) |>
  equalizeWidths(subelement = stringr::regex("^ex"), width = ex_width) |>
  spread(subelement = stringr::regex("^groups"), axis = "x", from = arm_from, to = arm_to,
         type = "center") |>
  move(subelement = "rando",
       x = position("groups", position = "center", type = "x")) |>
  move(subelement = list(c("ex1", 1), c("ex2", 1), c("ex3", 1)),
       x = position(c("groups", 1), position = "center", type = "x") + ex_offset) |>
  move(subelement = list(c("ex1", 2), c("ex2", 2), c("ex3", 2)),
       x = position(c("groups", 2), position = "center", type = "x") + ex_offset) |>
  connect("rando", "groups", type = "N", lty_gp = main_con_gp, arrow_size = 3) |>
  connect("groups", "groups1", type = "vertical", lty_gp = main_con_gp, arrow_size = 3) |>
  connect("groups1", "groups2", type = "vertical", lty_gp = main_con_gp, arrow_size = 3) |>
  connect("groups2", "groups3", type = "vertical", lty_gp = main_con_gp, arrow_size = 3) |>
  connect("groups", "ex1", type = "L", lty_gp = main_con_gp, arrow_size = 3) |>
  connect("groups1", "ex2", type = "L", lty_gp = main_con_gp, arrow_size = 3) |>
  connect("groups2", "ex3", type = "L", lty_gp = main_con_gp, arrow_size = 3) |>
  connect(stringr::regex("^ex"), "groups3", type = "side",
          lty_gp = dotted_gp, arrow_size = 3,
          side = "right",
          end_side = "right",
          side_route = "outside",
          side_offset = ex_gap)

options(old_opts)

## ----flowchart-group-width-and-padding, fig.height = 5.5, fig.width = 8-------
old_opts <- options(boxGrobTxtPadding = unit(2, "mm"))

flowchart(
  rando = glue("Randomised\nN = 100"),
  groups = list(
    glue("Group 1\nn = 50"),
    glue("Group 2\nn = 50")
  ),
  groups2 = list(
    glue("Analysed\nn = 49"),
    glue("Analysed\nn = 48")
  )
) |>
  spread(axis = "y", margin = unit(0.02, "npc")) |>
  spread(subelement = "groups", axis = "x", margin = unit(.05, "npc")) |>
  spread(subelement = "groups2", axis = "x", margin = unit(.05, "npc")) |>
  equalizeWidths(subelement = list("groups", "groups2")) |>
  connect("rando", "groups", type = "N") |>
  connect("groups", "groups2", type = "vertical")

options(old_opts)

## ----axis_preserving_connectors, fig.width = 10, fig.height = 7---------------
input_gp     <- gpar(fill = "#F3F8FF", col = "#3B73C5", lwd = 1.3)
process_gp   <- gpar(fill = "#FFF4C7", col = "#C69214", lwd = 1.3)
issue_gp     <- gpar(fill = "#FCE4EC", col = "#AD1457", lwd = 1.2)
output_gp    <- gpar(fill = "#E8F5E9", col = "#2E7D32", lwd = 1.3)
con_gp       <- gpar(col = "#555555", fill = "#555555", lwd = 1.3)
issue_con_gp <- gpar(col = "#AD1457", fill = "#AD1457", lwd = 1.1)
main_path    <- list("validation", "clean")

grid.newpage()
flowchart(
  inputs = list(
    web    = boxEllipseGrob("REDCap\nform",   width = unit(42, "mm"), height = unit(24, "mm"), box_gp = input_gp),
    import = boxDatabaseGrob("CSV\nimport",    width = unit(42, "mm"), height = unit(24, "mm"), box_gp = input_gp),
    manual = boxDocumentGrob("Manual\nentry",  width = unit(42, "mm"), height = unit(24, "mm"), box_gp = input_gp)
  ),
  validation = boxTapeGrob(
    "Validation queue\nIDs, dates, ranges, missingness",
    width = unit(.58, "npc"), height = unit(.14, "npc"), box_gp = process_gp
  ),
  issues = list(
    missing   = boxDiamondGrob("Missing\nfields", width = unit(48, "mm"), height = unit(14, "mm"), box_gp = issue_gp),
    duplicate = boxDiamondGrob("Duplicate\nID",   width = unit(48, "mm"), height = unit(14, "mm"), box_gp = issue_gp),
    outlier   = boxDiamondGrob("Outlier\nvalue",  width = unit(48, "mm"), height = unit(14, "mm"), box_gp = issue_gp)
  ),
  log = boxDocumentsGrob(
    "Issue log\nqueries sent\nchanges reviewed",
    width = unit(48, "mm"), height = unit(.44, "npc"), box_gp = issue_gp
  ),
  clean = boxDatabaseGrob(
    "Analysis-ready dataset\nlocked for report",
    width = unit(.44, "npc"), height = unit(.16, "npc"), box_gp = output_gp
  )
) |>
  # Main vertical flow (inputs -> validation -> clean); issues are a side column
  spread(axis = "y", margin = unit(7, "mm"), exclude = "issues") |>
  spread(axis = "x", subelement = "inputs", from = 0, to = 0.7, margin = 0.05, type = "center") |>
  equalizeWidths(subelement = main_path) |>
  align(axis = "x", subelement = "validation", reference = "inputs") |>
  align(axis = "x", subelement = "clean", reference = "validation") |>
  # Place the issue log beside the main flow and stack the diamonds along it
  align(axis = "y", subelement = "log", references = list("validation", "clean")) |>
  spread(axis = "y", subelement = "issues",
         from = position("log", position = "top", type = "y"),
         to   = position("log", position = "bottom", type = "y"),
         margin = unit(2, "mm")) |>
  move(subelement = "issues", x = 0.08, just = "left") |>
  move(subelement = "log",    x = 0.92, just = "right") |>
  connect("inputs", "validation", type = "vertical_axis",   lty_gp = con_gp,       arrow_size = 3) |>
  connect("issues", "log",        type = "horizontal_axis", lty_gp = issue_con_gp, arrow_size = 3) |>
  connect("validation", "clean",  type = "vertical_axis",   lty_gp = con_gp,       arrow_size = 3, smooth = TRUE) |>
  print()

## ----basic_box, fig.height = 1.5, fig.width = 3, message = FALSE--------------
grid.newpage()
txt <-
"Just a plain box
with some text
- Note that newline is OK"
boxGrob(txt)

## ----styled_box, fig.height = 3, fig.width = 3--------------------------------
grid.newpage()
boxGrob("A large\noffset\nyellow\nbox",
        width = .8, height = .8,
        x = 0, y = 0,
        bjust = c("left", "bottom"),
        txt_gp = gpar(col = "darkblue", cex = 2),
        box_gp = gpar(fill = "lightyellow", col = "darkblue"))

## ----prop_box, fig.height = 2, fig.width = 4----------------------------------
grid.newpage()
boxPropGrob("A box with proportions",
            "Left side", "Right side",
            prop = .7)

## ----box_coordinates, fig.height = 3, fig.width = 4---------------------------
grid.newpage()
smpl_bx <- boxGrob(
  label = "A simple box",
  x = .5,
  y = .9,
  just = "center")

prop_bx <- boxPropGrob(
  label = "A split box",
  label_left = "Left side",
  label_right = "Right side",
  x = .5,
  y = .3,
  prop = .3,
  just = "center")

plot(smpl_bx)
plot(prop_bx)

smpl_bx_coords <- coords(smpl_bx)
grid.circle(y = smpl_bx_coords$y,
            x = smpl_bx_coords$x,
            r = unit(2, "mm"),
            gp = gpar(fill = "#FFFFFF99", col = "black"))
grid.circle(y = smpl_bx_coords$bottom,
            x = smpl_bx_coords$right,
            r = unit(1, "mm"),
            gp = gpar(fill = "red"))
grid.circle(y = smpl_bx_coords$top,
            x = smpl_bx_coords$right,
            r = unit(1, "mm"),
            gp = gpar(fill = "purple"))
grid.circle(y = smpl_bx_coords$bottom,
            x = smpl_bx_coords$left,
            r = unit(1, "mm"),
            gp = gpar(fill = "blue"))
grid.circle(y = smpl_bx_coords$top,
            x = smpl_bx_coords$left,
            r = unit(1, "mm"),
            gp = gpar(fill = "orange"))

prop_bx_coords <- coords(prop_bx)
grid.circle(y = prop_bx_coords$y,
            x = prop_bx_coords$x,
            r = unit(2, "mm"),
            gp = gpar(fill = "#FFFFFF99", col = "black"))
grid.circle(y = prop_bx_coords$bottom,
            x = prop_bx_coords$right_x,
            r = unit(1, "mm"),
            gp = gpar(fill = "red"))
grid.circle(y = prop_bx_coords$top,
            x = prop_bx_coords$right_x,
            r = unit(1, "mm"),
            gp = gpar(fill = "purple"))
grid.circle(y = prop_bx_coords$bottom,
            x = prop_bx_coords$left_x,
            r = unit(1, "mm"),
            gp = gpar(fill = "blue"))
grid.circle(y = prop_bx_coords$top,
            x = prop_bx_coords$left_x,
            r = unit(1, "mm"),
            gp = gpar(fill = "orange"))

grid.circle(y = prop_bx_coords$bottom,
            x = prop_bx_coords$right,
            r = unit(2, "mm"),
            gp = gpar(fill = "red"))
grid.circle(y = prop_bx_coords$top,
            x = prop_bx_coords$right,
            r = unit(2, "mm"),
            gp = gpar(fill = "purple"))
grid.circle(y = prop_bx_coords$bottom,
            x = prop_bx_coords$left,
            r = unit(2, "mm"),
            gp = gpar(fill = "blue"))
grid.circle(y = prop_bx_coords$top,
            x = prop_bx_coords$left,
            r = unit(2, "mm"),
            gp = gpar(fill = "orange"))

## ----extra_shapes, fig.height = 3, fig.width = 6------------------------------
# --- Branch labels on alternate shapes ---
grid.newpage()

decision <- boxDiamondGrob("Decision", box_gp = gpar(fill = "#FFF4E6"))
local    <- boxEllipseGrob("Local", box_gp = gpar(fill = "#E6FFF4"))
server   <- boxServerGrob("Server", box_gp = gpar(fill = "#E8F0FF"))

# Position the boxes, then draw them. The ellipse carries extra padding so its
# text fits the curved outline, making it taller than the server box; equalize
# the outcome heights so both branches line up symmetrically.
boxes <- list(decision = decision, outcomes = list(local, server)) |>
  equalizeHeights(subelement = "outcomes") |>
  spreadHorizontal(from = unit(.1, "npc"), to = unit(.9, "npc"), subelement = "outcomes") |>
  spreadVertical() |>
  print()

# Build one N connector for both branches and attach a label to each with
# setConnectorLabels(); print() then draws the lines and labels together.
connectGrob(boxes$decision, boxes$outcomes, type = "N") |>
  setConnectorLabels(c("Local", "Server")) |>
  print()

## ----standard_shapes, fig.height = 3.5, fig.width = 8-------------------------
# Arrange shapes in three rows for better readability
# 1) Grid-based objects (basic boxGrob / boxPropGrob / rect)
row1 <- list(
  boxGrob("Box (default)", box_gp = gpar(fill = "#EFEFEF"), y = unit(.85, "npc")),
  boxPropGrob("Prop", "Left", "Right", prop = .4, box_left_gp = gpar(fill = "#EFEFAF"), box_right_gp = gpar(fill = "#EFAFEF"), y = unit(.85, "npc")),
  boxGrob("Rectangle", box_fn = rectGrob, box_gp = gpar(fill = "#EFEFEF"), y = unit(.85, "npc"))
)

# 2) Gmisc row 1 (rounded/sharp diamond + ellipse + rack + server)
row2 <- list(
  boxDiamondGrob("Diamond\n(rounded)", box_gp = gpar(fill = "#FFF4E6"), y = unit(.55, "npc")),
  boxDiamondGrob("Diamond\n(sharp)", rounded = FALSE, box_gp = gpar(fill = "#FFF4E6"), y = unit(.55, "npc")),
  boxEllipseGrob("Ellipse", box_gp = gpar(fill = "#E6FFF4"), y = unit(.55, "npc")),
  boxRackGrob("Rack", box_gp = gpar(fill = "#E8F0FF"), y = unit(.55, "npc")),
  boxServerGrob("Server", box_gp = gpar(fill = "#E8F0FF"), y = unit(.55, "npc"))
)

# 3) Gmisc row 2 (database, document, documents, tape)
row3 <- list(
  boxDatabaseGrob("Database", box_gp = gpar(fill = "#DFF4E6"), y = unit(.25, "npc")),
  boxDocumentGrob("Document", box_gp = gpar(fill = "#FFF6E6"), y = unit(.25, "npc")),
  boxDocumentsGrob("Documents", box_gp = gpar(fill = "#FFF6E6"), y = unit(.25, "npc")),
  boxTapeGrob("Tape", box_gp = gpar(fill = "#E6F0FF"), y = unit(.25, "npc"))
)

# Spread each row across the horizontal span
spreadHorizontal(row1, from = unit(.05, "npc"), to = unit(.95, "npc"))
spreadHorizontal(row2, from = unit(.05, "npc"), to = unit(.95, "npc"))
spreadHorizontal(row3, from = unit(.05, "npc"), to = unit(.95, "npc"))

## ----"Connected boxes", fig.width = 7, fig.height = 5-------------------------
grid.newpage()
# Initiate the boxes that we want to connect
side <- boxPropGrob("Side", "Left", "Right",
                    prop = .3,
                    x = 0, y = .9,
                    bjust = c(0,1))
start <- boxGrob("Top",
                 x = .6, y = coords(side)$y,
                 box_gp = gpar(fill = "yellow"))
bottom <- boxGrob("Bottom",
                  x = .6, y = 0,
                  bjust = "bottom")


sub_side_left <- boxGrob("Left",
                         x = coords(side)$left_x,
                         y = 0,
                         bjust = "bottom")
sub_side_right <- boxGrob("Right",
                          x = coords(side)$right_x,
                          y = 0,
                          bjust = "bottom")

odd <- boxGrob("Odd\nbox",
               x = coords(side)$right,
               y = .5)

odd2 <- boxGrob("Also odd",
               x = coords(odd)$right +
                 distance(bottom, odd, type = "h", half = TRUE) -
                 unit(2, "mm"),
               y = 0,
               bjust = c(1,0))

exclude <- boxGrob("Exclude:\n - Too sick\n - Prev. surgery",
                   x = 1,
                   y = coords(bottom)$top +
                     distance(start, bottom, type = "v", half = TRUE),
                   just = "left", bjust = "right")

# Connect the boxes and print/plot them
connectGrob(start, bottom, "vertical")
connectGrob(start, side, "horizontal")
connectGrob(bottom, odd, "Z", "l")
connectGrob(odd, odd2, "N", "l")
connectGrob(side, sub_side_left, "v", "l")
connectGrob(side, sub_side_right, "v", "r")
connectGrob(start, exclude, "-",
            lty_gp = gpar(lwd = 2, col = "darkred", fill = "darkred"))

# Print the grobs
start
bottom
side
exclude
sub_side_left
sub_side_right
odd
odd2

## ----connect_multi, fig.width = 4, fig.height = 4-----------------------------
grid.newpage()

# Three upstream boxes + one side box
a_boxes <- paste("A", 1:3) |>
  lapply(\(x) boxGrob(x, box_gp = gpar(fill = "#E6F2FF"))) |>
  spreadHorizontal(from = unit(.1, "npc"), to = unit(1, "npc") - unit(1, "cm")) |>
  alignVertical(position="top",
                reference = unit(1, "npc")) |>
  print()

b_side <- boxGrob("B",  y = .70, box_gp = gpar(fill = "#FFF3BF")) |>
  moveBox(x = unit(1, "npc"),
          just = 1) |>
  print()

# Target box
c <- boxGrob("C", x = .50, box_gp = gpar(fill = "#D3F9D8"), width = unit(4, "cm")) |>
  moveBox(y = unit(0, "npc"),
          just = "bottom") |>
  print()


# Many -> one: merge on top with evenly distributed attachment points + margin
connectGrob(c(a_boxes, list(b_side)), c,
            type = "fan_in_top",
            margin = 4)

## ----horizontal_alignment, fig.width=10, fig.height=6-------------------------
align_1 <- boxGrob("Align 1",
                   y = .9,
                   x = 0,
                   bjust = c(0),
                   box_gp = gpar(fill = "#E6E8EF"))

align_2 <- boxPropGrob("Align 2",
                       "Placebo",
                       "Treatment",
                       prop = .7,
                       y = .8,
                       x = .5)

align_3 <- boxGrob("Align 3\nvertical\ntext",
                   y = 1,
                   x = 1,
                   bjust = c(1, 1),
                   box_gp = gpar(fill = "#E6E8EF"))

b1 <- boxGrob("B1",
              y = .3,
              x = .1,
              bjust = c(0))
b2 <- boxGrob("B2 with long\ndescription",
              y = .6,
              x = .5)
b3 <- boxGrob("B3",
              y = .2,
              x = .8,
              bjust = c(0, 1))

grid.newpage()
align_1
alignHorizontal(reference = align_1,
                b1, b2, b3,
                position = "left")

align_2
alignHorizontal(reference = align_2,
                b1, b2, b3,
                position = "center",
                sub_position = "left")
alignHorizontal(reference = align_2,
                b1, b2, b3,
                position = "left",
                sub_position = "right")

align_3
alignHorizontal(reference = align_3,
                b1, b2, b3,
                position = "right")

## ----vertical_alignment, fig.width=10, fig.height=6---------------------------
align_1 <- boxGrob("Align 1\nvertical\ntext",
                   y = 1,
                   x = 1,
                   bjust = c(1, 1),
                   box_gp = gpar(fill = "#E6E8EF"))

align_2 <- boxPropGrob("Align 2",
                       "Placebo",
                       "Treatment",
                       prop = .7,
                       y = .5,
                       x = .6)

align_3 <- boxGrob("Align 3",
                   y = 0,
                   x = 0,
                   bjust = c(0, 0),
                   box_gp = gpar(fill = "#E6E8EF"))


b1 <- boxGrob("B1",
              y = .3,
              x = 0.1,
              bjust = c(0, 0))
b2 <- boxGrob("B2 with long\ndescription",
              y = .6,
              x = .3)
b3 <- boxGrob("B3",
              y = .2,
              x = .85,
              bjust = c(0, 1))

grid.newpage()
align_1
alignVertical(reference = align_1,
              b1, b2, b3,
              position = "top")

align_2
alignVertical(reference = align_2,
              b1, b2, b3,
              position = "center")

align_3
alignVertical(reference = align_3,
              b1, b2, b3,
              position = "bottom")

## ----horizontal_spread, fig.width = 11, fig.height = 8------------------------
b1 <- boxGrob("B1", y = .85, x = .1, bjust = c(0, 0))
b2 <- boxGrob("B2", y = .65, x = .6)
b3 <- boxGrob("B3", y = .45, x = .6)
b4 <- boxGrob("B4 with long\ndescription", y = .7, x = .8)

from <- boxGrob("from",
                y = .25,
                x = .05,
                box_gp = gpar(fill = "darkgreen"),
                txt_gp = gpar(col = "white"))
to <- boxGrob("to this wide box",
              y = coords(from)$y,
              x = .95,
              bjust = "right",
              box_gp = gpar(fill = "darkred"),
              txt_gp = gpar(col = "white"))
txtOut <- function(txt, y_top) {
  grid.text(txt,
            x = unit(2, "mm"),
            y = y_top + unit(2, "mm"),
            just = c("left", "bottom"))
  grid.lines(y = y_top + unit(1, "mm"),
             gp = gpar(col = "grey"))
}

drawRow <- function(label, row_y, spread_args = list()) {
  row <- alignVertical(reference = row_y, b1, b2, b3, b4, position = "top")
  txtOut(label, coords(row[[1]])$top)
  do.call(spreadHorizontal, c(list(row), spread_args))
}

rowYs <- unit(c(.93, .76, .59, .42, .25, .12), "npc")

grid.newpage()

drawRow("Basic (viewport)", rowYs[1])
drawRow("From–to + margin (numeric = npc)", rowYs[2],
        spread_args = list(from = .2, to = .7, margin = .05))
drawRow("Only to (defaults from = 0)", rowYs[3],
        spread_args = list(to = .7))
drawRow("Only from (defaults to = 1)", rowYs[4],
        spread_args = list(from = .2))

# Row 5: Between boxes (box-to-box span)
row5_y <- rowYs[5]
row5 <- alignVertical(reference = row5_y, b1, b2, b3, b4, position = "top")
txtOut("Between boxes", coords(row5[[1]])$top)

span <- alignVertical(reference = row5_y, from  = from, to = to, position = "top")
span
spreadHorizontal(row5, from = span$from, to = span$to)

# Row 6: Reverse box order + center distribution
row6_y <- unit(.10, "npc")

bottom_from <- moveBox(from, x = coords(to)$right, y = 0, just = c(1, 0))
bottom_to <- moveBox(to, x = coords(from)$left, y = 0, just = c(0, 0))
bottom_from
bottom_to

row6 <- alignVertical(reference = bottom_from, b1, b2, b3, b4, position = "bottom")
txtOut("Reverse box order + center", coords(row6[[4]])$top)

spreadHorizontal(row6,
                 from = bottom_from,
                 to = bottom_to,
                 type = "center")



## ----vertical_spread, fig.width=6, fig.height=6-------------------------------
b1 <- boxGrob("B1",
              y = .8,
              x = 0.1,
              bjust = c(0, 0))
b2 <- boxGrob("B2 with long\ndescription",
              y = .5,
              x = .5)
b3 <- boxGrob("B3",
              y = .2,
              x = .8)
b4 <- boxGrob("B4",
              y = .7,
              x = .8)


txtOut <- function(txt, refBx) {
  grid.text(txt,
            x = coords(refBx)$left - unit(2, "mm"),
            y = .5,
            just = c("center", "bottom"),
            rot = 90)
  grid.lines(x = coords(refBx)$left - unit(1, "mm"),
             gp = gpar(col = "grey"))
}

grid.newpage()
txtOut("Basic", b1)
alignHorizontal(reference = b1,
                b1, b2, b3, b4,
                position = "left") |>
  spreadVertical()

txtOut("From-to", b2)
alignHorizontal(reference = b2,
                b1, b2, b3, b4,
                position = "left") |>
  spreadVertical(from = .2,
                 to = .7)

txtOut("From-to with center and reverse the box order", b3)
alignHorizontal(reference = b3,
                b1, b2, b3, b4,
                position = "left") |>
  spreadVertical(from = .7,
                 to = .2,
                 type = "center")

## ----complex_nested, fig.width = 7, fig.height = 8----------------------------
# Helper function to convert nested structure to grobs
make_boxes <- function(x) {
  if (is.list(x) && !inherits(x, "box_header")) {
    return(lapply(x, make_boxes))
  }

  if (inherits(x, "box_header")) {
    return(do.call(boxHeaderGrob, x))
  }

  # Simple text box fallback
  args <- attr(x, "args")
  if (is.null(args)) return(boxGrob(label = x))

  args$label <- x
  do.call(boxGrob, args)
}

# Define styling for different elements
arm_a_style <- list(
  header = gpar(fill = "#E8F5E9", col = "#2E7D32", lwd = 1.4),
  box = gpar(fill = "#F1F8E9", col = "#43A047")
)

arm_b_style <- list(
  header = gpar(fill = "#FFF8E1", col = "#EF6C00", lwd = 1.4),
  box = gpar(fill = "#FFFDE7", col = "#F9A825")
)

# Build flowchart structure
flowchart <- list(
  # Shared inclusion criteria
  criteria = structure(
    list(
      header = "Inclusion Criteria",
      body = paste(
        "• Adults aged 18-65",
        "• Confirmed diagnosis",
        "• Written informed consent",
        "• No contraindications",
        "• Available for 6-month follow-up",
        sep = "\n"
      ),
      box_gp = gpar(fill = "#E3F2FD", col = "#1E88E5", lwd = 1.4),
      body_gp = gpar(fontsize = 10)
    ),
    class = "box_header"
  ),

  # Two treatment arms
  arms = list(
    arm_a = list(
      # Arm header
      structure("Intensive Protocol", args = list(
        box_gp = arm_a_style$header,
        txt_gp = gpar(fontsize = 11, fontface = "bold")
      )),

      # Timeline boxes
      structure(list(
        header = "Week 0-1",
        body = "• Daily sessions\n• Supervised therapy\n",
        box_gp = arm_a_style$box,
        body_gp = gpar(fontsize = 9.5)
      ), class = "box_header"),

      structure(list(
        header = "Week 2-4",
        body = "• 3× weekly sessions\n• Progressive loading",
        box_gp = arm_a_style$box,
        body_gp = gpar(fontsize = 9.5)
      ), class = "box_header"),

      structure(list(
        header = "Week 5-8",
        body = "• Home program\n• Monthly check-ins\n• Return to activity",
        box_gp = arm_a_style$box,
        body_gp = gpar(fontsize = 9.5)
      ), class = "box_header")
    ),

    arm_b = list(
      # Arm header
      structure("Standard Care", args = list(
        box_gp = arm_b_style$header,
        txt_gp = gpar(fontsize = 11, fontface = "bold")
      )),

      # Timeline boxes - different schedule
      structure(list(
        header = "Month 0",
        body = "• Initial consultation\n• Exercise booklet",
        box_gp = arm_b_style$box,
        body_gp = gpar(fontsize = 9.5)
      ), class = "box_header"),

      structure(list(
        header = "Month 3",
        body = "• Follow-up visit\n• Progress review",
        box_gp = arm_b_style$box,
        body_gp = gpar(fontsize = 9.5)
      ), class = "box_header"),

      structure(list(
        header = "Month 6",
        body = "• Final assessment\n• Discharge planning",
        box_gp = arm_b_style$box,
        body_gp = gpar(fontsize = 9.5)
      ), class = "box_header")
    )
  )
)

# Convert to grobs and layout
grid.newpage()
boxes <- flowchart |>
  make_boxes() |>
  spreadVertical() |>
  spreadHorizontal(subelement = "arms", from = 0.15, to = 0.85) |>
  spreadVertical(subelement = c("arms", "arm_a"), from = 0.65) |>
  spreadVertical(subelement = c("arms", "arm_b"), from = 0.65) |>
  print()

# Connect criteria to both arms
connectGrob(boxes$criteria, boxes$arms, type = "N")

# Connect timeline within each arm
for (arm_name in names(boxes$arms)) {
  arm_boxes <- boxes$arms[[arm_name]]
  for (i in 2:length(arm_boxes)) {
    connectGrob(arm_boxes[[i-1]], arm_boxes[[i]], type = "v") |> print()
  }
}

## ----s3_api_example, fig.height=8, fig.width=6, eval=FALSE--------------------
# grid.newpage()
# 
# # Define the nodes
# b1 <- boxGrob("Start", y = 0.8)
# b2 <- boxGrob("Process", y = 0.5)
# b3 <- boxGrob("End", y = 0.2)
# 
# # Pipeline: list -> align -> connect -> print
# list(start = b1, process = b2, end = b3) |>
#   align(axis = "y") |>
#   spread(axis = "x") |>
#   connect("start", "process", type = "horizontal") |>
#   connect("process", "end", type = "horizontal") |>
#   print()

## ----math_expressions, fig.width=6, fig.height=3------------------------------
grid.newpage()
###############
# Expressions #
###############
# Font style
list(expression(bold("Bold text")),
     expression(italic("Italics text")),
     expression(paste("Mixed: ", italic("Italics"), " and ", bold("bold")))) |>
  lapply(boxGrob) |>
  alignVertical(reference = unit(1, "npc"),
                position = "top") |>
  spreadHorizontal()

# Math
list(expression(paste("y = ", beta[0], " + ", beta[1], X[1], " + ", beta[2], X[2]^2)),
     expression(paste(hat(mu) == sum(frac(x[i], n), i == 1, n))),
     expression(paste(int(a, b, f(x) * dx) == F(b) - F(a)))) |>
  lapply(boxGrob) |>
  alignVertical(reference = unit(0.5, "npc"),
                position = "center") |>
  spreadHorizontal()

##########
# Quotes #
##########
a = 5
list(bquote(alpha == theta[1] * .(a) + ldots),
     paste("argument", sQuote("x"), "\nmust be non-zero")) |>
  lapply(boxGrob) |>
  alignVertical(reference = unit(0, "npc"),
                position = "bottom") |>
  spreadHorizontal(from = .2, to = .8)

## ----basic_plot, fig.height = 2, fig.width = 2--------------------------------
# Load the grid library
# part of standard R libraries so no need installing
library(grid)

# Create a new graph
grid.newpage()

pushViewport(viewport(width = .5, height = .8))

grid.rect(gp = gpar(fill = "#D8F0D1"))

popViewport()

## ----relative_lines, fig.height = 3, fig.width = 3----------------------------
grid.newpage()
pushViewport(viewport(width = .5, height = .8, clip = "on"))
grid.rect(gp = gpar(lty = 2, fill = "lightyellow"))
lg <- linesGrob(x = unit(c(.2, 1), "npc"),
                y = unit(c(.2, 1), "npc"),
                gp = gpar(lwd = 2))
grid.draw(lg)
pushViewport(viewport(x = 0, y = .6, just = "left", width = .4, height = .4, angle = 20))
grid.rect(gp = gpar(fill = "lightblue")) # A translucent box to indicate the new viewport
grid.draw(lg)
popViewport()

## ----absolute_lines, fig.height = 3, fig.width = 3----------------------------
grid.newpage()
pushViewport(viewport(width = .5, height = .8, clip = "on"))
grid.rect(gp = gpar(lty = 2, fill = "lightyellow"))
lg <- linesGrob(x = unit(c(2, 10), "mm"),
                y = unit(c(2, 10), "mm"),
                gp = gpar(lwd = 2))
grid.draw(lg)
pushViewport(viewport(x = 0, y = .6, just = "left", width = .4, height = .4, angle = 20))
grid.rect(gp = gpar(fill = "lightblue")) # A translucent box to indicate the new viewport
grid.draw(lg)
popViewport()

## ----complex_example, fig.height = 9, fig.width = 9---------------------------
# Define the boxes
org_cohort <- glue("Proximal humerus fracture",
                   "  - \u2265 18 years",
                   "  - \u2264 4 weeks of trauma",
                   "  - Not pathological",
                   .sep = "\n") |>
  boxGrob(just = "left",
          box_gp = gpar(fill = "#E3F2FD"))

surgery <- glue("Surgery",
                "  - Direct (\u2248 4%)",
                "  - Delayed (\u2248 4%)",
                .sep = "\n") |>
  boxGrob(just = "left",
          box_gp = gpar(fill = "#F8BBD0"))

randomize <- boxGrob("Non-surgical\nRandomise",
                     box_gp = gpar(fill = "#FFF3E0"))

treatments <- list(early = boxGrob("Early rehab",
                                   box_gp = gpar(fill = "#DCEDC8")),
                   late = boxGrob("Late rehab",
                                  box_gp = gpar(fill = "#DCEDC8")),
                   obs = boxGrob("Observation",
                                 box_gp = gpar(fill = "#E0E0E0")))

early_followup <- glue("Early follow-up",
                       "  - 2 weeks [PNRS]",
                       "  - 4 weeks [PNRS]",
                       .sep = "\n") |>
  boxGrob(just = "left",
          box_gp = gpar(fill = "#E0F7FA"))

late_followup <- glue("Late follow-up",
                      "  - 2-10 months (random) [OSS, PNRS]",
                      "  - 1 year [OSS, PNRS, accelerometer]",
                      "  - 2 years [OSS, PNRS]",
                      "  - 5 years [OSS, PNRS]",
                      .sep = "\n") |>
  boxGrob(just = "left",
                       box_gp = gpar(fill = "#E0F7FA"))

# Create the flowchart
grid.newpage()
flowchart(start = org_cohort,
          step_1 = list(surgery = surgery,
                        `non-surgical` = randomize),
          treatment = treatments,
          early_followup = early_followup,
          followup = late_followup) |>
  spread(axis = "y") |>
  spread(axis = "x", subelement = "step_1") |>
  spread(axis = "x", subelement = "treatment", from = 0.35) |>
  align(axis = "x",
        reference = c("treatment", "late"),
        subelement = c("step_1", "non-surgical")) |>
  connect(from = "start", to = "step_1", type = "N") |>
  connect(from = "step_1$non-surgical", to = "treatment", type = "N") |>
  connect(from = "treatment", to = "early_followup", type = "fan_in_center") |>
  connect(from = "early_followup", to = "followup", type = "v") |>
  connect(from = "early_followup", to = "step_1$surgery", type = "Z",
          label = "Crossover\nto surgery") |>
  connect(from = "step_1$surgery", to = "followup", type = "L") |>
  print()

