Enhance boxGrob with corner radius fix and equalizeHeights feature

.Rbuildignore

@@ -27,3 +27,5 @@ Gmisc/inst/extdata/Full_test_suite_files/*
 ^.github/
 ^docs/
 ^README\.Rmd$
+^README\.html$
+^Rplots\.pdf$

.github/workflows/ci.yaml

@@ -10,7 +10,7 @@ jobs:
   R-CMD-check:
     runs-on: ubuntu-latest
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
       - uses: r-lib/actions/setup-r@v2
       - uses: r-lib/actions/setup-r-dependencies@v2
         with:

NAMESPACE

@@ -26,6 +26,9 @@ S3method(phaseLabel,default)
 S3method(plot,box)
 S3method(plot,connect_boxes)
 S3method(plot,connect_boxes_list)
+S3method(position,box)
+S3method(position,coords)
+S3method(position,default)
 S3method(prCalculateConnector,ConnectorStrategy)
 S3method(prCalculateConnector,ManyToOneFanInCenterConnectorStrategy)
 S3method(prCalculateConnector,ManyToOneFanInTopConnectorStrategy)
@@ -84,6 +87,7 @@ export(document_box_fn)
 export(documents_box_fn)
 export(docx_document)
 export(ellipse_box_fn)
+export(equalizeHeights)
 export(equalizeWidths)
 export(fastDoCall)
 export(figCapNo)
@@ -109,6 +113,7 @@ export(move)
 export(moveBox)
 export(pathJoin)
 export(phaseLabel)
+export(position)
 export(rack_box_fn)
 export(retrieve)
 export(server_box_fn)

NEWS.md

@@ -2,13 +2,19 @@ NEWS for the Gmisc package
 
 ## Changes for 3.4.0
 
+- Added `vertical_axis` and `horizontal_axis` connector types for flowcharts. These opt-in connectors preserve the source box's x- or y-axis and project it onto the target boundary, giving true 90-degree vertical/horizontal arrows for shared wide or tall target boxes. Existing `vertical` and `horizontal` connector behavior is unchanged.
 - Added `phaseLabel()` for flowchart box lists: a one-call-per-stage helper that adds a CONSORT-style phase label (e.g. *Allocation*, *Follow-up*, *Analysis*) centred between a stage's arms, sitting slightly above it and drawn on top. The label width adapts to the stage — spanning the central gap (plus a small corner overlap) for two arms, or the full stage width as a banner for three or more arms — and can be set explicitly via `width`. It correctly handles nested arm lists (arms that are themselves lists of boxes) by resolving their merged bounding box.
 - Added `on_top` to `insert()` for flowchart box lists. A box inserted with `insert(..., on_top = TRUE)` is drawn on top of the other boxes and connections, regardless of its position in the list, and the marker is preserved through subsequent `move()`/`align()` operations. This is the lower-level overlay mechanism that `phaseLabel()` builds on.
 - `insert()` now resolves grouped (list) neighbours via their merged bounding box, so a box can be inserted between grouped stages without error.
 - Added a CONSORT phase-label example to the grid-based flowchart vignette showing `phaseLabel()` centred between randomisation arms.
 - Updated flowchart examples to emphasize the `flowchart()` + pipe (`|>`) style API in `inst/examples/connectGrob_example.R`, `inst/examples/spreadBox_ex.R`, and `inst/examples/alignBox_ex.R`.
 - Clarified spread/connect documentation to state that spread/align return updated objects (no in-place mutation) and that connectors should use the returned boxes.
 - Improved interactive example ergonomics by pausing between graph pages in multi-plot examples.
+- Added `box_fn_args` parameter to `boxGrob()` for passing extra arguments directly to the box drawing function. The default is now `list(r = unit(5, "pt"))`, giving every box a fixed 5 pt corner radius (approximately equivalent to the widely-used 5 px CSS `border-radius`) regardless of box size — solving the issue where larger boxes had visibly rounder corners than smaller ones. Override per box or globally via `options(boxGrobFnArgs = list(...))`.
+- Added `equalizeHeights()` for flowchart box lists, mirroring the existing `equalizeWidths()`. It sets selected boxes to a shared height (defaulting to the tallest among the selection) and supports the same `subelement` path syntax as `equalizeWidths()`.
+- Added `position()` with relative moves.
+- Added dotted arrows lines for flowcharts
+- Added regex selector for box lists
 
 ## Changes for 3.3.0
 

R/boxGrobs_align.R

@@ -9,9 +9,13 @@
 #' @param position How to align the boxes, differs slightly for vertical and horizontal alignment
 #'  see the accepted arguments
 #' @param subelement If a `list` of boxes is provided, this parameter can be used
-#'   to target a specific element (by name or index), or a deep path into nested
-#'   lists (e.g., `c("detail", 1)`), for the alignment operation. You can also
-#'   provide multiple targets by giving a list of paths (e.g., `list(c("detail", 1), c("followup", 1))`).
+#'   to target a specific element (by name or index), a deep path into nested
+#'   lists (e.g., `c("detail", 1)`), or a regex selector created with
+#'   [stringr::regex()] that is matched against top-level names
+#'   (e.g. `stringr::regex("^groups")`). You can also provide multiple targets
+#'   as a list of paths or selectors (e.g.,
+#'   `list(c("detail", 1), stringr::regex("^followup"))`).
+#'   Bare character strings are always treated as literal paths.
 #'   When a list of boxes is *piped* into `alignVertical()`/`alignHorizontal()` and a named `reference` is
 #'   provided (e.g. `my_boxes |> alignHorizontal(reference = c("grp","sub"), .subelement = ...)`), the
 #'   function will unwrap a single-element wrapper so nested `.subelement` targets are found as expected.
@@ -79,7 +83,7 @@ alignVertical <- function(reference, ..., position = c("center", "top", "bottom"
 
   if (!is.null(subelement)) {
     # Normalize into a list of paths (each path is an atomic vector)
-    paths <- if (is.list(subelement) && all(sapply(subelement, is.atomic))) subelement else list(subelement)
+    paths <- prResolveSubelementSelector(subelement, boxes2align)
 
     for (path in paths) {
       # Find target using helper (search top-level and first nested container)
@@ -197,7 +201,7 @@ alignHorizontal <- function(
 
   if (!is.null(subelement)) {
     # Normalize into a list of paths (each path is an atomic vector)
-    paths <- if (is.list(subelement) && all(sapply(subelement, is.atomic))) subelement else list(subelement)
+    paths <- prResolveSubelementSelector(subelement, boxes2align)
 
     for (path in paths) {
       # Find target using helper (search top-level and first nested container)

R/boxGrobs_boxGrob.R

@@ -18,6 +18,12 @@
 #' @param box_gp The \code{\link[grid]{gpar}} style to apply to the box function of `box_fn` below.
 #' @param box_fn Function to create box for the text. Parameters of `x=0.5`, `y=0.5` and `box_gp` will
 #'  be passed to this function and return a \code{grob} object.
+#' @param box_fn_args An optional named list of extra arguments forwarded to `box_fn`. This is useful
+#'  for controlling parameters such as the corner radius `r` of \code{\link[grid]{roundrectGrob}} so that
+#'  all boxes have the same absolute corner radius regardless of their size. Defaults to
+#'  \code{list(r = grid::unit(5, "pt"))} which gives every box a fixed 5 pt corner radius
+#'  (approximately equivalent to the widely-used 5 px CSS \code{border-radius}).
+#'  You can override per box or set a global default via \code{options(boxGrobFnArgs = list(r = grid::unit(5, "mm")))}.
 #' @seealso The package provides several convenience shape helpers that can be
 #' passed to `boxGrob(..., box_fn = ...)`: \code{boxDiamondGrob},
 #' \code{boxEllipseGrob}, \code{boxRackGrob}, \code{boxServerGrob},
@@ -56,6 +62,7 @@ boxGrob <- function(label,
                     txt_padding = getOption("boxGrobTxtPadding", default = unit(6 * ifelse(is.null(txt_gp$cex), 1, txt_gp$cex), "mm")),
                     box_gp = getOption("boxGrob", default = gpar(fill = "white")),
                     box_fn = roundrectGrob,
+                    box_fn_args = getOption("boxGrobFnArgs", default = list(r = unit(5, "pt"))),
                     name = NULL,
                     badge_label = NULL,
                     badge_position = "top",
@@ -66,6 +73,19 @@ boxGrob <- function(label,
     checkNumeric(label),
     is.language(label)
   )
+  if (!is.list(box_fn_args) ||
+      is.null(names(box_fn_args)) ||
+      any(!nzchar(names(box_fn_args)))) {
+    stop("`box_fn_args` must be a named list.", call. = FALSE)
+  }
+  reserved_box_fn_args <- intersect(names(box_fn_args), c("x", "y", "gp"))
+  if (length(reserved_box_fn_args) > 0) {
+    stop(
+      "`box_fn_args` cannot include reserved arguments: ",
+      paste(reserved_box_fn_args, collapse = ", "),
+      call. = FALSE
+    )
+  }
   assert_unit(y)
   assert_unit(x)
   assert_unit(width)
@@ -83,10 +103,20 @@ boxGrob <- function(label,
   x <- prAsUnit(x)
   y <- prAsUnit(y)
 
+  # Filter box_fn_args to only the parameters box_fn actually accepts.
+  # This lets the default r = unit(5, "pt") be silently ignored for custom
+  # shape functions (e.g. diamond_rounded_box_fn) that have no `r` parameter.
+  # Functions that accept `...` receive all args unchanged.
+  fn_formals <- tryCatch(formals(box_fn), error = function(e) NULL)
+  if (!is.null(fn_formals) && !"..." %in% names(fn_formals)) {
+    accepted <- names(fn_formals)
+    box_fn_args <- box_fn_args[names(box_fn_args) %in% accepted]
+  }
+
   # Call the box function early to collect any suggested padding attributes
   # (e.g., diamonds may request extra padding). This allows the padding to
   # influence text layout and the computed box width/height.
-  rect <- do.call(box_fn, list(x = .5, y = .5, gp = box_gp))
+  rect <- do.call(box_fn, c(list(x = .5, y = .5, gp = box_gp), box_fn_args))
   extra_pad <- attr(rect, "box_fn_padding")
   if (!is.null(extra_pad)) {
     tryCatch(

R/boxGrobs_connect.R

@@ -21,8 +21,16 @@
 #'
 #' `type` controls the connector shape:
 #'
-#' - `"vertical"`: straight vertical connector
-#' - `"horizontal"`: straight horizontal connector
+#' - `"vertical"`: straight connector between vertical faces (top/bottom).
+#'   If the box centers differ on the x-axis, the line is diagonal.
+#' - `"vertical_axis"`: strict vertical connector preserving the source box
+#'   center x-coordinate and projecting that 90-degree axis onto the target
+#'   boundary. Source and target must be vertically separated.
+#' - `"horizontal"`: straight connector between horizontal faces (left/right).
+#'   If the box centers differ on the y-axis, the line is diagonal.
+#' - `"horizontal_axis"`: strict horizontal connector preserving the source box
+#'   center y-coordinate and projecting that 90-degree axis onto the target
+#'   boundary. Source and target must be horizontally separated.
 #' - `"L"`: vertical then horizontal (direction chosen automatically)
 #' - `"-"`: straight horizontal connector at the end box y-position
 #' - `"Z"`: horizontal connector with two 90-degree turns
@@ -40,6 +48,11 @@
 #' bend position is computed so that the horizontal segment aligns visually across
 #' all connectors.
 #'
+#' Use `"vertical_axis"` or `"horizontal_axis"` when the visual requirement is a
+#' true axis-aligned connector. Use `"vertical"` or `"horizontal"` when you want
+#' the shortest straight connector between the corresponding box faces and a
+#' diagonal line is acceptable.
+#'
 #' ## Labels
 #'
 #' For one-to-one connectors you can add a text label (for example `"yes"` / `"no"`).
@@ -82,6 +95,14 @@
 #'   A [grid::unit()] or numeric (interpreted as millimeters). Default `unit(3, "mm")`.
 #' @param side For `type = "side"`, which side of the start box to exit from.
 #'   `"auto"` (default) picks the side that faces the end box.
+#' @param end_side For `type = "side"`, which side of the end box to enter.
+#'   `"auto"` (default) picks the side that faces the start box.
+#' @param side_fan_in_route For grouped `connect(..., type = "side")` calls in
+#'   the S3 flowchart API, where to draw the shared vertical return path.
+#'   `"outside"` offsets it away from the source boxes; `"edge"` draws it on
+#'   the source box edge.
+#' @param side_fan_in_offset Offset used when `side_fan_in_route = "outside"`.
+#'   Numeric values are interpreted as millimeters.
 #' @param label Optional text label for one-to-one connectors (e.g. `"yes"` / `"no"`).
 #'   Only supported when both `start` and `end` are single boxes.
 #' @param label_gp A [grid::gpar()] controlling label appearance.
@@ -104,7 +125,8 @@
 connectGrob <- function(
   start,
   end,
-  type = c("vertical", "horizontal", "L", "-", "Z", "N", "fan_in_top", "fan_in_center", "side"),
+  type = c("vertical", "vertical_axis", "horizontal", "horizontal_axis",
+           "L", "-", "Z", "N", "fan_in_top", "fan_in_center", "side"),
   subelmnt = c("right", "left"),
   lty_gp = getOption("connectGrob", default = gpar(fill = "black")),
   arrow_obj = getOption("connectGrobArrow", default = arrow(ends = "last", type = "closed")),
@@ -114,16 +136,34 @@ connectGrob <- function(
   smooth = FALSE,
   corner_radius = unit(3, "mm"),
   side = c("auto", "left", "right"),
+  end_side = c("auto", "left", "right"),
+  side_fan_in_route = c("outside", "edge"),
+  side_fan_in_offset = unit(5, "mm"),
   label = NULL,
   label_gp = grid::gpar(cex = 0.9),
   label_bg_gp = grid::gpar(fill = "white", col = NA),
   label_pad = unit(1.5, "mm"),
   label_pos = c("mid", "near_start", "near_end"),
   label_offset = unit(2, "mm")
 ) {
+  if (length(type) == 1) {
+    type_aliases <- c(
+      "v" = "vertical",
+      "vert" = "vertical",
+      "h" = "horizontal",
+      "hor" = "horizontal",
+      "horiz" = "horizontal"
+    )
+    if (type %in% names(type_aliases)) {
+      type <- unname(type_aliases[type])
+    }
+  }
+
   type <- match.arg(type)
   label_pos <- match.arg(label_pos)
   side <- match.arg(side)
+  end_side <- match.arg(end_side)
+  side_fan_in_route <- match.arg(side_fan_in_route)
 
   if (!is.null(arrow_size)) {
     ends_map <- c("1" = "first", "2" = "last", "3" = "both")
@@ -216,6 +256,9 @@ connectGrob <- function(
     smooth = smooth,
     corner_radius = corner_radius,
     side = side,
+    end_side = end_side,
+    side_fan_in_route = side_fan_in_route,
+    side_fan_in_offset = side_fan_in_offset,
     label = label,
     label_gp = label_gp,
     label_bg_gp = label_bg_gp,

R/boxGrobs_connect_pr_helpers.R

@@ -66,6 +66,68 @@ prEdgeSlots <- function(left, right, n, margin = unit(0, "mm")) {
   unit.c(xs)
 }
 
+prClampUnit <- function(value, lower, upper, axis = c("x", "y")) {
+  axis <- match.arg(axis)
+  convert_fn <- if (axis == "x") prConvertWidthToMm else prConvertHeightToMm
+
+  value_mm <- convert_fn(value)
+  lower_mm <- convert_fn(lower)
+  upper_mm <- convert_fn(upper)
+
+  if (value_mm < lower_mm) {
+    return(lower)
+  }
+  if (value_mm > upper_mm) {
+    return(upper)
+  }
+  value
+}
+
+prSpansOverlap <- function(first_min, first_max, second_min, second_max,
+                           axis = c("x", "y")) {
+  axis <- match.arg(axis)
+  convert_fn <- if (axis == "x") prConvertWidthToMm else prConvertHeightToMm
+
+  first_min_mm <- convert_fn(first_min)
+  first_max_mm <- convert_fn(first_max)
+  second_min_mm <- convert_fn(second_min)
+  second_max_mm <- convert_fn(second_max)
+
+  max(first_min_mm, second_min_mm) < min(first_max_mm, second_max_mm)
+}
+
+prVerticalAxisEdges <- function(start, end) {
+  if (prSpansOverlap(start$bottom, start$top, end$bottom, end$top, axis = "y")) {
+    stop(
+      "`type = \"vertical_axis\"` requires source and target boxes to be vertically separated; ",
+      "use `type = \"vertical\"` or adjust the layout.",
+      call. = FALSE
+    )
+  }
+
+  target_below <- prConvertHeightToMm(start$bottom) >= prConvertHeightToMm(end$top)
+  if (target_below) {
+    return(list(start_edge = start$bottom, target_edge = end$top))
+  }
+  list(start_edge = start$top, target_edge = end$bottom)
+}
+
+prHorizontalAxisEdges <- function(start, end) {
+  if (prSpansOverlap(start$left, start$right, end$left, end$right, axis = "x")) {
+    stop(
+      "`type = \"horizontal_axis\"` requires source and target boxes to be horizontally separated; ",
+      "use `type = \"horizontal\"` or adjust the layout.",
+      call. = FALSE
+    )
+  }
+
+  target_right <- prConvertWidthToMm(start$right) <= prConvertWidthToMm(end$left)
+  if (target_right) {
+    return(list(start_edge = start$right, target_edge = end$left))
+  }
+  list(start_edge = start$left, target_edge = end$right)
+}
+
 # Find the first boxed element in a possibly nested container. Useful for
 # making many-to-one connectors robust to inputs where the intended `end`
 # was wrapped in container lists by layout pipelines.

R/boxGrobs_connect_pr_single_boxes.R

@@ -95,6 +95,9 @@ prConnect1 <- function(
   smooth = FALSE,
   corner_radius = unit(3, "mm"),
   side = c("auto", "left", "right"),
+  end_side = c("auto", "left", "right"),
+  side_fan_in_route = c("outside", "edge"),
+  side_fan_in_offset = unit(5, "mm"),
   label = NULL,
   label_gp = grid::gpar(cex = 0.9),
   label_bg_gp = grid::gpar(fill = "white", col = NA),
@@ -110,6 +113,8 @@ prConnect1 <- function(
 
   label_pos <- match.arg(label_pos)
   side <- match.arg(side)
+  end_side <- match.arg(end_side)
+  side_fan_in_route <- match.arg(side_fan_in_route)
 
   start <- coords(start)
   end <- coords(end)
@@ -193,21 +198,38 @@ prConnect1 <- function(
     } else {
       line$y <- unit.c(start$bottom, end$top)
     }
+  } else if (type == "vertical_axis") {
+    axis_x <- getX4elmnt(start, "x")
+    target_x <- prClampUnit(axis_x, end$left, end$right, axis = "x")
+    edges <- prVerticalAxisEdges(start, end)
+
+    line$x <- unit.c(axis_x, target_x)
+    line$y <- unit.c(edges$start_edge, edges$target_edge)
   } else if (type == "side") {
-    # Horizontal-first exit: leave from start side, travel horizontally,
-    # then drop vertically to the end box.
+    # Vertical-first side route: leave from a selected start side, travel vertically
+    # outside/alongside the flow, then enter the selected side of the end box.
     end_is_right <- prConvertWidthToMm(getX4elmnt(end, "x")) > prConvertWidthToMm(start$x)
     exit_x <- if (side == "right" || (side == "auto" && end_is_right)) {
       start$right
     } else {
       start$left
     }
-    line$x <- unit.c(exit_x, getX4elmnt(end, "x"), getX4elmnt(end, "x"))
-    if (prConvertHeightToMm(start$y) > prConvertHeightToMm(end$y)) {
-      line$y <- unit.c(start$y, start$y, end$top)
+
+    start_is_left <- prConvertWidthToMm(start$x) < prConvertWidthToMm(getX4elmnt(end, "x"))
+    entry_x <- if (end_side == "left" || (end_side == "auto" && start_is_left)) {
+      end$left
     } else {
-      line$y <- unit.c(start$y, start$y, end$bottom)
+      end$right
     }
+    line$x <- unit.c(exit_x, exit_x, entry_x)
+    line$y <- unit.c(start$y, end$y, end$y)
+  } else if (type == "horizontal_axis") {
+    axis_y <- start$y
+    target_y <- prClampUnit(axis_y, end$bottom, end$top, axis = "y")
+    edges <- prHorizontalAxisEdges(start, end)
+
+    line$x <- unit.c(edges$start_edge, edges$target_edge)
+    line$y <- unit.c(axis_y, target_y)
   } else { # horizontal
     line$y <- unit.c(start$y, end$y)
     if (prConvertWidthToMm(getX4elmnt(start, "x")) < prConvertWidthToMm(getX4elmnt(end, "x"))) {