diff --git a/DESCRIPTION b/DESCRIPTION
index d7944c2..2290e64 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -39,7 +39,8 @@ Suggests:
ggrepel,
ggtext,
scales,
- reactable
+ reactable,
+ patchwork
Config/Needs/website: sf, geofacet, ggtext, quarto, kcuilla/reactablefmtr
Config/testthat/edition: 3
Depends:
diff --git a/NAMESPACE b/NAMESPACE
index 2ca9ed9..0d3f2a4 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -15,7 +15,10 @@ export(geom_pop)
export(ggpop_markers)
export(icon_grid)
export(key_legend)
+export(legend_box)
export(legend_canvas)
+export(legend_composite)
+export(legend_ratios)
export(legend_strip)
export(marker_legend)
export(process_data)
@@ -32,7 +35,10 @@ importFrom(ggplot2,draw_key_point)
importFrom(ggplot2,ggplot)
importFrom(ggplot2,ggplot_add)
importFrom(ggplot2,ggplot_build)
+importFrom(ggplot2,ggsave)
importFrom(ggplot2,last_plot)
+importFrom(ggplot2,margin)
+importFrom(ggplot2,theme)
importFrom(ggplot2,theme_void)
importFrom(ggplot2,zeroGrob)
importFrom(grDevices,as.raster)
diff --git a/NEWS.md b/NEWS.md
index 25c1a46..51c0cf4 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -7,10 +7,23 @@
- `ggpop_markers()` lists the bundled marker names (and the names found in an `icon_path` folder) - the companion to `fa_icons()` (#383).
- `marker_legend()` builds a standalone composite legend of icon markers - multiple columns, mixed icon sources (Font Awesome, bundled markers, or your own SVGs), and room for extra annotations - for cases that ggplot2's built-in guides cannot express. For an ordinary data-driven legend, keep using `legend_icons = TRUE` with `scale_legend_icon()` (#385).
- `marker_legend()` gains a `label_colour` argument (default `"black"`) to control the text colour of both entry labels and the title (#385).
+- `key_legend()` gains a `label_fontface` argument (default `"plain"`) controlling the title and entry-label font face; does not affect the `"point"`-type `"*"` glyph, which stays bold regardless (#393).
+- `legend_canvas()` gains a `label_fontface` argument, passed through to both the grid (`marker_legend()`) and group/symbol (`key_legend()`) sections so the whole composite legend can be set bold/italic/plain from one place (#393).
+- `legend_canvas()` gains a `label_scale` argument - an extra multiplier applied on top of `scale` to the label text sizes only (grid, group, and symbol labels), leaving marker and spacing sizes untouched. Use it to enlarge or shrink every label relative to the markers from one place (#393).
+- `legend_canvas()`'s `scale` now multiplies **every** length uniformly, including `group_width`, `group_gap`, `symbol_right_gap`, and `symbol_key_width` (previously these four were the only lengths left unscaled). This lets the whole legend be written as plain multiples of one base module with `scale` sizing the result. Note: this changes the rendered size of those sections when `scale` is not `1` - divide those four values by your `scale` to reproduce earlier output (#393).
+- `legend_box()` draws a border tightly around a composite legend's actual rendered content. `legend_canvas()` positions sections from nominal geometry, but text labels overflow their anchor points by a font/output-size-dependent amount, so a geometry-derived box clips them; `legend_box()` renders the legend once at the intended output size, measures the true content extent, and fits the border to it (#393).
+- `legend_composite()` builds a bordered three-section legend (icon grid + colour tiles + typed-symbol key) in one call, wrapping `legend_canvas()` + `legend_box()`. Every layout length is a multiple of one `module`, every text size a multiple of one `text` base, and icons one `marker` size; the fixed proportion ladder is `legend_ratios()` (overridable). Supply the content and strip size and it applies the ladder, centres the content, and fits the border (#393).
+- `legend_composite()` gains a `base_width` argument (default `27`): its base sizes are calibrated for a `base_width`-inch strip and multiplied by `width / base_width`, so passing any `width` reproduces the same legend proportions at that physical size - the template now generalises to any figure width, not just the 27-inch one it was tuned on. Set `base_width = width` to size in absolute units instead (#393).
+- `legend_composite()` now warns (class `"ggpop_swatch_aspect_warning"`) when a small `content_range` relative to `width` stretches the group colour swatches into wide banners while the fixed-size icons stay put. The message points to raising `content_range` or reducing `width` so sparse legends stay compact instead of stretched (#393).
+- `legend_ratios()` returns the default proportion ladder used by `legend_composite()` as a named list, for inspection or partial override (#393).
## Bug Fixes
- `geom_pop()` and `geom_icon_point()` now bake the mapped colour directly into each icon at draw time instead of relying on `ggimage`'s tinting. The previous approach depended on the installed `magick`/ImageMagick build producing an RGBA bitmap; when it did not, icons rendered black even though the legend showed the correct colours. Colours (including custom `scale_colour_*()` scales) and per-group transparency are now applied deterministically (#380).
+- `legend_canvas()`'s default `x_margin` and `y_margin` were asymmetric (`c(0.10, 1.00)` and `c(0.6, 1.1)` respectively), pushing composite legend content visibly off-centre. Both defaults are now symmetric (`c(1.00, 1.00)` and `c(1.1, 1.1)`), and new `align = c("center", "left", "right")` and `valign = c("center", "top", "bottom")` arguments offer a convenient way to bias the padding without hand-tuning `x_margin`/`y_margin` directly (#393).
+- `legend_canvas()` sized the canvas height from the grid's row count alone, so a `group_section` or `symbol_section` with more entries than the grid has rows extended below the fitted border and was clipped. The auto `ylim` now encloses whichever section runs deepest, so taller colour-tile or symbol blocks are always contained (#393).
+- `legend_strip()` silently rendered only the last panel (stretched to the full width) when the main plot was a `patchwork` combination of several `ggplot`s, because `ggplot2::ggplotGrob()` cannot see a patchwork's individual panels. It now detects `patchwork` mains and converts them with `patchwork::patchworkGrob()` instead, rendering every panel correctly (requires the `patchwork` package, now listed in `Suggests`).
+- `marker_legend()`'s title was always drawn `"plain"` regardless of `label_fontface`, so a bold-labelled legend still showed a plain title. The title now follows `label_fontface`, matching the entry labels (#393).
# ggpop 1.7.1
diff --git a/R/key_legend.R b/R/key_legend.R
index 73d00f8..491e2ef 100644
--- a/R/key_legend.R
+++ b/R/key_legend.R
@@ -48,6 +48,10 @@
#' @param label_inside When \code{TRUE}, centres the label inside the key
#' symbol instead of beside it. Only takes effect for \code{swatch} rows
#' (default \code{FALSE}).
+#' @param label_fontface Font face for the title and entry labels (default
+#' \code{"plain"}). Common values: \code{"plain"}, \code{"bold"},
+#' \code{"italic"}. Does not affect the \code{"point"}-type \code{"*"}
+#' glyph, which is always bold.
#' @param title_color Colour of the section title. Inherits
#' \code{label_color} when \code{NULL} (the default).
#' @param swatch_height Height of swatch rectangles as a fraction of
@@ -97,6 +101,7 @@ key_legend <- function(
label_size = 2.8,
label_color = "black",
label_inside = FALSE,
+ label_fontface = "plain",
title_color = NULL,
swatch_height = 0.45,
point_size = 1.6
@@ -105,20 +110,21 @@ key_legend <- function(
structure(
list(
- entries = entries,
- x = x,
- y_start = y_start,
- title = title,
- title_frac = title_frac,
- row_spacing = row_spacing,
- key_width = key_width,
- label_gap = label_gap,
- label_size = label_size,
- label_color = label_color,
- label_inside = label_inside,
- title_color = title_color %||% label_color,
- swatch_height = swatch_height,
- point_size = point_size
+ entries = entries,
+ x = x,
+ y_start = y_start,
+ title = title,
+ title_frac = title_frac,
+ row_spacing = row_spacing,
+ key_width = key_width,
+ label_gap = label_gap,
+ label_size = label_size,
+ label_color = label_color,
+ label_inside = label_inside,
+ label_fontface = label_fontface,
+ title_color = title_color %||% label_color,
+ swatch_height = swatch_height,
+ point_size = point_size
),
class = "ggpop_key_legend"
)
@@ -188,6 +194,7 @@ build_key_legend_layers <- function(obj) {
layers <- list()
tc <- obj$title_color %||% lc
+ ff <- obj$label_fontface %||% "plain"
if (!is.null(obj$title)) {
layers <- c(layers, list(
ggplot2::annotate(
@@ -195,7 +202,7 @@ build_key_legend_layers <- function(obj) {
x = x_sym_mid, y = rs * tf,
label = obj$title,
hjust = 0.5, vjust = 0.5,
- size = ls, colour = tc
+ size = ls, colour = tc, fontface = ff
)
))
}
@@ -255,14 +262,14 @@ build_key_legend_layers <- function(obj) {
"text",
x = x + kw / 2, y = y,
label = lbl, hjust = 0.5, vjust = 0.5,
- size = row_ls, colour = lc, lineheight = row_lh
+ size = row_ls, colour = lc, lineheight = row_lh, fontface = ff
)
} else {
ggplot2::annotate(
"text",
x = x_label, y = y,
label = lbl, hjust = 0, vjust = 0.5,
- size = row_ls, colour = lc, lineheight = row_lh
+ size = row_ls, colour = lc, lineheight = row_lh, fontface = ff
)
}
diff --git a/R/legend-canvas.R b/R/legend-canvas.R
index 6d8293b..42896cf 100644
--- a/R/legend-canvas.R
+++ b/R/legend-canvas.R
@@ -89,8 +89,10 @@ icon_grid <- function(df, icon, label, row, col, label_fn = NULL, section = "gri
#' \code{NULL} skips the group section.
#' @param group_title Title drawn above the colour tiles. Inherits
#' \code{group_section} when \code{NULL}.
-#' @param group_width Width of the colour tile section.
-#' @param group_gap Gap between the tile right edge and \code{x = 0}.
+#' @param group_width Width of the colour tile section (scaled by
+#' \code{scale}).
+#' @param group_gap Gap between the tile right edge and \code{x = 0}
+#' (scaled by \code{scale}).
#' @param group_label_size Label size inside tiles; inherits \code{label_size}
#' (after scaling) when \code{NA}.
#' @param group_label_color Label colour inside tiles (default \code{"white"}).
@@ -99,8 +101,9 @@ icon_grid <- function(df, icon, label, row, col, label_fn = NULL, section = "gri
#' @param symbol_section Value of \code{section} identifying typed-symbol rows.
#' \code{NULL} skips the symbol section.
#' @param symbol_right_gap Gap between icon grid right edge and symbol section
-#' (default \code{0.30}).
-#' @param symbol_key_width Width of the key symbol area (default \code{0.20}).
+#' (default \code{0.30}; scaled by \code{scale}).
+#' @param symbol_key_width Width of the key symbol area (default \code{0.20};
+#' scaled by \code{scale}).
#' @param symbol_label_gap Gap between key symbol and label; inherits
#' \code{label_gap} (after scaling) when \code{NULL}.
#' @param col_spacing Horizontal distance between icon grid columns.
@@ -108,20 +111,54 @@ icon_grid <- function(df, icon, label, row, col, label_fn = NULL, section = "gri
#' @param label_gap Default gap between key symbol and label.
#' @param marker_size Icon size for the grid.
#' @param label_size Default label text size.
-#' @param scale Multiplier applied to \code{col_spacing},
-#' \code{row_spacing}, \code{label_gap}, \code{marker_size},
-#' \code{label_size}, and the \code{label_size} column in \code{df_legend}.
-#' Use to scale the whole legend without touching individual values (default
-#' \code{1}).
+#' @param label_fontface Font face for every title and label in the legend
+#' (grid title, group title/tile labels, symbol title/labels) - default
+#' \code{"plain"}. Common values: \code{"plain"}, \code{"bold"},
+#' \code{"italic"}. Does not affect the \code{"point"}-type \code{"*"}
+#' glyph, which is always bold.
+#' @param scale Multiplier applied to every length and size:
+#' \code{col_spacing}, \code{row_spacing}, \code{label_gap},
+#' \code{marker_size}, \code{label_size} (and its \code{df_legend} column),
+#' \code{group_width}, \code{group_gap}, \code{group_label_size},
+#' \code{symbol_right_gap}, \code{symbol_key_width}, and
+#' \code{symbol_label_gap}. Because it scales the whole legend uniformly,
+#' every length can be written as a plain multiple of one base module and
+#' \code{scale} sizes the result (default \code{1}).
+#' @param label_scale Extra multiplier applied on top of \code{scale} to the
+#' text sizes only - \code{label_size}, \code{group_label_size}, and the
+#' \code{label_size} column in \code{df_legend} - leaving marker and spacing
+#' sizes untouched. Use to enlarge/shrink every label relative to the
+#' markers from one place (default \code{1}).
#' @param dpi Icon render resolution (default \code{300}).
#' @param xlim Length-2 numeric; x limits of the canvas. Auto-computed
#' when \code{NULL}.
#' @param ylim Length-2 numeric; y limits of the canvas. Auto-computed
-#' when \code{NULL}.
+#' when \code{NULL} to enclose whichever section reaches deepest - the grid
+#' rows, the group tiles, or the symbol keys - so a group/symbol block with
+#' more entries than the grid has rows is not clipped.
#' @param x_margin Length-2 numeric: left/right padding added to auto x range
-#' (default \code{c(0.10, 1.00)}).
+#' (default \code{c(1.00, 1.00)}, i.e. centred). Ignored when \code{xlim}
+#' is supplied directly; overridden when \code{align} is set. A
+#' \code{symbol_section}'s labels extend right of \code{x_right} with no
+#' accounting for label width, so the default is sized generously enough
+#' to hold typical labels without clipping - not the smallest margin that
+#' centres the nominal content bounds.
+#' @param align Optional convenience for biasing \code{x_margin}: one of
+#' \code{"center"} (equal left/right padding), \code{"left"} (small left /
+#' large right padding), or \code{"right"} (large left / small right
+#' padding). Redistributes \code{sum(x_margin)} between the two sides -
+#' the total padding is unchanged, only its left/right split. \code{NULL}
+#' (default) leaves \code{x_margin} untouched.
#' @param y_margin Length-2 numeric: top/bottom padding as multiples of
-#' (scaled) \code{row_spacing} (default \code{c(0.6, 1.1)}).
+#' (scaled) \code{row_spacing} (default \code{c(1.1, 1.1)}, i.e. centred).
+#' Ignored when \code{ylim} is supplied directly; overridden when
+#' \code{valign} is set.
+#' @param valign Optional convenience for biasing \code{y_margin}: one of
+#' \code{"center"} (equal top/bottom padding), \code{"top"} (small top /
+#' large bottom padding), or \code{"bottom"} (large top / small bottom
+#' padding). Redistributes \code{sum(y_margin)} between the two sides,
+#' the same way \code{align} redistributes \code{x_margin}. \code{NULL}
+#' (default) leaves \code{y_margin} untouched.
#' @param clip Passed to \code{coord_cartesian} (default \code{"off"}).
#'
#' @return A \code{ggplot} ready to save or pass to \code{\link{legend_strip}}.
@@ -150,19 +187,30 @@ legend_canvas <- function(
label_gap,
marker_size,
label_size,
- scale = 1,
+ label_fontface = "plain",
+ scale = 1,
+ label_scale = 1,
dpi = 300,
xlim = NULL,
ylim = NULL,
- x_margin = c(0.10, 1.00),
- y_margin = c(0.6, 1.1),
+ x_margin = c(1.00, 1.00),
+ align = NULL,
+ y_margin = c(1.1, 1.1),
+ valign = NULL,
clip = "off"
) {
cs <- col_spacing * scale
rs <- row_spacing * scale
lg <- label_gap * scale
ms <- marker_size * scale
- ls <- label_size * scale
+ ls <- label_size * scale * label_scale
+
+ # Group/symbol section lengths scale with the grid too, so `scale` sizes the
+ # whole legend uniformly (every length is in one unit).
+ gw <- if (is.null(group_width)) NULL else group_width * scale
+ gg <- group_gap * scale
+ srg <- symbol_right_gap * scale
+ skw <- symbol_key_width * scale
icon_rows <- df_legend[df_legend$section == grid_section, ]
n_cols <- max(icon_rows$col, na.rm = TRUE)
@@ -171,16 +219,35 @@ legend_canvas <- function(
# ---- auto xlim / ylim ------------------------------------------------------
if (is.null(xlim)) {
+ x_margin <- resolve_margin_align(x_margin, align, "left", "right", "align")
+
x_left <- if (!is.null(group_section) && !is.null(group_width))
- -(group_width + group_gap) else 0
+ -(gw + gg) else 0
x_right <- if (!is.null(symbol_section))
- grid_end + symbol_right_gap + symbol_key_width
+ grid_end + srg + skw
else grid_end
xlim <- c(x_left - x_margin[[1L]], x_right + x_margin[[2L]])
}
if (is.null(ylim)) {
- ylim <- c(-(n_rows - 1) * rs - rs * y_margin[[2L]],
+ y_margin <- resolve_margin_align(y_margin, valign, "top", "bottom", "valign")
+
+ # The canvas must enclose whichever section reaches deepest: the grid
+ # (rows), the group tiles (one per entry from y = 0), or the symbol keys
+ # (first entry sits in the title slot, the rest from y = 0). Sizing on the
+ # grid alone let taller group/symbol blocks spill below the border.
+ depths <- n_rows - 1L
+ if (!is.null(group_section)) {
+ n_group <- sum(df_legend$section == group_section)
+ if (n_group > 0L) depths <- c(depths, n_group - 1L)
+ }
+ if (!is.null(symbol_section)) {
+ n_symbol <- sum(df_legend$section == symbol_section)
+ if (n_symbol > 0L) depths <- c(depths, max(n_symbol - 2L, 0L))
+ }
+ depth <- max(depths)
+
+ ylim <- c(-depth * rs - rs * y_margin[[2L]],
rs * 0.85 + rs * y_margin[[1L]])
}
@@ -195,14 +262,15 @@ legend_canvas <- function(
p <- marker_legend(
grid_entries,
- layout = "grid",
- title = grid_title,
- marker_size = ms,
- label_size = ls,
- dpi = dpi,
- col_spacing = cs,
- row_spacing = rs,
- label_gap = lg
+ layout = "grid",
+ title = grid_title,
+ marker_size = ms,
+ label_size = ls,
+ label_fontface = label_fontface,
+ dpi = dpi,
+ col_spacing = cs,
+ row_spacing = rs,
+ label_gap = lg
) + ggplot2::coord_cartesian(xlim = xlim, ylim = ylim, clip = clip)
# ---- group / colour tiles --------------------------------------------------
@@ -210,8 +278,8 @@ legend_canvas <- function(
grp <- df_legend[df_legend$section == group_section, ]
if (is.null(group_width))
cli::cli_abort("{.arg group_width} is required when {.arg group_section} is set.")
- grp_x <- -(group_width + group_gap)
- grp_ls <- if (is.na(group_label_size)) ls else group_label_size * scale
+ grp_x <- -(gw + gg)
+ grp_ls <- if (is.na(group_label_size)) ls else group_label_size * scale * label_scale
grp_type <- if ("type" %in% names(grp)) as.character(grp$type) else rep(NA_character_, nrow(grp))
grp_type[is.na(grp_type) | !nzchar(grp_type)] <- "swatch"
@@ -225,24 +293,25 @@ legend_canvas <- function(
p <- p + key_legend(
grp_entries,
- x = grp_x,
- y_start = 0,
- title = group_title %||% group_section,
- row_spacing = rs,
- key_width = group_width,
- label_gap = lg,
- label_size = grp_ls,
- label_inside = TRUE,
- label_color = group_label_color,
- title_color = "black",
- swatch_height = group_swatch_height
+ x = grp_x,
+ y_start = 0,
+ title = group_title %||% group_section,
+ row_spacing = rs,
+ key_width = gw,
+ label_gap = lg,
+ label_size = grp_ls,
+ label_inside = TRUE,
+ label_color = group_label_color,
+ label_fontface = label_fontface,
+ title_color = "black",
+ swatch_height = group_swatch_height
)
}
# ---- typed-symbol section --------------------------------------------------
if (!is.null(symbol_section)) {
sym <- df_legend[df_legend$section == symbol_section, ]
- sym_x <- grid_end + symbol_right_gap
+ sym_x <- grid_end + srg
sym_lg <- if (is.null(symbol_label_gap)) lg else symbol_label_gap * scale
sym_entries <- data.frame(
@@ -252,19 +321,334 @@ legend_canvas <- function(
stringsAsFactors = FALSE
)
if ("label_size" %in% names(sym) && any(!is.na(sym$label_size)))
- sym_entries$label_size <- as.numeric(sym$label_size) * scale
+ sym_entries$label_size <- as.numeric(sym$label_size) * scale * label_scale
if ("lineheight" %in% names(sym) && any(!is.na(sym$lineheight)))
sym_entries$lineheight <- as.numeric(sym$lineheight)
p <- p + key_legend(
sym_entries,
- x = sym_x,
- row_spacing = rs,
- key_width = symbol_key_width,
- label_gap = sym_lg,
- label_size = ls
+ x = sym_x,
+ row_spacing = rs,
+ key_width = skw,
+ label_gap = sym_lg,
+ label_size = ls,
+ label_fontface = label_fontface
)
}
p
}
+
+
+#' Draw a border tightly around a composite legend's rendered content
+#'
+#' @description
+#' \code{\link{legend_canvas}} positions its sections from nominal geometry,
+#' but text labels overflow their anchor points by an amount that depends on
+#' the font, the label strings, and the final output size - none of which are
+#' known when the layers are built. A border drawn from that nominal geometry
+#' therefore clips the labels. \code{legend_box()} sidesteps this by rendering
+#' the legend once at the intended output size, measuring the true pixel extent
+#' of the drawn content, mapping it back to data coordinates, and adding a
+#' border rectangle around it.
+#'
+#' Because it renders once to measure, the border reflects exactly what will be
+#' drawn - long labels, mixed fonts, any content - with no per-figure hand
+#' tuning.
+#'
+#' @param plot A \code{ggplot} (typically \code{\link{legend_canvas}} output)
+#' whose coordinate system supplies fixed \code{xlim}/\code{ylim}
+#' (\code{legend_canvas()} always does). Add \code{legend_box()} last, after
+#' any other layers, so it encloses everything.
+#' @param width,height Physical size in inches of the region the legend will be
+#' drawn in for the final export - pass the same values used there so the
+#' measured text width matches. For a \code{\link{legend_strip}} legend this
+#' is the full figure width and the strip \code{height}.
+#' @param padding Length-2 numeric: gap between content and border, as
+#' fractions of the measured content width and height
+#' (default \code{c(0.02, 0.12)}).
+#' @param colour Border colour (default \code{"black"}).
+#' @param linewidth Border line width (default \code{0.7}).
+#' @param fill Border fill (default \code{NA}, i.e. transparent).
+#' @param threshold Grayscale ink cutoff (0-255) for detecting content;
+#' pixels darker than this count as content (default \code{150}).
+#' @param dpi Resolution of the internal measurement render (default
+#' \code{150}); higher is more precise but slower.
+#'
+#' @return \code{plot} with a border \code{ggplot2::annotate("rect", ...)}
+#' layer added.
+#'
+#' @seealso \code{\link{legend_canvas}}, \code{\link{legend_strip}}
+#' @importFrom ggplot2 coord_cartesian theme margin annotate ggsave
+#' @export
+legend_box <- function(plot, width, height,
+ padding = c(0.02, 0.12),
+ colour = "black",
+ linewidth = 0.7,
+ fill = NA,
+ threshold = 150,
+ dpi = 150) {
+ xr <- plot$coordinates$limits$x
+ yr <- plot$coordinates$limits$y
+ if (is.null(xr) || is.null(yr)) {
+ cli::cli_abort(c(
+ "{.arg plot} must have fixed x and y limits for {.fn legend_box}.",
+ i = "Pass a {.fn legend_canvas} result, or set {.fn ggplot2::coord_cartesian} {.arg xlim}/{.arg ylim}."
+ ))
+ }
+ if (!requireNamespace("magick", quietly = TRUE)) {
+ cli::cli_abort("{.fn legend_box} needs the {.pkg magick} package.")
+ }
+
+ tmp <- tempfile(fileext = ".png")
+ on.exit(unlink(tmp), add = TRUE)
+ measure_plot <- suppressMessages(
+ plot +
+ ggplot2::coord_cartesian(xlim = xr, ylim = yr, expand = FALSE, clip = "off") +
+ ggplot2::theme(plot.margin = ggplot2::margin(0, 0, 0, 0))
+ )
+ ggplot2::ggsave(tmp, measure_plot, width = width, height = height, dpi = dpi, bg = "white")
+
+ bmp <- magick::image_data(magick::image_read(tmp), channels = "gray")
+ storage.mode(bmp) <- "integer"
+ px_w <- dim(bmp)[2]
+ px_h <- dim(bmp)[3]
+ col_ink <- which(apply(bmp[1, , ], 1, function(cc) any(cc < threshold)))
+ row_ink <- which(apply(bmp[1, , ], 2, function(rr) any(rr < threshold)))
+ if (!length(col_ink) || !length(row_ink)) {
+ cli::cli_abort("{.fn legend_box} found no content to enclose.")
+ }
+
+ px_to_x <- function(px) xr[[1L]] + (px / px_w) * (xr[[2L]] - xr[[1L]])
+ px_to_y <- function(py) yr[[2L]] - (py / px_h) * (yr[[2L]] - yr[[1L]])
+ cx_lo <- px_to_x(min(col_ink))
+ cx_hi <- px_to_x(max(col_ink))
+ cy_hi <- px_to_y(min(row_ink))
+ cy_lo <- px_to_y(max(row_ink))
+ pad_x <- (cx_hi - cx_lo) * padding[[1L]]
+ pad_y <- (cy_hi - cy_lo) * padding[[2L]]
+
+ plot +
+ ggplot2::annotate(
+ "rect",
+ xmin = cx_lo - pad_x, xmax = cx_hi + pad_x,
+ ymin = cy_lo - pad_y, ymax = cy_hi + pad_y,
+ fill = fill, colour = colour, linewidth = linewidth
+ )
+}
+
+
+#' Default proportion ladder for \code{\link{legend_composite}}
+#'
+#' @description
+#' Returns the fixed layout proportions used by \code{\link{legend_composite}}
+#' as a named list. Lengths are multiples of the layout module (see the
+#' \code{module} argument there); the two \code{*_label} entries are multiples
+#' of the text base (\code{text} there). Override individual entries and pass
+#' the result back via \code{legend_composite(ratios = ...)}.
+#'
+#' @return A named list of proportions.
+#' @seealso \code{\link{legend_composite}}
+#' @export
+legend_ratios <- function() {
+ list(
+ col_spacing = 0.986, # x module
+ row_spacing = 1.000, # x module
+ label_gap = 0.167, # x module
+ group_width = 1.065, # x module
+ group_gap = 0.365, # x module
+ symbol_right_gap = 0.875, # x module
+ symbol_key_width = 0.567, # x module
+ symbol_label_gap = 0.060, # x module
+ group_label = 0.933, # x text
+ label = 1.000 # x text
+ )
+}
+
+
+#' Build a bordered composite legend in one call
+#'
+#' @description
+#' Opinionated wrapper over \code{\link{legend_canvas}} + \code{\link{legend_box}}
+#' for the recurring three-section legend (an icon grid, a block of colour
+#' tiles, and a small typed-symbol key). You supply the \emph{content}
+#' (\code{df_legend}) and the strip size; the wrapper applies a fixed
+#' proportion ladder (\code{\link{legend_ratios}}) driven by three base sizes,
+#' centres the content in the strip, and fits a border to the rendered result.
+#'
+#' Every layout length is a multiple of one \code{module}; every text size is a
+#' multiple of one \code{text} base; icons use one \code{marker} size. A
+#' \code{label_size} column on the symbol-section rows is read as multiples of
+#' \code{text}.
+#'
+#' The base sizes are calibrated for a \code{base_width}-inch strip and are
+#' scaled by \code{width / base_width}, so a legend keeps identical proportions
+#' at any output \code{width} - pass your width and the text, markers, and
+#' layout all follow. The group and symbol blocks may hold more entries than
+#' the grid has rows; the border grows to enclose whichever section runs
+#' deepest.
+#'
+#' The group colour swatches are rectangles in data coordinates, so shrinking
+#' \code{content_range} to make sparse content fill a wide strip stretches them
+#' into banners while the fixed-size icons stay put. \code{legend_composite()}
+#' warns (class \code{"ggpop_swatch_aspect_warning"}) when the rendered swatch
+#' aspect ratio gets banner-like, pointing you to raise \code{content_range} or
+#' reduce \code{width} - keep sparse legends compact rather than stretched.
+#'
+#' @param df_legend Legend content, as for \code{\link{legend_canvas}} - grid
+#' rows plus optional group/symbol rows, identified by \code{section}.
+#' @param width,height Physical size (inches) of the strip the legend will fill
+#' (passed to \code{\link{legend_box}} and used to size/centre the content).
+#' @param grid_title,group_title Section titles (\code{NULL} = none / inherit).
+#' @param grid_section,group_section,symbol_section \code{section} values that
+#' identify each block (defaults \code{"grid"}, \code{"group"},
+#' \code{"symbol"}). A missing group/symbol section is skipped.
+#' @param module Layout module: one row / one column pitch, in legend units.
+#' @param text Base text size (ggplot mm) - the primary label size.
+#' @param marker Icon marker size (\code{\link{geom_icon_point}} units).
+#' @param content_range Total data-x range the strip maps to; larger renders a
+#' smaller legend. The content is centred within it.
+#' @param base_width Output width (inches) at which the base sizes
+#' (\code{module}, \code{text}, \code{marker}, \code{content_range}) are
+#' calibrated. Every size is multiplied by \code{width / base_width} so the
+#' legend keeps identical proportions at any \code{width} (default
+#' \code{27}). Set \code{base_width = width} to disable scaling and size in
+#' absolute units.
+#' @param swatch_height Colour-tile height as a fraction of a row.
+#' @param fontface Font face for all titles and labels.
+#' @param border Border colour (\code{NA} to skip the border).
+#' @param border_padding Length-2 \code{padding} passed to
+#' \code{\link{legend_box}}.
+#' @param ratios Proportion ladder; defaults to \code{\link{legend_ratios}()}.
+#' @param dpi Icon render resolution.
+#'
+#' @return A \code{ggplot} with a fitted border, ready for
+#' \code{\link{legend_strip}}.
+#'
+#' @seealso \code{\link{legend_canvas}}, \code{\link{legend_box}},
+#' \code{\link{legend_ratios}}, \code{\link{legend_strip}}
+#' @export
+legend_composite <- function(
+ df_legend, width, height,
+ grid_title = NULL,
+ group_title = NULL,
+ grid_section = "grid",
+ group_section = "group",
+ symbol_section = "symbol",
+ module = 0.44294,
+ text = 7.756,
+ marker = 4.562,
+ content_range = 7.21636,
+ base_width = 27,
+ swatch_height = 0.80,
+ fontface = "plain",
+ border = "#231F20",
+ border_padding = c(0.018, 0.09),
+ ratios = legend_ratios(),
+ dpi = 300
+) {
+ # The base sizes are calibrated at `base_width` inches; scale every physical
+ # size (text mm, marker units) and every data-unit length (module,
+ # content_range) by `width / base_width` so the legend keeps identical
+ # proportions at any output width. `width == base_width` leaves them as-is;
+ # `base_width == width` disables scaling for a fully custom design.
+ k <- width / base_width
+ u <- module * k
+ text <- text * k
+ marker <- marker * k
+ content_range <- content_range * k
+
+ # symbol-section per-row label_size is given in multiples of `text`
+ if (!is.null(symbol_section) && "label_size" %in% names(df_legend)) {
+ sel <- df_legend$section == symbol_section & !is.na(df_legend$label_size)
+ df_legend$label_size[sel] <- df_legend$label_size[sel] * text
+ }
+
+ has_group <- !is.null(group_section) && group_section %in% df_legend$section
+ has_symbol <- !is.null(symbol_section) && symbol_section %in% df_legend$section
+ n_cols <- max(df_legend$col[df_legend$section == grid_section], na.rm = TRUE)
+ grid_end <- (n_cols - 1) * ratios$col_spacing * u
+ content_span <- grid_end +
+ (if (has_group) (ratios$group_width + ratios$group_gap) * u else 0) +
+ (if (has_symbol) (ratios$symbol_right_gap + ratios$symbol_key_width) * u else 0)
+ x_margin <- (content_range - content_span) / 2
+
+ p <- legend_canvas(
+ df_legend,
+ grid_section = grid_section,
+ grid_title = grid_title,
+ group_section = if (has_group) group_section else NULL,
+ group_title = group_title,
+ group_width = ratios$group_width * u,
+ group_gap = ratios$group_gap * u,
+ group_label_size = ratios$group_label * text,
+ group_swatch_height = swatch_height,
+ symbol_section = if (has_symbol) symbol_section else NULL,
+ symbol_right_gap = ratios$symbol_right_gap * u,
+ symbol_key_width = ratios$symbol_key_width * u,
+ symbol_label_gap = ratios$symbol_label_gap * u,
+ col_spacing = ratios$col_spacing * u,
+ row_spacing = ratios$row_spacing * u,
+ label_gap = ratios$label_gap * u,
+ marker_size = marker,
+ label_size = ratios$label * text,
+ label_fontface = fontface,
+ scale = 1,
+ label_scale = 1,
+ dpi = dpi,
+ x_margin = c(x_margin, x_margin)
+ )
+
+ warn_swatch_aspect(p, has_group, ratios, u, swatch_height, width, height)
+
+ if (is.na(border)) return(p)
+ legend_box(p, width = width, height = height,
+ padding = border_padding, colour = border)
+}
+
+# ---- Internal ---------------------------------------------------------------
+
+# Guardrail: a group colour swatch is a rect in data coordinates, so shrinking
+# `content_range` to fill a wide strip balloons its width while the fixed-size
+# icons stay put - the banner-bar look. Compute the swatch's rendered aspect
+# (width:height, in inches) from the built plot's limits and warn when it goes
+# banner-like. Calibrated so the dense AllModels legend (~4:1) stays quiet.
+warn_swatch_aspect <- function(p, has_group, ratios, u, swatch_height, width, height,
+ threshold = 7) {
+ if (!isTRUE(has_group)) return(invisible())
+ xr <- p$coordinates$limits$x
+ yr <- p$coordinates$limits$y
+ if (is.null(xr) || is.null(yr)) return(invisible())
+
+ swatch_w <- (ratios$group_width * u) / abs(diff(xr)) * width
+ swatch_h <- (ratios$row_spacing * u * swatch_height) / abs(diff(yr)) * height
+ aspect <- swatch_w / swatch_h
+ if (!is.finite(aspect) || aspect <= threshold) return(invisible())
+
+ cli::cli_warn(
+ c(
+ "Group colour swatches are rendering very wide ({round(aspect)}:1).",
+ "!" = "A small {.arg content_range} relative to {.arg width} stretches the swatches into banners while the fixed-size icons stay put.",
+ "i" = "Increase {.arg content_range} (or reduce {.arg width}) to keep the legend compact and unstretched."
+ ),
+ class = "ggpop_swatch_aspect_warning"
+ )
+ invisible()
+}
+
+resolve_margin_align <- function(margin, align, near_side, far_side, arg_name) {
+ if (is.null(align)) return(margin)
+
+ valid <- c("center", near_side, far_side)
+ if (!is.character(align) || length(align) != 1L || !align %in% valid) {
+ cli::cli_abort(c(
+ "{.arg {arg_name}} must be one of {.val {valid}}.",
+ x = "You supplied {.val {align}}."
+ ))
+ }
+
+ total <- sum(margin)
+ if (align == "center") return(c(total, total) / 2)
+ if (align == near_side) return(c(total * 0.1, total * 0.9))
+ c(total * 0.9, total * 0.1)
+}
diff --git a/R/legend-strip.R b/R/legend-strip.R
index 72a43df..e8296ea 100644
--- a/R/legend-strip.R
+++ b/R/legend-strip.R
@@ -3,7 +3,10 @@
#' Returns a \code{ggpop_legend_strip} object. When added to a \code{ggplot}
#' with \code{+}, produces a \code{ggpop_composite} that stacks the main plot
#' above the strip at the specified physical height. The composite works with
-#' \code{ggplot2::ggsave()} and \code{print()}.
+#' \code{ggplot2::ggsave()} and \code{print()}. The main plot (the object
+#' \code{legend_strip()} is added to) may itself be a \code{patchwork} object
+#' (e.g. several panels combined with \code{+}/\code{\link[patchwork]{plot_layout}})
+#' - this requires the \pkg{patchwork} package to be installed.
#'
#' @param strip_plot A \code{ggplot} to render as the bottom strip (e.g. the
#' output of \code{\link{marker_legend}}).
@@ -53,8 +56,8 @@ grid.draw.ggpop_composite <- function(x, recording = TRUE) {
# ---- Internal ---------------------------------------------------------------
draw_composite <- function(x) {
- g_main <- ggplot2::ggplotGrob(x$main)
- g_strip <- ggplot2::ggplotGrob(x$strip)
+ g_main <- composite_grob(x$main)
+ g_strip <- composite_grob(x$strip)
grid::pushViewport(grid::viewport(
layout = grid::grid.layout(
@@ -74,3 +77,18 @@ draw_composite <- function(x) {
grid::popViewport()
grid::popViewport()
}
+
+composite_grob <- function(p) {
+ if (!inherits(p, "patchwork")) return(ggplot2::ggplotGrob(p))
+
+ if (!requireNamespace("patchwork", quietly = TRUE)) {
+ cli::cli_abort(c(
+ "A {.cls patchwork} object was passed to {.fn legend_strip}, which requires the {.pkg patchwork} package.",
+ i = "Install it with {.code install.packages(\"patchwork\")}."
+ ))
+ }
+ # ggplot2::ggplotGrob() only sees a patchwork object's base ggplot fields
+ # and silently renders just the last panel, stretched full-width - the
+ # patchwork-aware grob converter is required to capture every panel.
+ patchwork::patchworkGrob(p)
+}
diff --git a/R/marker_legend.R b/R/marker_legend.R
index 21561c6..88b66bb 100644
--- a/R/marker_legend.R
+++ b/R/marker_legend.R
@@ -136,7 +136,7 @@ marker_legend <- function(entries,
y = y_max + row_spacing * 0.85,
label = title,
hjust = 0.5,
- fontface = "plain",
+ fontface = label_fontface,
size = label_size,
colour = label_colour
)
diff --git a/_pkgdown.yml b/_pkgdown.yml
index b7e45d2..072cbc4 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -237,6 +237,9 @@ reference:
- marker_legend
- icon_grid
- legend_canvas
+ - legend_box
+ - legend_composite
+ - legend_ratios
- key_legend
- legend_strip
- fa_icons
diff --git a/man/key_legend.Rd b/man/key_legend.Rd
index 4cef5c0..3b3c77f 100644
--- a/man/key_legend.Rd
+++ b/man/key_legend.Rd
@@ -16,6 +16,7 @@ key_legend(
label_size = 2.8,
label_color = "black",
label_inside = FALSE,
+ label_fontface = "plain",
title_color = NULL,
swatch_height = 0.45,
point_size = 1.6
@@ -54,6 +55,11 @@ places entry\,1 at \code{row_spacing * title_frac}.}
symbol instead of beside it. Only takes effect for \code{swatch} rows
(default \code{FALSE}).}
+\item{label_fontface}{Font face for the title and entry labels (default
+\code{"plain"}). Common values: \code{"plain"}, \code{"bold"},
+\code{"italic"}. Does not affect the \code{"point"}-type \code{"*"}
+glyph, which is always bold.}
+
\item{title_color}{Colour of the section title. Inherits
\code{label_color} when \code{NULL} (the default).}
diff --git a/man/legend_box.Rd b/man/legend_box.Rd
new file mode 100644
index 0000000..f11cffb
--- /dev/null
+++ b/man/legend_box.Rd
@@ -0,0 +1,66 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/legend-canvas.R
+\name{legend_box}
+\alias{legend_box}
+\title{Draw a border tightly around a composite legend's rendered content}
+\usage{
+legend_box(
+ plot,
+ width,
+ height,
+ padding = c(0.02, 0.12),
+ colour = "black",
+ linewidth = 0.7,
+ fill = NA,
+ threshold = 150,
+ dpi = 150
+)
+}
+\arguments{
+\item{plot}{A \code{ggplot} (typically \code{\link{legend_canvas}} output)
+whose coordinate system supplies fixed \code{xlim}/\code{ylim}
+(\code{legend_canvas()} always does). Add \code{legend_box()} last, after
+any other layers, so it encloses everything.}
+
+\item{width, height}{Physical size in inches of the region the legend will be
+drawn in for the final export - pass the same values used there so the
+measured text width matches. For a \code{\link{legend_strip}} legend this
+is the full figure width and the strip \code{height}.}
+
+\item{padding}{Length-2 numeric: gap between content and border, as
+fractions of the measured content width and height
+(default \code{c(0.02, 0.12)}).}
+
+\item{colour}{Border colour (default \code{"black"}).}
+
+\item{linewidth}{Border line width (default \code{0.7}).}
+
+\item{fill}{Border fill (default \code{NA}, i.e. transparent).}
+
+\item{threshold}{Grayscale ink cutoff (0-255) for detecting content;
+pixels darker than this count as content (default \code{150}).}
+
+\item{dpi}{Resolution of the internal measurement render (default
+\code{150}); higher is more precise but slower.}
+}
+\value{
+\code{plot} with a border \code{ggplot2::annotate("rect", ...)}
+layer added.
+}
+\description{
+\code{\link{legend_canvas}} positions its sections from nominal geometry,
+but text labels overflow their anchor points by an amount that depends on
+the font, the label strings, and the final output size - none of which are
+known when the layers are built. A border drawn from that nominal geometry
+therefore clips the labels. \code{legend_box()} sidesteps this by rendering
+the legend once at the intended output size, measuring the true pixel extent
+of the drawn content, mapping it back to data coordinates, and adding a
+border rectangle around it.
+
+Because it renders once to measure, the border reflects exactly what will be
+drawn - long labels, mixed fonts, any content - with no per-figure hand
+tuning.
+}
+\seealso{
+\code{\link{legend_canvas}}, \code{\link{legend_strip}}
+}
diff --git a/man/legend_canvas.Rd b/man/legend_canvas.Rd
index 794a813..7c66521 100644
--- a/man/legend_canvas.Rd
+++ b/man/legend_canvas.Rd
@@ -24,12 +24,16 @@ legend_canvas(
label_gap,
marker_size,
label_size,
+ label_fontface = "plain",
scale = 1,
+ label_scale = 1,
dpi = 300,
xlim = NULL,
ylim = NULL,
- x_margin = c(0.1, 1),
- y_margin = c(0.6, 1.1),
+ x_margin = c(1, 1),
+ align = NULL,
+ y_margin = c(1.1, 1.1),
+ valign = NULL,
clip = "off"
)
}
@@ -64,9 +68,11 @@ rows go through \code{\link{marker_legend}} instead, a separate path.}
\item{group_title}{Title drawn above the colour tiles. Inherits
\code{group_section} when \code{NULL}.}
-\item{group_width}{Width of the colour tile section.}
+\item{group_width}{Width of the colour tile section (scaled by
+\code{scale}).}
-\item{group_gap}{Gap between the tile right edge and \code{x = 0}.}
+\item{group_gap}{Gap between the tile right edge and \code{x = 0}
+(scaled by \code{scale}).}
\item{group_label_size}{Label size inside tiles; inherits \code{label_size}
(after scaling) when \code{NA}.}
@@ -80,9 +86,10 @@ rows go through \code{\link{marker_legend}} instead, a separate path.}
\code{NULL} skips the symbol section.}
\item{symbol_right_gap}{Gap between icon grid right edge and symbol section
-(default \code{0.30}).}
+(default \code{0.30}; scaled by \code{scale}).}
-\item{symbol_key_width}{Width of the key symbol area (default \code{0.20}).}
+\item{symbol_key_width}{Width of the key symbol area (default \code{0.20};
+scaled by \code{scale}).}
\item{symbol_label_gap}{Gap between key symbol and label; inherits
\code{label_gap} (after scaling) when \code{NULL}.}
@@ -97,11 +104,26 @@ rows go through \code{\link{marker_legend}} instead, a separate path.}
\item{label_size}{Default label text size.}
-\item{scale}{Multiplier applied to \code{col_spacing},
-\code{row_spacing}, \code{label_gap}, \code{marker_size},
-\code{label_size}, and the \code{label_size} column in \code{df_legend}.
-Use to scale the whole legend without touching individual values (default
-\code{1}).}
+\item{label_fontface}{Font face for every title and label in the legend
+(grid title, group title/tile labels, symbol title/labels) - default
+\code{"plain"}. Common values: \code{"plain"}, \code{"bold"},
+\code{"italic"}. Does not affect the \code{"point"}-type \code{"*"}
+glyph, which is always bold.}
+
+\item{scale}{Multiplier applied to every length and size:
+\code{col_spacing}, \code{row_spacing}, \code{label_gap},
+\code{marker_size}, \code{label_size} (and its \code{df_legend} column),
+\code{group_width}, \code{group_gap}, \code{group_label_size},
+\code{symbol_right_gap}, \code{symbol_key_width}, and
+\code{symbol_label_gap}. Because it scales the whole legend uniformly,
+every length can be written as a plain multiple of one base module and
+\code{scale} sizes the result (default \code{1}).}
+
+\item{label_scale}{Extra multiplier applied on top of \code{scale} to the
+text sizes only - \code{label_size}, \code{group_label_size}, and the
+\code{label_size} column in \code{df_legend} - leaving marker and spacing
+sizes untouched. Use to enlarge/shrink every label relative to the
+markers from one place (default \code{1}).}
\item{dpi}{Icon render resolution (default \code{300}).}
@@ -109,13 +131,36 @@ Use to scale the whole legend without touching individual values (default
when \code{NULL}.}
\item{ylim}{Length-2 numeric; y limits of the canvas. Auto-computed
-when \code{NULL}.}
+when \code{NULL} to enclose whichever section reaches deepest - the grid
+rows, the group tiles, or the symbol keys - so a group/symbol block with
+more entries than the grid has rows is not clipped.}
\item{x_margin}{Length-2 numeric: left/right padding added to auto x range
-(default \code{c(0.10, 1.00)}).}
+(default \code{c(1.00, 1.00)}, i.e. centred). Ignored when \code{xlim}
+is supplied directly; overridden when \code{align} is set. A
+\code{symbol_section}'s labels extend right of \code{x_right} with no
+accounting for label width, so the default is sized generously enough
+to hold typical labels without clipping - not the smallest margin that
+centres the nominal content bounds.}
+
+\item{align}{Optional convenience for biasing \code{x_margin}: one of
+\code{"center"} (equal left/right padding), \code{"left"} (small left /
+large right padding), or \code{"right"} (large left / small right
+padding). Redistributes \code{sum(x_margin)} between the two sides -
+the total padding is unchanged, only its left/right split. \code{NULL}
+(default) leaves \code{x_margin} untouched.}
\item{y_margin}{Length-2 numeric: top/bottom padding as multiples of
-(scaled) \code{row_spacing} (default \code{c(0.6, 1.1)}).}
+(scaled) \code{row_spacing} (default \code{c(1.1, 1.1)}, i.e. centred).
+Ignored when \code{ylim} is supplied directly; overridden when
+\code{valign} is set.}
+
+\item{valign}{Optional convenience for biasing \code{y_margin}: one of
+\code{"center"} (equal top/bottom padding), \code{"top"} (small top /
+large bottom padding), or \code{"bottom"} (large top / small bottom
+padding). Redistributes \code{sum(y_margin)} between the two sides,
+the same way \code{align} redistributes \code{x_margin}. \code{NULL}
+(default) leaves \code{y_margin} untouched.}
\item{clip}{Passed to \code{coord_cartesian} (default \code{"off"}).}
}
diff --git a/man/legend_composite.Rd b/man/legend_composite.Rd
new file mode 100644
index 0000000..ca080e2
--- /dev/null
+++ b/man/legend_composite.Rd
@@ -0,0 +1,105 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/legend-canvas.R
+\name{legend_composite}
+\alias{legend_composite}
+\title{Build a bordered composite legend in one call}
+\usage{
+legend_composite(
+ df_legend,
+ width,
+ height,
+ grid_title = NULL,
+ group_title = NULL,
+ grid_section = "grid",
+ group_section = "group",
+ symbol_section = "symbol",
+ module = 0.44294,
+ text = 7.756,
+ marker = 4.562,
+ content_range = 7.21636,
+ base_width = 27,
+ swatch_height = 0.8,
+ fontface = "plain",
+ border = "#231F20",
+ border_padding = c(0.018, 0.09),
+ ratios = legend_ratios(),
+ dpi = 300
+)
+}
+\arguments{
+\item{df_legend}{Legend content, as for \code{\link{legend_canvas}} - grid
+rows plus optional group/symbol rows, identified by \code{section}.}
+
+\item{width, height}{Physical size (inches) of the strip the legend will fill
+(passed to \code{\link{legend_box}} and used to size/centre the content).}
+
+\item{grid_title, group_title}{Section titles (\code{NULL} = none / inherit).}
+
+\item{grid_section, group_section, symbol_section}{\code{section} values that
+identify each block (defaults \code{"grid"}, \code{"group"},
+\code{"symbol"}). A missing group/symbol section is skipped.}
+
+\item{module}{Layout module: one row / one column pitch, in legend units.}
+
+\item{text}{Base text size (ggplot mm) - the primary label size.}
+
+\item{marker}{Icon marker size (\code{\link{geom_icon_point}} units).}
+
+\item{content_range}{Total data-x range the strip maps to; larger renders a
+smaller legend. The content is centred within it.}
+
+\item{base_width}{Output width (inches) at which the base sizes
+(\code{module}, \code{text}, \code{marker}, \code{content_range}) are
+calibrated. Every size is multiplied by \code{width / base_width} so the
+legend keeps identical proportions at any \code{width} (default
+\code{27}). Set \code{base_width = width} to disable scaling and size in
+absolute units.}
+
+\item{swatch_height}{Colour-tile height as a fraction of a row.}
+
+\item{fontface}{Font face for all titles and labels.}
+
+\item{border}{Border colour (\code{NA} to skip the border).}
+
+\item{border_padding}{Length-2 \code{padding} passed to
+\code{\link{legend_box}}.}
+
+\item{ratios}{Proportion ladder; defaults to \code{\link{legend_ratios}()}.}
+
+\item{dpi}{Icon render resolution.}
+}
+\value{
+A \code{ggplot} with a fitted border, ready for
+\code{\link{legend_strip}}.
+}
+\description{
+Opinionated wrapper over \code{\link{legend_canvas}} + \code{\link{legend_box}}
+for the recurring three-section legend (an icon grid, a block of colour
+tiles, and a small typed-symbol key). You supply the \emph{content}
+(\code{df_legend}) and the strip size; the wrapper applies a fixed
+proportion ladder (\code{\link{legend_ratios}}) driven by three base sizes,
+centres the content in the strip, and fits a border to the rendered result.
+
+Every layout length is a multiple of one \code{module}; every text size is a
+multiple of one \code{text} base; icons use one \code{marker} size. A
+\code{label_size} column on the symbol-section rows is read as multiples of
+\code{text}.
+
+The base sizes are calibrated for a \code{base_width}-inch strip and are
+scaled by \code{width / base_width}, so a legend keeps identical proportions
+at any output \code{width} - pass your width and the text, markers, and
+layout all follow. The group and symbol blocks may hold more entries than
+the grid has rows; the border grows to enclose whichever section runs
+deepest.
+
+The group colour swatches are rectangles in data coordinates, so shrinking
+\code{content_range} to make sparse content fill a wide strip stretches them
+into banners while the fixed-size icons stay put. \code{legend_composite()}
+warns (class \code{"ggpop_swatch_aspect_warning"}) when the rendered swatch
+aspect ratio gets banner-like, pointing you to raise \code{content_range} or
+reduce \code{width} - keep sparse legends compact rather than stretched.
+}
+\seealso{
+\code{\link{legend_canvas}}, \code{\link{legend_box}},
+\code{\link{legend_ratios}}, \code{\link{legend_strip}}
+}
diff --git a/man/legend_ratios.Rd b/man/legend_ratios.Rd
new file mode 100644
index 0000000..dbcecb7
--- /dev/null
+++ b/man/legend_ratios.Rd
@@ -0,0 +1,21 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/legend-canvas.R
+\name{legend_ratios}
+\alias{legend_ratios}
+\title{Default proportion ladder for \code{\link{legend_composite}}}
+\usage{
+legend_ratios()
+}
+\value{
+A named list of proportions.
+}
+\description{
+Returns the fixed layout proportions used by \code{\link{legend_composite}}
+as a named list. Lengths are multiples of the layout module (see the
+\code{module} argument there); the two \code{*_label} entries are multiples
+of the text base (\code{text} there). Override individual entries and pass
+the result back via \code{legend_composite(ratios = ...)}.
+}
+\seealso{
+\code{\link{legend_composite}}
+}
diff --git a/man/legend_strip.Rd b/man/legend_strip.Rd
index d257907..8060f5a 100644
--- a/man/legend_strip.Rd
+++ b/man/legend_strip.Rd
@@ -20,7 +20,12 @@ A \code{ggpop_legend_strip} object; add it to a \code{ggplot} with
Returns a \code{ggpop_legend_strip} object. When added to a \code{ggplot}
with \code{+}, produces a \code{ggpop_composite} that stacks the main plot
above the strip at the specified physical height. The composite works with
-\code{ggplot2::ggsave()} and \code{print()}.
+\code{ggplot2::ggsave()} and \code{print()}. The main plot (the object
+\code{legend_strip()} is added to) may itself be a \code{patchwork} object
+(e.g. several panels combined with \code{+}/\code{\link[patchwork]{plot_layout}})
+\itemize{
+\item this requires the \pkg{patchwork} package to be installed.
+}
}
\examples{
\donttest{
diff --git a/tests/testthat/_snaps/15_legend-canvas/allmodels-frontier-compact-legend.png b/tests/testthat/_snaps/15_legend-canvas/allmodels-frontier-compact-legend.png
new file mode 100644
index 0000000..77b1ef8
Binary files /dev/null and b/tests/testthat/_snaps/15_legend-canvas/allmodels-frontier-compact-legend.png differ
diff --git a/tests/testthat/_snaps/15_legend-canvas/legend-canvas-composite.png b/tests/testthat/_snaps/15_legend-canvas/legend-canvas-composite.png
new file mode 100644
index 0000000..bab3d6b
Binary files /dev/null and b/tests/testthat/_snaps/15_legend-canvas/legend-canvas-composite.png differ
diff --git a/tests/testthat/_snaps/17_legend-strip/legend-strip-composite.png b/tests/testthat/_snaps/17_legend-strip/legend-strip-composite.png
new file mode 100644
index 0000000..bc3f5e0
Binary files /dev/null and b/tests/testthat/_snaps/17_legend-strip/legend-strip-composite.png differ
diff --git a/tests/testthat/_snaps/17_legend-strip/legend-strip-simcrc-style.png b/tests/testthat/_snaps/17_legend-strip/legend-strip-simcrc-style.png
new file mode 100644
index 0000000..02fd3f3
Binary files /dev/null and b/tests/testthat/_snaps/17_legend-strip/legend-strip-simcrc-style.png differ
diff --git a/tests/testthat/test-13_marker-legend.R b/tests/testthat/test-13_marker-legend.R
index a121854..54bf180 100644
--- a/tests/testthat/test-13_marker-legend.R
+++ b/tests/testthat/test-13_marker-legend.R
@@ -166,13 +166,13 @@ testthat::test_that("label_fontface is applied to the label layer", {
testthat::expect_equal(p$layers[[2]]$aes_params$fontface, "bold")
})
-testthat::test_that("the title stays plain regardless of label_fontface", {
+testthat::test_that("the title follows label_fontface, matching the entry labels", {
df <- data.frame(icon = "star", label = "A", stringsAsFactors = FALSE)
p <- marker_legend(df, title = "Groups", label_fontface = "bold")
title_layer <- p$layers[[which(vapply(
- p$layers, function(l) inherits(l$geom, "GeomText") && identical(l$data$label, "Groups"),
+ p$layers, function(l) inherits(l$geom, "GeomText") && identical(l$aes_params$label, "Groups"),
logical(1)
))]]
- testthat::expect_equal(title_layer$aes_params$fontface, "plain")
+ testthat::expect_equal(title_layer$aes_params$fontface, "bold")
})
diff --git a/tests/testthat/test-15_legend-canvas.R b/tests/testthat/test-15_legend-canvas.R
index 524f9d3..d47d1e4 100644
--- a/tests/testthat/test-15_legend-canvas.R
+++ b/tests/testthat/test-15_legend-canvas.R
@@ -29,14 +29,24 @@ geom_classes <- function(p) vapply(p$layers, function(l) class(l$geom)[1], chara
text_labels <- function(p) {
unlist(lapply(p$layers, function(l) {
- if (inherits(l$geom, "GeomText") && !is.null(l$data) && "label" %in% names(l$data)) {
- as.character(l$data$label)
- } else {
- character(0)
+ if (!inherits(l$geom, "GeomText")) {
+ return(character(0))
}
+ labs <- character(0)
+ # entry labels live in the layer data; annotate() titles live in aes_params
+ if (!is.null(l$data) && is.data.frame(l$data) && "label" %in% names(l$data)) {
+ labs <- c(labs, as.character(l$data$label))
+ }
+ if (!is.null(l$aes_params$label)) {
+ labs <- c(labs, as.character(l$aes_params$label))
+ }
+ labs
}))
}
+x_range <- function(p) p$coordinates$limits$x
+y_range <- function(p) p$coordinates$limits$y
+
grid_rows <- function(type = "icon") {
data.frame(
section = "grid", type = type,
@@ -105,7 +115,9 @@ testthat::test_that("group_title overrides group_section for the displayed title
})
testthat::test_that("group_section rows default to swatch when type column is missing", {
- df <- rbind(
+ testthat::skip_if_not_installed("dplyr")
+ # bind_rows (not rbind) so the group row can legitimately omit `type`
+ df <- dplyr::bind_rows(
grid_rows(),
data.frame(section = "modality", label = "FIT", icon = NA, row = NA, col = NA, color = "pink")
)
@@ -187,3 +199,403 @@ testthat::test_that("legend_canvas composite renders (snapshot)", {
ggplot2::ggsave(path, p, width = 6, height = 1.5, dpi = 120, bg = "white")
testthat::expect_snapshot_file(path, "legend-canvas-composite.png")
})
+
+# ******************************************************************************
+# 05 x_margin / align centering ---------------------------------------------------
+# ******************************************************************************
+
+testthat::test_that("default x_margin centres content symmetrically (#393)", {
+ p <- do.call(legend_canvas, c(list(df_legend = grid_rows()), canvas_args))
+ xlim <- x_range(p)
+ grid_end <- 1 # (n_cols - 1) * col_spacing = (2 - 1) * 1
+ left_pad <- 0 - xlim[[1]]
+ right_pad <- xlim[[2]] - grid_end
+ testthat::expect_equal(left_pad, right_pad)
+})
+
+testthat::test_that("align = 'left' biases padding toward the right", {
+ args <- c(list(df_legend = grid_rows(), align = "left"), canvas_args)
+ xlim <- x_range(do.call(legend_canvas, args))
+ left_pad <- 0 - xlim[[1]]
+ right_pad <- xlim[[2]] - 1
+ testthat::expect_lt(left_pad, right_pad)
+})
+
+testthat::test_that("align = 'right' biases padding toward the left", {
+ args <- c(list(df_legend = grid_rows(), align = "right"), canvas_args)
+ xlim <- x_range(do.call(legend_canvas, args))
+ left_pad <- 0 - xlim[[1]]
+ right_pad <- xlim[[2]] - 1
+ testthat::expect_gt(left_pad, right_pad)
+})
+
+testthat::test_that("align = 'center' matches the symmetric default", {
+ default_xlim <- x_range(do.call(legend_canvas, c(list(df_legend = grid_rows()), canvas_args)))
+ center_xlim <- x_range(do.call(legend_canvas, c(list(df_legend = grid_rows(), align = "center"), canvas_args)))
+ testthat::expect_equal(center_xlim, default_xlim)
+})
+
+testthat::test_that("explicit x_margin is honoured when align is not set", {
+ args <- c(list(df_legend = grid_rows(), x_margin = c(0.425, 0.675)), canvas_args)
+ xlim <- x_range(do.call(legend_canvas, args))
+ testthat::expect_equal(xlim, c(0 - 0.425, 1 + 0.675))
+})
+
+testthat::test_that("align overrides an explicit x_margin, preserving its total", {
+ args <- c(
+ list(df_legend = grid_rows(), x_margin = c(0.425, 0.675), align = "left"),
+ canvas_args
+ )
+ xlim <- x_range(do.call(legend_canvas, args))
+ total <- 0.425 + 0.675
+ left_pad <- 0 - xlim[[1]]
+ right_pad <- xlim[[2]] - 1
+ testthat::expect_equal(left_pad + right_pad, total)
+ testthat::expect_lt(left_pad, right_pad)
+})
+
+testthat::test_that("invalid align value errors", {
+ args <- c(list(df_legend = grid_rows(), align = "top"), canvas_args)
+ testthat::expect_error(do.call(legend_canvas, args), "align")
+})
+
+# ******************************************************************************
+# 06 y_margin / valign centering ---------------------------------------------------
+# ******************************************************************************
+
+testthat::test_that("default y_margin centres content symmetrically", {
+ p <- do.call(legend_canvas, c(list(df_legend = grid_rows()), canvas_args))
+ ylim <- y_range(p)
+ top_content <- 0.85 # row_spacing * 0.85 title row, row_spacing = 1
+ bottom_content <- 0 # -(n_rows - 1) * row_spacing, n_rows = 1
+ top_pad <- ylim[[2]] - top_content
+ bottom_pad <- bottom_content - ylim[[1]]
+ testthat::expect_equal(top_pad, bottom_pad)
+})
+
+testthat::test_that("valign = 'top' biases padding toward the bottom", {
+ args <- c(list(df_legend = grid_rows(), valign = "top"), canvas_args)
+ ylim <- y_range(do.call(legend_canvas, args))
+ top_pad <- ylim[[2]] - 0.85
+ bottom_pad <- 0 - ylim[[1]]
+ testthat::expect_lt(top_pad, bottom_pad)
+})
+
+testthat::test_that("valign = 'bottom' biases padding toward the top", {
+ args <- c(list(df_legend = grid_rows(), valign = "bottom"), canvas_args)
+ ylim <- y_range(do.call(legend_canvas, args))
+ top_pad <- ylim[[2]] - 0.85
+ bottom_pad <- 0 - ylim[[1]]
+ testthat::expect_gt(top_pad, bottom_pad)
+})
+
+testthat::test_that("valign = 'center' matches the symmetric default", {
+ default_ylim <- y_range(do.call(legend_canvas, c(list(df_legend = grid_rows()), canvas_args)))
+ center_ylim <- y_range(do.call(legend_canvas, c(list(df_legend = grid_rows(), valign = "center"), canvas_args)))
+ testthat::expect_equal(center_ylim, default_ylim)
+})
+
+testthat::test_that("explicit y_margin is honoured when valign is not set", {
+ args <- c(list(df_legend = grid_rows(), y_margin = c(0.6, 1.1)), canvas_args)
+ ylim <- y_range(do.call(legend_canvas, args))
+ testthat::expect_equal(ylim, c(0 - 1.1, 0.85 + 0.6))
+})
+
+testthat::test_that("valign overrides an explicit y_margin, preserving its total", {
+ args <- c(
+ list(df_legend = grid_rows(), y_margin = c(0.6, 1.1), valign = "top"),
+ canvas_args
+ )
+ ylim <- y_range(do.call(legend_canvas, args))
+ total <- 0.6 + 1.1
+ top_pad <- ylim[[2]] - 0.85
+ bottom_pad <- 0 - ylim[[1]]
+ testthat::expect_equal(top_pad + bottom_pad, total)
+ testthat::expect_lt(top_pad, bottom_pad)
+})
+
+testthat::test_that("invalid valign value errors", {
+ args <- c(list(df_legend = grid_rows(), valign = "middle"), canvas_args)
+ testthat::expect_error(do.call(legend_canvas, args), "valign")
+})
+
+# ******************************************************************************
+# 07 label_fontface -----------------------------------------------------------
+# ******************************************************************************
+
+testthat::test_that("label_fontface defaults to plain throughout", {
+ p <- do.call(legend_canvas, c(list(df_legend = grid_rows(), grid_title = "Ages"), canvas_args))
+ text_layers <- Filter(function(l) inherits(l$geom, "GeomText"), p$layers)
+ fontfaces <- vapply(text_layers, function(l) l$aes_params$fontface %||% "plain", character(1))
+ testthat::expect_true(all(fontfaces == "plain"))
+})
+
+testthat::test_that("label_fontface reaches the grid title/labels and the group title/tiles", {
+ df <- rbind(
+ grid_rows(),
+ data.frame(section = "modality", type = "swatch", label = "FIT", icon = NA, row = NA, col = NA, color = "pink")
+ )
+ args <- c(
+ list(df_legend = df, grid_title = "Ages", group_section = "modality", group_width = 0.3, label_fontface = "bold"),
+ canvas_args
+ )
+ p <- do.call(legend_canvas, args)
+ title_labels <- c("Ages", "modality", "FIT")
+ for (lbl in title_labels) {
+ layer <- Find(function(l) inherits(l$geom, "GeomText") && identical(l$aes_params$label, lbl), p$layers)
+ testthat::expect_equal(layer$aes_params$fontface, "bold", label = paste("fontface for", lbl))
+ }
+})
+
+# ******************************************************************************
+# 08 label_scale --------------------------------------------------------------
+# ******************************************************************************
+
+group_title_size <- function(p) {
+ layer <- Find(function(l) inherits(l$geom, "GeomText") && identical(l$aes_params$label, "modality"), p$layers)
+ layer$aes_params$size
+}
+marker_icon_size <- function(p) {
+ layer <- Find(function(l) inherits(l$geom, "GeomPopImage"), p$layers)
+ unique(layer$data$icon_size)
+}
+
+testthat::test_that("label_scale multiplies text size but leaves marker size untouched", {
+ df <- rbind(
+ grid_rows(),
+ data.frame(section = "modality", type = "swatch", label = "FIT", icon = NA, row = NA, col = NA, color = "pink")
+ )
+ base <- c(list(df_legend = df, group_section = "modality", group_width = 0.3), canvas_args)
+ p1 <- do.call(legend_canvas, base)
+ p2 <- do.call(legend_canvas, c(base, list(label_scale = 2)))
+
+ testthat::expect_equal(group_title_size(p2), group_title_size(p1) * 2)
+ testthat::expect_equal(marker_icon_size(p2), marker_icon_size(p1))
+})
+
+testthat::test_that("label_scale defaults to 1 (no change)", {
+ p1 <- do.call(legend_canvas, c(list(df_legend = grid_rows(), grid_title = "Ages"), canvas_args))
+ p2 <- do.call(legend_canvas, c(list(df_legend = grid_rows(), grid_title = "Ages", label_scale = 1), canvas_args))
+ s1 <- Find(function(l) inherits(l$geom, "GeomText") && identical(l$aes_params$label, "Ages"), p1$layers)$aes_params$size
+ s2 <- Find(function(l) inherits(l$geom, "GeomText") && identical(l$aes_params$label, "Ages"), p2$layers)$aes_params$size
+ testthat::expect_equal(s1, s2)
+})
+
+# ******************************************************************************
+# 09 legend_box ---------------------------------------------------------------
+# ******************************************************************************
+
+testthat::test_that("legend_box errors when the plot has no fixed limits", {
+ p <- ggplot2::ggplot(mtcars, ggplot2::aes(mpg, wt)) + ggplot2::geom_point()
+ testthat::expect_error(legend_box(p, width = 4, height = 4), "limits")
+})
+
+testthat::test_that("legend_box adds a fitted border rect (render)", {
+ testthat::skip_on_cran()
+ testthat::skip_if_not_installed("rsvg")
+ testthat::skip_if_not_installed("magick")
+
+ p <- do.call(legend_canvas, c(list(df_legend = grid_rows(), grid_title = "Ages"), canvas_args))
+ n_before <- length(p$layers)
+ pb <- legend_box(p, width = 5, height = 1.5)
+
+ testthat::expect_length(pb$layers, n_before + 1L)
+ testthat::expect_s3_class(pb$layers[[length(pb$layers)]]$geom, "GeomRect")
+
+ # the border encloses the plot's content, so it sits within the coord limits
+ rect <- pb$layers[[length(pb$layers)]]
+ testthat::expect_true(rect$data$xmin >= p$coordinates$limits$x[[1]])
+ testthat::expect_true(rect$data$xmax <= p$coordinates$limits$x[[2]])
+})
+
+# ******************************************************************************
+# 10 legend_ratios / legend_composite -----------------------------------------
+# ******************************************************************************
+
+testthat::test_that("legend_ratios returns the proportion ladder", {
+ r <- legend_ratios()
+ testthat::expect_type(r, "list")
+ testthat::expect_true(all(c(
+ "col_spacing", "row_spacing", "label_gap", "group_width", "group_gap",
+ "symbol_right_gap", "symbol_key_width", "symbol_label_gap",
+ "group_label", "label"
+ ) %in% names(r)))
+})
+
+testthat::test_that("legend_composite builds a grid-only legend (no group/symbol) without a border", {
+ df <- grid_rows()
+ p <- legend_composite(df, width = 5, height = 1.5, border = NA)
+ testthat::expect_s3_class(p, "ggplot")
+ # border = NA => no border rect layer added
+ testthat::expect_false(any(vapply(
+ p$layers, function(l) inherits(l$geom, "GeomRect"), logical(1)
+ )))
+})
+
+testthat::test_that("legend_composite scales symbol label_size by the text base", {
+ testthat::skip_if_not_installed("dplyr")
+ df <- dplyr::bind_rows(
+ grid_rows(),
+ data.frame(
+ section = "symbol", type = "line", label = "Trend",
+ color = "black", label_size = 0.5, stringsAsFactors = FALSE
+ )
+ )
+ # em ratio 0.5 * text 4 => effective 2 on that row (base_width = width => k = 1)
+ p <- legend_composite(df, width = 5, height = 1.5, text = 4, base_width = 5, border = NA)
+ lab <- Find(function(l) inherits(l$geom, "GeomText") && identical(l$aes_params$label, "Trend"), p$layers)
+ testthat::expect_equal(lab$aes_params$size, 2)
+})
+
+testthat::test_that("legend_composite scales sizes by width / base_width", {
+ testthat::skip_if_not_installed("dplyr")
+ df <- dplyr::bind_rows(
+ grid_rows(),
+ data.frame(
+ section = "symbol", type = "line", label = "Trend",
+ color = "black", label_size = 0.5, stringsAsFactors = FALSE
+ )
+ )
+ size_of <- function(p) {
+ lab <- Find(function(l) inherits(l$geom, "GeomText") && identical(l$aes_params$label, "Trend"), p$layers)
+ lab$aes_params$size
+ }
+ # base_width = 5: at width 5, k = 1; at width 10, k = 2 => sizes double
+ base <- legend_composite(df, width = 5, height = 1.5, text = 4, base_width = 5, border = NA)
+ dbl <- legend_composite(df, width = 10, height = 1.5, text = 4, base_width = 5, border = NA)
+ testthat::expect_equal(size_of(base), 2)
+ testthat::expect_equal(size_of(dbl), 4)
+})
+
+testthat::test_that("legend_composite adds a fitted border by default (render)", {
+ testthat::skip_on_cran()
+ testthat::skip_if_not_installed("rsvg")
+ testthat::skip_if_not_installed("magick")
+
+ df <- rbind(
+ grid_rows(),
+ data.frame(section = "group", type = "swatch", label = "FIT", icon = NA, row = NA, col = NA, color = "pink", stringsAsFactors = FALSE)
+ )
+ p <- legend_composite(df, width = 6, height = 1.5, group_title = "Modality")
+ testthat::expect_s3_class(p$layers[[length(p$layers)]]$geom, "GeomRect")
+})
+
+testthat::test_that("legend_composite warns when group swatches render banner-wide", {
+ df <- rbind(
+ grid_rows(),
+ data.frame(section = "group", type = "swatch", label = "FIT",
+ icon = NA, row = NA, col = NA, color = "pink")
+ )
+ # small content_range vs width stretches the swatch into a banner
+ testthat::expect_warning(
+ legend_composite(df, width = 10, height = 1, content_range = 1.2, border = NA),
+ class = "ggpop_swatch_aspect_warning"
+ )
+})
+
+testthat::test_that("legend_composite is quiet at natural (unstretched) proportions", {
+ df <- rbind(
+ grid_rows(),
+ data.frame(section = "group", type = "swatch", label = "FIT",
+ icon = NA, row = NA, col = NA, color = "pink")
+ )
+ testthat::expect_no_warning(
+ legend_composite(df, width = 6, height = 1.5, border = NA)
+ )
+})
+
+# ******************************************************************************
+# 11 auto-enclosure of a section taller than the grid -------------------------
+# ******************************************************************************
+
+testthat::test_that("legend_canvas encloses a group block taller than the grid", {
+ # grid_rows() is a single row; a 3-tile group runs to y = -2 (row_spacing 1)
+ three <- rbind(
+ grid_rows(),
+ data.frame(
+ section = "grp", type = "swatch", label = c("a", "b", "c"),
+ icon = NA, row = NA, col = NA, color = c("red", "green", "blue")
+ )
+ )
+ one <- rbind(
+ grid_rows(),
+ data.frame(
+ section = "grp", type = "swatch", label = "a",
+ icon = NA, row = NA, col = NA, color = "red"
+ )
+ )
+ y3 <- y_range(do.call(legend_canvas, c(
+ list(df_legend = three, group_section = "grp", group_width = 0.3), canvas_args
+ )))
+ y1 <- y_range(do.call(legend_canvas, c(
+ list(df_legend = one, group_section = "grp", group_width = 0.3), canvas_args
+ )))
+ testthat::expect_lte(y3[[1]], -2)
+ testthat::expect_gt(y1[[1]], y3[[1]])
+})
+
+testthat::test_that("legend_canvas encloses a symbol key taller than the grid", {
+ df <- rbind(
+ grid_rows(),
+ data.frame(
+ section = "ef", type = "line", label = c("w", "x", "y", "z"),
+ icon = NA, row = NA, col = NA, color = "black"
+ )
+ )
+ # 4 symbol entries occupy the title slot plus y = 0, -1, -2
+ p <- do.call(legend_canvas, c(
+ list(df_legend = df, symbol_section = "ef", symbol_key_width = 0.2), canvas_args
+ ))
+ testthat::expect_lte(y_range(p)[[1]], -2)
+})
+
+# ******************************************************************************
+# 12 GOLD STANDARD - AllModels frontier compact legend (snapshot) -------------
+# ******************************************************************************
+# Locks the rendered AllModels composite legend (the reference figure). The
+# scatter reads external sda2028 data so it cannot live here, but the legend is
+# built from inline content and IS the gold standard. Any drift in the layout
+# or rendering changes this PNG. Record with testthat::snapshot_accept(); after
+# that, an unreviewed change fails the test.
+
+testthat::test_that("AllModels frontier compact legend renders (snapshot)", {
+ testthat::skip_on_cran()
+ testthat::skip_if_not_installed("rsvg")
+ testthat::skip_if_not_installed("magick")
+ testthat::skip_if_not_installed("dplyr")
+
+ df_legend <- dplyr::bind_rows(
+ data.frame(
+ section = "grid", type = "icon",
+ label = c("45-70y", "45-75y", "45-80y", "45-85y",
+ "50-70y", "50-75y", "50-80y", "50-85y",
+ "55-70y", "55-75y", "55-80y", "55-85y"),
+ icon = c("square-inset", "square-hollow", "square-cross", "square-solid",
+ "circle-inset", "circle-hollow", "circle-cross", "circle-solid",
+ "diamond-inset", "diamond-hollow", "diamond-cross", "diamond-solid"),
+ row = rep(1:3, each = 4), col = rep(1:4, times = 3), color = NA,
+ stringsAsFactors = FALSE
+ ),
+ data.frame(
+ section = "group", type = "swatch",
+ label = c("FIT", "sDNA+FIT", "HSgFOBT"),
+ color = c("palevioletred1", "lightseagreen", "lightslateblue"),
+ stringsAsFactors = FALSE
+ ),
+ data.frame(
+ section = "symbol", type = c("line", "swatch", "point"),
+ label = c("Efficient frontier", "3 days/person\nfrom frontier", "Near efficient"),
+ color = c("black", "#C2C2C2", "black"),
+ label_size = c(0.90, 0.82, 0.82), lineheight = c(NA, 0.85, NA),
+ stringsAsFactors = FALSE
+ )
+ )
+ p <- legend_composite(
+ df_legend, width = 27, height = 2.73175,
+ grid_title = "Age to begin-age to end screening", group_title = "Modality"
+ )
+
+ path <- tempfile(fileext = ".png")
+ ggplot2::ggsave(path, p, width = 27, height = 2.73175, dpi = 120, bg = "white")
+ testthat::expect_snapshot_file(path, "allmodels-frontier-compact-legend.png")
+})
diff --git a/tests/testthat/test-16_key-legend.R b/tests/testthat/test-16_key-legend.R
index 0711fd4..a481efa 100644
--- a/tests/testthat/test-16_key-legend.R
+++ b/tests/testthat/test-16_key-legend.R
@@ -104,21 +104,23 @@ testthat::test_that("key_legend returns a ggpop_key_legend object", {
testthat::test_that("swatch entries render as a filled rect", {
df <- data.frame(type = "swatch", label = "Grey zone", color = "grey75", stringsAsFactors = FALSE)
p <- ggplot2::ggplot() + key_legend(df, row_spacing = 1, key_width = 0.3)
- testthat::expect_equal(geom_classes(p), "GeomRect")
+ # a key entry renders the swatch plus its label, so check for the key geom
+ testthat::expect_true("GeomRect" %in% geom_classes(p))
})
testthat::test_that("line entries render as a segment", {
df <- data.frame(type = "line", label = "Efficient frontier", color = "black", stringsAsFactors = FALSE)
p <- ggplot2::ggplot() + key_legend(df, row_spacing = 1, key_width = 0.3)
- testthat::expect_equal(geom_classes(p), "GeomSegment")
+ testthat::expect_true("GeomSegment" %in% geom_classes(p))
})
testthat::test_that("point entries render as text, default glyph is an asterisk", {
df <- data.frame(type = "point", label = "Near efficient", color = "black", stringsAsFactors = FALSE)
p <- ggplot2::ggplot() + key_legend(df, row_spacing = 1, key_width = 0.3)
- testthat::expect_equal(geom_classes(p), "GeomText")
- # first layer is the point glyph itself (label layer is added second)
- testthat::expect_equal(p$layers[[1]]$data$label, "*")
+ testthat::expect_true("GeomText" %in% geom_classes(p))
+ # first layer is the point glyph itself (label layer is added second); the
+ # glyph is a literal annotate() value, stored in aes_params, not $data
+ testthat::expect_equal(p$layers[[1]]$aes_params$label, "*")
})
testthat::test_that("point entries honour a custom pch character", {
@@ -127,7 +129,7 @@ testthat::test_that("point entries honour a custom pch character", {
stringsAsFactors = FALSE
)
p <- ggplot2::ggplot() + key_legend(df, row_spacing = 1, key_width = 0.3)
- testthat::expect_equal(p$layers[[1]]$data$label, "†")
+ testthat::expect_equal(p$layers[[1]]$aes_params$label, "†")
})
testthat::test_that("mixed types in one entries data frame each dispatch correctly", {
@@ -180,7 +182,8 @@ testthat::test_that("label_inside has no effect on non-swatch types", {
testthat::test_that("title is drawn as its own text layer when provided", {
df <- data.frame(type = "swatch", label = "FIT", color = "pink", stringsAsFactors = FALSE)
p <- ggplot2::ggplot() + key_legend(df, row_spacing = 1, key_width = 0.3, title = "Modality")
- labels <- unlist(lapply(p$layers, function(l) if (inherits(l$geom, "GeomText")) l$data$label else NULL))
+ # annotate()'s literal label value lives in aes_params, not $data
+ labels <- unlist(lapply(p$layers, function(l) if (inherits(l$geom, "GeomText")) l$aes_params$label else NULL))
testthat::expect_true("Modality" %in% labels)
})
@@ -203,3 +206,43 @@ testthat::test_that("print.ggpop_key_legend does not error", {
ef <- data.frame(type = "point", label = "Near efficient", color = "black", stringsAsFactors = FALSE)
testthat::expect_no_error(print(key_legend(ef, row_spacing = 1, key_width = 0.3)))
})
+
+# ******************************************************************************
+# 08 label_fontface ---------------------------------------------------------------
+# ******************************************************************************
+
+testthat::test_that("label_fontface defaults to plain for entries and title", {
+ df <- data.frame(type = "swatch", label = "FIT", color = "pink", stringsAsFactors = FALSE)
+ p <- ggplot2::ggplot() + key_legend(df, row_spacing = 1, key_width = 0.3, title = "Modality")
+ label_layer <- p$layers[[which(geom_classes(p) == "GeomText")[1]]]
+ testthat::expect_equal(label_layer$aes_params$fontface, "plain")
+ title_layer <- p$layers[[which(vapply(
+ p$layers, function(l) inherits(l$geom, "GeomText") && identical(l$aes_params$label, "Modality"),
+ logical(1)
+ ))]]
+ testthat::expect_equal(title_layer$aes_params$fontface, "plain")
+})
+
+testthat::test_that("label_fontface is applied to both entry labels and the title", {
+ df <- data.frame(type = "swatch", label = "FIT", color = "pink", stringsAsFactors = FALSE)
+ p <- ggplot2::ggplot() + key_legend(
+ df, row_spacing = 1, key_width = 0.3, title = "Modality", label_fontface = "bold"
+ )
+ label_layer <- p$layers[[which(geom_classes(p) == "GeomText")[1]]]
+ testthat::expect_equal(label_layer$aes_params$fontface, "bold")
+ title_layer <- p$layers[[which(vapply(
+ p$layers, function(l) inherits(l$geom, "GeomText") && identical(l$aes_params$label, "Modality"),
+ logical(1)
+ ))]]
+ testthat::expect_equal(title_layer$aes_params$fontface, "bold")
+})
+
+testthat::test_that("the point-type asterisk glyph stays bold regardless of label_fontface", {
+ df <- data.frame(type = "point", label = "Near efficient", color = "black", stringsAsFactors = FALSE)
+ p <- ggplot2::ggplot() + key_legend(df, row_spacing = 1, key_width = 0.3, label_fontface = "bold")
+ # first layer is the glyph itself; label_fontface should not touch it
+ testthat::expect_equal(p$layers[[1]]$aes_params$fontface, "bold")
+
+ p2 <- ggplot2::ggplot() + key_legend(df, row_spacing = 1, key_width = 0.3, label_fontface = "italic")
+ testthat::expect_equal(p2$layers[[1]]$aes_params$fontface, "bold")
+})
diff --git a/tests/testthat/test-17_legend-strip.R b/tests/testthat/test-17_legend-strip.R
index bc0cd24..496a3e3 100644
--- a/tests/testthat/test-17_legend-strip.R
+++ b/tests/testthat/test-17_legend-strip.R
@@ -45,8 +45,12 @@ testthat::test_that("adding legend_strip to a ggplot produces a ggpop_composite"
composite <- main + legend_strip(strip, height = 1.2)
testthat::expect_s3_class(composite, "ggpop_composite")
- testthat::expect_identical(composite$main, main)
- testthat::expect_identical(composite$strip, strip)
+ # compare structurally: identical() on whole ggplots is brittle (internal
+ # ggproto/scales environments differ even for the same plot)
+ testthat::expect_s3_class(composite$main, "ggplot")
+ testthat::expect_s3_class(composite$strip, "ggplot")
+ testthat::expect_identical(composite$main$layers, main$layers)
+ testthat::expect_identical(composite$strip$layers, strip$layers)
testthat::expect_equal(composite$strip_height, 1.2)
})
@@ -113,3 +117,109 @@ testthat::test_that("legend_strip composite of a plot + legend_canvas renders (s
)
testthat::expect_snapshot_file(path, "legend-strip-composite.png")
})
+
+# ******************************************************************************
+# 05 visual snapshot: SimCRC-style icon scatter + full grid/group/symbol legend -
+# ******************************************************************************
+
+testthat::test_that("legend_strip composite of an icon scatter + grid/group/symbol legend_canvas renders (snapshot, #393)", {
+ testthat::skip_on_cran()
+ testthat::skip_if_not_installed("rsvg")
+ testthat::skip_if_not_installed("magick")
+
+ df_points <- data.frame(
+ x = c(1, 2, 3, 4),
+ y = c(1, 2, 1.5, 2.5),
+ icon = c("square-inset", "circle-inset", "square-inset", "circle-inset"),
+ group = c("A", "A", "B", "B"),
+ stringsAsFactors = FALSE
+ )
+ group_colors <- c(A = "palevioletred1", B = "lightseagreen")
+
+ p_main <- ggplot2::ggplot(df_points, ggplot2::aes(x, y)) +
+ geom_icon_point(
+ ggplot2::aes(icon = icon, colour = group),
+ size = 3, dpi = 120, legend_icons = FALSE, show.legend = FALSE
+ ) +
+ ggplot2::scale_colour_manual(values = group_colors, guide = "none") +
+ ggplot2::theme_classic()
+
+ df_legend <- rbind(
+ data.frame(
+ section = "grid", type = "icon",
+ label = c("A", "B"), icon = c("square-inset", "circle-inset"),
+ row = c(1, 1), col = c(1, 2), color = NA,
+ stringsAsFactors = FALSE
+ ),
+ data.frame(
+ section = "group", type = "swatch",
+ label = names(group_colors), color = unname(group_colors),
+ icon = NA, row = NA, col = NA,
+ stringsAsFactors = FALSE
+ ),
+ data.frame(
+ section = "key",
+ type = c("line", "point"),
+ label = c("Trend", "Flagged"),
+ icon = NA, row = NA, col = NA,
+ color = c("black", "black"),
+ stringsAsFactors = FALSE
+ )
+ )
+
+ p_legend <- legend_canvas(
+ df_legend,
+ group_section = "group", group_title = "Group", group_width = 0.3,
+ symbol_section = "key", symbol_key_width = 0.2,
+ col_spacing = 1, row_spacing = 1, label_gap = 0.2,
+ marker_size = 3, label_size = 2.5, dpi = 120
+ )
+
+ path <- tempfile(fileext = ".png")
+ ggplot2::ggsave(
+ path, p_main + legend_strip(p_legend, height = 1.2),
+ width = 6, height = 5, dpi = 120, bg = "white"
+ )
+ testthat::expect_snapshot_file(path, "legend-strip-simcrc-style.png")
+})
+
+# ******************************************************************************
+# 06 patchwork main support -------------------------------------------------------
+# ******************************************************************************
+
+testthat::test_that("composite_grob() renders every panel of a patchwork main, not just the last", {
+ testthat::skip_if_not_installed("patchwork")
+
+ p1 <- ggplot2::ggplot(data.frame(x = 1, y = 1), ggplot2::aes(x, y)) + ggplot2::geom_point()
+ p2 <- ggplot2::ggplot(data.frame(x = 2, y = 2), ggplot2::aes(x, y)) + ggplot2::geom_point()
+ p_patch <- p1 + p2 + patchwork::plot_layout(nrow = 1)
+
+ g_wrong <- ggplot2::ggplotGrob(p_patch)
+ g_right <- composite_grob(p_patch)
+
+ testthat::expect_gt(length(g_right$grobs), length(g_wrong$grobs))
+})
+
+testthat::test_that("legend_strip composite with a patchwork main renders without error", {
+ testthat::skip_if_not_installed("patchwork")
+
+ p1 <- ggplot2::ggplot(data.frame(x = 1:3, y = 1:3), ggplot2::aes(x, y)) + ggplot2::geom_point()
+ p2 <- ggplot2::ggplot(data.frame(x = 1:3, y = 1:3), ggplot2::aes(x, y)) + ggplot2::geom_point()
+ p_main <- p1 + p2 + patchwork::plot_layout(nrow = 1)
+ strip <- ggplot2::ggplot(data.frame(x = 1, y = 1), ggplot2::aes(x, y)) +
+ ggplot2::geom_point() + ggplot2::theme_void()
+ composite <- p_main + legend_strip(strip, height = 1)
+
+ path <- tempfile(fileext = ".pdf")
+ grDevices::pdf(path, width = 8, height = 5)
+ on.exit(grDevices::dev.off(), add = TRUE)
+
+ testthat::expect_no_error(print(composite))
+})
+
+testthat::test_that("composite_grob() errors clearly when patchwork isn't installed", {
+ testthat::local_mocked_bindings(requireNamespace = function(...) FALSE, .package = "base")
+
+ p1 <- structure(list(), class = c("patchwork", "gg", "ggplot"))
+ testthat::expect_error(composite_grob(p1), "patchwork")
+})
diff --git a/vignettes/articles/examples-geom-icon-point.qmd b/vignettes/articles/examples-geom-icon-point.qmd
index b27d0ec..6d843e2 100644
--- a/vignettes/articles/examples-geom-icon-point.qmd
+++ b/vignettes/articles/examples-geom-icon-point.qmd
@@ -687,15 +687,13 @@ ggplot(df_grid, aes(x = x, y = y)) +
annotate(
"richtext",
x = 5, y = 7.8,
- label = "4 NEW SPORTS
- JOIN THE PARIS 2024 OLYMPICS",
+ label = "4 NEW SPORTS
JOIN THE PARIS 2024 OLYMPICS",
fill = NA, label.size = 0, lineheight = 1.2
) +
annotate(
"richtext",
x = 5, y = 6.75,
- label = "BREAKING \u00b7
- SKATEBOARDING \u00b7 SPORT CLIMBING \u00b7 SURFING",
+ label = "BREAKING \u00b7 SKATEBOARDING \u00b7 SPORT CLIMBING \u00b7 SURFING",
fill = NA, label.size = 0
) +
annotate("point", x = 2.6, y = -0.55, color = "#E8C84A", size = 3.5) +
@@ -709,10 +707,7 @@ ggplot(df_grid, aes(x = x, y = y)) +
annotate(
"richtext",
x = 5, y = -1.15,
- label = "Source: IOC / Paris 2024 \u00b7
- Original concept: G. Karamanis
- github.com/gkaramanis/30DayChartChallenge \u00b7
- Remake: ggpop",
+ label = "Source: IOC / Paris 2024 \u00b7 Original concept: G. Karamanis github.com/gkaramanis/30DayChartChallenge \u00b7 Remake: ggpop",
fill = NA, label.size = 0, size = 2.5, lineheight = 1.2
) +
coord_fixed(clip = "off", xlim = c(0.5, 9.5), ylim = c(-1.6, 9.2)) +
@@ -802,15 +797,13 @@ ggplot(df_grid, aes(x = x, y = y)) +
annotate(
"richtext",
x = 5, y = 7.8,
- label = "4 NEW SPORTS
- JOIN THE PARIS 2024 OLYMPICS",
+ label = "4 NEW SPORTS
JOIN THE PARIS 2024 OLYMPICS",
fill = NA, label.size = 0, lineheight = 1.2
) +
annotate(
"richtext",
x = 5, y = 6.75,
- label = "BREAKING \u00b7
- SKATEBOARDING \u00b7 SPORT CLIMBING \u00b7 SURFING",
+ label = "BREAKING \u00b7 SKATEBOARDING \u00b7 SPORT CLIMBING \u00b7 SURFING",
fill = NA, label.size = 0
) +
annotate("point", x = 2.6, y = -0.55, color = "#E8C84A", size = 3.5) +
@@ -824,10 +817,7 @@ ggplot(df_grid, aes(x = x, y = y)) +
annotate(
"richtext",
x = 5, y = -1.15,
- label = "Source: IOC / Paris 2024 \u00b7
- Original concept: G. Karamanis
- github.com/gkaramanis/30DayChartChallenge \u00b7
- Remake: ggpop",
+ label = "Source: IOC / Paris 2024 \u00b7 Original concept: G. Karamanis github.com/gkaramanis/30DayChartChallenge \u00b7 Remake: ggpop",
fill = NA, label.size = 0, size = 2.5, lineheight = 1.2
) +
coord_fixed(clip = "off", xlim = c(0.5, 9.5), ylim = c(-1.6, 9.2)) +
diff --git a/vignettes/articles/examples-geom-pop.qmd b/vignettes/articles/examples-geom-pop.qmd
index 5e25de1..ba5d37f 100644
--- a/vignettes/articles/examples-geom-pop.qmd
+++ b/vignettes/articles/examples-geom-pop.qmd
@@ -480,9 +480,7 @@ ggplot() +
scale_legend_icon(size = 7) +
labs(
title = "Educational Attainment",
- subtitle = "Each icon = 2% of the population ·
- **42%** reached secondary,
- only **28%** completed university",
+ subtitle = "Each icon = 2% of the population · **42%** reached secondary, only **28%** completed university",
caption = "Hypothetical survey data · Visualization: ggpop",
color = "Education Level"
)
@@ -591,9 +589,7 @@ ggplot() +
scale_legend_icon(size = 7) +
labs(
title = "Educational Attainment",
- subtitle = "Each icon = 2% of the population ·
- **42%** reached secondary,
- only **28%** completed university",
+ subtitle = "Each icon = 2% of the population · **42%** reached secondary, only **28%** completed university",
caption = "Hypothetical survey data · Visualization: ggpop",
color = "Education Level"
)
diff --git a/vignettes/articles/marker-legend.qmd b/vignettes/articles/marker-legend.qmd
index eec2ad1..fdad5d9 100644
--- a/vignettes/articles/marker-legend.qmd
+++ b/vignettes/articles/marker-legend.qmd
@@ -107,22 +107,26 @@ one legend.
#| label: fig-composite-fa
#| message: false
#| warning: false
-#| fig-width: 7
-#| fig-height: 2.6
+#| fig-width: 4
+#| fig-height: 2.2
#| fig-cap: "A two-column composite legend built entirely from Font Awesome icons."
df_legend <- data.frame(
column = c(1, 1, 1, 2, 2, 2),
icon = c("car", "bus", "bicycle", "plane", "ship", "truck"),
- label = c("Car", "Bus", "Bicycle", "Plane", "Ferry", "Truck"),
+ label = c("Car", "Bus", "Bike", "Plane", "Ferry", "Truck"),
colour = c("#E41A1C", "#377EB8", "#984EA3", "#FF7F00", "#009E9E", "#A65628"),
stringsAsFactors = FALSE
)
+# Keep col_spacing and label_gap small: marker_legend()'s coordinate range
+# grows with col_spacing, so a large value spreads the columns apart and leaves
+# a wide empty margin. Small values pack the two columns close and keep each
+# icon tight to its label.
marker_legend(
df_legend,
title = "Transport modes",
- marker_size = 5, label_size = 4, col_spacing = 14, label_gap = 1.6
+ marker_size = 5, label_size = 4, col_spacing = 0.6, label_gap = 0.15
)
```
@@ -203,28 +207,29 @@ the only place a new type could be added.
### Deriving the icon grid from data with `icon_grid()`
If your icon-grid combinations already exist in a data frame - say, one row
-per package-size / distance-zone combination - `icon_grid()` derives the
+per temperature / precipitation combination - `icon_grid()` derives the
unique `row`/`col` positions for you instead of typing them by hand. Factor
columns keep a deliberate row/col order; unordered columns sort automatically.
+Each combination gets a Font Awesome weather icon, so the grid reads as a
+legend of conditions rather than abstract shapes.
```{r}
#| label: icon-grid-derive
#| code-fold: false
-df_plans <- data.frame(
- size = factor(c("Small", "Small", "Large", "Large"), levels = c("Small", "Large")),
- distance = factor(c("Local", "National", "Local", "National"), levels = c("Local", "National")),
- icon = c("square-hollow", "square-solid", "circle-hollow", "circle-solid"),
+df_cond <- data.frame(
+ temp = factor(c("Warm", "Warm", "Cold", "Cold"), levels = c("Warm", "Cold")),
+ precip = factor(c("Dry", "Wet", "Dry", "Wet"), levels = c("Dry", "Wet")),
+ icon = c("sun", "cloud-rain", "wind", "snowflake"),
stringsAsFactors = FALSE
)
-df_plans$cell_label <- paste0(
- substr(df_plans$size, 1, 1), "-",
- c(Local = "Loc", National = "Natl")[as.character(df_plans$distance)]
+df_cond$cell_label <- paste0(
+ substr(df_cond$temp, 1, 1), "-", df_cond$precip
)
df_grid <- icon_grid(
- df_plans, icon = "icon", label = "cell_label",
- row = "size", col = "distance"
+ df_cond, icon = "icon", label = "cell_label",
+ row = "temp", col = "precip"
)
df_grid
```
@@ -239,41 +244,42 @@ symbol key (`symbol_section`) by `rbind()`-ing three data frames that share
#| label: fig-legend-canvas
#| message: false
#| warning: false
-#| fig-width: 9.5
+#| fig-width: 9
#| fig-height: 2
#| fig-cap: "A grid + group + symbol composite legend built from one df_legend data frame."
-plan_colours <- c(Standard = "#8D99AE", Express = "#EF476F")
+alert_col <- c(Advisory = "#F4C542", Warning = "#C0392B")
df_legend <- rbind(
df_grid,
data.frame(
- section = "plan", type = "swatch",
- label = names(plan_colours), color = unname(plan_colours),
+ section = "alert", type = "swatch",
+ label = names(alert_col), color = unname(alert_col),
icon = NA, row = NA, col = NA
),
data.frame(
- section = "value", type = c("line", "swatch", "point"),
- label = c("Best-value frontier", "Acceptable range", "Best pick"),
- color = c("black", "grey75", "black"),
+ section = "mark", type = c("line", "swatch", "point"),
+ label = c("Seasonal", "Typical", "Warmest"),
+ color = c("grey35", "grey80", "black"),
icon = NA, row = NA, col = NA
)
)
legend_canvas(
df_legend,
- grid_title = "Package size × distance zone",
- group_section = "plan", group_title = "Plan", group_width = 0.9, group_gap = 0.3,
- symbol_section = "value", symbol_right_gap = 0.8, symbol_key_width = 0.5,
- col_spacing = 2.2, row_spacing = 1.2, label_gap = 0.15,
- marker_size = 5, label_size = 3.6, dpi = 150
+ grid_title = "Temp and precip",
+ group_section = "alert", group_title = "Alert", group_width = 0.85, group_gap = 0.18,
+ symbol_section = "mark", symbol_right_gap = 0.75, symbol_key_width = 0.45,
+ col_spacing = 0.95, row_spacing = 1.2, label_gap = 0.12,
+ marker_size = 5, label_size = 3.6, dpi = 150,
+ x_margin = c(1.6, 1.6)
)
```
::: {.callout-tip}
`group_title` lets the displayed heading differ from the `section` value used
-to match rows - keep `section` values plain and lowercase (`"plan"`) while the
-on-plot title stays capitalised (`"Plan"`). `grid_section` and `grid_title`
+to match rows - keep `section` values plain and lowercase (`"alert"`) while the
+on-plot title stays capitalised (`"Alert"`). `grid_section` and `grid_title`
work the same way for the icon grid.
:::
@@ -281,43 +287,137 @@ Column spacing has to leave room for your longest label in that column before
the next section starts - if sections start overlapping, widen `col_spacing`,
`group_width`, or `symbol_right_gap` rather than shortening labels first.
+## One call for the whole thing: `legend_composite()`
+
+`legend_canvas()` gives you every knob, but for the standard grid + group +
+symbol legend you end up repeating the same spacing, sizing, and centring
+numbers on every figure. `legend_composite()` is the opinionated wrapper: hand
+it the same `df_legend` and the physical strip size, and it applies a fixed
+proportion ladder (`legend_ratios()`), centres the content, and fits a tight
+border with `legend_box()` - the whole legend from one call.
+
+```{r}
+#| label: fig-legend-composite
+#| message: false
+#| warning: false
+#| fig-width: 11
+#| fig-height: 1.7
+#| fig-cap: "The same three-section df_legend, rendered in one legend_composite() call with a fitted border."
+
+legend_composite(
+ df_legend,
+ width = 11, height = 1.7,
+ grid_title = "Temp and precip",
+ group_section = "alert", group_title = "Alert",
+ symbol_section = "mark",
+ ratios = modifyList(legend_ratios(), list(col_spacing = 1.5, symbol_right_gap = 1.4))
+)
+```
+
+Instead of hand-setting `col_spacing`, `group_width`, `marker_size`,
+`label_size`, and the rest, you give `legend_composite()` the physical
+`width`/`height` and it derives every length from three base sizes and the
+ratio ladder. You usually touch nothing but the titles; when a section needs
+more room - here the two-column grid's title and the wide symbol labels -
+override a single rung with `ratios = modifyList(legend_ratios(), ...)`.
+
+### The same proportions at any figure width
+
+The base sizes are calibrated for a `base_width`-inch strip (default 27) and
+multiplied by `width / base_width`, so passing your actual `width` reproduces
+the identical legend at that physical size - no per-figure retuning. Halve the
+width and text, markers, spacing, and border all scale together. Set
+`base_width = width` to opt out and size in absolute units instead.
+
+::: {.callout-tip}
+Keep sparse legends compact - do not stretch them. `content_range` sets how
+much horizontal room the content is centred in. A dense legend (many columns,
+long labels) fills a wide strip on its own; a sparse one should stay compact.
+Leave `content_range` at its default rather than shrinking it to force the
+content to fill the width - the colour swatches are drawn in data coordinates,
+so a small `content_range` stretches them into wide banners while the
+fixed-size icons stay put. `legend_composite()` warns when the swatches get
+that lopsided so you catch it early.
+:::
+
+The grid's `icon` column resolves per row, so one grid can mix Font Awesome
+names, bundled ggpop markers, and your own `.svg` files in a single legend -
+see [Custom SVG icons](custom-svg-icons.html).
+
## Stacking a plot and its legend with `legend_strip()`
-The composite above is a self-contained `ggplot`. To pin it under a real plot
-in one exported figure - rather than a standalone panel - add it with
-`legend_strip(strip_plot, height)`:
+A composite legend earns its keep only when the plot uses every key it
+advertises. Here the forecast draws each day with `geom_icon_point()` -
+marker shape for the temperature/precipitation condition, colour for the
+alert level - over a seasonal-average line, a typical-range band, and a
+flagged warmest day: exactly the sections the legend describes. To pin that
+legend under the plot in one exported figure - rather than a standalone panel -
+add it with `legend_strip(strip_plot, height)`:
```{r}
#| label: fig-legend-strip
#| message: false
#| warning: false
-#| fig-width: 9.5
-#| fig-height: 5.5
-#| fig-cap: "A scatter plot with its legend_canvas() legend stacked directly below it."
-
-df_points <- data.frame(
- cost = c(4, 6, 9, 14, 7, 11, 16, 22),
- days = c(6, 4, 2, 1, 5, 3, 1.5, 1),
- plan = c("Standard", "Standard", "Express", "Express",
- "Standard", "Standard", "Express", "Express")
+#| fig-width: 9
+#| fig-height: 5.8
+#| fig-cap: "An icon forecast answering a real question - marker shape shows the temperature/precipitation condition, colour shows the alert level - with its legend_canvas() legend stacked below, so every legend key is something you read off the plot."
+
+icon_map <- c(
+ "Warm.Dry" = "sun",
+ "Warm.Wet" = "cloud-rain",
+ "Cold.Dry" = "wind",
+ "Cold.Wet" = "snowflake"
)
-p_main <- ggplot(df_points, aes(x = cost, y = days, colour = plan)) +
- geom_point(size = 3) +
- scale_colour_manual(values = plan_colours, guide = "none") +
- scale_x_continuous("Cost ($)") +
- scale_y_continuous("Delivery time (days)") +
- ggtitle("Cost vs. delivery time") +
+df_fc <- data.frame(
+ day = 1:8,
+ temp = c(18, 20, 15, 12, 10, 9, 13, 17),
+ temp_cat = c("Warm", "Warm", "Warm", "Cold", "Cold", "Cold", "Cold", "Warm"),
+ precip = c("Dry", "Dry", "Wet", "Dry", "Wet", "Wet", "Dry", "Wet"),
+ alert = c("Advisory", "Advisory", "Advisory", "Warning",
+ "Warning", "Warning", "Advisory", "Advisory"),
+ avg = c(14, 14, 13.5, 13, 13, 13, 13.5, 14),
+ stringsAsFactors = FALSE
+)
+df_fc$icon <- icon_map[paste(df_fc$temp_cat, df_fc$precip, sep = ".")]
+
+# the warmest day in the outlook is flagged as the pick
+warmest <- df_fc[which.max(df_fc$temp), ]
+
+p_main <- ggplot(df_fc, aes(x = day, y = temp)) +
+ geom_ribbon(aes(ymin = avg - 4, ymax = avg + 4), fill = "grey88") +
+ geom_line(aes(y = avg), colour = "grey35", linewidth = 0.7) +
+ # a soft ring highlights the warmest day so the * is unambiguous
+ geom_point(data = warmest, shape = 21, size = 10, colour = "#D9A441",
+ fill = NA, stroke = 1.3) +
+ geom_icon_point(
+ aes(icon = icon, colour = alert),
+ size = 3, dpi = 150, legend_icons = FALSE, show.legend = FALSE
+ ) +
+ annotate("text", x = warmest$day + 0.35, y = warmest$temp + 1.3, label = "*",
+ size = 6, fontface = "bold") +
+ scale_colour_manual(values = alert_col, guide = "none") +
+ scale_x_continuous("Forecast day", breaks = 1:8) +
+ scale_y_continuous("High temperature (C)", limits = c(4, 22), breaks = seq(4, 20, 4)) +
+ labs(
+ title = "8-day temperature outlook",
+ subtitle = "Marker shape = temperature and precipitation; colour = alert level; the * is the warmest day"
+ ) +
theme_classic(base_size = 13) +
- theme(axis.line.x = element_blank())
+ theme(
+ axis.line.x = element_blank(),
+ plot.subtitle = element_text(size = 9.5, colour = "grey30"),
+ panel.grid.major.y = element_line(colour = "grey93", linewidth = 0.3)
+ )
p_legend <- legend_canvas(
df_legend,
- grid_title = "Package size × distance zone",
- group_section = "plan", group_title = "Plan", group_width = 0.9, group_gap = 0.3,
- symbol_section = "value", symbol_right_gap = 0.8, symbol_key_width = 0.5,
- col_spacing = 2.2, row_spacing = 1.2, label_gap = 0.15,
- marker_size = 5, label_size = 3.6, dpi = 150
+ grid_title = "Temp and precip",
+ group_section = "alert", group_title = "Alert", group_width = 0.85, group_gap = 0.18,
+ symbol_section = "mark", symbol_right_gap = 0.75, symbol_key_width = 0.45,
+ col_spacing = 0.95, row_spacing = 1.2, label_gap = 0.12,
+ marker_size = 5, label_size = 3.6, dpi = 150,
+ x_margin = c(1.6, 1.6)
)
p_main + legend_strip(p_legend, height = 1.4)