## ----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_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) # Arms span the inner portion; lost boxes flank outside on each side. # Using 0.28–0.72 keeps the arm centres far enough from the viewport edges # that the lost boxes' right/left edges don't cross the arm centres. left_from <- 0.28 left_to <- 0.72 main_x <- (left_from + left_to) / 2 # centre of the arms column (= 0.5) 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 — spread from 0 to 1 so they land # on the outside of each arm (left of cast, right of surgical) 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 — extra margin to keep badges from being clipped at the top spread(axis = "y", margin = unit(5, "mm")) |> # 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 spread across full width # so that lost_cast lands left of cast and lost_surgical right of surgical spread(axis = "x", subelement = "arms", from = left_from, to = left_to) |> spread(axis = "x", subelement = "analysis", from = left_from, to = left_to) |> spread(axis = "x", subelement = "lost", from = 0, to = 1) |> # Exclusion box: auto-positioned between assessed and randomised, then moved right 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 = 0.85) |> # Main-flow connectors 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) |> # 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) 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) ## ----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) ## ----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 + sharp diamond variant --- grid.newpage() # rounded and sharp diamond examples d_rounded <- boxDiamondGrob("Decision", box_gp = gpar(fill = "#FFF4E6")) d_sharp <- boxDiamondGrob("Decision\n(sharp)", rounded = FALSE, box_gp = gpar(fill = "#FFF4E6")) # outcomes e <- boxEllipseGrob("Local", box_gp = gpar(fill = "#E6FFF4")) r <- boxServerGrob("Server", box_gp = gpar(fill = "#E8F0FF")) # arrange and draw boxes <- list(decision = d_rounded, outcomes = list(e, r)) |> spreadHorizontal(from = unit(.1, "npc"), to = unit(.9, "npc"), subelement = "outcomes") |> spreadVertical() |> print() # 1) quick many-to-many style connector (no labels) con <- connectGrob(boxes$decision, boxes$outcomes, type = "N") print(con) # 2) explicit per-branch connectors with labels (preferred when you want text) connectGrob(boxes$decision, boxes$outcomes[[1]], type = "N", label = "Local") |> print() connectGrob(boxes$decision, boxes$outcomes[[2]], type = "N", label = "Server") |> print() # 3) If you prefer the single connector and want labels on each branch: # place text at the midpoint of each returned grob (example) con_list <- connectGrob(boxes$decision, boxes$outcomes, type = "N") # Preferred: attach labels and let `print()` handle rendering con_list <- setConnectorLabels(con_list, c("Local", "Server")) print(con_list) ## ----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()