From 71e3e8e60a99afa27ca6218a611d84a1ca403dc2 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 08:26:34 -0500 Subject: [PATCH 01/14] prepare_legend_context() helper delegation --- R/legend_prepare.R | 162 +++++++++++++++++++++++++++++++++++++++++++++ R/tinyplot.R | 121 +++------------------------------ 2 files changed, 171 insertions(+), 112 deletions(-) create mode 100644 R/legend_prepare.R diff --git a/R/legend_prepare.R b/R/legend_prepare.R new file mode 100644 index 00000000..e008d027 --- /dev/null +++ b/R/legend_prepare.R @@ -0,0 +1,162 @@ +prepare_legend_context = function(settings) { + env2env( + settings, + environment(), + c( + "col", + "by_continuous", + "by", + "bubble", + "null_by", + "legend", + "legend_args", + "bubble_cex", + "cex_fct_adj", + "cex_dep", + "add", + "sub", + "ngrps", + "datapoints", + "ylab" + ) + ) + + ncolors = length(col) + lgnd_labs = rep(NA, times = ncolors) + + if (isTRUE(by_continuous)) { + nlabs = 5 + ubyvar = unique(by) + byvar_range = range(ubyvar) + pbyvar = pretty(byvar_range, n = nlabs) + pbyvar = pbyvar[pbyvar >= byvar_range[1] & pbyvar <= byvar_range[2]] + if (length(ubyvar) == 2 && all(ubyvar %in% pbyvar)) { + pbyvar = ubyvar + } else if (length(pbyvar) > nlabs) { + pbyvar = pbyvar[seq_along(pbyvar) %% 2 == 0] + } + pidx = rescale_num(c(byvar_range, pbyvar), to = c(1, ncolors))[-c(1:2)] + pidx = round(pidx) + lgnd_labs[pidx] = pbyvar + } + + has_legend = FALSE + dual_legend = bubble && !null_by && !isFALSE(legend) + lgnd_cex = NULL + + if (isFALSE(legend)) { + legend = "none" + } else if (isTRUE(legend)) { + legend = NULL + } + + if (!is.null(legend) && is.character(legend) && legend == "none") { + legend_args[["x"]] = "none" + dual_legend = FALSE + } + + if (null_by) { + if (bubble && !dual_legend) { + legend_args[["title"]] = cex_dep + lgnd_labs = names(bubble_cex) + lgnd_cex = bubble_cex * cex_fct_adj + } else if (is.null(legend)) { + legend = "none" + legend_args[["x"]] = "none" + } + } + + legend_draw_flag = (is.null(legend) || !is.character(legend) || legend != "none" || bubble) && !isTRUE(add) + has_sub = !is.null(sub) + + if (legend_draw_flag && isFALSE(by_continuous) && (!bubble || dual_legend)) { + if (ngrps > 1) { + lgnd_labs = if (is.factor(datapoints$by)) levels(datapoints$by) else unique(datapoints$by) + } else { + lgnd_labs = ylab + } + } + + env2env( + environment(), + settings, + c( + "lgnd_labs", + "has_legend", + "dual_legend", + "lgnd_cex", + "legend", + "legend_args", + "legend_draw_flag", + "has_sub" + ) + ) +} + +prepare_dual_legend = function(settings) { + env2env( + settings, + environment(), + c( + "legend", + "legend_args", + "by_dep", + "lgnd_labs", + "type", + "pch", + "lty", + "lwd", + "col", + "bg", + "by_continuous", + "lgnd_cex", + "cex_dep", + "bubble_cex", + "cex_fct_adj", + "bubble_alpha", + "bubble_bg_alpha", + "has_sub" + ) + ) + + legend_args = sanitize_legend(legend, legend_args) + + lgby = list( + legend_args = modifyList( + legend_args, + list(x.intersp = 1, y.intersp = 1), + keep.null = TRUE + ), + by_dep = by_dep, + lgnd_labs = lgnd_labs, + type = type, + pch = pch, + lty = lty, + lwd = lwd, + col = col, + bg = bg, + gradient = by_continuous, + cex = lgnd_cex, + has_sub = has_sub + ) + + lgbub = list( + legend_args = modifyList( + legend_args, + list(title = cex_dep, ncol = 1), + keep.null = TRUE + ), + lgnd_labs = names(bubble_cex), + type = type, + pch = pch, + lty = lty, + lwd = lwd, + col = adjustcolor(par("col"), alpha.f = bubble_alpha), + bg = adjustcolor(par("col"), alpha.f = bubble_bg_alpha), + cex = bubble_cex * cex_fct_adj, + has_sub = has_sub, + draw = FALSE + ) + + env2env(environment(), settings, c("legend_args", "lgby", "lgbub")) +} diff --git a/R/tinyplot.R b/R/tinyplot.R index 1073a4c9..1d316571 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -915,77 +915,19 @@ tinyplot.default = function( by_aesthetics(settings) - # - ## make settings available in the environment directly ----- - # - - env2env(settings, environment()) - - # ## legends ----- # - # legend labels - ncolors = length(col) - lgnd_labs = rep(NA, times = ncolors) - if (isTRUE(by_continuous)) { - ## Identify the pretty break points for our labels - nlabs = 5 - ncolors = length(col) - ubyvar = unique(by) - byvar_range = range(ubyvar) - pbyvar = pretty(byvar_range, n = nlabs) - pbyvar = pbyvar[pbyvar >= byvar_range[1] & pbyvar <= byvar_range[2]] - # optional thinning - if (length(ubyvar) == 2 && all(ubyvar %in% pbyvar)) { - pbyvar = ubyvar - } else if (length(pbyvar) > nlabs) { - pbyvar = pbyvar[seq_along(pbyvar) %% 2 == 0] - } - ## Find the (approximate) location of our pretty labels - pidx = rescale_num(c(byvar_range, pbyvar), to = c(1, ncolors))[-c(1:2)] - pidx = round(pidx) - lgnd_labs[pidx] = pbyvar - } - - # simple indicator variables for later use - has_legend = FALSE - dual_legend = bubble && !null_by && !isFALSE(legend) - lgnd_cex = NULL - - if (isFALSE(legend)) { - legend = "none" - } else if (isTRUE(legend)) { - legend = NULL - } - if (!is.null(legend) && is.character(legend) && legend == "none") { - legend_args[["x"]] = "none" - dual_legend = FALSE - } + prepare_legend_context(settings) - if (null_by) { - if (bubble && !dual_legend) { - legend_args[["title"]] = cex_dep - lgnd_labs = names(bubble_cex) - lgnd_cex = bubble_cex * cex_fct_adj - } else if (is.null(legend)) { - legend = "none" - legend_args[["x"]] = "none" - } - } - - if ((is.null(legend) || !is.character(legend) || legend != "none" || bubble) && !add) { - if (isFALSE(by_continuous) && (!bubble || dual_legend)) { - if (ngrps > 1) { - lgnd_labs = if (is.factor(datapoints$by)) levels(datapoints$by) else unique(datapoints$by) - } else { - lgnd_labs = ylab - } - } + # + ## make settings available in the environment directly ----- + # - has_sub = !is.null(sub) + env2env(settings, environment()) + if (legend_draw_flag) { if (!dual_legend) { ## simple case: single legend only if (is.null(lgnd_cex)) lgnd_cex = cex * cex_fct_adj @@ -1006,60 +948,15 @@ tinyplot.default = function( ) } else { ## dual legend case... - - # sanitize_legend: processes legend arguments and returns standardized legend_args list - legend_args = sanitize_legend(legend, legend_args) - - # legend 1: by (grouping) key - lgby = list( - # legend = lgby_pos, - legend_args = modifyList( - legend_args, - list(x.intersp = 1, y.intersp = 1), - keep.null = TRUE - ), - by_dep = by_dep, - lgnd_labs = lgnd_labs, - type = type, - pch = pch, - lty = lty, - lwd = lwd, - col = col, - bg = bg, - gradient = by_continuous, - # cex = cex * cex_fct_adj, - cex = lgnd_cex, - has_sub = has_sub - ) - # legend 2: bubble (size) key - lgbub = list( - # legend = lgbub_pos, - legend_args = modifyList( - legend_args, - list(title = cex_dep, ncol = 1), - keep.null = TRUE - ), - # by_dep = cex_dep, - lgnd_labs = names(bubble_cex), - type = type, - pch = pch, - lty = lty, - lwd = lwd, - col = adjustcolor(par("col"), alpha.f = bubble_alpha), - bg = adjustcolor(par("col"), alpha.f = bubble_bg_alpha), - # gradient = by_continuous, - cex = bubble_cex * cex_fct_adj, - has_sub = has_sub, - draw = FALSE - ) - + prepare_dual_legend(settings) + env2env(settings, environment(), c("legend_args", "lgby", "lgbub")) # draw dual legend draw_multi_legend(list(lgby, lgbub), position = legend_args[["x"]]) } has_legend = TRUE - } else if (legend_args[["x"]] == "none" && !add) { + } else if (legend_args[["x"]] == "none" && !isTRUE(add)) { omar = par("mar") ooma = par("oma") topmar_epsilon = 0.1 From 0dd41d91014905337d5c2e6dc33f6b0e2d07d6b7 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 09:07:19 -0500 Subject: [PATCH 02/14] consolidate legend in legend.R --- R/draw_legend.R | 694 ------------------ R/draw_legend_utils.R | 171 ----- R/draw_multi_legend.R | 133 ---- R/legend.R | 1263 +++++++++++++++++++++++++++++++++ R/legend_prepare.R | 162 ----- R/sanitize_legend.R | 35 - R/utils.R | 54 ++ man/build_legend_spec.Rd | 62 ++ man/draw_gradient_swatch.Rd | 42 ++ man/draw_legend.Rd | 12 +- man/draw_legend_positioned.Rd | 67 ++ man/draw_multi_legend.Rd | 12 +- man/prepare_dual_legend.Rd | 20 + man/prepare_legend_context.Rd | 24 + man/restore_margin_inner.Rd | 22 + man/restore_margin_outer.Rd | 16 + man/sanitize_legend.Rd | 21 + 17 files changed, 1606 insertions(+), 1204 deletions(-) delete mode 100644 R/draw_legend.R delete mode 100644 R/draw_legend_utils.R delete mode 100644 R/draw_multi_legend.R create mode 100644 R/legend.R delete mode 100644 R/legend_prepare.R delete mode 100644 R/sanitize_legend.R create mode 100644 man/build_legend_spec.Rd create mode 100644 man/draw_gradient_swatch.Rd create mode 100644 man/draw_legend_positioned.Rd create mode 100644 man/prepare_dual_legend.Rd create mode 100644 man/prepare_legend_context.Rd create mode 100644 man/restore_margin_inner.Rd create mode 100644 man/restore_margin_outer.Rd create mode 100644 man/sanitize_legend.Rd diff --git a/R/draw_legend.R b/R/draw_legend.R deleted file mode 100644 index d97ccc45..00000000 --- a/R/draw_legend.R +++ /dev/null @@ -1,694 +0,0 @@ -#' @title Calculate placement of legend and draw it -#' -#' @description Function used to calculate the placement of (including -#' outside the plotting area) and drawing of legend. -#' -#' @md -#' @param legend Legend placement keyword or list, passed down from [tinyplot]. -#' @param legend_args Additional legend arguments to be passed to -#' \code{\link[graphics]{legend}}. -#' @param by_dep The (deparsed) "by" grouping variable name. -#' @param lgnd_labs The labels passed to `legend(legend = ...)`. -#' @param labeller Character or function for formatting the labels (`lgnd_labs`). -#' Passed down to [`tinylabel`]. -#' @param type Plotting type(s), passed down from [tinyplot]. -#' @param pch Plotting character(s), passed down from [tinyplot]. -#' @param lty Plotting linetype(s), passed down from [tinyplot]. -#' @param lwd Plotting line width(s), passed down from [tinyplot]. -#' @param col Plotting colour(s), passed down from [tinyplot]. -#' @param bg Plotting character background fill colour(s), passed down from [tinyplot]. -#' @param cex Plotting character expansion(s), passed down from [tinyplot]. -#' @param gradient Logical indicating whether a continuous gradient swatch -#' should be used to represent the colors. -#' @param lmar Legend margins (in lines). Should be a numeric vector of the form -#' `c(inner, outer)`, where the first number represents the "inner" margin -#' between the legend and the plot, and the second number represents the -#' "outer" margin between the legend and edge of the graphics device. If no -#' explicit value is provided by the user, then reverts back to `tpar("lmar")` -#' for which the default values are `c(1.0, 0.1)`. -#' @param has_sub Logical. Does the plot have a sub-caption. Only used if -#' keyword position is "bottom!", in which case we need to bump the legend -#' margin a bit further. -#' @param new_plot Logical. Should we be calling plot.new internally? -#' @param draw Logical. If `FALSE`, no legend is drawn but the sizes are -#' returned. Note that a new (blank) plot frame will still need to be started -#' in order to perform the calculations. -#' -#' @returns No return value, called for side effect of producing a(n empty) plot -#' with a legend in the margin. -#' -#' @importFrom graphics grconvertX grconvertY rasterImage strwidth -#' @importFrom grDevices as.raster recordGraphics -#' @importFrom utils modifyList -#' -#' @examples -#' oldmar = par("mar") -#' -#' draw_legend( -#' legend = "right!", ## default (other options incl, "left(!)", ""bottom(!)", etc.) -#' legend_args = list(title = "Key", bty = "o"), -#' lgnd_labs = c("foo", "bar"), -#' type = "p", -#' pch = 21:22, -#' col = 1:2 -#' ) -#' -#' # The legend is placed in the outer margin... -#' box("figure", col = "cyan", lty = 4) -#' # ... and the plot is proportionally adjusted against the edge of this -#' # margin. -#' box("plot") -#' # You can add regular plot objects per normal now -#' plot.window(xlim = c(1,10), ylim = c(1,10)) -#' points(1:10) -#' points(10:1, pch = 22, col = "red") -#' axis(1); axis(2) -#' # etc. -#' -#' # Important: A side effect of draw_legend is that the inner margins have been -#' # adjusted. (Here: The right margin, since we called "right!" above.) -#' par("mar") -#' -#' # To reset you should call `dev.off()` or just reset manually. -#' par(mar = oldmar) -#' -#' # Note that the inner and outer margin of the legend itself can be set via -#' # the `lmar` argument. (This can also be set globally via -#' # `tpar(lmar = c(inner, outer))`.) -#' draw_legend( -#' legend_args = list(title = "Key", bty = "o"), -#' lgnd_labs = c("foo", "bar"), -#' type = "p", -#' pch = 21:22, -#' col = 1:2, -#' lmar = c(0, 0.1) ## set inner margin to zero -#' ) -#' box("figure", col = "cyan", lty = 4) -#' -#' par(mar = oldmar) -#' -#' # Continuous (gradient) legends are also supported -#' draw_legend( -#' legend = "right!", -#' legend_args = list(title = "Key"), -#' lgnd_labs = LETTERS[1:5], -#' col = hcl.colors(5), -#' gradient = TRUE ## enable gradient legend -#' ) -#' -#' par(mar = oldmar) -#' -#' @export -draw_legend = function( - legend = NULL, - legend_args = NULL, - by_dep = NULL, - lgnd_labs = NULL, - labeller = NULL, - type = NULL, - pch = NULL, - lty = NULL, - lwd = NULL, - col = NULL, - bg = NULL, - cex = NULL, - gradient = FALSE, - lmar = NULL, - has_sub = FALSE, - new_plot = TRUE, - draw = TRUE -) { - if (is.null(lmar)) { - lmar = tpar("lmar") - } else { - if (!is.numeric(lmar) || length(lmar) != 2) { - stop("lmar must be a numeric of length 2.") - } - } - - assert_logical(gradient) - assert_logical(has_sub) - assert_logical(new_plot) - assert_logical(draw) - - # - ## legend args ---- - - outer_side = outer_end = outer_right = outer_bottom = FALSE - list2env( - compute_legend_args( - legend = legend, - legend_args = legend_args, - by_dep = by_dep, - lgnd_labs = lgnd_labs, - labeller = labeller, - type = type, - pch = pch, - lty = lty, - lwd = lwd, - col = col, - bg = bg, - cex = cex, - gradient = gradient - ), - environment() - ) - - # - ## legend placement ---- - dynmar = isTRUE(.tpar[["dynmar"]]) - - # flag for (extra) user inset (also used for dual legends) - user_inset = !is.null(legend_args[["inset"]]) - - ## restore margin defaults - ## (in case the plot region/margins were affected by the preceding tinyplot call) - topmar_epsilon = 0.1 - restore_margin_outer() - if (!dynmar) { - restore_margin_inner(ooma, topmar_epsilon = topmar_epsilon) - } - - ooma = par("oma") - omar = par("mar") - - ## Legend to outer side (either right or left) of plot - if (outer_side) { - # extra bump for spineplot if outer_right legend (to accommodate secondary y-axis) - if (identical(type, "spineplot")) { - lmar[1] = lmar[1] + 1.1 - } - - ## We have to set the inner margins of the plot before the (fake) legend is - ## drawn, otherwise the inset calculation---which is based in the legend - ## width---will be off the first time. - if (outer_right) { - omar[4] = 0 - } else { - # For outer left we have to account for the y-axis label too, which - # requires additional space - omar[2] = par("mgp")[1] + 1 * par("cex.lab") - } - par(mar = omar) - - # if (new_plot && draw) { - if (new_plot) { - plot.new() - # For themed + dynamic plots, we need to make sure the adjusted plot - # margins for the legend are reinstated (after being overwritten by - # the before.plot.new hook. - if (dynmar) { - omar = par("mar") - if (outer_right) { - omar[4] = 0 - } else { - omar[2] = par("mgp")[1] + 1 * par("cex.lab") - } - par(mar = omar) - } - } - - ## Legend at the outer top or bottom of plot - } else if (outer_end) { - ## We have to set the inner margins of the plot before the (fake) legend is - ## drawn, otherwise the inset calculation---which is based in the legend - ## width---will be off the first time. - if (outer_bottom) { - omar[1] = par("mgp")[1] + 1 * par("cex.lab") - if ( - has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1) - ) { - omar[1] = omar[1] + 1 * par("cex.sub") - } - } else { - ## For "top!", the logic is slightly different: We don't expand the outer - ## margin b/c we need the legend to come underneath the main title. So - ## we rather expand the existing inner margin. - ooma[3] = ooma[3] + topmar_epsilon - par(oma = ooma) - } - par(mar = omar) - - # if (new_plot && draw) { - if (new_plot) { - plot.new() - # For themed + dynamic plots, we need to make sure the adjusted plot - # margins for the legend are reinstated (after being overwritten by - # the before.plot.new hook. - if (dynmar) { - omar = par("mar") - if (outer_bottom) { - # omar[1] = par("mgp")[1] + 1*par("cex.lab") - omar[1] = theme_clean$mgp[1] + 1 * par("cex.lab") ## bit of a hack - if ( - has_sub && - (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1) - ) { - omar[1] = omar[1] + 1 * par("cex.sub") - } - } else { - ooma[3] = ooma[3] + topmar_epsilon - par(oma = ooma) - } - par(mar = omar) - } - } - } else { - if (new_plot) plot.new() - } - # - ## draw the legend ---- - # Legend drawing is handled by the internal `tinylegend()` function, which: - # 1. calculates appropriate insets for "outer" legend placement - # 2. can draw gradient legends (via `gradient_legend()` below) - # - # Note: We wrap everything in `recordGraphics()` to preserve legend spacing - # if the plot is resized (also necessary for Positron graphics logic regardless) - recordGraphics( - tinylegend( - legend_args = legend_args, - ooma = ooma, - omar = omar, - lmar = lmar, - topmar_epsilon = topmar_epsilon, - outer_side = outer_side, - outer_right = outer_right, - outer_end = outer_end, - outer_bottom = outer_bottom, - gradient = gradient, - user_inset = user_inset, - draw = draw - ), - list = list( - legend_args = legend_args, - ooma = ooma, - omar = omar, - lmar = lmar, - topmar_epsilon = topmar_epsilon, - outer_side = outer_side, - outer_right = outer_right, - outer_end = outer_end, - outer_bottom = outer_bottom, - gradient = gradient, - user_inset = user_inset, - draw = draw - ), - env = getNamespace("tinyplot") - ) -} - - -# tinylegend ---- - -## Internal workhorse function that draws the legend, given a set of legend -## arguments and other graphical parameters. It does this in three steps: -## 1) draw a fake legend, 2) calculate the associated inset and adjust the plot -## margins accordingly, 3) draw the real legend - -tinylegend = function( - legend_args, - ooma, - omar, - lmar, - topmar_epsilon, - outer_side, - outer_right, - outer_end, - outer_bottom, - gradient, - user_inset = FALSE, - draw -) { - # - ## Step 1: "draw" fake legend - - fklgnd.args = modifyList( - legend_args, - list(plot = FALSE), - keep.null = TRUE - ) - - if (gradient) { - lgnd_labs_tmp = na.omit(fklgnd.args[["legend"]]) - if (length(lgnd_labs_tmp) < 5L) { - nmore = 5L - length(lgnd_labs_tmp) - lgnd_labs_tmp = c(lgnd_labs_tmp, rep("", nmore)) - } - fklgnd.args = modifyList( - fklgnd.args, - list(legend = lgnd_labs_tmp), - keep.null = TRUE - ) - if (outer_end) { - fklgnd.args = modifyList( - fklgnd.args, - list(title = NULL), - keep.null = TRUE - ) - } - } - - fklgnd = do.call("legend", fklgnd.args) - if (!draw) { - return(fklgnd) - } - - # - ## Step 2: Calculate legend inset (for outer placement in plot region) - - # calculate outer margin width in lines - soma = 0 - if (outer_side) { - soma = grconvertX(fklgnd$rect$w, to = "lines") - grconvertX(0, to = "lines") - } else if (outer_end) { - soma = grconvertY(fklgnd$rect$h, to = "lines") - grconvertY(0, to = "lines") - } - # Add legend margins to the outer margin - soma = soma + sum(lmar) - - ## differing outer margin adjustments depending on side - if (outer_side) { - if (outer_right) { - ooma[4] = soma - } else { - ooma[2] = soma - } - } else if (outer_end) { - if (outer_bottom) { - ooma[1] = soma - } else { - omar[3] = omar[3] + soma - topmar_epsilon - par(mar = omar) - } - } - par(oma = ooma) - - # determine legend inset - inset = 0 - if (outer_side) { - inset = grconvertX(lmar[1], from = "lines", to = "npc") - - grconvertX(0, from = "lines", to = "npc") - # extra space needed for "left!" b/c of lhs inner margin - if (!outer_right) { - inset_bump = grconvertX(par("mar")[2], from = "lines", to = "npc") - - grconvertX(0, from = "lines", to = "npc") - inset = inset + inset_bump - } - inset = c(1 + inset, 0) - } else if (outer_end) { - inset = grconvertY(lmar[1], from = "lines", to = "npc") - - grconvertY(0, from = "lines", to = "npc") - if (outer_bottom) { - # extra space needed for "bottom!" b/c of lhs inner margin - inset_bump = grconvertY(par("mar")[1], from = "lines", to = "npc") - - grconvertY(0, from = "lines", to = "npc") - inset = inset + inset_bump - } else { - epsilon_bump = grconvertY(topmar_epsilon, from = "lines", to = "npc") - - grconvertY(0, from = "lines", to = "npc") - inset = inset + epsilon_bump - } - inset = c(0, 1 + inset) - } - - # GM: The legend inset spacing only works _exactly_ if we refresh the plot - # area. I'm not sure why (and it works properly if we use the same - # parameters manually while debugging), but this hack seems to work. - ## v0.3.0 update: Using (temporary) hook instead of direct par(new = TRUE) - ## assignment to play nice with tinytheme logic. - oldhook = getHook("before.plot.new") - setHook("before.plot.new", function() par(new = TRUE), action = "append") - setHook("before.plot.new", function() par(mar = omar), action = "append") - plot.new() - setHook("before.plot.new", oldhook, action = "replace") - - # Finally, set the inset as part of the legend args. - legend_args[["inset"]] = if (user_inset) { - legend_args[["inset"]] + inset - } else { - inset - } - - # - ## Step 3: Draw the legend - - if (gradient) { - if (!more_than_n_unique(legend_args[["col"]], 1)) { - if ( - !is.null(legend_args[["pt.bg"]]) && - length(legend_args[["pt.bg"]]) == 100 - ) { - legend_args[["col"]] = legend_args[["pt.bg"]] - } - } - gradient_legend( - legend_args = legend_args, - fklgnd = fklgnd, - lmar = lmar, - outer_side = outer_side, - outer_end = outer_end, - outer_right = outer_right, - outer_bottom = outer_bottom, - user_inset = user_inset - ) - } else { - do.call("legend", legend_args) - } -} - - -# gradient legend ---- - -# For gradient (i.e., continuous color) legends, we'll role our own bespoke -# legend function based on grDevices::as.raster - -gradient_legend = function( - legend_args, - fklgnd, - lmar, - outer_side, - outer_end, - outer_right, - outer_bottom, - user_inset = FALSE -) { - pal = legend_args[["col"]] - lgnd_labs = legend_args[["legend"]] - if (!is.null(legend_args[["horiz"]])) { - horiz = legend_args[["horiz"]] - } else { - horiz = FALSE - } - if (isTRUE(horiz)) { - rasterlgd = as.raster(matrix(pal, nrow = 1)) - } else { - rasterlgd = as.raster(matrix(rev(pal), ncol = 1)) - } - - corners = par("usr") - rasterbox = rep(NA_real_, 4) - - inner = !any(c(outer_side, outer_end)) - inner_right = inner_bottom = FALSE - if (inner) { - if ( - !is.null(legend_args[["x"]]) && grepl("left$|right$", legend_args[["x"]]) - ) { - inner_right = grepl("right$", legend_args[["x"]]) - } - if ( - !is.null(legend_args[["x"]]) && grepl("^bottoml|^top", legend_args[["x"]]) - ) { - inner_bottom = grepl("^bottom", legend_args[["x"]]) - } - } - - if (inner) { - fklgnd$rect$h = fklgnd$rect$h - - (grconvertY(1.5 + 0.4, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user")) - - rasterbox[1] = fklgnd$rect$left - if (isFALSE(inner_right)) { - rasterbox[1] = rasterbox[1] + - (grconvertX(0.2, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user")) - } - rasterbox[2] = fklgnd$rect$top - - fklgnd$rect$h - - (grconvertY(1.5 + 0.2, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user")) - rasterbox[3] = rasterbox[1] + - (grconvertX(1.25, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user")) - rasterbox[4] = rasterbox[2] + fklgnd$rect$h - } else if (outer_side) { - rb1_adj = grconvertX(lmar[1] + 0.2, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user") - rb3_adj = grconvertX(1.25, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user") - rb2_adj = (corners[4] - - corners[3] - - (grconvertY(5 + 1 + 2.5, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user"))) / - 2 - # override if top or bottom - if (!is.null(legend_args[["x"]])) { - if (grepl("^bottom", legend_args[["x"]])) { - rb2_adj = corners[3] - } - if (grepl("^top", legend_args[["x"]])) { - rb2_adj = corners[4] - - (grconvertY(5 + 1 + 2.5, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user")) - } - } - if (user_inset) { - rb2_adj = rb2_adj + legend_args[["inset"]][2] + 0.05 - } - rb4_adj = grconvertY(5 + 1, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user") - - if (outer_right) { - rasterbox[1] = corners[2] + rb1_adj - if (user_inset) { - rasterbox[1] = rasterbox[1] - - (corners[2] - legend_args[["inset"]][1]) / 2 - } - rasterbox[2] = rb2_adj - rasterbox[3] = rasterbox[1] + rb3_adj - rasterbox[4] = rasterbox[2] + rb4_adj - } else { - rb1_adj = rb1_adj + - grconvertX(par("mar")[2] + 1, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user") - rasterbox[1] = corners[1] - rb1_adj - rasterbox[2] = rb2_adj - rasterbox[3] = rasterbox[1] - rb3_adj - rasterbox[4] = rasterbox[2] + rb4_adj - } - } else if (outer_end) { - rb1_adj = (corners[2] - - corners[1] - - (grconvertX(5 + 1, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user"))) / - 2 - rb3_adj = grconvertX(5 + 1, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user") - rb2_adj = grconvertY(lmar[1], from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user") - rb4_adj = grconvertY(1.25, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user") - - if (outer_bottom) { - rb2_adj = rb2_adj + - grconvertY(par("mar")[2], from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user") - rasterbox[1] = rb1_adj - rasterbox[2] = corners[3] - rb2_adj - rasterbox[3] = rasterbox[1] + rb3_adj - rasterbox[4] = rasterbox[2] - rb4_adj - } else { - rb2_adj = rb2_adj + - grconvertY(1.25 + 1, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user") - rasterbox[1] = rb1_adj - rasterbox[2] = corners[4] + rb2_adj - rasterbox[3] = rasterbox[1] + rb3_adj - rasterbox[4] = rasterbox[2] - rb4_adj - } - } - - # - ## Draw the gradient swatch - - rasterImage( - rasterlgd, - rasterbox[1], #x1 - rasterbox[2], #y1 - rasterbox[3], #x2 - rasterbox[4], #y2 - xpd = NA - ) - - # - ## Add the labels, tick marks, and title - - if (isFALSE(horiz)) { - labs_idx = !is.na(lgnd_labs) - lgnd_labs[labs_idx] = paste0(" ", format(lgnd_labs[labs_idx])) - lbl_x_anchor = rasterbox[3] - ttl_x_anchor = rasterbox[1] - lbl_adj = c(0, 0.5) - tck_adj = c(1, 0.5) - ttl_adj = c(0, 0) - if (!inner && !outer_right) { - lbl_x_anchor = rasterbox[1] - ttl_x_anchor = ttl_x_anchor + max(strwidth(lgnd_labs[labs_idx])) - ttl_adj = c(1, 0) - } - text( - x = lbl_x_anchor, - y = seq(rasterbox[2], rasterbox[4], length.out = length(lgnd_labs)), - labels = lgnd_labs, - xpd = NA, - adj = lbl_adj - ) - # legend tick marks - lgnd_ticks = lgnd_labs - lgnd_ticks[labs_idx] = "- -" - text( - x = lbl_x_anchor, - y = seq(rasterbox[2], rasterbox[4], length.out = length(lgnd_labs)), - labels = lgnd_ticks, - col = "white", - xpd = NA, - adj = tck_adj - ) - # legend title - text( - x = ttl_x_anchor, - y = rasterbox[4] + - grconvertY(1, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user"), - labels = legend_args[["title"]], - xpd = NA, - adj = ttl_adj - ) - } else { - lbl_y_anchor = rasterbox[4] - ttl_y_anchor = rasterbox[4] - lbl_adj = c(0.5, 1.25) - tck_adj = c(0, 0.5) - ttl_adj = c(1, -0.5) - # legend labs - text( - x = seq(rasterbox[1], rasterbox[3], length.out = length(lgnd_labs)), - y = lbl_y_anchor, - labels = lgnd_labs, - xpd = NA, - adj = lbl_adj - ) - # legend tick marks - lgnd_ticks = lgnd_labs - lgnd_ticks[!is.na(lgnd_ticks)] = "- -" - text( - x = seq(rasterbox[1], rasterbox[3], length.out = length(lgnd_labs)), - y = lbl_y_anchor, - labels = lgnd_ticks, - col = "white", - xpd = NA, - adj = tck_adj, - srt = 90 - ) - # legend title - text( - x = rasterbox[1], - y = ttl_y_anchor, - labels = paste0(legend_args[["title"]], " "), - xpd = NA, - adj = ttl_adj - ) - } -} - diff --git a/R/draw_legend_utils.R b/R/draw_legend_utils.R deleted file mode 100644 index fac21ae2..00000000 --- a/R/draw_legend_utils.R +++ /dev/null @@ -1,171 +0,0 @@ -restore_margin_outer = function() { - par(omd = c(0,1,0,1)) -} - - -restore_margin_inner = function(ooma, topmar_epsilon = 0.1) { - ooma = par("oma") - omar = par("mar") - - if (!any(ooma != 0)) return(invisible(NULL)) - - ## restore inner margin defaults - ## (in case the plot region/margins were affected by the preceding tinyplot call) - if (any(ooma != 0)) { - if (ooma[1] != 0 && omar[1] == par("mgp")[1] + 1 * par("cex.lab")) { - omar[1] = 5.1 - } - if (ooma[2] != 0 && omar[2] == par("mgp")[1] + 1 * par("cex.lab")) { - omar[2] = 4.1 - } - if (ooma[3] == topmar_epsilon && omar[3] != 4.1) { - omar[3] = 4.1 - } - if (ooma[4] != 0 && omar[4] == 0) { - omar[4] = 2.1 - } - par(mar = omar) - } - ## restore outer margin defaults (with a catch for custom mfrow plots) - if (all(par("mfrow") == c(1, 1))) { - par(omd = c(0, 1, 0, 1)) - } -} - - -compute_legend_args = function( - legend, - legend_args, - by_dep, - lgnd_labs, - labeller = NULL, - type, - pch, - lty, - lwd, - col, - bg, - cex, - gradient -) { - legend_args = sanitize_legend(legend, legend_args) - ## Use `!exists` rather than `is.null` for title in case user specified no title - if (!exists("title", where = legend_args)) legend_args[["title"]] = by_dep - legend_args[["pch"]] = legend_args[["pch"]] %||% pch - legend_args[["lty"]] = legend_args[["lty"]] %||% lty - legend_args[["col"]] = legend_args[["col"]] %||% col - legend_args[["bty"]] = legend_args[["bty"]] %||% "n" - legend_args[["horiz"]] = legend_args[["horiz"]] %||% FALSE - legend_args[["xpd"]] = legend_args[["xpd"]] %||% NA - legend_args[["lwd"]] = legend_args[["lwd"]] %||% lwd - # special handling of pt.cex for bubble plots - # (fixme: can't handle ahead of time in bubble.R b/c of dual legend gotcha) - if (is.null(type) || type %in% c("p", "text")) { - legend_args[["pt.cex"]] = legend_args[["pt.cex"]] %||% (cex %||% par("cex")) - } - if (gradient) { - legend_args[["pch"]] = 22 - legend_args[["pt.cex"]] = legend_args[["pt.cex"]] %||% 3.5 - legend_args[["y.intersp"]] = legend_args[["y.intersp"]] %||% 1.25 - legend_args[["seg.len"]] = legend_args[["seg.len"]] %||% 1.25 - } - if (identical(type, "n") && isFALSE(gradient)) { - legend_args[["pch"]] = legend_args[["pch"]] %||% par("pch") - } - # Special pt.bg handling for types that need color-based fills - if (identical(type, "spineplot")) { - legend_args[["pt.bg"]] = legend_args[["pt.bg"]] %||% legend_args[["col"]] - } else if (identical(type, "ridge") && isFALSE(gradient)) { - legend_args[["pt.bg"]] = legend_args[["pt.bg"]] %||% sapply(legend_args[["col"]], function(ccol) seq_palette(ccol, n = 2)[2]) - } else { - legend_args[["pt.bg"]] = legend_args[["pt.bg"]] %||% bg - } - legend_args[["legend"]] = legend_args[["legend"]] %||% lgnd_labs - if (length(lgnd_labs) != length(eval(legend_args[["legend"]]))) { - warning( - "\nUser-supplied legend labels do not match the number of groups.\n", - "Defaulting to automatic labels determined by the group splits in `by`,\n" - ) - legend_args[["legend"]] = lgnd_labs - } - if (!is.null(legend_args[["labeller"]])) { - labeller = legend_args[["labeller"]] - legend_args[["labeller"]] = NULL - legend_args[["legend"]] = tinylabel(legend_args[["legend"]], labeller = labeller) - } - if (isTRUE(gradient)) { - legend_args[["ncol"]] = NULL - } - # flag for multicolumn legend - mcol_flag = !is.null(legend_args[["ncol"]]) && legend_args[["ncol"]] > 1 - # flag for (extra) user inset (also used for dual legends) - user_inset = !is.null(legend_args[["inset"]]) - - # placement flags and anchor normalization (no par() calls here) - outer_side = outer_end = outer_right = outer_bottom = FALSE - if (grepl("right!$|left!$", legend_args[["x"]])) { - outer_side = TRUE - outer_right = grepl("right!$", legend_args[["x"]]) - } else if (grepl("bottom!$|top!$", legend_args[["x"]])) { - outer_end = TRUE - outer_bottom = grepl("bottom!$", legend_args[["x"]]) - } - - ## Switch position anchor (we'll adjust relative to the _opposite_ side below) - if (outer_end) { - if (outer_bottom) { - legend_args[["x"]] = gsub("bottom!$", "top", legend_args[["x"]]) - } - if (!outer_bottom) { - legend_args[["x"]] = gsub("top!$", "bottom", legend_args[["x"]]) - } - - # enforce horizontal legend if user hasn't specified ncol arg - # (exception: gradient legends at bottom/top are always horizontal) - if (is.null(legend_args[["ncol"]]) || gradient) legend_args[["horiz"]] = TRUE - - } else if (outer_side) { - if (outer_right) { - legend_args[["x"]] = gsub("right!$", "left", legend_args[["x"]]) - } - if (!outer_right) { - legend_args[["x"]] = gsub("left!$", "right", legend_args[["x"]]) - } - } else { - legend_args[["inset"]] = 0 - } - - # Additional tweaks for horiz and/or multi-column legends - if (isTRUE(legend_args[["horiz"]]) || mcol_flag) { - # tighter horizontal labelling - # See: https://github.com/grantmcdermott/tinyplot/issues/434 - if (!gradient) { - legend_args[["text.width"]] = NA - # Add a space to all labs except the outer most right ones - nlabs = length(legend_args[["legend"]]) - nidx = nlabs - if (mcol_flag) nidx = tail(1:nlabs, (nlabs %/% legend_args[["ncol"]])) - legend_args[["legend"]][-nidx] = paste(legend_args[["legend"]][-nidx], " ") - } - # catch for horizontal ribbon legend spacing - if (type=="ribbon") { - if (legend_args[["pt.lwd"]] == 1) { - legend_args[["x.intersp"]] = 1 - } else { - legend_args[["x.intersp"]] = 0.5 - } - } else if (gradient) { - legend_args[["x.intersp"]] = 0.5 - } - } - - list( - legend_args = legend_args, - mcol_flag = mcol_flag, - user_inset = user_inset, - outer_side = outer_side, - outer_end = outer_end, - outer_right = outer_right, - outer_bottom = outer_bottom - ) -} diff --git a/R/draw_multi_legend.R b/R/draw_multi_legend.R deleted file mode 100644 index 6575fb63..00000000 --- a/R/draw_multi_legend.R +++ /dev/null @@ -1,133 +0,0 @@ -#' @title Draw multiple legends with automatic positioning -#' -#' @description Internal function to draw multiple legends (e.g., bubble + color) -#' with automatic dimension calculation and positioning. This function handles -#' the internal gymnastics required to determine the individual legend -#' dimensions, before drawing them in the optimal order and position. -#' -#' @md -#' @param legend_list A list of legend arguments, where each element is itself a -#' list of arguments that can be passed on to [draw_legend]. Legends will be -#' drawn vertically (top to bottom) in the order that they are provided. Note -#' that we currently only support dual legends, i.e. the top-level list has a -#' maximum length of 2. -#' @param position String indicating the base keyword position for the -#' multi-legend. Currently only `"right!"` and `"left!"` are supported. -#' -#' @returns No return value, called for side effect of drawing multiple legends. -#' -#' @seealso [draw_legend] -#' -#' @keywords internal -#' -#' @examples -#' \dontrun{ -#' oldmar = par("mar") -#' -#' # Dual legend example (color + bubble) -#' -#' l1 = list( -#' lgnd_labs = c("Red", "Blue", "Green"), -#' legend_args = list(title = "Colors"), -#' pch = 16, -#' col = c("red", "blue", "green"), -#' type = "p" -#' ) -#' -#' l2 = list( -#' lgnd_labs = c("Tiny", "Small", "Medium", "Large", "Huge"), -#' legend_args = list(title = "Size"), -#' pch = 16, -#' col = "black", -#' cex = seq(0.5, 2.5, length.out = 5), -#' type = "p" -#' ) -#' -#' # Draw together -#' draw_multi_legend(list(l1, l2), position = "right!") -#' -#' par(mar = oldmar) -#' } -#' -#' @keywords internal -draw_multi_legend = function( - legend_list, - position = "right!" -) { - - # Validate inputs - if (!is.list(legend_list) || length(legend_list) != 2) { - stop("Currently only 2 legends are supported in multi-legend mode") - } - - # Currently only support right!/left! positioning - if (!grepl("right!$|left!$", position)) { - warning( - '\nMulti-legends currently only work with "right!" or "left!" keyword positioning.\n', - 'Reverting to "right!" default\n' - ) - position = "right!" - } - - ## FIXME: current logic only works for "right!"/"left!" legend - # Determine sub-positions based on main position - if (grepl("right!$", position)) { - sub_positions = c("bottomright!", "topright!") - } else if (grepl("left!$", position)) { - sub_positions = c("bottomleft!", "topleft!") - } - - # Assign positions of individual legends - for (ll in seq_along(legend_list)) { - legend_list[[ll]][["legend"]] = sub_positions[ll] - legend_list[[ll]][["legend_args"]][["x"]] = NULL - } - - # - ## Step 1: Extract legend dimensions (by drawing fake legends) - # - - legend_dims = vector("list", length(legend_list)) - for (ll in seq_along(legend_list)) { - legend_ll = legend_list[[ll]] - legend_ll$new_plot = ll==1 ## only draw new plot for first legend - legend_ll$draw = FALSE - legend_dims[[ll]] = do.call(draw_legend, legend_ll) - } - - # - ## Step 2: Calculate sub-positioning based on dimensions - # - - # Extract dimensions - lwidths = sapply(legend_dims, function(x) x$rect$w) - lheights = sapply(legend_dims, function(x) x$rect$h) - # for inset adjustment, default to 0.5 unless one or more of the two legends - # is bigger than half the plot height. - linset = if (any(lheights > 0.5)) lheights[2] / sum(lheights) else 0.5 - - # - ## Step 3: Reposition (via adjusted an `inset` arg) and draw legends - # - - # Note: we draw the legends in ascending order of width (i.e., widest legend - # last) in order to correctly set the overall plot dimensions. - width_order = order(lwidths) - - # quick idx for original order (needed for vertical legend placement) - for (i in seq_along(legend_list)) legend_list[[i]]$idx = i - - for (o in seq_along(width_order)) { - io = width_order[o] - legend_o = legend_list[[io]] - legend_o$new_plot = FALSE - legend_o$draw = TRUE - legend_o$legend_args$inset = c(0, 0) - legend_o$legend_args$inset[1] = if(o==1) -abs(diff(lwidths))/2 else 0 - legend_o$legend_args$inset[2] = if (legend_o$idx==1) linset + 0.01 else 1 - linset + 0.01 - legend_o$idx = NULL - do.call(draw_legend, legend_o) - } - - invisible(NULL) -} diff --git a/R/legend.R b/R/legend.R new file mode 100644 index 00000000..a64606ed --- /dev/null +++ b/R/legend.R @@ -0,0 +1,1263 @@ +# LEGEND SYSTEM +# +# This file consolidates all legend-related functionality for tinyplot. +# Previously spread across 5 files, now organized into logical sections: +# +# 1. Input Sanitization +# 2. Legend Context & Preparation +# 3. Single Legend Rendering +# 4. Gradient Legend Rendering +# 5. Multi-Legend Rendering + + +# +## Input Sanitization ----- +# + +#' Sanitize and normalize legend input +#' +#' @description Converts various legend input formats (NULL, character, list, +#' call) into a standardized legend_args list with an "x" position element. +#' +#' @param legend Legend specification (NULL, character, list, or call) +#' @param legend_args Existing legend_args list to merge with +#' +#' @returns Normalized legend_args list with at least an "x" element +#' +#' @keywords internal +sanitize_legend = function(legend, legend_args) { + if (is.null(legend_args[["x"]])) { + + # Normalize legend to a list + largs = if (is.null(legend)) { + list(x = "right!") + } else if (is.character(legend)) { + list(x = legend) + } else if (is.list(legend)) { + # Handle unnamed first element as position + if (length(legend) >= 1 && is.character(legend[[1]]) && + (is.null(names(legend)) || names(legend)[1] == "")) { + names(legend)[1] = "x" + } + legend + } else if (inherits(legend, c("call", "name"))) { + # Convert call to list and handle unnamed first arg as position + new_legend = as.list(legend)[-1] # Remove function name + if (length(new_legend) >= 1 && (is.null(names(new_legend)) || names(new_legend)[1] == "")) { + names(new_legend)[1] = "x" + } + new_legend + } else { + list(x = "right!") # Fallback + } + + # Ensure position exists + if (is.null(largs[["x"]])) largs[["x"]] = "right!" + + # Merge + legend_args = modifyList(legend_args, largs, keep.null = TRUE) + } + + legend_args +} + + +# +## Legend Context & Preparation ----- +# + +#' Prepare legend context from settings +#' +#' @description Main orchestrator that determines: +#' - Whether to draw legend +#' - Legend labels and formatting +#' - Whether dual legend is needed (for bubble charts) +#' - Gradient legend setup for continuous grouping +#' +#' @param settings Settings environment from tinyplot +#' +#' @returns NULL (modifies settings environment in-place) +#' +#' @keywords internal +prepare_legend_context = function(settings) { + env2env( + settings, + environment(), + c( + "col", + "by_continuous", + "by", + "bubble", + "null_by", + "legend", + "legend_args", + "bubble_cex", + "cex_fct_adj", + "cex_dep", + "add", + "sub", + "ngrps", + "datapoints", + "ylab" + ) + ) + + ncolors = length(col) + lgnd_labs = rep(NA, times = ncolors) + + # Generate labels for continuous (gradient) legends + if (isTRUE(by_continuous)) { + nlabs = 5 + ubyvar = unique(by) + byvar_range = range(ubyvar) + pbyvar = pretty(byvar_range, n = nlabs) + pbyvar = pbyvar[pbyvar >= byvar_range[1] & pbyvar <= byvar_range[2]] + if (length(ubyvar) == 2 && all(ubyvar %in% pbyvar)) { + pbyvar = ubyvar + } else if (length(pbyvar) > nlabs) { + pbyvar = pbyvar[seq_along(pbyvar) %% 2 == 0] + } + pidx = rescale_num(c(byvar_range, pbyvar), to = c(1, ncolors))[-c(1:2)] + pidx = round(pidx) + lgnd_labs[pidx] = pbyvar + } + + has_legend = FALSE + dual_legend = bubble && !null_by && !isFALSE(legend) + lgnd_cex = NULL + + # Normalize legend argument + if (isFALSE(legend)) { + legend = "none" + } else if (isTRUE(legend)) { + legend = NULL + } + + if (!is.null(legend) && is.character(legend) && legend == "none") { + legend_args[["x"]] = "none" + dual_legend = FALSE + } + + # Handle bubble-only legend (no grouping) + if (null_by) { + if (bubble && !dual_legend) { + legend_args[["title"]] = cex_dep + lgnd_labs = names(bubble_cex) + lgnd_cex = bubble_cex * cex_fct_adj + } else if (is.null(legend)) { + legend = "none" + legend_args[["x"]] = "none" + } + } + + legend_draw_flag = (is.null(legend) || !is.character(legend) || legend != "none" || bubble) && !isTRUE(add) + has_sub = !is.null(sub) + + # Generate labels for discrete legends + if (legend_draw_flag && isFALSE(by_continuous) && (!bubble || dual_legend)) { + if (ngrps > 1) { + lgnd_labs = if (is.factor(datapoints$by)) levels(datapoints$by) else unique(datapoints$by) + } else { + lgnd_labs = ylab + } + } + + env2env( + environment(), + settings, + c( + "lgnd_labs", + "has_legend", + "dual_legend", + "lgnd_cex", + "legend", + "legend_args", + "legend_draw_flag", + "has_sub" + ) + ) +} + + +#' Prepare dual legend specifications +#' +#' @description Sets up two separate legend specifications for dual legends +#' (e.g., color grouping + bubble size). Creates `lgby` and `lgbub` objects +#' that will be passed to draw_multi_legend(). +#' +#' @param settings Settings environment from tinyplot +#' +#' @returns NULL (modifies settings environment in-place) +#' +#' @keywords internal +prepare_dual_legend = function(settings) { + env2env( + settings, + environment(), + c( + "legend", + "legend_args", + "by_dep", + "lgnd_labs", + "type", + "pch", + "lty", + "lwd", + "col", + "bg", + "by_continuous", + "lgnd_cex", + "cex_dep", + "bubble_cex", + "cex_fct_adj", + "bubble_alpha", + "bubble_bg_alpha", + "has_sub" + ) + ) + + legend_args = sanitize_legend(legend, legend_args) + + # Legend for grouping variable (by) + lgby = list( + legend_args = modifyList( + legend_args, + list(x.intersp = 1, y.intersp = 1), + keep.null = TRUE + ), + by_dep = by_dep, + lgnd_labs = lgnd_labs, + type = type, + pch = pch, + lty = lty, + lwd = lwd, + col = col, + bg = bg, + gradient = by_continuous, + cex = lgnd_cex, + has_sub = has_sub + ) + + # Legend for bubble sizes + lgbub = list( + legend_args = modifyList( + legend_args, + list(title = cex_dep, ncol = 1), + keep.null = TRUE + ), + lgnd_labs = names(bubble_cex), + type = type, + pch = pch, + lty = lty, + lwd = lwd, + col = adjustcolor(par("col"), alpha.f = bubble_alpha), + bg = adjustcolor(par("col"), alpha.f = bubble_bg_alpha), + cex = bubble_cex * cex_fct_adj, + has_sub = has_sub, + draw = FALSE + ) + + env2env(environment(), settings, c("legend_args", "lgby", "lgbub")) +} + + +#' Build legend specification +#' +#' @description Constructs a complete legend_args list by: +#' - Sanitizing legend input +#' - Setting defaults for all legend parameters +#' - Computing positioning flags (outer_side, outer_right, etc.) +#' - Adjusting for special cases (gradient, horizontal, multi-column) +#' +#' @param legend Legend placement keyword or list +#' @param legend_args Additional legend arguments +#' @param by_dep The (deparsed) "by" grouping variable name +#' @param lgnd_labs The legend labels +#' @param labeller Character or function for formatting labels +#' @param type Plot type +#' @param pch Plotting character(s) +#' @param lty Line type(s) +#' @param lwd Line width(s) +#' @param col Color(s) +#' @param bg Background fill color(s) +#' @param cex Character expansion(s) +#' @param gradient Logical indicating gradient legend +#' +#' @returns List with legend_args and positioning flags +#' +#' @keywords internal +build_legend_spec = function( + legend, + legend_args, + by_dep, + lgnd_labs, + labeller = NULL, + type, + pch, + lty, + lwd, + col, + bg, + cex, + gradient +) { + legend_args = sanitize_legend(legend, legend_args) + + # Set defaults + if (!exists("title", where = legend_args)) legend_args[["title"]] = by_dep + legend_args[["pch"]] = legend_args[["pch"]] %||% pch + legend_args[["lty"]] = legend_args[["lty"]] %||% lty + legend_args[["col"]] = legend_args[["col"]] %||% col + legend_args[["bty"]] = legend_args[["bty"]] %||% "n" + legend_args[["horiz"]] = legend_args[["horiz"]] %||% FALSE + legend_args[["xpd"]] = legend_args[["xpd"]] %||% NA + legend_args[["lwd"]] = legend_args[["lwd"]] %||% lwd + + # Special handling of pt.cex for bubble plots + if (is.null(type) || type %in% c("p", "text")) { + legend_args[["pt.cex"]] = legend_args[["pt.cex"]] %||% (cex %||% par("cex")) + } + + # Gradient legend adjustments + if (gradient) { + legend_args[["pch"]] = 22 + legend_args[["pt.cex"]] = legend_args[["pt.cex"]] %||% 3.5 + legend_args[["y.intersp"]] = legend_args[["y.intersp"]] %||% 1.25 + legend_args[["seg.len"]] = legend_args[["seg.len"]] %||% 1.25 + } + + if (identical(type, "n") && isFALSE(gradient)) { + legend_args[["pch"]] = legend_args[["pch"]] %||% par("pch") + } + + # Special pt.bg handling for types that need color-based fills + if (identical(type, "spineplot")) { + legend_args[["pt.bg"]] = legend_args[["pt.bg"]] %||% legend_args[["col"]] + } else if (identical(type, "ridge") && isFALSE(gradient)) { + legend_args[["pt.bg"]] = legend_args[["pt.bg"]] %||% sapply(legend_args[["col"]], function(ccol) seq_palette(ccol, n = 2)[2]) + } else { + legend_args[["pt.bg"]] = legend_args[["pt.bg"]] %||% bg + } + + # Set legend labels + legend_args[["legend"]] = legend_args[["legend"]] %||% lgnd_labs + if (length(lgnd_labs) != length(eval(legend_args[["legend"]]))) { + warning( + "\nUser-supplied legend labels do not match the number of groups.\n", + "Defaulting to automatic labels determined by the group splits in `by`,\n" + ) + legend_args[["legend"]] = lgnd_labs + } + + # Apply label formatter if provided + if (!is.null(legend_args[["labeller"]])) { + labeller = legend_args[["labeller"]] + legend_args[["labeller"]] = NULL + legend_args[["legend"]] = tinylabel(legend_args[["legend"]], labeller = labeller) + } + + if (isTRUE(gradient)) { + legend_args[["ncol"]] = NULL + } + + # Flags + mcol_flag = !is.null(legend_args[["ncol"]]) && legend_args[["ncol"]] > 1 + user_inset = !is.null(legend_args[["inset"]]) + + # Determine positioning + outer_side = outer_end = outer_right = outer_bottom = FALSE + if (grepl("right!$|left!$", legend_args[["x"]])) { + outer_side = TRUE + outer_right = grepl("right!$", legend_args[["x"]]) + } else if (grepl("bottom!$|top!$", legend_args[["x"]])) { + outer_end = TRUE + outer_bottom = grepl("bottom!$", legend_args[["x"]]) + } + + # Adjust position anchor (we'll position relative to opposite side) + if (outer_end) { + if (outer_bottom) { + legend_args[["x"]] = gsub("bottom!$", "top", legend_args[["x"]]) + } + if (!outer_bottom) { + legend_args[["x"]] = gsub("top!$", "bottom", legend_args[["x"]]) + } + # Enforce horizontal legend if user hasn't specified ncol arg + if (is.null(legend_args[["ncol"]]) || gradient) legend_args[["horiz"]] = TRUE + } else if (outer_side) { + if (outer_right) { + legend_args[["x"]] = gsub("right!$", "left", legend_args[["x"]]) + } + if (!outer_right) { + legend_args[["x"]] = gsub("left!$", "right", legend_args[["x"]]) + } + } else { + legend_args[["inset"]] = 0 + } + + # Additional tweaks for horizontal and/or multi-column legends + if (isTRUE(legend_args[["horiz"]]) || mcol_flag) { + # Tighter horizontal labelling + if (!gradient) { + legend_args[["text.width"]] = NA + # Add a space to all labs except the outermost right ones + nlabs = length(legend_args[["legend"]]) + nidx = nlabs + if (mcol_flag) nidx = tail(1:nlabs, (nlabs %/% legend_args[["ncol"]])) + legend_args[["legend"]][-nidx] = paste(legend_args[["legend"]][-nidx], " ") + } + # Catch for horizontal ribbon legend spacing + if (type == "ribbon") { + if (legend_args[["pt.lwd"]] == 1) { + legend_args[["x.intersp"]] = 1 + } else { + legend_args[["x.intersp"]] = 0.5 + } + } else if (gradient) { + legend_args[["x.intersp"]] = 0.5 + } + } + + list( + legend_args = legend_args, + mcol_flag = mcol_flag, + user_inset = user_inset, + outer_side = outer_side, + outer_end = outer_end, + outer_right = outer_right, + outer_bottom = outer_bottom + ) +} + + +# +## Single Legend Rendering ----- +# + +#' Calculate placement and draw legend +#' +#' @description Main exported function for drawing legends. Supports: +#' - Inner and outer positioning (with "!" suffix) +#' - Discrete and continuous (gradient) legends +#' - Automatic margin adjustment +#' +#' @md +#' @param legend Legend placement keyword or list, passed down from [tinyplot]. +#' @param legend_args Additional legend arguments to be passed to +#' \code{\link[graphics]{legend}}. +#' @param by_dep The (deparsed) "by" grouping variable name. +#' @param lgnd_labs The labels passed to `legend(legend = ...)`. +#' @param labeller Character or function for formatting the labels (`lgnd_labs`). +#' Passed down to [`tinylabel`]. +#' @param type Plotting type(s), passed down from [tinyplot]. +#' @param pch Plotting character(s), passed down from [tinyplot]. +#' @param lty Plotting linetype(s), passed down from [tinyplot]. +#' @param lwd Plotting line width(s), passed down from [tinyplot]. +#' @param col Plotting colour(s), passed down from [tinyplot]. +#' @param bg Plotting character background fill colour(s), passed down from [tinyplot]. +#' @param cex Plotting character expansion(s), passed down from [tinyplot]. +#' @param gradient Logical indicating whether a continuous gradient swatch +#' should be used to represent the colors. +#' @param lmar Legend margins (in lines). Should be a numeric vector of the form +#' `c(inner, outer)`, where the first number represents the "inner" margin +#' between the legend and the plot, and the second number represents the +#' "outer" margin between the legend and edge of the graphics device. If no +#' explicit value is provided by the user, then reverts back to `tpar("lmar")` +#' for which the default values are `c(1.0, 0.1)`. +#' @param has_sub Logical. Does the plot have a sub-caption. Only used if +#' keyword position is "bottom!", in which case we need to bump the legend +#' margin a bit further. +#' @param new_plot Logical. Should we be calling plot.new internally? +#' @param draw Logical. If `FALSE`, no legend is drawn but the sizes are +#' returned. Note that a new (blank) plot frame will still need to be started +#' in order to perform the calculations. +#' +#' @returns No return value, called for side effect of producing a(n empty) plot +#' with a legend in the margin. +#' +#' @importFrom graphics grconvertX grconvertY rasterImage strwidth +#' @importFrom grDevices as.raster recordGraphics +#' @importFrom utils modifyList +#' +#' @examples +#' oldmar = par("mar") +#' +#' draw_legend( +#' legend = "right!", ## default (other options incl, "left(!)", ""bottom(!)", etc.) +#' legend_args = list(title = "Key", bty = "o"), +#' lgnd_labs = c("foo", "bar"), +#' type = "p", +#' pch = 21:22, +#' col = 1:2 +#' ) +#' +#' # The legend is placed in the outer margin... +#' box("figure", col = "cyan", lty = 4) +#' # ... and the plot is proportionally adjusted against the edge of this +#' # margin. +#' box("plot") +#' # You can add regular plot objects per normal now +#' plot.window(xlim = c(1,10), ylim = c(1,10)) +#' points(1:10) +#' points(10:1, pch = 22, col = "red") +#' axis(1); axis(2) +#' # etc. +#' +#' # Important: A side effect of draw_legend is that the inner margins have been +#' # adjusted. (Here: The right margin, since we called "right!" above.) +#' par("mar") +#' +#' # To reset you should call `dev.off()` or just reset manually. +#' par(mar = oldmar) +#' +#' # Note that the inner and outer margin of the legend itself can be set via +#' # the `lmar` argument. (This can also be set globally via +#' # `tpar(lmar = c(inner, outer))`.) +#' draw_legend( +#' legend_args = list(title = "Key", bty = "o"), +#' lgnd_labs = c("foo", "bar"), +#' type = "p", +#' pch = 21:22, +#' col = 1:2, +#' lmar = c(0, 0.1) ## set inner margin to zero +#' ) +#' box("figure", col = "cyan", lty = 4) +#' +#' par(mar = oldmar) +#' +#' # Continuous (gradient) legends are also supported +#' draw_legend( +#' legend = "right!", +#' legend_args = list(title = "Key"), +#' lgnd_labs = LETTERS[1:5], +#' col = hcl.colors(5), +#' gradient = TRUE ## enable gradient legend +#' ) +#' +#' par(mar = oldmar) +#' +#' @export +draw_legend = function( + legend = NULL, + legend_args = NULL, + by_dep = NULL, + lgnd_labs = NULL, + labeller = NULL, + type = NULL, + pch = NULL, + lty = NULL, + lwd = NULL, + col = NULL, + bg = NULL, + cex = NULL, + gradient = FALSE, + lmar = NULL, + has_sub = FALSE, + new_plot = TRUE, + draw = TRUE +) { + if (is.null(lmar)) { + lmar = tpar("lmar") + } else { + if (!is.numeric(lmar) || length(lmar) != 2) { + stop("lmar must be a numeric of length 2.") + } + } + + assert_logical(gradient) + assert_logical(has_sub) + assert_logical(new_plot) + assert_logical(draw) + + # Build complete legend specification + outer_side = outer_end = outer_right = outer_bottom = FALSE + list2env( + build_legend_spec( + legend = legend, + legend_args = legend_args, + by_dep = by_dep, + lgnd_labs = lgnd_labs, + labeller = labeller, + type = type, + pch = pch, + lty = lty, + lwd = lwd, + col = col, + bg = bg, + cex = cex, + gradient = gradient + ), + environment() + ) + + # Restore margin defaults + dynmar = isTRUE(.tpar[["dynmar"]]) + topmar_epsilon = 0.1 + user_inset = !is.null(legend_args[["inset"]]) + + restore_margin_outer() + if (!dynmar) { + restore_margin_inner(par("oma"), topmar_epsilon = topmar_epsilon) + } + + ooma = par("oma") + omar = par("mar") + + # Adjust margins for outer legends + if (outer_side) { + # Extra bump for spineplot if outer_right legend (to accommodate secondary y-axis) + if (identical(type, "spineplot")) { + lmar[1] = lmar[1] + 1.1 + } + + # Set inner margins before fake legend is drawn + if (outer_right) { + omar[4] = 0 + } else { + # For outer left we have to account for the y-axis label too + omar[2] = par("mgp")[1] + 1 * par("cex.lab") + } + par(mar = omar) + + if (new_plot) { + plot.new() + # For themed + dynamic plots, reinstate adjusted plot margins + if (dynmar) { + omar = par("mar") + if (outer_right) { + omar[4] = 0 + } else { + omar[2] = par("mgp")[1] + 1 * par("cex.lab") + } + par(mar = omar) + } + } + + } else if (outer_end) { + # Set inner margins before fake legend is drawn + if (outer_bottom) { + omar[1] = par("mgp")[1] + 1 * par("cex.lab") + if (has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { + omar[1] = omar[1] + 1 * par("cex.sub") + } + } else { + # For "top!", expand existing inner margin rather than outer margin + ooma[3] = ooma[3] + topmar_epsilon + par(oma = ooma) + } + par(mar = omar) + + if (new_plot) { + plot.new() + # For themed + dynamic plots, reinstate adjusted plot margins + if (dynmar) { + omar = par("mar") + if (outer_bottom) { + omar[1] = theme_clean$mgp[1] + 1 * par("cex.lab") + if (has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { + omar[1] = omar[1] + 1 * par("cex.sub") + } + } else { + ooma[3] = ooma[3] + topmar_epsilon + par(oma = ooma) + } + par(mar = omar) + } + } + } else { + if (new_plot) plot.new() + } + + # Draw the legend using internal function + # Wrapped in recordGraphics() to preserve spacing if plot is resized + recordGraphics( + draw_legend_positioned( + legend_args = legend_args, + ooma = ooma, + omar = omar, + lmar = lmar, + topmar_epsilon = topmar_epsilon, + outer_side = outer_side, + outer_right = outer_right, + outer_end = outer_end, + outer_bottom = outer_bottom, + gradient = gradient, + user_inset = user_inset, + draw = draw + ), + list = list( + legend_args = legend_args, + ooma = ooma, + omar = omar, + lmar = lmar, + topmar_epsilon = topmar_epsilon, + outer_side = outer_side, + outer_right = outer_right, + outer_end = outer_end, + outer_bottom = outer_bottom, + gradient = gradient, + user_inset = user_inset, + draw = draw + ), + env = getNamespace("tinyplot") + ) +} + + +#' Internal legend drawing with positioning +#' +#' @description Internal workhorse that draws the legend in three steps: +#' 1. Draw a fake legend (plot = FALSE) to measure dimensions +#' 2. Calculate required inset and adjust plot margins +#' 3. Draw the real legend +#' +#' @inheritParams draw_legend +#' @param ooma Outer margins +#' @param omar Inner margins +#' @param topmar_epsilon Small epsilon for top margin adjustment +#' @param outer_side Logical flag for outer side placement +#' @param outer_right Logical flag for outer right placement +#' @param outer_end Logical flag for outer end placement +#' @param outer_bottom Logical flag for outer bottom placement +#' @param user_inset Logical flag indicating user-supplied inset +#' +#' @returns Legend dimensions (from fake legend) if draw=FALSE, otherwise NULL +#' +#' @keywords internal +draw_legend_positioned = function( + legend_args, + ooma, + omar, + lmar, + topmar_epsilon, + outer_side, + outer_right, + outer_end, + outer_bottom, + gradient, + user_inset = FALSE, + draw +) { + # + ## Step 1: Draw fake legend to measure dimensions + # + + fklgnd.args = modifyList( + legend_args, + list(plot = FALSE), + keep.null = TRUE + ) + + if (gradient) { + lgnd_labs_tmp = na.omit(fklgnd.args[["legend"]]) + if (length(lgnd_labs_tmp) < 5L) { + nmore = 5L - length(lgnd_labs_tmp) + lgnd_labs_tmp = c(lgnd_labs_tmp, rep("", nmore)) + } + fklgnd.args = modifyList( + fklgnd.args, + list(legend = lgnd_labs_tmp), + keep.null = TRUE + ) + if (outer_end) { + fklgnd.args = modifyList( + fklgnd.args, + list(title = NULL), + keep.null = TRUE + ) + } + } + + fklgnd = do.call("legend", fklgnd.args) + if (!draw) { + return(fklgnd) + } + + # + ## Step 2: Calculate legend inset (for outer placement) + # + + # Calculate outer margin width in lines + soma = 0 + if (outer_side) { + soma = grconvertX(fklgnd$rect$w, to = "lines") - grconvertX(0, to = "lines") + } else if (outer_end) { + soma = grconvertY(fklgnd$rect$h, to = "lines") - grconvertY(0, to = "lines") + } + # Add legend margins to the outer margin + soma = soma + sum(lmar) + + # Adjust outer margins depending on side + if (outer_side) { + if (outer_right) { + ooma[4] = soma + } else { + ooma[2] = soma + } + } else if (outer_end) { + if (outer_bottom) { + ooma[1] = soma + } else { + omar[3] = omar[3] + soma - topmar_epsilon + par(mar = omar) + } + } + par(oma = ooma) + + # Determine legend inset + inset = 0 + if (outer_side) { + inset = grconvertX(lmar[1], from = "lines", to = "npc") - + grconvertX(0, from = "lines", to = "npc") + # Extra space needed for "left!" because of lhs inner margin + if (!outer_right) { + inset_bump = grconvertX(par("mar")[2], from = "lines", to = "npc") - + grconvertX(0, from = "lines", to = "npc") + inset = inset + inset_bump + } + inset = c(1 + inset, 0) + } else if (outer_end) { + inset = grconvertY(lmar[1], from = "lines", to = "npc") - + grconvertY(0, from = "lines", to = "npc") + if (outer_bottom) { + # Extra space needed for "bottom!" because of lhs inner margin + inset_bump = grconvertY(par("mar")[1], from = "lines", to = "npc") - + grconvertY(0, from = "lines", to = "npc") + inset = inset + inset_bump + } else { + epsilon_bump = grconvertY(topmar_epsilon, from = "lines", to = "npc") - + grconvertY(0, from = "lines", to = "npc") + inset = inset + epsilon_bump + } + inset = c(0, 1 + inset) + } + + # Refresh plot area for exact inset spacing + # Using temporary hook instead of direct par(new = TRUE) + oldhook = getHook("before.plot.new") + setHook("before.plot.new", function() par(new = TRUE), action = "append") + setHook("before.plot.new", function() par(mar = omar), action = "append") + plot.new() + setHook("before.plot.new", oldhook, action = "replace") + + # Set the inset as part of the legend args + legend_args[["inset"]] = if (user_inset) { + legend_args[["inset"]] + inset + } else { + inset + } + + # + ## Step 3: Draw the real legend + # + + if (gradient) { + if (!more_than_n_unique(legend_args[["col"]], 1)) { + if (!is.null(legend_args[["pt.bg"]]) && length(legend_args[["pt.bg"]]) == 100) { + legend_args[["col"]] = legend_args[["pt.bg"]] + } + } + draw_gradient_swatch( + legend_args = legend_args, + fklgnd = fklgnd, + lmar = lmar, + outer_side = outer_side, + outer_end = outer_end, + outer_right = outer_right, + outer_bottom = outer_bottom, + user_inset = user_inset + ) + } else { + do.call("legend", legend_args) + } +} + + +# +## Gradient Legend Rendering ----- +# + +#' Draw gradient (continuous) legend swatch +#' +#' @description For gradient legends, we draw a custom color swatch using +#' grDevices::as.raster and add labels, tick marks, and title manually. +#' +#' @param legend_args Legend arguments list +#' @param fklgnd Fake legend object (from drawing with plot=FALSE) +#' @param lmar Legend margins +#' @param outer_side Logical flag for outer side placement +#' @param outer_end Logical flag for outer end placement +#' @param outer_right Logical flag for outer right placement +#' @param outer_bottom Logical flag for outer bottom placement +#' @param user_inset Logical flag indicating user-supplied inset +#' +#' @returns NULL (draws gradient legend as side effect) +#' +#' @keywords internal +draw_gradient_swatch = function( + legend_args, + fklgnd, + lmar, + outer_side, + outer_end, + outer_right, + outer_bottom, + user_inset = FALSE +) { + pal = legend_args[["col"]] + lgnd_labs = legend_args[["legend"]] + if (!is.null(legend_args[["horiz"]])) { + horiz = legend_args[["horiz"]] + } else { + horiz = FALSE + } + + # Create raster color swatch + if (isTRUE(horiz)) { + rasterlgd = as.raster(matrix(pal, nrow = 1)) + } else { + rasterlgd = as.raster(matrix(rev(pal), ncol = 1)) + } + + corners = par("usr") + rasterbox = rep(NA_real_, 4) + + # Determine positioning flags + inner = !any(c(outer_side, outer_end)) + inner_right = inner_bottom = FALSE + if (inner) { + if (!is.null(legend_args[["x"]]) && grepl("left$|right$", legend_args[["x"]])) { + inner_right = grepl("right$", legend_args[["x"]]) + } + if (!is.null(legend_args[["x"]]) && grepl("^bottoml|^top", legend_args[["x"]])) { + inner_bottom = grepl("^bottom", legend_args[["x"]]) + } + } + + # Calculate raster box coordinates based on position + if (inner) { + fklgnd$rect$h = fklgnd$rect$h - + (grconvertY(1.5 + 0.4, from = "lines", to = "user") - + grconvertY(0, from = "lines", to = "user")) + + rasterbox[1] = fklgnd$rect$left + if (isFALSE(inner_right)) { + rasterbox[1] = rasterbox[1] + + (grconvertX(0.2, from = "lines", to = "user") - + grconvertX(0, from = "lines", to = "user")) + } + rasterbox[2] = fklgnd$rect$top - + fklgnd$rect$h - + (grconvertY(1.5 + 0.2, from = "lines", to = "user") - + grconvertY(0, from = "lines", to = "user")) + rasterbox[3] = rasterbox[1] + + (grconvertX(1.25, from = "lines", to = "user") - + grconvertX(0, from = "lines", to = "user")) + rasterbox[4] = rasterbox[2] + fklgnd$rect$h + + } else if (outer_side) { + rb1_adj = grconvertX(lmar[1] + 0.2, from = "lines", to = "user") - + grconvertX(0, from = "lines", to = "user") + rb3_adj = grconvertX(1.25, from = "lines", to = "user") - + grconvertX(0, from = "lines", to = "user") + rb2_adj = (corners[4] - + corners[3] - + (grconvertY(5 + 1 + 2.5, from = "lines", to = "user") - + grconvertY(0, from = "lines", to = "user"))) / + 2 + # Override if top or bottom + if (!is.null(legend_args[["x"]])) { + if (grepl("^bottom", legend_args[["x"]])) { + rb2_adj = corners[3] + } + if (grepl("^top", legend_args[["x"]])) { + rb2_adj = corners[4] - + (grconvertY(5 + 1 + 2.5, from = "lines", to = "user") - + grconvertY(0, from = "lines", to = "user")) + } + } + if (user_inset) { + rb2_adj = rb2_adj + legend_args[["inset"]][2] + 0.05 + } + rb4_adj = grconvertY(5 + 1, from = "lines", to = "user") - + grconvertY(0, from = "lines", to = "user") + + if (outer_right) { + rasterbox[1] = corners[2] + rb1_adj + if (user_inset) { + rasterbox[1] = rasterbox[1] - + (corners[2] - legend_args[["inset"]][1]) / 2 + } + rasterbox[2] = rb2_adj + rasterbox[3] = rasterbox[1] + rb3_adj + rasterbox[4] = rasterbox[2] + rb4_adj + } else { + rb1_adj = rb1_adj + + grconvertX(par("mar")[2] + 1, from = "lines", to = "user") - + grconvertX(0, from = "lines", to = "user") + rasterbox[1] = corners[1] - rb1_adj + rasterbox[2] = rb2_adj + rasterbox[3] = rasterbox[1] - rb3_adj + rasterbox[4] = rasterbox[2] + rb4_adj + } + + } else if (outer_end) { + rb1_adj = (corners[2] - + corners[1] - + (grconvertX(5 + 1, from = "lines", to = "user") - + grconvertX(0, from = "lines", to = "user"))) / + 2 + rb3_adj = grconvertX(5 + 1, from = "lines", to = "user") - + grconvertX(0, from = "lines", to = "user") + rb2_adj = grconvertY(lmar[1], from = "lines", to = "user") - + grconvertY(0, from = "lines", to = "user") + rb4_adj = grconvertY(1.25, from = "lines", to = "user") - + grconvertY(0, from = "lines", to = "user") + + if (outer_bottom) { + rb2_adj = rb2_adj + + grconvertY(par("mar")[2], from = "lines", to = "user") - + grconvertY(0, from = "lines", to = "user") + rasterbox[1] = rb1_adj + rasterbox[2] = corners[3] - rb2_adj + rasterbox[3] = rasterbox[1] + rb3_adj + rasterbox[4] = rasterbox[2] - rb4_adj + } else { + rb2_adj = rb2_adj + + grconvertY(1.25 + 1, from = "lines", to = "user") - + grconvertY(0, from = "lines", to = "user") + rasterbox[1] = rb1_adj + rasterbox[2] = corners[4] + rb2_adj + rasterbox[3] = rasterbox[1] + rb3_adj + rasterbox[4] = rasterbox[2] - rb4_adj + } + } + + # Draw the gradient swatch + rasterImage( + rasterlgd, + rasterbox[1], #x1 + rasterbox[2], #y1 + rasterbox[3], #x2 + rasterbox[4], #y2 + xpd = NA + ) + + # Add labels, tick marks, and title + if (isFALSE(horiz)) { + # Vertical gradient legend + labs_idx = !is.na(lgnd_labs) + lgnd_labs[labs_idx] = paste0(" ", format(lgnd_labs[labs_idx])) + lbl_x_anchor = rasterbox[3] + ttl_x_anchor = rasterbox[1] + lbl_adj = c(0, 0.5) + tck_adj = c(1, 0.5) + ttl_adj = c(0, 0) + if (!inner && !outer_right) { + lbl_x_anchor = rasterbox[1] + ttl_x_anchor = ttl_x_anchor + max(strwidth(lgnd_labs[labs_idx])) + ttl_adj = c(1, 0) + } + text( + x = lbl_x_anchor, + y = seq(rasterbox[2], rasterbox[4], length.out = length(lgnd_labs)), + labels = lgnd_labs, + xpd = NA, + adj = lbl_adj + ) + # Legend tick marks + lgnd_ticks = lgnd_labs + lgnd_ticks[labs_idx] = "- -" + text( + x = lbl_x_anchor, + y = seq(rasterbox[2], rasterbox[4], length.out = length(lgnd_labs)), + labels = lgnd_ticks, + col = "white", + xpd = NA, + adj = tck_adj + ) + # Legend title + text( + x = ttl_x_anchor, + y = rasterbox[4] + + grconvertY(1, from = "lines", to = "user") - + grconvertY(0, from = "lines", to = "user"), + labels = legend_args[["title"]], + xpd = NA, + adj = ttl_adj + ) + } else { + # Horizontal gradient legend + lbl_y_anchor = rasterbox[4] + ttl_y_anchor = rasterbox[4] + lbl_adj = c(0.5, 1.25) + tck_adj = c(0, 0.5) + ttl_adj = c(1, -0.5) + # Legend labs + text( + x = seq(rasterbox[1], rasterbox[3], length.out = length(lgnd_labs)), + y = lbl_y_anchor, + labels = lgnd_labs, + xpd = NA, + adj = lbl_adj + ) + # Legend tick marks + lgnd_ticks = lgnd_labs + lgnd_ticks[!is.na(lgnd_ticks)] = "- -" + text( + x = seq(rasterbox[1], rasterbox[3], length.out = length(lgnd_labs)), + y = lbl_y_anchor, + labels = lgnd_ticks, + col = "white", + xpd = NA, + adj = tck_adj, + srt = 90 + ) + # Legend title + text( + x = rasterbox[1], + y = ttl_y_anchor, + labels = paste0(legend_args[["title"]], " "), + xpd = NA, + adj = ttl_adj + ) + } +} + + +# +## Multi-Legend Rendering ----- +# + +#' Draw multiple legends with automatic positioning +#' +#' @description Handles dual legends (e.g., color grouping + bubble size) by: +#' 1. Extracting dimensions from fake legends +#' 2. Calculating sub-positioning based on dimensions +#' 3. Drawing legends in ascending order of width (widest last) +#' +#' @md +#' @param legend_list A list of legend arguments, where each element is itself a +#' list of arguments that can be passed on to [draw_legend]. Legends will be +#' drawn vertically (top to bottom) in the order that they are provided. Note +#' that we currently only support dual legends, i.e. the top-level list has a +#' maximum length of 2. +#' @param position String indicating the base keyword position for the +#' multi-legend. Currently only `"right!"` and `"left!"` are supported. +#' +#' @returns No return value, called for side effect of drawing multiple legends. +#' +#' @seealso [draw_legend] +#' +#' @keywords internal +#' +#' @examples +#' \dontrun{ +#' oldmar = par("mar") +#' +#' # Dual legend example (color + bubble) +#' +#' l1 = list( +#' lgnd_labs = c("Red", "Blue", "Green"), +#' legend_args = list(title = "Colors"), +#' pch = 16, +#' col = c("red", "blue", "green"), +#' type = "p" +#' ) +#' +#' l2 = list( +#' lgnd_labs = c("Tiny", "Small", "Medium", "Large", "Huge"), +#' legend_args = list(title = "Size"), +#' pch = 16, +#' col = "black", +#' cex = seq(0.5, 2.5, length.out = 5), +#' type = "p" +#' ) +#' +#' # Draw together +#' draw_multi_legend(list(l1, l2), position = "right!") +#' +#' par(mar = oldmar) +#' } +#' +#' @keywords internal +draw_multi_legend = function( + legend_list, + position = "right!" +) { + + # Validate inputs + if (!is.list(legend_list) || length(legend_list) != 2) { + stop("Currently only 2 legends are supported in multi-legend mode") + } + + # Currently only support right!/left! positioning + if (!grepl("right!$|left!$", position)) { + warning( + '\nMulti-legends currently only work with "right!" or "left!" keyword positioning.\n', + 'Reverting to "right!" default\n' + ) + position = "right!" + } + + # Determine sub-positions based on main position + if (grepl("right!$", position)) { + sub_positions = c("bottomright!", "topright!") + } else if (grepl("left!$", position)) { + sub_positions = c("bottomleft!", "topleft!") + } + + # Assign positions of individual legends + for (ll in seq_along(legend_list)) { + legend_list[[ll]][["legend"]] = sub_positions[ll] + legend_list[[ll]][["legend_args"]][["x"]] = NULL + } + + # + ## Step 1: Extract legend dimensions (by drawing fake legends) + # + + legend_dims = vector("list", length(legend_list)) + for (ll in seq_along(legend_list)) { + legend_ll = legend_list[[ll]] + legend_ll$new_plot = ll == 1 # Only draw new plot for first legend + legend_ll$draw = FALSE + legend_dims[[ll]] = do.call(draw_legend, legend_ll) + } + + # + ## Step 2: Calculate sub-positioning based on dimensions + # + + # Extract dimensions + lwidths = sapply(legend_dims, function(x) x$rect$w) + lheights = sapply(legend_dims, function(x) x$rect$h) + # For inset adjustment, default to 0.5 unless one or more of the two legends + # is bigger than half the plot height. + linset = if (any(lheights > 0.5)) lheights[2] / sum(lheights) else 0.5 + + # + ## Step 3: Reposition (via adjusted inset arg) and draw legends + # + + # Note: we draw the legends in ascending order of width (i.e., widest legend + # last) in order to correctly set the overall plot dimensions. + width_order = order(lwidths) + + # Quick idx for original order (needed for vertical legend placement) + for (i in seq_along(legend_list)) legend_list[[i]]$idx = i + + for (o in seq_along(width_order)) { + io = width_order[o] + legend_o = legend_list[[io]] + legend_o$new_plot = FALSE + legend_o$draw = TRUE + legend_o$legend_args$inset = c(0, 0) + legend_o$legend_args$inset[1] = if (o == 1) -abs(diff(lwidths)) / 2 else 0 + legend_o$legend_args$inset[2] = if (legend_o$idx == 1) linset + 0.01 else 1 - linset + 0.01 + legend_o$idx = NULL + do.call(draw_legend, legend_o) + } + + invisible(NULL) +} diff --git a/R/legend_prepare.R b/R/legend_prepare.R deleted file mode 100644 index e008d027..00000000 --- a/R/legend_prepare.R +++ /dev/null @@ -1,162 +0,0 @@ -prepare_legend_context = function(settings) { - env2env( - settings, - environment(), - c( - "col", - "by_continuous", - "by", - "bubble", - "null_by", - "legend", - "legend_args", - "bubble_cex", - "cex_fct_adj", - "cex_dep", - "add", - "sub", - "ngrps", - "datapoints", - "ylab" - ) - ) - - ncolors = length(col) - lgnd_labs = rep(NA, times = ncolors) - - if (isTRUE(by_continuous)) { - nlabs = 5 - ubyvar = unique(by) - byvar_range = range(ubyvar) - pbyvar = pretty(byvar_range, n = nlabs) - pbyvar = pbyvar[pbyvar >= byvar_range[1] & pbyvar <= byvar_range[2]] - if (length(ubyvar) == 2 && all(ubyvar %in% pbyvar)) { - pbyvar = ubyvar - } else if (length(pbyvar) > nlabs) { - pbyvar = pbyvar[seq_along(pbyvar) %% 2 == 0] - } - pidx = rescale_num(c(byvar_range, pbyvar), to = c(1, ncolors))[-c(1:2)] - pidx = round(pidx) - lgnd_labs[pidx] = pbyvar - } - - has_legend = FALSE - dual_legend = bubble && !null_by && !isFALSE(legend) - lgnd_cex = NULL - - if (isFALSE(legend)) { - legend = "none" - } else if (isTRUE(legend)) { - legend = NULL - } - - if (!is.null(legend) && is.character(legend) && legend == "none") { - legend_args[["x"]] = "none" - dual_legend = FALSE - } - - if (null_by) { - if (bubble && !dual_legend) { - legend_args[["title"]] = cex_dep - lgnd_labs = names(bubble_cex) - lgnd_cex = bubble_cex * cex_fct_adj - } else if (is.null(legend)) { - legend = "none" - legend_args[["x"]] = "none" - } - } - - legend_draw_flag = (is.null(legend) || !is.character(legend) || legend != "none" || bubble) && !isTRUE(add) - has_sub = !is.null(sub) - - if (legend_draw_flag && isFALSE(by_continuous) && (!bubble || dual_legend)) { - if (ngrps > 1) { - lgnd_labs = if (is.factor(datapoints$by)) levels(datapoints$by) else unique(datapoints$by) - } else { - lgnd_labs = ylab - } - } - - env2env( - environment(), - settings, - c( - "lgnd_labs", - "has_legend", - "dual_legend", - "lgnd_cex", - "legend", - "legend_args", - "legend_draw_flag", - "has_sub" - ) - ) -} - -prepare_dual_legend = function(settings) { - env2env( - settings, - environment(), - c( - "legend", - "legend_args", - "by_dep", - "lgnd_labs", - "type", - "pch", - "lty", - "lwd", - "col", - "bg", - "by_continuous", - "lgnd_cex", - "cex_dep", - "bubble_cex", - "cex_fct_adj", - "bubble_alpha", - "bubble_bg_alpha", - "has_sub" - ) - ) - - legend_args = sanitize_legend(legend, legend_args) - - lgby = list( - legend_args = modifyList( - legend_args, - list(x.intersp = 1, y.intersp = 1), - keep.null = TRUE - ), - by_dep = by_dep, - lgnd_labs = lgnd_labs, - type = type, - pch = pch, - lty = lty, - lwd = lwd, - col = col, - bg = bg, - gradient = by_continuous, - cex = lgnd_cex, - has_sub = has_sub - ) - - lgbub = list( - legend_args = modifyList( - legend_args, - list(title = cex_dep, ncol = 1), - keep.null = TRUE - ), - lgnd_labs = names(bubble_cex), - type = type, - pch = pch, - lty = lty, - lwd = lwd, - col = adjustcolor(par("col"), alpha.f = bubble_alpha), - bg = adjustcolor(par("col"), alpha.f = bubble_bg_alpha), - cex = bubble_cex * cex_fct_adj, - has_sub = has_sub, - draw = FALSE - ) - - env2env(environment(), settings, c("legend_args", "lgby", "lgbub")) -} diff --git a/R/sanitize_legend.R b/R/sanitize_legend.R deleted file mode 100644 index d7951951..00000000 --- a/R/sanitize_legend.R +++ /dev/null @@ -1,35 +0,0 @@ -sanitize_legend = function(legend, legend_args) { - if (is.null(legend_args[["x"]])) { - - # Normalize legend to a list - largs = if (is.null(legend)) { - list(x = "right!") - } else if (is.character(legend)) { - list(x = legend) - } else if (is.list(legend)) { - # Handle unnamed first element as position - if (length(legend) >= 1 && is.character(legend[[1]]) && - (is.null(names(legend)) || names(legend)[1] == "")) { - names(legend)[1] = "x" - } - legend - } else if (inherits(legend, c("call", "name"))) { - # Convert call to list and handle unnamed first arg as position - new_legend = as.list(legend)[-1] # Remove function name - if (length(new_legend) >= 1 && (is.null(names(new_legend)) || names(new_legend)[1] == "")) { - names(new_legend)[1] = "x" - } - new_legend - } else { - list(x = "right!") # Fallback - } - - # Ensure position exists - if (is.null(largs[["x"]])) largs[["x"]] = "right!" - - # Merge - legend_args = modifyList(legend_args, largs, keep.null = TRUE) - } - - legend_args -} diff --git a/R/utils.R b/R/utils.R index 371efe95..c680235d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -81,3 +81,57 @@ swap_columns = function(dp, a, b) { dp[[b]] = if (!is.null(va)) va else NULL dp } + + +#' Restore outer margin defaults +#' +#' @description Resets the outer margin display (omd) to default full device. +#' Used to clean up after legend drawing that may have adjusted margins. +#' +#' @returns NULL (called for side effect of resetting par("omd")) +#' +#' @keywords internal +restore_margin_outer = function() { + par(omd = c(0, 1, 0, 1)) +} + + +#' Restore inner margin defaults +#' +#' @description Resets inner margins that may have been adjusted for legend +#' placement. Handles special cases for each margin side and checks for +#' custom mfrow layouts. +#' +#' @param ooma Outer margins (from par("oma")) +#' @param topmar_epsilon Small epsilon value for top margin adjustment (default 0.1) +#' +#' @returns NULL (called for side effect of resetting par("mar")) +#' +#' @keywords internal +restore_margin_inner = function(ooma, topmar_epsilon = 0.1) { + ooma = par("oma") + omar = par("mar") + + if (!any(ooma != 0)) return(invisible(NULL)) + + # Restore inner margin defaults (in case affected by preceding tinyplot call) + if (any(ooma != 0)) { + if (ooma[1] != 0 && omar[1] == par("mgp")[1] + 1 * par("cex.lab")) { + omar[1] = 5.1 + } + if (ooma[2] != 0 && omar[2] == par("mgp")[1] + 1 * par("cex.lab")) { + omar[2] = 4.1 + } + if (ooma[3] == topmar_epsilon && omar[3] != 4.1) { + omar[3] = 4.1 + } + if (ooma[4] != 0 && omar[4] == 0) { + omar[4] = 2.1 + } + par(mar = omar) + } + # Restore outer margin defaults (with a catch for custom mfrow plots) + if (all(par("mfrow") == c(1, 1))) { + par(omd = c(0, 1, 0, 1)) + } +} diff --git a/man/build_legend_spec.Rd b/man/build_legend_spec.Rd new file mode 100644 index 00000000..c9c7fdfc --- /dev/null +++ b/man/build_legend_spec.Rd @@ -0,0 +1,62 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/legend.R +\name{build_legend_spec} +\alias{build_legend_spec} +\title{Build legend specification} +\usage{ +build_legend_spec( + legend, + legend_args, + by_dep, + lgnd_labs, + labeller = NULL, + type, + pch, + lty, + lwd, + col, + bg, + cex, + gradient +) +} +\arguments{ +\item{legend}{Legend placement keyword or list} + +\item{legend_args}{Additional legend arguments} + +\item{by_dep}{The (deparsed) "by" grouping variable name} + +\item{lgnd_labs}{The legend labels} + +\item{labeller}{Character or function for formatting labels} + +\item{type}{Plot type} + +\item{pch}{Plotting character(s)} + +\item{lty}{Line type(s)} + +\item{lwd}{Line width(s)} + +\item{col}{Color(s)} + +\item{bg}{Background fill color(s)} + +\item{cex}{Character expansion(s)} + +\item{gradient}{Logical indicating gradient legend} +} +\value{ +List with legend_args and positioning flags +} +\description{ +Constructs a complete legend_args list by: +\itemize{ +\item Sanitizing legend input +\item Setting defaults for all legend parameters +\item Computing positioning flags (outer_side, outer_right, etc.) +\item Adjusting for special cases (gradient, horizontal, multi-column) +} +} +\keyword{internal} diff --git a/man/draw_gradient_swatch.Rd b/man/draw_gradient_swatch.Rd new file mode 100644 index 00000000..e5dc8bc3 --- /dev/null +++ b/man/draw_gradient_swatch.Rd @@ -0,0 +1,42 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/legend.R +\name{draw_gradient_swatch} +\alias{draw_gradient_swatch} +\title{Draw gradient (continuous) legend swatch} +\usage{ +draw_gradient_swatch( + legend_args, + fklgnd, + lmar, + outer_side, + outer_end, + outer_right, + outer_bottom, + user_inset = FALSE +) +} +\arguments{ +\item{legend_args}{Legend arguments list} + +\item{fklgnd}{Fake legend object (from drawing with plot=FALSE)} + +\item{lmar}{Legend margins} + +\item{outer_side}{Logical flag for outer side placement} + +\item{outer_end}{Logical flag for outer end placement} + +\item{outer_right}{Logical flag for outer right placement} + +\item{outer_bottom}{Logical flag for outer bottom placement} + +\item{user_inset}{Logical flag indicating user-supplied inset} +} +\value{ +NULL (draws gradient legend as side effect) +} +\description{ +For gradient legends, we draw a custom color swatch using +grDevices::as.raster and add labels, tick marks, and title manually. +} +\keyword{internal} diff --git a/man/draw_legend.Rd b/man/draw_legend.Rd index 7d7fc3d3..c7033708 100644 --- a/man/draw_legend.Rd +++ b/man/draw_legend.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/draw_legend.R +% Please edit documentation in R/legend.R \name{draw_legend} \alias{draw_legend} -\title{Calculate placement of legend and draw it} +\title{Calculate placement and draw legend} \usage{ draw_legend( legend = NULL, @@ -76,8 +76,12 @@ No return value, called for side effect of producing a(n empty) plot with a legend in the margin. } \description{ -Function used to calculate the placement of (including -outside the plotting area) and drawing of legend. +Main exported function for drawing legends. Supports: +\itemize{ +\item Inner and outer positioning (with "!" suffix) +\item Discrete and continuous (gradient) legends +\item Automatic margin adjustment +} } \examples{ oldmar = par("mar") diff --git a/man/draw_legend_positioned.Rd b/man/draw_legend_positioned.Rd new file mode 100644 index 00000000..01e80359 --- /dev/null +++ b/man/draw_legend_positioned.Rd @@ -0,0 +1,67 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/legend.R +\name{draw_legend_positioned} +\alias{draw_legend_positioned} +\title{Internal legend drawing with positioning} +\usage{ +draw_legend_positioned( + legend_args, + ooma, + omar, + lmar, + topmar_epsilon, + outer_side, + outer_right, + outer_end, + outer_bottom, + gradient, + user_inset = FALSE, + draw +) +} +\arguments{ +\item{legend_args}{Additional legend arguments to be passed to +\code{\link[graphics]{legend}}.} + +\item{ooma}{Outer margins} + +\item{omar}{Inner margins} + +\item{lmar}{Legend margins (in lines). Should be a numeric vector of the form +\code{c(inner, outer)}, where the first number represents the "inner" margin +between the legend and the plot, and the second number represents the +"outer" margin between the legend and edge of the graphics device. If no +explicit value is provided by the user, then reverts back to \code{tpar("lmar")} +for which the default values are \code{c(1.0, 0.1)}.} + +\item{topmar_epsilon}{Small epsilon for top margin adjustment} + +\item{outer_side}{Logical flag for outer side placement} + +\item{outer_right}{Logical flag for outer right placement} + +\item{outer_end}{Logical flag for outer end placement} + +\item{outer_bottom}{Logical flag for outer bottom placement} + +\item{gradient}{Logical indicating whether a continuous gradient swatch +should be used to represent the colors.} + +\item{user_inset}{Logical flag indicating user-supplied inset} + +\item{draw}{Logical. If \code{FALSE}, no legend is drawn but the sizes are +returned. Note that a new (blank) plot frame will still need to be started +in order to perform the calculations.} +} +\value{ +Legend dimensions (from fake legend) if draw=FALSE, otherwise NULL +} +\description{ +Internal workhorse that draws the legend in three steps: +\enumerate{ +\item Draw a fake legend (plot = FALSE) to measure dimensions +\item Calculate required inset and adjust plot margins +\item Draw the real legend +} +} +\keyword{internal} diff --git a/man/draw_multi_legend.Rd b/man/draw_multi_legend.Rd index d754a35a..76f4ba6e 100644 --- a/man/draw_multi_legend.Rd +++ b/man/draw_multi_legend.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/draw_multi_legend.R +% Please edit documentation in R/legend.R \name{draw_multi_legend} \alias{draw_multi_legend} \title{Draw multiple legends with automatic positioning} @@ -20,10 +20,12 @@ multi-legend. Currently only \code{"right!"} and \code{"left!"} are supported.} No return value, called for side effect of drawing multiple legends. } \description{ -Internal function to draw multiple legends (e.g., bubble + color) -with automatic dimension calculation and positioning. This function handles -the internal gymnastics required to determine the individual legend -dimensions, before drawing them in the optimal order and position. +Handles dual legends (e.g., color grouping + bubble size) by: +\enumerate{ +\item Extracting dimensions from fake legends +\item Calculating sub-positioning based on dimensions +\item Drawing legends in ascending order of width (widest last) +} } \examples{ \dontrun{ diff --git a/man/prepare_dual_legend.Rd b/man/prepare_dual_legend.Rd new file mode 100644 index 00000000..af525bf2 --- /dev/null +++ b/man/prepare_dual_legend.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/legend.R +\name{prepare_dual_legend} +\alias{prepare_dual_legend} +\title{Prepare dual legend specifications} +\usage{ +prepare_dual_legend(settings) +} +\arguments{ +\item{settings}{Settings environment from tinyplot} +} +\value{ +NULL (modifies settings environment in-place) +} +\description{ +Sets up two separate legend specifications for dual legends +(e.g., color grouping + bubble size). Creates \code{lgby} and \code{lgbub} objects +that will be passed to draw_multi_legend(). +} +\keyword{internal} diff --git a/man/prepare_legend_context.Rd b/man/prepare_legend_context.Rd new file mode 100644 index 00000000..81293a65 --- /dev/null +++ b/man/prepare_legend_context.Rd @@ -0,0 +1,24 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/legend.R +\name{prepare_legend_context} +\alias{prepare_legend_context} +\title{Prepare legend context from settings} +\usage{ +prepare_legend_context(settings) +} +\arguments{ +\item{settings}{Settings environment from tinyplot} +} +\value{ +NULL (modifies settings environment in-place) +} +\description{ +Main orchestrator that determines: +\itemize{ +\item Whether to draw legend +\item Legend labels and formatting +\item Whether dual legend is needed (for bubble charts) +\item Gradient legend setup for continuous grouping +} +} +\keyword{internal} diff --git a/man/restore_margin_inner.Rd b/man/restore_margin_inner.Rd new file mode 100644 index 00000000..a5240955 --- /dev/null +++ b/man/restore_margin_inner.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{restore_margin_inner} +\alias{restore_margin_inner} +\title{Restore inner margin defaults} +\usage{ +restore_margin_inner(ooma, topmar_epsilon = 0.1) +} +\arguments{ +\item{ooma}{Outer margins (from par("oma"))} + +\item{topmar_epsilon}{Small epsilon value for top margin adjustment (default 0.1)} +} +\value{ +NULL (called for side effect of resetting par("mar")) +} +\description{ +Resets inner margins that may have been adjusted for legend +placement. Handles special cases for each margin side and checks for +custom mfrow layouts. +} +\keyword{internal} diff --git a/man/restore_margin_outer.Rd b/man/restore_margin_outer.Rd new file mode 100644 index 00000000..85265bdf --- /dev/null +++ b/man/restore_margin_outer.Rd @@ -0,0 +1,16 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{restore_margin_outer} +\alias{restore_margin_outer} +\title{Restore outer margin defaults} +\usage{ +restore_margin_outer() +} +\value{ +NULL (called for side effect of resetting par("omd")) +} +\description{ +Resets the outer margin display (omd) to default full device. +Used to clean up after legend drawing that may have adjusted margins. +} +\keyword{internal} diff --git a/man/sanitize_legend.Rd b/man/sanitize_legend.Rd new file mode 100644 index 00000000..61b845e9 --- /dev/null +++ b/man/sanitize_legend.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/legend.R +\name{sanitize_legend} +\alias{sanitize_legend} +\title{Sanitize and normalize legend input} +\usage{ +sanitize_legend(legend, legend_args) +} +\arguments{ +\item{legend}{Legend specification (NULL, character, list, or call)} + +\item{legend_args}{Existing legend_args list to merge with} +} +\value{ +Normalized legend_args list with at least an "x" element +} +\description{ +Converts various legend input formats (NULL, character, list, +call) into a standardized legend_args list with an "x" position element. +} +\keyword{internal} From 67287df3df2e4d9f8bc32f9be37964852328dad2 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 10:32:26 -0500 Subject: [PATCH 03/14] legend consolidation --- R/legend.R | 576 +++++++++++++++++++++++++++++------------------------ 1 file changed, 314 insertions(+), 262 deletions(-) diff --git a/R/legend.R b/R/legend.R index a64606ed..9d0b92a7 100644 --- a/R/legend.R +++ b/R/legend.R @@ -10,6 +10,282 @@ # 5. Multi-Legend Rendering +# +## Helper Functions ----- +# + +# Unit conversion helpers (used extensively throughout legend positioning) +lines_to_npc = function(val) { + grconvertX(val, from = "lines", to = "npc") - grconvertX(0, from = "lines", to = "npc") +} + +lines_to_user_x = function(val) { + grconvertX(val, from = "lines", to = "user") - grconvertX(0, from = "lines", to = "user") +} + +lines_to_user_y = function(val) { + grconvertY(val, from = "lines", to = "user") - grconvertY(0, from = "lines", to = "user") +} + +# Adjust margins for outer legend placement +adjust_margins_for_outer_legend = function(outer_side, outer_end, outer_right, + outer_bottom, omar, ooma, has_sub, + topmar_epsilon, type, lmar, new_plot, dynmar) { + if (outer_side) { + # Extra bump for spineplot if outer_right legend (to accommodate secondary y-axis) + if (identical(type, "spineplot")) { + lmar[1] = lmar[1] + 1.1 + } + + # Set inner margins before fake legend is drawn + if (outer_right) { + omar[4] = 0 + } else { + # For outer left we have to account for the y-axis label too + omar[2] = par("mgp")[1] + 1 * par("cex.lab") + } + par(mar = omar) + + if (new_plot) { + plot.new() + # For themed + dynamic plots, reinstate adjusted plot margins + if (dynmar) { + omar = par("mar") + if (outer_right) { + omar[4] = 0 + } else { + omar[2] = par("mgp")[1] + 1 * par("cex.lab") + } + par(mar = omar) + } + } + + } else if (outer_end) { + # Set inner margins before fake legend is drawn + if (outer_bottom) { + omar[1] = par("mgp")[1] + 1 * par("cex.lab") + if (has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { + omar[1] = omar[1] + 1 * par("cex.sub") + } + } else { + # For "top!", expand existing inner margin rather than outer margin + ooma[3] = ooma[3] + topmar_epsilon + par(oma = ooma) + } + par(mar = omar) + + if (new_plot) { + plot.new() + # For themed + dynamic plots, reinstate adjusted plot margins + if (dynmar) { + omar = par("mar") + if (outer_bottom) { + omar[1] = theme_clean$mgp[1] + 1 * par("cex.lab") + if (has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { + omar[1] = omar[1] + 1 * par("cex.sub") + } + } else { + ooma[3] = ooma[3] + topmar_epsilon + par(oma = ooma) + } + par(mar = omar) + } + } + } else { + if (new_plot) plot.new() + } + + list(omar = omar, ooma = ooma, lmar = lmar) +} + +# Calculate legend inset for outer placement +calculate_legend_inset = function(outer_side, outer_end, outer_right, outer_bottom, + lmar, omar, topmar_epsilon) { + if (outer_side) { + inset_val = lines_to_npc(lmar[1]) + # Extra space needed for "left!" because of lhs inner margin + if (!outer_right) { + inset_val = inset_val + lines_to_npc(par("mar")[2]) + } + c(1 + inset_val, 0) + + } else if (outer_end) { + # Note: Y-direction uses grconvertY (not lines_to_npc which is X-only) + inset_val = grconvertY(lmar[1], from = "lines", to = "npc") - + grconvertY(0, from = "lines", to = "npc") + if (outer_bottom) { + # Extra space needed for "bottom!" because of lhs inner margin + inset_bump = grconvertY(par("mar")[1], from = "lines", to = "npc") - + grconvertY(0, from = "lines", to = "npc") + inset_val = inset_val + inset_bump + } else { + epsilon_bump = grconvertY(topmar_epsilon, from = "lines", to = "npc") - + grconvertY(0, from = "lines", to = "npc") + inset_val = inset_val + epsilon_bump + } + c(0, 1 + inset_val) + + } else { + 0 + } +} + +# Transform outer position string (e.g., "right!" -> "left" for positioning logic) +transform_outer_position = function(pos, outer_side, outer_end, outer_right, outer_bottom) { + if (outer_end) { + if (outer_bottom) return(gsub("bottom!$", "top", pos)) + return(gsub("top!$", "bottom", pos)) + } else if (outer_side) { + if (outer_right) return(gsub("right!$", "left", pos)) + return(gsub("left!$", "right", pos)) + } + pos +} + +# Prepare fake legend arguments for dimension measurement +prepare_fake_legend_args = function(legend_args, gradient, outer_end) { + fklgnd.args = modifyList( + legend_args, + list(plot = FALSE), + keep.null = TRUE + ) + + if (gradient) { + lgnd_labs_tmp = na.omit(fklgnd.args[["legend"]]) + if (length(lgnd_labs_tmp) < 5L) { + nmore = 5L - length(lgnd_labs_tmp) + lgnd_labs_tmp = c(lgnd_labs_tmp, rep("", nmore)) + } + fklgnd.args = modifyList( + fklgnd.args, + list(legend = lgnd_labs_tmp), + keep.null = TRUE + ) + if (outer_end) { + fklgnd.args = modifyList( + fklgnd.args, + list(title = NULL), + keep.null = TRUE + ) + } + } + + fklgnd.args +} + +# Calculate and apply soma (outer margin size) based on legend dimensions +calculate_and_apply_soma = function(fklgnd, outer_side, outer_end, outer_right, + outer_bottom, lmar, ooma, omar, topmar_epsilon) { + # Calculate size + soma = if (outer_side) { + grconvertX(fklgnd$rect$w, to = "lines") - grconvertX(0, to = "lines") + } else if (outer_end) { + grconvertY(fklgnd$rect$h, to = "lines") - grconvertY(0, to = "lines") + } else { + 0 + } + soma = soma + sum(lmar) + + # Apply to appropriate margin + if (outer_side) { + ooma[if (outer_right) 4 else 2] = soma + } else if (outer_end) { + if (outer_bottom) { + ooma[1] = soma + } else { + omar[3] = omar[3] + soma - topmar_epsilon + par(mar = omar) + } + } + par(oma = ooma) + + list(ooma = ooma, omar = omar) +} + +# Draw vertical gradient legend labels, ticks, and title +draw_gradient_labels_vertical = function(rasterbox, lgnd_labs, legend_args, inner, outer_right) { + labs_idx = !is.na(lgnd_labs) + lgnd_labs[labs_idx] = paste0(" ", format(lgnd_labs[labs_idx])) + + # Determine anchors based on position + if (!inner && !outer_right) { + lbl_x_anchor = rasterbox[1] + ttl_x_anchor = rasterbox[1] + max(strwidth(lgnd_labs[labs_idx])) + lbl_adj = c(0, 0.5) + ttl_adj = c(1, 0) + } else { + lbl_x_anchor = rasterbox[3] + ttl_x_anchor = rasterbox[1] + lbl_adj = c(0, 0.5) + ttl_adj = c(0, 0) + } + + # Draw labels + text( + x = lbl_x_anchor, + y = seq(rasterbox[2], rasterbox[4], length.out = length(lgnd_labs)), + labels = lgnd_labs, + xpd = NA, + adj = lbl_adj + ) + + # Draw tick marks (white dashes) + lgnd_ticks = lgnd_labs + lgnd_ticks[labs_idx] = "- -" + text( + x = lbl_x_anchor, + y = seq(rasterbox[2], rasterbox[4], length.out = length(lgnd_labs)), + labels = lgnd_ticks, + col = "white", + xpd = NA, + adj = c(1, 0.5) + ) + + # Draw title + text( + x = ttl_x_anchor, + y = rasterbox[4] + lines_to_user_y(1), + labels = legend_args[["title"]], + xpd = NA, + adj = ttl_adj + ) +} + +# Draw horizontal gradient legend labels, ticks, and title +draw_gradient_labels_horizontal = function(rasterbox, lgnd_labs, legend_args) { + # Legend labels + text( + x = seq(rasterbox[1], rasterbox[3], length.out = length(lgnd_labs)), + y = rasterbox[4], + labels = lgnd_labs, + xpd = NA, + adj = c(0.5, 1.25) + ) + + # Legend tick marks (white dashes) + lgnd_ticks = lgnd_labs + lgnd_ticks[!is.na(lgnd_ticks)] = "- -" + text( + x = seq(rasterbox[1], rasterbox[3], length.out = length(lgnd_labs)), + y = rasterbox[4], + labels = lgnd_ticks, + col = "white", + xpd = NA, + adj = c(0, 0.5), + srt = 90 + ) + + # Legend title + text( + x = rasterbox[1], + y = rasterbox[4], + labels = paste0(legend_args[["title"]], " "), + xpd = NA, + adj = c(1, -0.5) + ) +} + + # ## Input Sanitization ----- # @@ -375,23 +651,15 @@ build_legend_spec = function( } # Adjust position anchor (we'll position relative to opposite side) + legend_args[["x"]] = transform_outer_position( + legend_args[["x"]], outer_side, outer_end, outer_right, outer_bottom + ) + + # Additional positioning adjustments if (outer_end) { - if (outer_bottom) { - legend_args[["x"]] = gsub("bottom!$", "top", legend_args[["x"]]) - } - if (!outer_bottom) { - legend_args[["x"]] = gsub("top!$", "bottom", legend_args[["x"]]) - } # Enforce horizontal legend if user hasn't specified ncol arg if (is.null(legend_args[["ncol"]]) || gradient) legend_args[["horiz"]] = TRUE - } else if (outer_side) { - if (outer_right) { - legend_args[["x"]] = gsub("right!$", "left", legend_args[["x"]]) - } - if (!outer_right) { - legend_args[["x"]] = gsub("left!$", "right", legend_args[["x"]]) - } - } else { + } else if (!outer_side) { legend_args[["inset"]] = 0 } @@ -604,69 +872,13 @@ draw_legend = function( omar = par("mar") # Adjust margins for outer legends - if (outer_side) { - # Extra bump for spineplot if outer_right legend (to accommodate secondary y-axis) - if (identical(type, "spineplot")) { - lmar[1] = lmar[1] + 1.1 - } - - # Set inner margins before fake legend is drawn - if (outer_right) { - omar[4] = 0 - } else { - # For outer left we have to account for the y-axis label too - omar[2] = par("mgp")[1] + 1 * par("cex.lab") - } - par(mar = omar) - - if (new_plot) { - plot.new() - # For themed + dynamic plots, reinstate adjusted plot margins - if (dynmar) { - omar = par("mar") - if (outer_right) { - omar[4] = 0 - } else { - omar[2] = par("mgp")[1] + 1 * par("cex.lab") - } - par(mar = omar) - } - } - - } else if (outer_end) { - # Set inner margins before fake legend is drawn - if (outer_bottom) { - omar[1] = par("mgp")[1] + 1 * par("cex.lab") - if (has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { - omar[1] = omar[1] + 1 * par("cex.sub") - } - } else { - # For "top!", expand existing inner margin rather than outer margin - ooma[3] = ooma[3] + topmar_epsilon - par(oma = ooma) - } - par(mar = omar) - - if (new_plot) { - plot.new() - # For themed + dynamic plots, reinstate adjusted plot margins - if (dynmar) { - omar = par("mar") - if (outer_bottom) { - omar[1] = theme_clean$mgp[1] + 1 * par("cex.lab") - if (has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { - omar[1] = omar[1] + 1 * par("cex.sub") - } - } else { - ooma[3] = ooma[3] + topmar_epsilon - par(oma = ooma) - } - par(mar = omar) - } - } - } else { - if (new_plot) plot.new() - } + margin_result = adjust_margins_for_outer_legend( + outer_side, outer_end, outer_right, outer_bottom, + omar, ooma, has_sub, topmar_epsilon, type, lmar, new_plot, dynmar + ) + omar = margin_result$omar + ooma = margin_result$ooma + lmar = margin_result$lmar # Draw the legend using internal function # Wrapped in recordGraphics() to preserve spacing if plot is resized @@ -742,32 +954,7 @@ draw_legend_positioned = function( ## Step 1: Draw fake legend to measure dimensions # - fklgnd.args = modifyList( - legend_args, - list(plot = FALSE), - keep.null = TRUE - ) - - if (gradient) { - lgnd_labs_tmp = na.omit(fklgnd.args[["legend"]]) - if (length(lgnd_labs_tmp) < 5L) { - nmore = 5L - length(lgnd_labs_tmp) - lgnd_labs_tmp = c(lgnd_labs_tmp, rep("", nmore)) - } - fklgnd.args = modifyList( - fklgnd.args, - list(legend = lgnd_labs_tmp), - keep.null = TRUE - ) - if (outer_end) { - fklgnd.args = modifyList( - fklgnd.args, - list(title = NULL), - keep.null = TRUE - ) - } - } - + fklgnd.args = prepare_fake_legend_args(legend_args, gradient, outer_end) fklgnd = do.call("legend", fklgnd.args) if (!draw) { return(fklgnd) @@ -777,60 +964,19 @@ draw_legend_positioned = function( ## Step 2: Calculate legend inset (for outer placement) # - # Calculate outer margin width in lines - soma = 0 - if (outer_side) { - soma = grconvertX(fklgnd$rect$w, to = "lines") - grconvertX(0, to = "lines") - } else if (outer_end) { - soma = grconvertY(fklgnd$rect$h, to = "lines") - grconvertY(0, to = "lines") - } - # Add legend margins to the outer margin - soma = soma + sum(lmar) - - # Adjust outer margins depending on side - if (outer_side) { - if (outer_right) { - ooma[4] = soma - } else { - ooma[2] = soma - } - } else if (outer_end) { - if (outer_bottom) { - ooma[1] = soma - } else { - omar[3] = omar[3] + soma - topmar_epsilon - par(mar = omar) - } - } - par(oma = ooma) + # Calculate and apply soma (outer margin size) + margin_result = calculate_and_apply_soma( + fklgnd, outer_side, outer_end, outer_right, outer_bottom, + lmar, ooma, omar, topmar_epsilon + ) + ooma = margin_result$ooma + omar = margin_result$omar # Determine legend inset - inset = 0 - if (outer_side) { - inset = grconvertX(lmar[1], from = "lines", to = "npc") - - grconvertX(0, from = "lines", to = "npc") - # Extra space needed for "left!" because of lhs inner margin - if (!outer_right) { - inset_bump = grconvertX(par("mar")[2], from = "lines", to = "npc") - - grconvertX(0, from = "lines", to = "npc") - inset = inset + inset_bump - } - inset = c(1 + inset, 0) - } else if (outer_end) { - inset = grconvertY(lmar[1], from = "lines", to = "npc") - - grconvertY(0, from = "lines", to = "npc") - if (outer_bottom) { - # Extra space needed for "bottom!" because of lhs inner margin - inset_bump = grconvertY(par("mar")[1], from = "lines", to = "npc") - - grconvertY(0, from = "lines", to = "npc") - inset = inset + inset_bump - } else { - epsilon_bump = grconvertY(topmar_epsilon, from = "lines", to = "npc") - - grconvertY(0, from = "lines", to = "npc") - inset = inset + epsilon_bump - } - inset = c(0, 1 + inset) - } + inset = calculate_legend_inset( + outer_side, outer_end, outer_right, outer_bottom, + lmar, omar, topmar_epsilon + ) # Refresh plot area for exact inset spacing # Using temporary hook instead of direct par(new = TRUE) @@ -936,65 +1082,44 @@ draw_gradient_swatch = function( # Calculate raster box coordinates based on position if (inner) { - fklgnd$rect$h = fklgnd$rect$h - - (grconvertY(1.5 + 0.4, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user")) + fklgnd$rect$h = fklgnd$rect$h - lines_to_user_y(1.5 + 0.4) rasterbox[1] = fklgnd$rect$left if (isFALSE(inner_right)) { - rasterbox[1] = rasterbox[1] + - (grconvertX(0.2, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user")) + rasterbox[1] = rasterbox[1] + lines_to_user_x(0.2) } - rasterbox[2] = fklgnd$rect$top - - fklgnd$rect$h - - (grconvertY(1.5 + 0.2, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user")) - rasterbox[3] = rasterbox[1] + - (grconvertX(1.25, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user")) + rasterbox[2] = fklgnd$rect$top - fklgnd$rect$h - lines_to_user_y(1.5 + 0.2) + rasterbox[3] = rasterbox[1] + lines_to_user_x(1.25) rasterbox[4] = rasterbox[2] + fklgnd$rect$h } else if (outer_side) { - rb1_adj = grconvertX(lmar[1] + 0.2, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user") - rb3_adj = grconvertX(1.25, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user") - rb2_adj = (corners[4] - - corners[3] - - (grconvertY(5 + 1 + 2.5, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user"))) / - 2 + rb1_adj = lines_to_user_x(lmar[1] + 0.2) + rb3_adj = lines_to_user_x(1.25) + rb2_adj = (corners[4] - corners[3] - lines_to_user_y(5 + 1 + 2.5)) / 2 # Override if top or bottom if (!is.null(legend_args[["x"]])) { if (grepl("^bottom", legend_args[["x"]])) { rb2_adj = corners[3] } if (grepl("^top", legend_args[["x"]])) { - rb2_adj = corners[4] - - (grconvertY(5 + 1 + 2.5, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user")) + rb2_adj = corners[4] - lines_to_user_y(5 + 1 + 2.5) } } if (user_inset) { rb2_adj = rb2_adj + legend_args[["inset"]][2] + 0.05 } - rb4_adj = grconvertY(5 + 1, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user") + rb4_adj = lines_to_user_y(5 + 1) if (outer_right) { rasterbox[1] = corners[2] + rb1_adj if (user_inset) { - rasterbox[1] = rasterbox[1] - - (corners[2] - legend_args[["inset"]][1]) / 2 + rasterbox[1] = rasterbox[1] - (corners[2] - legend_args[["inset"]][1]) / 2 } rasterbox[2] = rb2_adj rasterbox[3] = rasterbox[1] + rb3_adj rasterbox[4] = rasterbox[2] + rb4_adj } else { - rb1_adj = rb1_adj + - grconvertX(par("mar")[2] + 1, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user") + rb1_adj = rb1_adj + lines_to_user_x(par("mar")[2] + 1) rasterbox[1] = corners[1] - rb1_adj rasterbox[2] = rb2_adj rasterbox[3] = rasterbox[1] - rb3_adj @@ -1045,82 +1170,9 @@ draw_gradient_swatch = function( # Add labels, tick marks, and title if (isFALSE(horiz)) { - # Vertical gradient legend - labs_idx = !is.na(lgnd_labs) - lgnd_labs[labs_idx] = paste0(" ", format(lgnd_labs[labs_idx])) - lbl_x_anchor = rasterbox[3] - ttl_x_anchor = rasterbox[1] - lbl_adj = c(0, 0.5) - tck_adj = c(1, 0.5) - ttl_adj = c(0, 0) - if (!inner && !outer_right) { - lbl_x_anchor = rasterbox[1] - ttl_x_anchor = ttl_x_anchor + max(strwidth(lgnd_labs[labs_idx])) - ttl_adj = c(1, 0) - } - text( - x = lbl_x_anchor, - y = seq(rasterbox[2], rasterbox[4], length.out = length(lgnd_labs)), - labels = lgnd_labs, - xpd = NA, - adj = lbl_adj - ) - # Legend tick marks - lgnd_ticks = lgnd_labs - lgnd_ticks[labs_idx] = "- -" - text( - x = lbl_x_anchor, - y = seq(rasterbox[2], rasterbox[4], length.out = length(lgnd_labs)), - labels = lgnd_ticks, - col = "white", - xpd = NA, - adj = tck_adj - ) - # Legend title - text( - x = ttl_x_anchor, - y = rasterbox[4] + - grconvertY(1, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user"), - labels = legend_args[["title"]], - xpd = NA, - adj = ttl_adj - ) + draw_gradient_labels_vertical(rasterbox, lgnd_labs, legend_args, inner, outer_right) } else { - # Horizontal gradient legend - lbl_y_anchor = rasterbox[4] - ttl_y_anchor = rasterbox[4] - lbl_adj = c(0.5, 1.25) - tck_adj = c(0, 0.5) - ttl_adj = c(1, -0.5) - # Legend labs - text( - x = seq(rasterbox[1], rasterbox[3], length.out = length(lgnd_labs)), - y = lbl_y_anchor, - labels = lgnd_labs, - xpd = NA, - adj = lbl_adj - ) - # Legend tick marks - lgnd_ticks = lgnd_labs - lgnd_ticks[!is.na(lgnd_ticks)] = "- -" - text( - x = seq(rasterbox[1], rasterbox[3], length.out = length(lgnd_labs)), - y = lbl_y_anchor, - labels = lgnd_ticks, - col = "white", - xpd = NA, - adj = tck_adj, - srt = 90 - ) - # Legend title - text( - x = rasterbox[1], - y = ttl_y_anchor, - labels = paste0(legend_args[["title"]], " "), - xpd = NA, - adj = ttl_adj - ) + draw_gradient_labels_horizontal(rasterbox, lgnd_labs, legend_args) } } From e74bea49653eadec5d2e48d71af1be57215eafd4 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 10:42:49 -0500 Subject: [PATCH 04/14] legend: minor inlining --- R/legend.R | 23 ++++++----------------- 1 file changed, 6 insertions(+), 17 deletions(-) diff --git a/R/legend.R b/R/legend.R index 9d0b92a7..c292d92e 100644 --- a/R/legend.R +++ b/R/legend.R @@ -1127,30 +1127,19 @@ draw_gradient_swatch = function( } } else if (outer_end) { - rb1_adj = (corners[2] - - corners[1] - - (grconvertX(5 + 1, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user"))) / - 2 - rb3_adj = grconvertX(5 + 1, from = "lines", to = "user") - - grconvertX(0, from = "lines", to = "user") - rb2_adj = grconvertY(lmar[1], from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user") - rb4_adj = grconvertY(1.25, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user") + rb1_adj = (corners[2] - corners[1] - lines_to_user_x(5 + 1)) / 2 + rb3_adj = lines_to_user_x(5 + 1) + rb2_adj = lines_to_user_y(lmar[1]) + rb4_adj = lines_to_user_y(1.25) if (outer_bottom) { - rb2_adj = rb2_adj + - grconvertY(par("mar")[2], from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user") + rb2_adj = rb2_adj + lines_to_user_y(par("mar")[2]) rasterbox[1] = rb1_adj rasterbox[2] = corners[3] - rb2_adj rasterbox[3] = rasterbox[1] + rb3_adj rasterbox[4] = rasterbox[2] - rb4_adj } else { - rb2_adj = rb2_adj + - grconvertY(1.25 + 1, from = "lines", to = "user") - - grconvertY(0, from = "lines", to = "user") + rb2_adj = rb2_adj + lines_to_user_y(1.25 + 1) rasterbox[1] = rb1_adj rasterbox[2] = corners[4] + rb2_adj rasterbox[3] = rasterbox[1] + rb3_adj From 718654870ae8e645b9e7b4e4dd00f79df187ab43 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 11:12:41 -0500 Subject: [PATCH 05/14] naming convention: dual -> multi legend --- R/legend.R | 456 ++++++++++-------- R/tinyplot.R | 8 +- man/create_legend_spec.Rd | 29 ++ man/draw_legend_positioned.Rd | 67 --- man/draw_multi_legend.Rd | 6 +- man/legend_spec_apply_margins.Rd | 19 + man/legend_spec_draw.Rd | 18 + man/legend_spec_layout.Rd | 21 + man/prepare_legend_context.Rd | 2 +- ...dual_legend.Rd => prepare_multi_legend.Rd} | 10 +- 10 files changed, 367 insertions(+), 269 deletions(-) create mode 100644 man/create_legend_spec.Rd delete mode 100644 man/draw_legend_positioned.Rd create mode 100644 man/legend_spec_apply_margins.Rd create mode 100644 man/legend_spec_draw.Rd create mode 100644 man/legend_spec_layout.Rd rename man/{prepare_dual_legend.Rd => prepare_multi_legend.Rd} (66%) diff --git a/R/legend.R b/R/legend.R index c292d92e..42db1e34 100644 --- a/R/legend.R +++ b/R/legend.R @@ -27,6 +27,67 @@ lines_to_user_y = function(val) { grconvertY(val, from = "lines", to = "user") - grconvertY(0, from = "lines", to = "user") } +#' Create legend specification object +#' +#' @description Creates a structured specification object that flows through +#' the legend rendering pipeline, eliminating redundant state and parameter passing. +#' +#' @param legend_args List of legend arguments (x, legend, col, etc.) +#' @param type Plot type (for type-specific adjustments) +#' @param gradient Logical indicating if this is a gradient legend +#' @param has_sub Logical indicating if plot has subtitle +#' @param new_plot Logical indicating if new plot should be created +#' @param dynmar Logical indicating if dynamic margins are enabled +#' +#' @returns A legend_spec object containing args, flags, margins, dims, layout, and meta +#' +#' @keywords internal +create_legend_spec = function(legend_args, type, gradient, has_sub, new_plot, dynmar) { + structure( + list( + # User-facing arguments + args = legend_args, + + # Positioning flags (set during build phase) + flags = list( + outer_side = FALSE, + outer_end = FALSE, + outer_right = FALSE, + outer_bottom = FALSE, + mcol = FALSE, + user_inset = FALSE, + gradient = gradient + ), + + # Margins (set during margin adjustment phase) + margins = list( + lmar = NULL, + omar = NULL, + ooma = NULL + ), + + # Dimensions from fake legend (set during measure phase) + dims = NULL, + + # Calculated layout (set during layout phase) + layout = list( + inset = NULL, + rasterbox = NULL + ), + + # Metadata + meta = list( + type = type, + has_sub = has_sub, + new_plot = new_plot, + dynmar = dynmar, + topmar_epsilon = 0.1 + ) + ), + class = "legend_spec" + ) +} + # Adjust margins for outer legend placement adjust_margins_for_outer_legend = function(outer_side, outer_end, outer_right, outer_bottom, omar, ooma, has_sub, @@ -130,18 +191,6 @@ calculate_legend_inset = function(outer_side, outer_end, outer_right, outer_bott } } -# Transform outer position string (e.g., "right!" -> "left" for positioning logic) -transform_outer_position = function(pos, outer_side, outer_end, outer_right, outer_bottom) { - if (outer_end) { - if (outer_bottom) return(gsub("bottom!$", "top", pos)) - return(gsub("top!$", "bottom", pos)) - } else if (outer_side) { - if (outer_right) return(gsub("right!$", "left", pos)) - return(gsub("left!$", "right", pos)) - } - pos -} - # Prepare fake legend arguments for dimension measurement prepare_fake_legend_args = function(legend_args, gradient, outer_end) { fklgnd.args = modifyList( @@ -286,6 +335,139 @@ draw_gradient_labels_horizontal = function(rasterbox, lgnd_labs, legend_args) { } +# +## Legend Spec Pipeline ----- +# + +#' Apply margin adjustments for outer legends +#' +#' @description Second stage of pipeline: initializes margins and adjusts +#' them for outer legend placement. +#' +#' @param spec Legend specification object +#' +#' @returns Modified spec with margins populated +#' +#' @keywords internal +legend_spec_apply_margins = function(spec) { + # Get current margins + spec$margins$omar = par("mar") + spec$margins$ooma = par("oma") + spec$margins$lmar = tpar("lmar") + + # Adjust for outer placement + margin_result = adjust_margins_for_outer_legend( + spec$flags$outer_side, + spec$flags$outer_end, + spec$flags$outer_right, + spec$flags$outer_bottom, + spec$margins$omar, + spec$margins$ooma, + spec$meta$has_sub, + spec$meta$topmar_epsilon, + spec$meta$type, + spec$margins$lmar, + spec$meta$new_plot, + spec$meta$dynmar + ) + + spec$margins = modifyList(spec$margins, margin_result) + spec +} + +#' Calculate legend layout (inset and rasterbox) +#' +#' @description Fourth stage of pipeline: calculates inset for positioning +#' and rasterbox coordinates for gradient legends. +#' +#' @param spec Legend specification object +#' @param draw Logical indicating if this is for actual drawing (vs measurement) +#' +#' @returns Modified spec with layout populated +#' +#' @keywords internal +legend_spec_layout = function(spec, draw = TRUE) { + if (!draw) { + return(spec) + } + + # Calculate and apply soma (outer margin adjustment) + margin_result = calculate_and_apply_soma( + spec$dims, + spec$flags$outer_side, + spec$flags$outer_end, + spec$flags$outer_right, + spec$flags$outer_bottom, + spec$margins$lmar, + spec$margins$ooma, + spec$margins$omar, + spec$meta$topmar_epsilon + ) + spec$margins$ooma = margin_result$ooma + spec$margins$omar = margin_result$omar + + # Calculate inset + spec$layout$inset = calculate_legend_inset( + spec$flags$outer_side, + spec$flags$outer_end, + spec$flags$outer_right, + spec$flags$outer_bottom, + spec$margins$lmar, + spec$margins$omar, + spec$meta$topmar_epsilon + ) + + # Refresh plot area for exact inset spacing + oldhook = getHook("before.plot.new") + setHook("before.plot.new", function() par(new = TRUE), action = "append") + setHook("before.plot.new", function() par(mar = spec$margins$omar), action = "append") + plot.new() + setHook("before.plot.new", oldhook, action = "replace") + + # Set the inset in args + spec$args[["inset"]] = if (spec$flags$user_inset) { + spec$args[["inset"]] + spec$layout$inset + } else { + spec$layout$inset + } + + spec +} + +#' Draw legend from specification +#' +#' @description Final stage of pipeline: draws the actual legend. +#' +#' @param spec Legend specification object +#' +#' @returns NULL (called for side effect of drawing legend) +#' +#' @keywords internal +legend_spec_draw = function(spec) { + if (spec$flags$gradient) { + # Ensure col is set correctly for gradients + if (!more_than_n_unique(spec$args[["col"]], 1)) { + if (!is.null(spec$args[["pt.bg"]]) && length(spec$args[["pt.bg"]]) == 100) { + spec$args[["col"]] = spec$args[["pt.bg"]] + } + } + + draw_gradient_swatch( + legend_args = spec$args, + fklgnd = spec$dims, + lmar = spec$margins$lmar, + outer_side = spec$flags$outer_side, + outer_end = spec$flags$outer_end, + outer_right = spec$flags$outer_right, + outer_bottom = spec$flags$outer_bottom, + user_inset = spec$flags$user_inset + ) + } else { + do.call("legend", spec$args) + } +} + + # ## Input Sanitization ----- # @@ -347,7 +529,7 @@ sanitize_legend = function(legend, legend_args) { #' @description Main orchestrator that determines: #' - Whether to draw legend #' - Legend labels and formatting -#' - Whether dual legend is needed (for bubble charts) +#' - Whether multi-legend is needed (for bubble charts) #' - Gradient legend setup for continuous grouping #' #' @param settings Settings environment from tinyplot @@ -399,7 +581,7 @@ prepare_legend_context = function(settings) { } has_legend = FALSE - dual_legend = bubble && !null_by && !isFALSE(legend) + multi_legend = bubble && !null_by && !isFALSE(legend) lgnd_cex = NULL # Normalize legend argument @@ -411,12 +593,12 @@ prepare_legend_context = function(settings) { if (!is.null(legend) && is.character(legend) && legend == "none") { legend_args[["x"]] = "none" - dual_legend = FALSE + multi_legend = FALSE } # Handle bubble-only legend (no grouping) if (null_by) { - if (bubble && !dual_legend) { + if (bubble && !multi_legend) { legend_args[["title"]] = cex_dep lgnd_labs = names(bubble_cex) lgnd_cex = bubble_cex * cex_fct_adj @@ -430,7 +612,7 @@ prepare_legend_context = function(settings) { has_sub = !is.null(sub) # Generate labels for discrete legends - if (legend_draw_flag && isFALSE(by_continuous) && (!bubble || dual_legend)) { + if (legend_draw_flag && isFALSE(by_continuous) && (!bubble || multi_legend)) { if (ngrps > 1) { lgnd_labs = if (is.factor(datapoints$by)) levels(datapoints$by) else unique(datapoints$by) } else { @@ -444,7 +626,7 @@ prepare_legend_context = function(settings) { c( "lgnd_labs", "has_legend", - "dual_legend", + "multi_legend", "lgnd_cex", "legend", "legend_args", @@ -455,9 +637,9 @@ prepare_legend_context = function(settings) { } -#' Prepare dual legend specifications +#' Prepare multi-legend specifications #' -#' @description Sets up two separate legend specifications for dual legends +#' @description Sets up multiple legend specifications for multi-legends #' (e.g., color grouping + bubble size). Creates `lgby` and `lgbub` objects #' that will be passed to draw_multi_legend(). #' @@ -466,7 +648,7 @@ prepare_legend_context = function(settings) { #' @returns NULL (modifies settings environment in-place) #' #' @keywords internal -prepare_dual_legend = function(settings) { +prepare_multi_legend = function(settings) { env2env( settings, environment(), @@ -651,9 +833,19 @@ build_legend_spec = function( } # Adjust position anchor (we'll position relative to opposite side) - legend_args[["x"]] = transform_outer_position( - legend_args[["x"]], outer_side, outer_end, outer_right, outer_bottom - ) + if (outer_end) { + if (outer_bottom) { + legend_args[["x"]] = gsub("bottom!$", "top", legend_args[["x"]]) + } else { + legend_args[["x"]] = gsub("top!$", "bottom", legend_args[["x"]]) + } + } else if (outer_side) { + if (outer_right) { + legend_args[["x"]] = gsub("right!$", "left", legend_args[["x"]]) + } else { + legend_args[["x"]] = gsub("left!$", "right", legend_args[["x"]]) + } + } # Additional positioning adjustments if (outer_end) { @@ -837,185 +1029,71 @@ draw_legend = function( assert_logical(new_plot) assert_logical(draw) - # Build complete legend specification - outer_side = outer_end = outer_right = outer_bottom = FALSE - list2env( - build_legend_spec( - legend = legend, - legend_args = legend_args, - by_dep = by_dep, - lgnd_labs = lgnd_labs, - labeller = labeller, - type = type, - pch = pch, - lty = lty, - lwd = lwd, - col = col, - bg = bg, - cex = cex, - gradient = gradient - ), - environment() + # Build complete legend arguments from inputs + legend_build = build_legend_spec( + legend = legend, + legend_args = legend_args, + by_dep = by_dep, + lgnd_labs = lgnd_labs, + labeller = labeller, + type = type, + pch = pch, + lty = lty, + lwd = lwd, + col = col, + bg = bg, + cex = cex, + gradient = gradient ) # Restore margin defaults dynmar = isTRUE(.tpar[["dynmar"]]) - topmar_epsilon = 0.1 - user_inset = !is.null(legend_args[["inset"]]) - restore_margin_outer() if (!dynmar) { - restore_margin_inner(par("oma"), topmar_epsilon = topmar_epsilon) + restore_margin_inner(par("oma"), topmar_epsilon = 0.1) } - ooma = par("oma") - omar = par("mar") - - # Adjust margins for outer legends - margin_result = adjust_margins_for_outer_legend( - outer_side, outer_end, outer_right, outer_bottom, - omar, ooma, has_sub, topmar_epsilon, type, lmar, new_plot, dynmar + # Create spec object and populate from build_legend_spec results + spec = create_legend_spec( + legend_args = legend_build$legend_args, + type = type, + gradient = gradient, + has_sub = has_sub, + new_plot = new_plot, + dynmar = dynmar ) - omar = margin_result$omar - ooma = margin_result$ooma - lmar = margin_result$lmar - # Draw the legend using internal function - # Wrapped in recordGraphics() to preserve spacing if plot is resized - recordGraphics( - draw_legend_positioned( - legend_args = legend_args, - ooma = ooma, - omar = omar, - lmar = lmar, - topmar_epsilon = topmar_epsilon, - outer_side = outer_side, - outer_right = outer_right, - outer_end = outer_end, - outer_bottom = outer_bottom, - gradient = gradient, - user_inset = user_inset, - draw = draw - ), - list = list( - legend_args = legend_args, - ooma = ooma, - omar = omar, - lmar = lmar, - topmar_epsilon = topmar_epsilon, - outer_side = outer_side, - outer_right = outer_right, - outer_end = outer_end, - outer_bottom = outer_bottom, - gradient = gradient, - user_inset = user_inset, - draw = draw - ), - env = getNamespace("tinyplot") + # Populate flags from build_legend_spec output (which already parsed positioning) + spec$flags$outer_side = legend_build$outer_side + spec$flags$outer_end = legend_build$outer_end + spec$flags$outer_right = legend_build$outer_right + spec$flags$outer_bottom = legend_build$outer_bottom + spec$flags$mcol = legend_build$mcol_flag + spec$flags$user_inset = legend_build$user_inset + + # Run pipeline stages (skip build since build_legend_spec already did that work) + spec = legend_spec_apply_margins(spec) + + # Measure dimensions with fake legend + fklgnd_args = prepare_fake_legend_args( + spec$args, + spec$flags$gradient, + spec$flags$outer_end ) -} - + spec$dims = do.call("legend", fklgnd_args) -#' Internal legend drawing with positioning -#' -#' @description Internal workhorse that draws the legend in three steps: -#' 1. Draw a fake legend (plot = FALSE) to measure dimensions -#' 2. Calculate required inset and adjust plot margins -#' 3. Draw the real legend -#' -#' @inheritParams draw_legend -#' @param ooma Outer margins -#' @param omar Inner margins -#' @param topmar_epsilon Small epsilon for top margin adjustment -#' @param outer_side Logical flag for outer side placement -#' @param outer_right Logical flag for outer right placement -#' @param outer_end Logical flag for outer end placement -#' @param outer_bottom Logical flag for outer bottom placement -#' @param user_inset Logical flag indicating user-supplied inset -#' -#' @returns Legend dimensions (from fake legend) if draw=FALSE, otherwise NULL -#' -#' @keywords internal -draw_legend_positioned = function( - legend_args, - ooma, - omar, - lmar, - topmar_epsilon, - outer_side, - outer_right, - outer_end, - outer_bottom, - gradient, - user_inset = FALSE, - draw -) { - # - ## Step 1: Draw fake legend to measure dimensions - # - - fklgnd.args = prepare_fake_legend_args(legend_args, gradient, outer_end) - fklgnd = do.call("legend", fklgnd.args) if (!draw) { - return(fklgnd) + return(spec$dims) } - # - ## Step 2: Calculate legend inset (for outer placement) - # - - # Calculate and apply soma (outer margin size) - margin_result = calculate_and_apply_soma( - fklgnd, outer_side, outer_end, outer_right, outer_bottom, - lmar, ooma, omar, topmar_epsilon - ) - ooma = margin_result$ooma - omar = margin_result$omar + spec = legend_spec_layout(spec, draw = draw) - # Determine legend inset - inset = calculate_legend_inset( - outer_side, outer_end, outer_right, outer_bottom, - lmar, omar, topmar_epsilon + # Draw wrapped in recordGraphics() to preserve spacing if plot is resized + recordGraphics( + legend_spec_draw(spec), + list = list(spec = spec), + env = getNamespace("tinyplot") ) - - # Refresh plot area for exact inset spacing - # Using temporary hook instead of direct par(new = TRUE) - oldhook = getHook("before.plot.new") - setHook("before.plot.new", function() par(new = TRUE), action = "append") - setHook("before.plot.new", function() par(mar = omar), action = "append") - plot.new() - setHook("before.plot.new", oldhook, action = "replace") - - # Set the inset as part of the legend args - legend_args[["inset"]] = if (user_inset) { - legend_args[["inset"]] + inset - } else { - inset - } - - # - ## Step 3: Draw the real legend - # - - if (gradient) { - if (!more_than_n_unique(legend_args[["col"]], 1)) { - if (!is.null(legend_args[["pt.bg"]]) && length(legend_args[["pt.bg"]]) == 100) { - legend_args[["col"]] = legend_args[["pt.bg"]] - } - } - draw_gradient_swatch( - legend_args = legend_args, - fklgnd = fklgnd, - lmar = lmar, - outer_side = outer_side, - outer_end = outer_end, - outer_right = outer_right, - outer_bottom = outer_bottom, - user_inset = user_inset - ) - } else { - do.call("legend", legend_args) - } } @@ -1172,7 +1250,7 @@ draw_gradient_swatch = function( #' Draw multiple legends with automatic positioning #' -#' @description Handles dual legends (e.g., color grouping + bubble size) by: +#' @description Handles multiple legends (e.g., color grouping + bubble size) by: #' 1. Extracting dimensions from fake legends #' 2. Calculating sub-positioning based on dimensions #' 3. Drawing legends in ascending order of width (widest last) @@ -1181,7 +1259,7 @@ draw_gradient_swatch = function( #' @param legend_list A list of legend arguments, where each element is itself a #' list of arguments that can be passed on to [draw_legend]. Legends will be #' drawn vertically (top to bottom) in the order that they are provided. Note -#' that we currently only support dual legends, i.e. the top-level list has a +#' that we currently only support 2 legends, i.e. the top-level list has a #' maximum length of 2. #' @param position String indicating the base keyword position for the #' multi-legend. Currently only `"right!"` and `"left!"` are supported. @@ -1196,7 +1274,7 @@ draw_gradient_swatch = function( #' \dontrun{ #' oldmar = par("mar") #' -#' # Dual legend example (color + bubble) +#' # Multi-legend example (color + bubble) #' #' l1 = list( #' lgnd_labs = c("Red", "Blue", "Green"), diff --git a/R/tinyplot.R b/R/tinyplot.R index 1d316571..5f873c27 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -928,7 +928,7 @@ tinyplot.default = function( env2env(settings, environment()) if (legend_draw_flag) { - if (!dual_legend) { + if (!multi_legend) { ## simple case: single legend only if (is.null(lgnd_cex)) lgnd_cex = cex * cex_fct_adj draw_legend( @@ -947,10 +947,10 @@ tinyplot.default = function( has_sub = has_sub ) } else { - ## dual legend case... - prepare_dual_legend(settings) + ## multi-legend case... + prepare_multi_legend(settings) env2env(settings, environment(), c("legend_args", "lgby", "lgbub")) - # draw dual legend + # draw multi-legend draw_multi_legend(list(lgby, lgbub), position = legend_args[["x"]]) } diff --git a/man/create_legend_spec.Rd b/man/create_legend_spec.Rd new file mode 100644 index 00000000..bb6675ef --- /dev/null +++ b/man/create_legend_spec.Rd @@ -0,0 +1,29 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/legend.R +\name{create_legend_spec} +\alias{create_legend_spec} +\title{Create legend specification object} +\usage{ +create_legend_spec(legend_args, type, gradient, has_sub, new_plot, dynmar) +} +\arguments{ +\item{legend_args}{List of legend arguments (x, legend, col, etc.)} + +\item{type}{Plot type (for type-specific adjustments)} + +\item{gradient}{Logical indicating if this is a gradient legend} + +\item{has_sub}{Logical indicating if plot has subtitle} + +\item{new_plot}{Logical indicating if new plot should be created} + +\item{dynmar}{Logical indicating if dynamic margins are enabled} +} +\value{ +A legend_spec object containing args, flags, margins, dims, layout, and meta +} +\description{ +Creates a structured specification object that flows through +the legend rendering pipeline, eliminating redundant state and parameter passing. +} +\keyword{internal} diff --git a/man/draw_legend_positioned.Rd b/man/draw_legend_positioned.Rd deleted file mode 100644 index 01e80359..00000000 --- a/man/draw_legend_positioned.Rd +++ /dev/null @@ -1,67 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/legend.R -\name{draw_legend_positioned} -\alias{draw_legend_positioned} -\title{Internal legend drawing with positioning} -\usage{ -draw_legend_positioned( - legend_args, - ooma, - omar, - lmar, - topmar_epsilon, - outer_side, - outer_right, - outer_end, - outer_bottom, - gradient, - user_inset = FALSE, - draw -) -} -\arguments{ -\item{legend_args}{Additional legend arguments to be passed to -\code{\link[graphics]{legend}}.} - -\item{ooma}{Outer margins} - -\item{omar}{Inner margins} - -\item{lmar}{Legend margins (in lines). Should be a numeric vector of the form -\code{c(inner, outer)}, where the first number represents the "inner" margin -between the legend and the plot, and the second number represents the -"outer" margin between the legend and edge of the graphics device. If no -explicit value is provided by the user, then reverts back to \code{tpar("lmar")} -for which the default values are \code{c(1.0, 0.1)}.} - -\item{topmar_epsilon}{Small epsilon for top margin adjustment} - -\item{outer_side}{Logical flag for outer side placement} - -\item{outer_right}{Logical flag for outer right placement} - -\item{outer_end}{Logical flag for outer end placement} - -\item{outer_bottom}{Logical flag for outer bottom placement} - -\item{gradient}{Logical indicating whether a continuous gradient swatch -should be used to represent the colors.} - -\item{user_inset}{Logical flag indicating user-supplied inset} - -\item{draw}{Logical. If \code{FALSE}, no legend is drawn but the sizes are -returned. Note that a new (blank) plot frame will still need to be started -in order to perform the calculations.} -} -\value{ -Legend dimensions (from fake legend) if draw=FALSE, otherwise NULL -} -\description{ -Internal workhorse that draws the legend in three steps: -\enumerate{ -\item Draw a fake legend (plot = FALSE) to measure dimensions -\item Calculate required inset and adjust plot margins -\item Draw the real legend -} -} -\keyword{internal} diff --git a/man/draw_multi_legend.Rd b/man/draw_multi_legend.Rd index 76f4ba6e..16b8eb99 100644 --- a/man/draw_multi_legend.Rd +++ b/man/draw_multi_legend.Rd @@ -10,7 +10,7 @@ draw_multi_legend(legend_list, position = "right!") \item{legend_list}{A list of legend arguments, where each element is itself a list of arguments that can be passed on to \link{draw_legend}. Legends will be drawn vertically (top to bottom) in the order that they are provided. Note -that we currently only support dual legends, i.e. the top-level list has a +that we currently only support 2 legends, i.e. the top-level list has a maximum length of 2.} \item{position}{String indicating the base keyword position for the @@ -20,7 +20,7 @@ multi-legend. Currently only \code{"right!"} and \code{"left!"} are supported.} No return value, called for side effect of drawing multiple legends. } \description{ -Handles dual legends (e.g., color grouping + bubble size) by: +Handles multiple legends (e.g., color grouping + bubble size) by: \enumerate{ \item Extracting dimensions from fake legends \item Calculating sub-positioning based on dimensions @@ -31,7 +31,7 @@ Handles dual legends (e.g., color grouping + bubble size) by: \dontrun{ oldmar = par("mar") -# Dual legend example (color + bubble) +# Multi-legend example (color + bubble) l1 = list( lgnd_labs = c("Red", "Blue", "Green"), diff --git a/man/legend_spec_apply_margins.Rd b/man/legend_spec_apply_margins.Rd new file mode 100644 index 00000000..0d7c646b --- /dev/null +++ b/man/legend_spec_apply_margins.Rd @@ -0,0 +1,19 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/legend.R +\name{legend_spec_apply_margins} +\alias{legend_spec_apply_margins} +\title{Apply margin adjustments for outer legends} +\usage{ +legend_spec_apply_margins(spec) +} +\arguments{ +\item{spec}{Legend specification object} +} +\value{ +Modified spec with margins populated +} +\description{ +Second stage of pipeline: initializes margins and adjusts +them for outer legend placement. +} +\keyword{internal} diff --git a/man/legend_spec_draw.Rd b/man/legend_spec_draw.Rd new file mode 100644 index 00000000..367e6449 --- /dev/null +++ b/man/legend_spec_draw.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/legend.R +\name{legend_spec_draw} +\alias{legend_spec_draw} +\title{Draw legend from specification} +\usage{ +legend_spec_draw(spec) +} +\arguments{ +\item{spec}{Legend specification object} +} +\value{ +NULL (called for side effect of drawing legend) +} +\description{ +Final stage of pipeline: draws the actual legend. +} +\keyword{internal} diff --git a/man/legend_spec_layout.Rd b/man/legend_spec_layout.Rd new file mode 100644 index 00000000..cfb6d5b1 --- /dev/null +++ b/man/legend_spec_layout.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/legend.R +\name{legend_spec_layout} +\alias{legend_spec_layout} +\title{Calculate legend layout (inset and rasterbox)} +\usage{ +legend_spec_layout(spec, draw = TRUE) +} +\arguments{ +\item{spec}{Legend specification object} + +\item{draw}{Logical indicating if this is for actual drawing (vs measurement)} +} +\value{ +Modified spec with layout populated +} +\description{ +Fourth stage of pipeline: calculates inset for positioning +and rasterbox coordinates for gradient legends. +} +\keyword{internal} diff --git a/man/prepare_legend_context.Rd b/man/prepare_legend_context.Rd index 81293a65..30a793ae 100644 --- a/man/prepare_legend_context.Rd +++ b/man/prepare_legend_context.Rd @@ -17,7 +17,7 @@ Main orchestrator that determines: \itemize{ \item Whether to draw legend \item Legend labels and formatting -\item Whether dual legend is needed (for bubble charts) +\item Whether multi-legend is needed (for bubble charts) \item Gradient legend setup for continuous grouping } } diff --git a/man/prepare_dual_legend.Rd b/man/prepare_multi_legend.Rd similarity index 66% rename from man/prepare_dual_legend.Rd rename to man/prepare_multi_legend.Rd index af525bf2..33ed4806 100644 --- a/man/prepare_dual_legend.Rd +++ b/man/prepare_multi_legend.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/legend.R -\name{prepare_dual_legend} -\alias{prepare_dual_legend} -\title{Prepare dual legend specifications} +\name{prepare_multi_legend} +\alias{prepare_multi_legend} +\title{Prepare multi-legend specifications} \usage{ -prepare_dual_legend(settings) +prepare_multi_legend(settings) } \arguments{ \item{settings}{Settings environment from tinyplot} @@ -13,7 +13,7 @@ prepare_dual_legend(settings) NULL (modifies settings environment in-place) } \description{ -Sets up two separate legend specifications for dual legends +Sets up multiple legend specifications for multi-legends (e.g., color grouping + bubble size). Creates \code{lgby} and \code{lgbub} objects that will be passed to draw_multi_legend(). } From d7879289a07679ca2e1bd056b7bdaa53b1910a58 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 11:25:09 -0500 Subject: [PATCH 06/14] rename legend functions for consistency --- R/legend.R | 120 ++++++------------ R/tinyplot.R | 4 +- man/create_legend_spec.Rd | 29 ----- ...re_legend_context.Rd => prepare_legend.Rd} | 6 +- ...ulti_legend.Rd => prepare_legend_multi.Rd} | 6 +- 5 files changed, 45 insertions(+), 120 deletions(-) delete mode 100644 man/create_legend_spec.Rd rename man/{prepare_legend_context.Rd => prepare_legend.Rd} (84%) rename man/{prepare_multi_legend.Rd => prepare_legend_multi.Rd} (84%) diff --git a/R/legend.R b/R/legend.R index 42db1e34..07b5b5f2 100644 --- a/R/legend.R +++ b/R/legend.R @@ -27,67 +27,6 @@ lines_to_user_y = function(val) { grconvertY(val, from = "lines", to = "user") - grconvertY(0, from = "lines", to = "user") } -#' Create legend specification object -#' -#' @description Creates a structured specification object that flows through -#' the legend rendering pipeline, eliminating redundant state and parameter passing. -#' -#' @param legend_args List of legend arguments (x, legend, col, etc.) -#' @param type Plot type (for type-specific adjustments) -#' @param gradient Logical indicating if this is a gradient legend -#' @param has_sub Logical indicating if plot has subtitle -#' @param new_plot Logical indicating if new plot should be created -#' @param dynmar Logical indicating if dynamic margins are enabled -#' -#' @returns A legend_spec object containing args, flags, margins, dims, layout, and meta -#' -#' @keywords internal -create_legend_spec = function(legend_args, type, gradient, has_sub, new_plot, dynmar) { - structure( - list( - # User-facing arguments - args = legend_args, - - # Positioning flags (set during build phase) - flags = list( - outer_side = FALSE, - outer_end = FALSE, - outer_right = FALSE, - outer_bottom = FALSE, - mcol = FALSE, - user_inset = FALSE, - gradient = gradient - ), - - # Margins (set during margin adjustment phase) - margins = list( - lmar = NULL, - omar = NULL, - ooma = NULL - ), - - # Dimensions from fake legend (set during measure phase) - dims = NULL, - - # Calculated layout (set during layout phase) - layout = list( - inset = NULL, - rasterbox = NULL - ), - - # Metadata - meta = list( - type = type, - has_sub = has_sub, - new_plot = new_plot, - dynmar = dynmar, - topmar_epsilon = 0.1 - ) - ), - class = "legend_spec" - ) -} - # Adjust margins for outer legend placement adjust_margins_for_outer_legend = function(outer_side, outer_end, outer_right, outer_bottom, omar, ooma, has_sub, @@ -191,8 +130,8 @@ calculate_legend_inset = function(outer_side, outer_end, outer_right, outer_bott } } -# Prepare fake legend arguments for dimension measurement -prepare_fake_legend_args = function(legend_args, gradient, outer_end) { +# Measure legend dimensions using a fake (non-plotted) legend +measure_fake_legend = function(legend_args, gradient, outer_end) { fklgnd.args = modifyList( legend_args, list(plot = FALSE), @@ -219,7 +158,7 @@ prepare_fake_legend_args = function(legend_args, gradient, outer_end) { } } - fklgnd.args + do.call("legend", fklgnd.args) } # Calculate and apply soma (outer margin size) based on legend dimensions @@ -537,7 +476,7 @@ sanitize_legend = function(legend, legend_args) { #' @returns NULL (modifies settings environment in-place) #' #' @keywords internal -prepare_legend_context = function(settings) { +prepare_legend = function(settings) { env2env( settings, environment(), @@ -648,7 +587,7 @@ prepare_legend_context = function(settings) { #' @returns NULL (modifies settings environment in-place) #' #' @keywords internal -prepare_multi_legend = function(settings) { +prepare_legend_multi = function(settings) { env2env( settings, environment(), @@ -1054,33 +993,48 @@ draw_legend = function( } # Create spec object and populate from build_legend_spec results - spec = create_legend_spec( - legend_args = legend_build$legend_args, - type = type, - gradient = gradient, - has_sub = has_sub, - new_plot = new_plot, - dynmar = dynmar + spec = structure( + list( + args = legend_build$legend_args, + flags = list( + outer_side = legend_build$outer_side, + outer_end = legend_build$outer_end, + outer_right = legend_build$outer_right, + outer_bottom = legend_build$outer_bottom, + mcol = legend_build$mcol_flag, + user_inset = legend_build$user_inset, + gradient = gradient + ), + margins = list( + lmar = NULL, + omar = NULL, + ooma = NULL + ), + dims = NULL, + layout = list( + inset = NULL, + rasterbox = NULL + ), + meta = list( + type = type, + has_sub = has_sub, + new_plot = new_plot, + dynmar = dynmar, + topmar_epsilon = 0.1 + ) + ), + class = "legend_spec" ) - # Populate flags from build_legend_spec output (which already parsed positioning) - spec$flags$outer_side = legend_build$outer_side - spec$flags$outer_end = legend_build$outer_end - spec$flags$outer_right = legend_build$outer_right - spec$flags$outer_bottom = legend_build$outer_bottom - spec$flags$mcol = legend_build$mcol_flag - spec$flags$user_inset = legend_build$user_inset - # Run pipeline stages (skip build since build_legend_spec already did that work) spec = legend_spec_apply_margins(spec) # Measure dimensions with fake legend - fklgnd_args = prepare_fake_legend_args( + spec$dims = measure_fake_legend( spec$args, spec$flags$gradient, spec$flags$outer_end ) - spec$dims = do.call("legend", fklgnd_args) if (!draw) { return(spec$dims) diff --git a/R/tinyplot.R b/R/tinyplot.R index 5f873c27..a1304b2c 100644 --- a/R/tinyplot.R +++ b/R/tinyplot.R @@ -919,7 +919,7 @@ tinyplot.default = function( ## legends ----- # - prepare_legend_context(settings) + prepare_legend(settings) # ## make settings available in the environment directly ----- @@ -948,7 +948,7 @@ tinyplot.default = function( ) } else { ## multi-legend case... - prepare_multi_legend(settings) + prepare_legend_multi(settings) env2env(settings, environment(), c("legend_args", "lgby", "lgbub")) # draw multi-legend draw_multi_legend(list(lgby, lgbub), position = legend_args[["x"]]) diff --git a/man/create_legend_spec.Rd b/man/create_legend_spec.Rd deleted file mode 100644 index bb6675ef..00000000 --- a/man/create_legend_spec.Rd +++ /dev/null @@ -1,29 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/legend.R -\name{create_legend_spec} -\alias{create_legend_spec} -\title{Create legend specification object} -\usage{ -create_legend_spec(legend_args, type, gradient, has_sub, new_plot, dynmar) -} -\arguments{ -\item{legend_args}{List of legend arguments (x, legend, col, etc.)} - -\item{type}{Plot type (for type-specific adjustments)} - -\item{gradient}{Logical indicating if this is a gradient legend} - -\item{has_sub}{Logical indicating if plot has subtitle} - -\item{new_plot}{Logical indicating if new plot should be created} - -\item{dynmar}{Logical indicating if dynamic margins are enabled} -} -\value{ -A legend_spec object containing args, flags, margins, dims, layout, and meta -} -\description{ -Creates a structured specification object that flows through -the legend rendering pipeline, eliminating redundant state and parameter passing. -} -\keyword{internal} diff --git a/man/prepare_legend_context.Rd b/man/prepare_legend.Rd similarity index 84% rename from man/prepare_legend_context.Rd rename to man/prepare_legend.Rd index 30a793ae..faaedce5 100644 --- a/man/prepare_legend_context.Rd +++ b/man/prepare_legend.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/legend.R -\name{prepare_legend_context} -\alias{prepare_legend_context} +\name{prepare_legend} +\alias{prepare_legend} \title{Prepare legend context from settings} \usage{ -prepare_legend_context(settings) +prepare_legend(settings) } \arguments{ \item{settings}{Settings environment from tinyplot} diff --git a/man/prepare_multi_legend.Rd b/man/prepare_legend_multi.Rd similarity index 84% rename from man/prepare_multi_legend.Rd rename to man/prepare_legend_multi.Rd index 33ed4806..a2c1e6e2 100644 --- a/man/prepare_multi_legend.Rd +++ b/man/prepare_legend_multi.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/legend.R -\name{prepare_multi_legend} -\alias{prepare_multi_legend} +\name{prepare_legend_multi} +\alias{prepare_legend_multi} \title{Prepare multi-legend specifications} \usage{ -prepare_multi_legend(settings) +prepare_legend_multi(settings) } \arguments{ \item{settings}{Settings environment from tinyplot} From 246b7ace13d112c3eda0a7ee1d31a3bb5d6420de Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 11:55:46 -0500 Subject: [PATCH 07/14] rename legend functions for clarity --- R/legend.R | 517 ++---------------------------------- R/legend_gradient.R | 229 ++++++++++++++++ R/legend_multi.R | 218 +++++++++++++++ man/draw_gradient_swatch.Rd | 2 +- man/draw_multi_legend.Rd | 2 +- man/prepare_legend_multi.Rd | 2 +- 6 files changed, 475 insertions(+), 495 deletions(-) create mode 100644 R/legend_gradient.R create mode 100644 R/legend_multi.R diff --git a/R/legend.R b/R/legend.R index 07b5b5f2..5405964d 100644 --- a/R/legend.R +++ b/R/legend.R @@ -28,7 +28,7 @@ lines_to_user_y = function(val) { } # Adjust margins for outer legend placement -adjust_margins_for_outer_legend = function(outer_side, outer_end, outer_right, +legend_outer_margins_prepare = function(outer_side, outer_end, outer_right, outer_bottom, omar, ooma, has_sub, topmar_epsilon, type, lmar, new_plot, dynmar) { if (outer_side) { @@ -162,7 +162,7 @@ measure_fake_legend = function(legend_args, gradient, outer_end) { } # Calculate and apply soma (outer margin size) based on legend dimensions -calculate_and_apply_soma = function(fklgnd, outer_side, outer_end, outer_right, +legend_outer_margins_apply = function(fklgnd, outer_side, outer_end, outer_right, outer_bottom, lmar, ooma, omar, topmar_epsilon) { # Calculate size soma = if (outer_side) { @@ -190,130 +190,11 @@ calculate_and_apply_soma = function(fklgnd, outer_side, outer_end, outer_right, list(ooma = ooma, omar = omar) } -# Draw vertical gradient legend labels, ticks, and title -draw_gradient_labels_vertical = function(rasterbox, lgnd_labs, legend_args, inner, outer_right) { - labs_idx = !is.na(lgnd_labs) - lgnd_labs[labs_idx] = paste0(" ", format(lgnd_labs[labs_idx])) - - # Determine anchors based on position - if (!inner && !outer_right) { - lbl_x_anchor = rasterbox[1] - ttl_x_anchor = rasterbox[1] + max(strwidth(lgnd_labs[labs_idx])) - lbl_adj = c(0, 0.5) - ttl_adj = c(1, 0) - } else { - lbl_x_anchor = rasterbox[3] - ttl_x_anchor = rasterbox[1] - lbl_adj = c(0, 0.5) - ttl_adj = c(0, 0) - } - - # Draw labels - text( - x = lbl_x_anchor, - y = seq(rasterbox[2], rasterbox[4], length.out = length(lgnd_labs)), - labels = lgnd_labs, - xpd = NA, - adj = lbl_adj - ) - - # Draw tick marks (white dashes) - lgnd_ticks = lgnd_labs - lgnd_ticks[labs_idx] = "- -" - text( - x = lbl_x_anchor, - y = seq(rasterbox[2], rasterbox[4], length.out = length(lgnd_labs)), - labels = lgnd_ticks, - col = "white", - xpd = NA, - adj = c(1, 0.5) - ) - - # Draw title - text( - x = ttl_x_anchor, - y = rasterbox[4] + lines_to_user_y(1), - labels = legend_args[["title"]], - xpd = NA, - adj = ttl_adj - ) -} - -# Draw horizontal gradient legend labels, ticks, and title -draw_gradient_labels_horizontal = function(rasterbox, lgnd_labs, legend_args) { - # Legend labels - text( - x = seq(rasterbox[1], rasterbox[3], length.out = length(lgnd_labs)), - y = rasterbox[4], - labels = lgnd_labs, - xpd = NA, - adj = c(0.5, 1.25) - ) - - # Legend tick marks (white dashes) - lgnd_ticks = lgnd_labs - lgnd_ticks[!is.na(lgnd_ticks)] = "- -" - text( - x = seq(rasterbox[1], rasterbox[3], length.out = length(lgnd_labs)), - y = rasterbox[4], - labels = lgnd_ticks, - col = "white", - xpd = NA, - adj = c(0, 0.5), - srt = 90 - ) - - # Legend title - text( - x = rasterbox[1], - y = rasterbox[4], - labels = paste0(legend_args[["title"]], " "), - xpd = NA, - adj = c(1, -0.5) - ) -} - # ## Legend Spec Pipeline ----- # -#' Apply margin adjustments for outer legends -#' -#' @description Second stage of pipeline: initializes margins and adjusts -#' them for outer legend placement. -#' -#' @param spec Legend specification object -#' -#' @returns Modified spec with margins populated -#' -#' @keywords internal -legend_spec_apply_margins = function(spec) { - # Get current margins - spec$margins$omar = par("mar") - spec$margins$ooma = par("oma") - spec$margins$lmar = tpar("lmar") - - # Adjust for outer placement - margin_result = adjust_margins_for_outer_legend( - spec$flags$outer_side, - spec$flags$outer_end, - spec$flags$outer_right, - spec$flags$outer_bottom, - spec$margins$omar, - spec$margins$ooma, - spec$meta$has_sub, - spec$meta$topmar_epsilon, - spec$meta$type, - spec$margins$lmar, - spec$meta$new_plot, - spec$meta$dynmar - ) - - spec$margins = modifyList(spec$margins, margin_result) - spec -} - #' Calculate legend layout (inset and rasterbox) #' #' @description Fourth stage of pipeline: calculates inset for positioning @@ -331,7 +212,7 @@ legend_spec_layout = function(spec, draw = TRUE) { } # Calculate and apply soma (outer margin adjustment) - margin_result = calculate_and_apply_soma( + margin_result = legend_outer_margins_apply( spec$dims, spec$flags$outer_side, spec$flags$outer_end, @@ -576,88 +457,6 @@ prepare_legend = function(settings) { } -#' Prepare multi-legend specifications -#' -#' @description Sets up multiple legend specifications for multi-legends -#' (e.g., color grouping + bubble size). Creates `lgby` and `lgbub` objects -#' that will be passed to draw_multi_legend(). -#' -#' @param settings Settings environment from tinyplot -#' -#' @returns NULL (modifies settings environment in-place) -#' -#' @keywords internal -prepare_legend_multi = function(settings) { - env2env( - settings, - environment(), - c( - "legend", - "legend_args", - "by_dep", - "lgnd_labs", - "type", - "pch", - "lty", - "lwd", - "col", - "bg", - "by_continuous", - "lgnd_cex", - "cex_dep", - "bubble_cex", - "cex_fct_adj", - "bubble_alpha", - "bubble_bg_alpha", - "has_sub" - ) - ) - - legend_args = sanitize_legend(legend, legend_args) - - # Legend for grouping variable (by) - lgby = list( - legend_args = modifyList( - legend_args, - list(x.intersp = 1, y.intersp = 1), - keep.null = TRUE - ), - by_dep = by_dep, - lgnd_labs = lgnd_labs, - type = type, - pch = pch, - lty = lty, - lwd = lwd, - col = col, - bg = bg, - gradient = by_continuous, - cex = lgnd_cex, - has_sub = has_sub - ) - - # Legend for bubble sizes - lgbub = list( - legend_args = modifyList( - legend_args, - list(title = cex_dep, ncol = 1), - keep.null = TRUE - ), - lgnd_labs = names(bubble_cex), - type = type, - pch = pch, - lty = lty, - lwd = lwd, - col = adjustcolor(par("col"), alpha.f = bubble_alpha), - bg = adjustcolor(par("col"), alpha.f = bubble_bg_alpha), - cex = bubble_cex * cex_fct_adj, - has_sub = has_sub, - draw = FALSE - ) - - env2env(environment(), settings, c("legend_args", "lgby", "lgbub")) -} - - #' Build legend specification #' #' @description Constructs a complete legend_args list by: @@ -1026,8 +825,27 @@ draw_legend = function( class = "legend_spec" ) - # Run pipeline stages (skip build since build_legend_spec already did that work) - spec = legend_spec_apply_margins(spec) + # Initialize margins + spec$margins$omar = par("mar") + spec$margins$ooma = par("oma") + spec$margins$lmar = tpar("lmar") + + # Adjust margins for outer placement + margin_result = legend_outer_margins_prepare( + spec$flags$outer_side, + spec$flags$outer_end, + spec$flags$outer_right, + spec$flags$outer_bottom, + spec$margins$omar, + spec$margins$ooma, + spec$meta$has_sub, + spec$meta$topmar_epsilon, + spec$meta$type, + spec$margins$lmar, + spec$meta$new_plot, + spec$meta$dynmar + ) + spec$margins = modifyList(spec$margins, margin_result) # Measure dimensions with fake legend spec$dims = measure_fake_legend( @@ -1048,289 +866,4 @@ draw_legend = function( list = list(spec = spec), env = getNamespace("tinyplot") ) -} - - -# -## Gradient Legend Rendering ----- -# - -#' Draw gradient (continuous) legend swatch -#' -#' @description For gradient legends, we draw a custom color swatch using -#' grDevices::as.raster and add labels, tick marks, and title manually. -#' -#' @param legend_args Legend arguments list -#' @param fklgnd Fake legend object (from drawing with plot=FALSE) -#' @param lmar Legend margins -#' @param outer_side Logical flag for outer side placement -#' @param outer_end Logical flag for outer end placement -#' @param outer_right Logical flag for outer right placement -#' @param outer_bottom Logical flag for outer bottom placement -#' @param user_inset Logical flag indicating user-supplied inset -#' -#' @returns NULL (draws gradient legend as side effect) -#' -#' @keywords internal -draw_gradient_swatch = function( - legend_args, - fklgnd, - lmar, - outer_side, - outer_end, - outer_right, - outer_bottom, - user_inset = FALSE -) { - pal = legend_args[["col"]] - lgnd_labs = legend_args[["legend"]] - if (!is.null(legend_args[["horiz"]])) { - horiz = legend_args[["horiz"]] - } else { - horiz = FALSE - } - - # Create raster color swatch - if (isTRUE(horiz)) { - rasterlgd = as.raster(matrix(pal, nrow = 1)) - } else { - rasterlgd = as.raster(matrix(rev(pal), ncol = 1)) - } - - corners = par("usr") - rasterbox = rep(NA_real_, 4) - - # Determine positioning flags - inner = !any(c(outer_side, outer_end)) - inner_right = inner_bottom = FALSE - if (inner) { - if (!is.null(legend_args[["x"]]) && grepl("left$|right$", legend_args[["x"]])) { - inner_right = grepl("right$", legend_args[["x"]]) - } - if (!is.null(legend_args[["x"]]) && grepl("^bottoml|^top", legend_args[["x"]])) { - inner_bottom = grepl("^bottom", legend_args[["x"]]) - } - } - - # Calculate raster box coordinates based on position - if (inner) { - fklgnd$rect$h = fklgnd$rect$h - lines_to_user_y(1.5 + 0.4) - - rasterbox[1] = fklgnd$rect$left - if (isFALSE(inner_right)) { - rasterbox[1] = rasterbox[1] + lines_to_user_x(0.2) - } - rasterbox[2] = fklgnd$rect$top - fklgnd$rect$h - lines_to_user_y(1.5 + 0.2) - rasterbox[3] = rasterbox[1] + lines_to_user_x(1.25) - rasterbox[4] = rasterbox[2] + fklgnd$rect$h - - } else if (outer_side) { - rb1_adj = lines_to_user_x(lmar[1] + 0.2) - rb3_adj = lines_to_user_x(1.25) - rb2_adj = (corners[4] - corners[3] - lines_to_user_y(5 + 1 + 2.5)) / 2 - # Override if top or bottom - if (!is.null(legend_args[["x"]])) { - if (grepl("^bottom", legend_args[["x"]])) { - rb2_adj = corners[3] - } - if (grepl("^top", legend_args[["x"]])) { - rb2_adj = corners[4] - lines_to_user_y(5 + 1 + 2.5) - } - } - if (user_inset) { - rb2_adj = rb2_adj + legend_args[["inset"]][2] + 0.05 - } - rb4_adj = lines_to_user_y(5 + 1) - - if (outer_right) { - rasterbox[1] = corners[2] + rb1_adj - if (user_inset) { - rasterbox[1] = rasterbox[1] - (corners[2] - legend_args[["inset"]][1]) / 2 - } - rasterbox[2] = rb2_adj - rasterbox[3] = rasterbox[1] + rb3_adj - rasterbox[4] = rasterbox[2] + rb4_adj - } else { - rb1_adj = rb1_adj + lines_to_user_x(par("mar")[2] + 1) - rasterbox[1] = corners[1] - rb1_adj - rasterbox[2] = rb2_adj - rasterbox[3] = rasterbox[1] - rb3_adj - rasterbox[4] = rasterbox[2] + rb4_adj - } - - } else if (outer_end) { - rb1_adj = (corners[2] - corners[1] - lines_to_user_x(5 + 1)) / 2 - rb3_adj = lines_to_user_x(5 + 1) - rb2_adj = lines_to_user_y(lmar[1]) - rb4_adj = lines_to_user_y(1.25) - - if (outer_bottom) { - rb2_adj = rb2_adj + lines_to_user_y(par("mar")[2]) - rasterbox[1] = rb1_adj - rasterbox[2] = corners[3] - rb2_adj - rasterbox[3] = rasterbox[1] + rb3_adj - rasterbox[4] = rasterbox[2] - rb4_adj - } else { - rb2_adj = rb2_adj + lines_to_user_y(1.25 + 1) - rasterbox[1] = rb1_adj - rasterbox[2] = corners[4] + rb2_adj - rasterbox[3] = rasterbox[1] + rb3_adj - rasterbox[4] = rasterbox[2] - rb4_adj - } - } - - # Draw the gradient swatch - rasterImage( - rasterlgd, - rasterbox[1], #x1 - rasterbox[2], #y1 - rasterbox[3], #x2 - rasterbox[4], #y2 - xpd = NA - ) - - # Add labels, tick marks, and title - if (isFALSE(horiz)) { - draw_gradient_labels_vertical(rasterbox, lgnd_labs, legend_args, inner, outer_right) - } else { - draw_gradient_labels_horizontal(rasterbox, lgnd_labs, legend_args) - } -} - - -# -## Multi-Legend Rendering ----- -# - -#' Draw multiple legends with automatic positioning -#' -#' @description Handles multiple legends (e.g., color grouping + bubble size) by: -#' 1. Extracting dimensions from fake legends -#' 2. Calculating sub-positioning based on dimensions -#' 3. Drawing legends in ascending order of width (widest last) -#' -#' @md -#' @param legend_list A list of legend arguments, where each element is itself a -#' list of arguments that can be passed on to [draw_legend]. Legends will be -#' drawn vertically (top to bottom) in the order that they are provided. Note -#' that we currently only support 2 legends, i.e. the top-level list has a -#' maximum length of 2. -#' @param position String indicating the base keyword position for the -#' multi-legend. Currently only `"right!"` and `"left!"` are supported. -#' -#' @returns No return value, called for side effect of drawing multiple legends. -#' -#' @seealso [draw_legend] -#' -#' @keywords internal -#' -#' @examples -#' \dontrun{ -#' oldmar = par("mar") -#' -#' # Multi-legend example (color + bubble) -#' -#' l1 = list( -#' lgnd_labs = c("Red", "Blue", "Green"), -#' legend_args = list(title = "Colors"), -#' pch = 16, -#' col = c("red", "blue", "green"), -#' type = "p" -#' ) -#' -#' l2 = list( -#' lgnd_labs = c("Tiny", "Small", "Medium", "Large", "Huge"), -#' legend_args = list(title = "Size"), -#' pch = 16, -#' col = "black", -#' cex = seq(0.5, 2.5, length.out = 5), -#' type = "p" -#' ) -#' -#' # Draw together -#' draw_multi_legend(list(l1, l2), position = "right!") -#' -#' par(mar = oldmar) -#' } -#' -#' @keywords internal -draw_multi_legend = function( - legend_list, - position = "right!" -) { - - # Validate inputs - if (!is.list(legend_list) || length(legend_list) != 2) { - stop("Currently only 2 legends are supported in multi-legend mode") - } - - # Currently only support right!/left! positioning - if (!grepl("right!$|left!$", position)) { - warning( - '\nMulti-legends currently only work with "right!" or "left!" keyword positioning.\n', - 'Reverting to "right!" default\n' - ) - position = "right!" - } - - # Determine sub-positions based on main position - if (grepl("right!$", position)) { - sub_positions = c("bottomright!", "topright!") - } else if (grepl("left!$", position)) { - sub_positions = c("bottomleft!", "topleft!") - } - - # Assign positions of individual legends - for (ll in seq_along(legend_list)) { - legend_list[[ll]][["legend"]] = sub_positions[ll] - legend_list[[ll]][["legend_args"]][["x"]] = NULL - } - - # - ## Step 1: Extract legend dimensions (by drawing fake legends) - # - - legend_dims = vector("list", length(legend_list)) - for (ll in seq_along(legend_list)) { - legend_ll = legend_list[[ll]] - legend_ll$new_plot = ll == 1 # Only draw new plot for first legend - legend_ll$draw = FALSE - legend_dims[[ll]] = do.call(draw_legend, legend_ll) - } - - # - ## Step 2: Calculate sub-positioning based on dimensions - # - - # Extract dimensions - lwidths = sapply(legend_dims, function(x) x$rect$w) - lheights = sapply(legend_dims, function(x) x$rect$h) - # For inset adjustment, default to 0.5 unless one or more of the two legends - # is bigger than half the plot height. - linset = if (any(lheights > 0.5)) lheights[2] / sum(lheights) else 0.5 - - # - ## Step 3: Reposition (via adjusted inset arg) and draw legends - # - - # Note: we draw the legends in ascending order of width (i.e., widest legend - # last) in order to correctly set the overall plot dimensions. - width_order = order(lwidths) - - # Quick idx for original order (needed for vertical legend placement) - for (i in seq_along(legend_list)) legend_list[[i]]$idx = i - - for (o in seq_along(width_order)) { - io = width_order[o] - legend_o = legend_list[[io]] - legend_o$new_plot = FALSE - legend_o$draw = TRUE - legend_o$legend_args$inset = c(0, 0) - legend_o$legend_args$inset[1] = if (o == 1) -abs(diff(lwidths)) / 2 else 0 - legend_o$legend_args$inset[2] = if (legend_o$idx == 1) linset + 0.01 else 1 - linset + 0.01 - legend_o$idx = NULL - do.call(draw_legend, legend_o) - } - - invisible(NULL) -} +} \ No newline at end of file diff --git a/R/legend_gradient.R b/R/legend_gradient.R new file mode 100644 index 00000000..a921f758 --- /dev/null +++ b/R/legend_gradient.R @@ -0,0 +1,229 @@ +# Draw vertical gradient legend labels, ticks, and title +draw_gradient_labels_vertical = function(rasterbox, lgnd_labs, legend_args, inner, outer_right) { + labs_idx = !is.na(lgnd_labs) + lgnd_labs[labs_idx] = paste0(" ", format(lgnd_labs[labs_idx])) + + # Determine anchors based on position + if (!inner && !outer_right) { + lbl_x_anchor = rasterbox[1] + ttl_x_anchor = rasterbox[1] + max(strwidth(lgnd_labs[labs_idx])) + lbl_adj = c(0, 0.5) + ttl_adj = c(1, 0) + } else { + lbl_x_anchor = rasterbox[3] + ttl_x_anchor = rasterbox[1] + lbl_adj = c(0, 0.5) + ttl_adj = c(0, 0) + } + + # Draw labels + text( + x = lbl_x_anchor, + y = seq(rasterbox[2], rasterbox[4], length.out = length(lgnd_labs)), + labels = lgnd_labs, + xpd = NA, + adj = lbl_adj + ) + + # Draw tick marks (white dashes) + lgnd_ticks = lgnd_labs + lgnd_ticks[labs_idx] = "- -" + text( + x = lbl_x_anchor, + y = seq(rasterbox[2], rasterbox[4], length.out = length(lgnd_labs)), + labels = lgnd_ticks, + col = "white", + xpd = NA, + adj = c(1, 0.5) + ) + + # Draw title + text( + x = ttl_x_anchor, + y = rasterbox[4] + lines_to_user_y(1), + labels = legend_args[["title"]], + xpd = NA, + adj = ttl_adj + ) +} + +# Draw horizontal gradient legend labels, ticks, and title +draw_gradient_labels_horizontal = function(rasterbox, lgnd_labs, legend_args) { + # Legend labels + text( + x = seq(rasterbox[1], rasterbox[3], length.out = length(lgnd_labs)), + y = rasterbox[4], + labels = lgnd_labs, + xpd = NA, + adj = c(0.5, 1.25) + ) + + # Legend tick marks (white dashes) + lgnd_ticks = lgnd_labs + lgnd_ticks[!is.na(lgnd_ticks)] = "- -" + text( + x = seq(rasterbox[1], rasterbox[3], length.out = length(lgnd_labs)), + y = rasterbox[4], + labels = lgnd_ticks, + col = "white", + xpd = NA, + adj = c(0, 0.5), + srt = 90 + ) + + # Legend title + text( + x = rasterbox[1], + y = rasterbox[4], + labels = paste0(legend_args[["title"]], " "), + xpd = NA, + adj = c(1, -0.5) + ) +} + + +# +## Gradient Legend Rendering ----- +# + +#' Draw gradient (continuous) legend swatch +#' +#' @description For gradient legends, we draw a custom color swatch using +#' grDevices::as.raster and add labels, tick marks, and title manually. +#' +#' @param legend_args Legend arguments list +#' @param fklgnd Fake legend object (from drawing with plot=FALSE) +#' @param lmar Legend margins +#' @param outer_side Logical flag for outer side placement +#' @param outer_end Logical flag for outer end placement +#' @param outer_right Logical flag for outer right placement +#' @param outer_bottom Logical flag for outer bottom placement +#' @param user_inset Logical flag indicating user-supplied inset +#' +#' @returns NULL (draws gradient legend as side effect) +#' +#' @keywords internal +draw_gradient_swatch = function( + legend_args, + fklgnd, + lmar, + outer_side, + outer_end, + outer_right, + outer_bottom, + user_inset = FALSE +) { + pal = legend_args[["col"]] + lgnd_labs = legend_args[["legend"]] + if (!is.null(legend_args[["horiz"]])) { + horiz = legend_args[["horiz"]] + } else { + horiz = FALSE + } + + # Create raster color swatch + if (isTRUE(horiz)) { + rasterlgd = as.raster(matrix(pal, nrow = 1)) + } else { + rasterlgd = as.raster(matrix(rev(pal), ncol = 1)) + } + + corners = par("usr") + rasterbox = rep(NA_real_, 4) + + # Determine positioning flags + inner = !any(c(outer_side, outer_end)) + inner_right = inner_bottom = FALSE + if (inner) { + if (!is.null(legend_args[["x"]]) && grepl("left$|right$", legend_args[["x"]])) { + inner_right = grepl("right$", legend_args[["x"]]) + } + if (!is.null(legend_args[["x"]]) && grepl("^bottoml|^top", legend_args[["x"]])) { + inner_bottom = grepl("^bottom", legend_args[["x"]]) + } + } + + # Calculate raster box coordinates based on position + if (inner) { + fklgnd$rect$h = fklgnd$rect$h - lines_to_user_y(1.5 + 0.4) + + rasterbox[1] = fklgnd$rect$left + if (isFALSE(inner_right)) { + rasterbox[1] = rasterbox[1] + lines_to_user_x(0.2) + } + rasterbox[2] = fklgnd$rect$top - fklgnd$rect$h - lines_to_user_y(1.5 + 0.2) + rasterbox[3] = rasterbox[1] + lines_to_user_x(1.25) + rasterbox[4] = rasterbox[2] + fklgnd$rect$h + + } else if (outer_side) { + rb1_adj = lines_to_user_x(lmar[1] + 0.2) + rb3_adj = lines_to_user_x(1.25) + rb2_adj = (corners[4] - corners[3] - lines_to_user_y(5 + 1 + 2.5)) / 2 + # Override if top or bottom + if (!is.null(legend_args[["x"]])) { + if (grepl("^bottom", legend_args[["x"]])) { + rb2_adj = corners[3] + } + if (grepl("^top", legend_args[["x"]])) { + rb2_adj = corners[4] - lines_to_user_y(5 + 1 + 2.5) + } + } + if (user_inset) { + rb2_adj = rb2_adj + legend_args[["inset"]][2] + 0.05 + } + rb4_adj = lines_to_user_y(5 + 1) + + if (outer_right) { + rasterbox[1] = corners[2] + rb1_adj + if (user_inset) { + rasterbox[1] = rasterbox[1] - (corners[2] - legend_args[["inset"]][1]) / 2 + } + rasterbox[2] = rb2_adj + rasterbox[3] = rasterbox[1] + rb3_adj + rasterbox[4] = rasterbox[2] + rb4_adj + } else { + rb1_adj = rb1_adj + lines_to_user_x(par("mar")[2] + 1) + rasterbox[1] = corners[1] - rb1_adj + rasterbox[2] = rb2_adj + rasterbox[3] = rasterbox[1] - rb3_adj + rasterbox[4] = rasterbox[2] + rb4_adj + } + + } else if (outer_end) { + rb1_adj = (corners[2] - corners[1] - lines_to_user_x(5 + 1)) / 2 + rb3_adj = lines_to_user_x(5 + 1) + rb2_adj = lines_to_user_y(lmar[1]) + rb4_adj = lines_to_user_y(1.25) + + if (outer_bottom) { + rb2_adj = rb2_adj + lines_to_user_y(par("mar")[2]) + rasterbox[1] = rb1_adj + rasterbox[2] = corners[3] - rb2_adj + rasterbox[3] = rasterbox[1] + rb3_adj + rasterbox[4] = rasterbox[2] - rb4_adj + } else { + rb2_adj = rb2_adj + lines_to_user_y(1.25 + 1) + rasterbox[1] = rb1_adj + rasterbox[2] = corners[4] + rb2_adj + rasterbox[3] = rasterbox[1] + rb3_adj + rasterbox[4] = rasterbox[2] - rb4_adj + } + } + + # Draw the gradient swatch + rasterImage( + rasterlgd, + rasterbox[1], #x1 + rasterbox[2], #y1 + rasterbox[3], #x2 + rasterbox[4], #y2 + xpd = NA + ) + + # Add labels, tick marks, and title + if (isFALSE(horiz)) { + draw_gradient_labels_vertical(rasterbox, lgnd_labs, legend_args, inner, outer_right) + } else { + draw_gradient_labels_horizontal(rasterbox, lgnd_labs, legend_args) + } +} diff --git a/R/legend_multi.R b/R/legend_multi.R new file mode 100644 index 00000000..8b1596e6 --- /dev/null +++ b/R/legend_multi.R @@ -0,0 +1,218 @@ +#' Prepare multi-legend specifications +#' +#' @description Sets up multiple legend specifications for multi-legends +#' (e.g., color grouping + bubble size). Creates `lgby` and `lgbub` objects +#' that will be passed to draw_multi_legend(). +#' +#' @param settings Settings environment from tinyplot +#' +#' @returns NULL (modifies settings environment in-place) +#' +#' @keywords internal +prepare_legend_multi = function(settings) { + env2env( + settings, + environment(), + c( + "legend", + "legend_args", + "by_dep", + "lgnd_labs", + "type", + "pch", + "lty", + "lwd", + "col", + "bg", + "by_continuous", + "lgnd_cex", + "cex_dep", + "bubble_cex", + "cex_fct_adj", + "bubble_alpha", + "bubble_bg_alpha", + "has_sub" + ) + ) + + legend_args = sanitize_legend(legend, legend_args) + + # Legend for grouping variable (by) + lgby = list( + legend_args = modifyList( + legend_args, + list(x.intersp = 1, y.intersp = 1), + keep.null = TRUE + ), + by_dep = by_dep, + lgnd_labs = lgnd_labs, + type = type, + pch = pch, + lty = lty, + lwd = lwd, + col = col, + bg = bg, + gradient = by_continuous, + cex = lgnd_cex, + has_sub = has_sub + ) + + # Legend for bubble sizes + lgbub = list( + legend_args = modifyList( + legend_args, + list(title = cex_dep, ncol = 1), + keep.null = TRUE + ), + lgnd_labs = names(bubble_cex), + type = type, + pch = pch, + lty = lty, + lwd = lwd, + col = adjustcolor(par("col"), alpha.f = bubble_alpha), + bg = adjustcolor(par("col"), alpha.f = bubble_bg_alpha), + cex = bubble_cex * cex_fct_adj, + has_sub = has_sub, + draw = FALSE + ) + + env2env(environment(), settings, c("legend_args", "lgby", "lgbub")) +} + + +# +## Multi-Legend Rendering ----- +# + +#' Draw multiple legends with automatic positioning +#' +#' @description Handles multiple legends (e.g., color grouping + bubble size) by: +#' 1. Extracting dimensions from fake legends +#' 2. Calculating sub-positioning based on dimensions +#' 3. Drawing legends in ascending order of width (widest last) +#' +#' @md +#' @param legend_list A list of legend arguments, where each element is itself a +#' list of arguments that can be passed on to [draw_legend]. Legends will be +#' drawn vertically (top to bottom) in the order that they are provided. Note +#' that we currently only support 2 legends, i.e. the top-level list has a +#' maximum length of 2. +#' @param position String indicating the base keyword position for the +#' multi-legend. Currently only `"right!"` and `"left!"` are supported. +#' +#' @returns No return value, called for side effect of drawing multiple legends. +#' +#' @seealso [draw_legend] +#' +#' @keywords internal +#' +#' @examples +#' \dontrun{ +#' oldmar = par("mar") +#' +#' # Multi-legend example (color + bubble) +#' +#' l1 = list( +#' lgnd_labs = c("Red", "Blue", "Green"), +#' legend_args = list(title = "Colors"), +#' pch = 16, +#' col = c("red", "blue", "green"), +#' type = "p" +#' ) +#' +#' l2 = list( +#' lgnd_labs = c("Tiny", "Small", "Medium", "Large", "Huge"), +#' legend_args = list(title = "Size"), +#' pch = 16, +#' col = "black", +#' cex = seq(0.5, 2.5, length.out = 5), +#' type = "p" +#' ) +#' +#' # Draw together +#' draw_multi_legend(list(l1, l2), position = "right!") +#' +#' par(mar = oldmar) +#' } +#' +#' @keywords internal +draw_multi_legend = function( + legend_list, + position = "right!" +) { + + # Validate inputs + if (!is.list(legend_list) || length(legend_list) != 2) { + stop("Currently only 2 legends are supported in multi-legend mode") + } + + # Currently only support right!/left! positioning + if (!grepl("right!$|left!$", position)) { + warning( + '\nMulti-legends currently only work with "right!" or "left!" keyword positioning.\n', + 'Reverting to "right!" default\n' + ) + position = "right!" + } + + # Determine sub-positions based on main position + if (grepl("right!$", position)) { + sub_positions = c("bottomright!", "topright!") + } else if (grepl("left!$", position)) { + sub_positions = c("bottomleft!", "topleft!") + } + + # Assign positions of individual legends + for (ll in seq_along(legend_list)) { + legend_list[[ll]][["legend"]] = sub_positions[ll] + legend_list[[ll]][["legend_args"]][["x"]] = NULL + } + + # + ## Step 1: Extract legend dimensions (by drawing fake legends) + # + + legend_dims = vector("list", length(legend_list)) + for (ll in seq_along(legend_list)) { + legend_ll = legend_list[[ll]] + legend_ll$new_plot = ll == 1 # Only draw new plot for first legend + legend_ll$draw = FALSE + legend_dims[[ll]] = do.call(draw_legend, legend_ll) + } + + # + ## Step 2: Calculate sub-positioning based on dimensions + # + + # Extract dimensions + lwidths = sapply(legend_dims, function(x) x$rect$w) + lheights = sapply(legend_dims, function(x) x$rect$h) + # For inset adjustment, default to 0.5 unless one or more of the two legends + # is bigger than half the plot height. + linset = if (any(lheights > 0.5)) lheights[2] / sum(lheights) else 0.5 + + # + ## Step 3: Reposition (via adjusted inset arg) and draw legends + # + + # Note: we draw the legends in ascending order of width (i.e., widest legend + # last) in order to correctly set the overall plot dimensions. + width_order = order(lwidths) + + # Quick idx for original order (needed for vertical legend placement) + for (i in seq_along(legend_list)) legend_list[[i]]$idx = i + + for (o in seq_along(width_order)) { + io = width_order[o] + legend_o = legend_list[[io]] + legend_o$new_plot = FALSE + legend_o$draw = TRUE + legend_o$legend_args$inset = c(0, 0) + legend_o$legend_args$inset[1] = if (o == 1) -abs(diff(lwidths)) / 2 else 0 + legend_o$legend_args$inset[2] = if (legend_o$idx == 1) linset + 0.01 else 1 - linset + 0.01 + legend_o$idx = NULL + do.call(draw_legend, legend_o) + } + + invisible(NULL) +} diff --git a/man/draw_gradient_swatch.Rd b/man/draw_gradient_swatch.Rd index e5dc8bc3..838c060a 100644 --- a/man/draw_gradient_swatch.Rd +++ b/man/draw_gradient_swatch.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/legend.R +% Please edit documentation in R/legend_gradient.R \name{draw_gradient_swatch} \alias{draw_gradient_swatch} \title{Draw gradient (continuous) legend swatch} diff --git a/man/draw_multi_legend.Rd b/man/draw_multi_legend.Rd index 16b8eb99..3c4581b9 100644 --- a/man/draw_multi_legend.Rd +++ b/man/draw_multi_legend.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/legend.R +% Please edit documentation in R/legend_multi.R \name{draw_multi_legend} \alias{draw_multi_legend} \title{Draw multiple legends with automatic positioning} diff --git a/man/prepare_legend_multi.Rd b/man/prepare_legend_multi.Rd index a2c1e6e2..d578d500 100644 --- a/man/prepare_legend_multi.Rd +++ b/man/prepare_legend_multi.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/legend.R +% Please edit documentation in R/legend_multi.R \name{prepare_legend_multi} \alias{prepare_legend_multi} \title{Prepare multi-legend specifications} From 13e1a3624aaeb2ee26c43dcc4dd87197027069b3 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 14:06:33 -0500 Subject: [PATCH 08/14] minor --- R/legend.R | 269 +++++++++++++++++++---------------------------------- 1 file changed, 94 insertions(+), 175 deletions(-) diff --git a/R/legend.R b/R/legend.R index 5405964d..592edd68 100644 --- a/R/legend.R +++ b/R/legend.R @@ -1,15 +1,3 @@ -# LEGEND SYSTEM -# -# This file consolidates all legend-related functionality for tinyplot. -# Previously spread across 5 files, now organized into logical sections: -# -# 1. Input Sanitization -# 2. Legend Context & Preparation -# 3. Single Legend Rendering -# 4. Gradient Legend Rendering -# 5. Multi-Legend Rendering - - # ## Helper Functions ----- # @@ -28,17 +16,19 @@ lines_to_user_y = function(val) { } # Adjust margins for outer legend placement -legend_outer_margins_prepare = function(outer_side, outer_end, outer_right, - outer_bottom, omar, ooma, has_sub, - topmar_epsilon, type, lmar, new_plot, dynmar) { - if (outer_side) { +legend_outer_margins_prepare = function(spec) { + omar = spec$margins$omar + ooma = spec$margins$ooma + lmar = spec$margins$lmar + + if (spec$flags$outer_side) { # Extra bump for spineplot if outer_right legend (to accommodate secondary y-axis) - if (identical(type, "spineplot")) { + if (identical(spec$meta$type, "spineplot")) { lmar[1] = lmar[1] + 1.1 } # Set inner margins before fake legend is drawn - if (outer_right) { + if (spec$flags$outer_right) { omar[4] = 0 } else { # For outer left we have to account for the y-axis label too @@ -46,12 +36,12 @@ legend_outer_margins_prepare = function(outer_side, outer_end, outer_right, } par(mar = omar) - if (new_plot) { + if (spec$meta$new_plot) { plot.new() # For themed + dynamic plots, reinstate adjusted plot margins - if (dynmar) { + if (spec$meta$dynmar) { omar = par("mar") - if (outer_right) { + if (spec$flags$outer_right) { omar[4] = 0 } else { omar[2] = par("mgp")[1] + 1 * par("cex.lab") @@ -60,66 +50,65 @@ legend_outer_margins_prepare = function(outer_side, outer_end, outer_right, } } - } else if (outer_end) { + } else if (spec$flags$outer_end) { # Set inner margins before fake legend is drawn - if (outer_bottom) { + if (spec$flags$outer_bottom) { omar[1] = par("mgp")[1] + 1 * par("cex.lab") - if (has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { + if (spec$meta$has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { omar[1] = omar[1] + 1 * par("cex.sub") } } else { # For "top!", expand existing inner margin rather than outer margin - ooma[3] = ooma[3] + topmar_epsilon + ooma[3] = ooma[3] + spec$meta$topmar_epsilon par(oma = ooma) } par(mar = omar) - if (new_plot) { + if (spec$meta$new_plot) { plot.new() # For themed + dynamic plots, reinstate adjusted plot margins - if (dynmar) { + if (spec$meta$dynmar) { omar = par("mar") - if (outer_bottom) { + if (spec$flags$outer_bottom) { omar[1] = theme_clean$mgp[1] + 1 * par("cex.lab") - if (has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { + if (spec$meta$has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { omar[1] = omar[1] + 1 * par("cex.sub") } } else { - ooma[3] = ooma[3] + topmar_epsilon + ooma[3] = ooma[3] + spec$meta$topmar_epsilon par(oma = ooma) } par(mar = omar) } } } else { - if (new_plot) plot.new() + if (spec$meta$new_plot) plot.new() } list(omar = omar, ooma = ooma, lmar = lmar) } # Calculate legend inset for outer placement -calculate_legend_inset = function(outer_side, outer_end, outer_right, outer_bottom, - lmar, omar, topmar_epsilon) { - if (outer_side) { - inset_val = lines_to_npc(lmar[1]) +measure_legend_inset = function(spec) { + if (spec$flags$outer_side) { + inset_val = lines_to_npc(spec$margins$lmar[1]) # Extra space needed for "left!" because of lhs inner margin - if (!outer_right) { + if (!spec$flags$outer_right) { inset_val = inset_val + lines_to_npc(par("mar")[2]) } c(1 + inset_val, 0) - } else if (outer_end) { + } else if (spec$flags$outer_end) { # Note: Y-direction uses grconvertY (not lines_to_npc which is X-only) - inset_val = grconvertY(lmar[1], from = "lines", to = "npc") - + inset_val = grconvertY(spec$margins$lmar[1], from = "lines", to = "npc") - grconvertY(0, from = "lines", to = "npc") - if (outer_bottom) { + if (spec$flags$outer_bottom) { # Extra space needed for "bottom!" because of lhs inner margin inset_bump = grconvertY(par("mar")[1], from = "lines", to = "npc") - grconvertY(0, from = "lines", to = "npc") inset_val = inset_val + inset_bump } else { - epsilon_bump = grconvertY(topmar_epsilon, from = "lines", to = "npc") - + epsilon_bump = grconvertY(spec$meta$topmar_epsilon, from = "lines", to = "npc") - grconvertY(0, from = "lines", to = "npc") inset_val = inset_val + epsilon_bump } @@ -131,14 +120,14 @@ calculate_legend_inset = function(outer_side, outer_end, outer_right, outer_bott } # Measure legend dimensions using a fake (non-plotted) legend -measure_fake_legend = function(legend_args, gradient, outer_end) { +measure_fake_legend = function(spec) { fklgnd.args = modifyList( - legend_args, + spec$args, list(plot = FALSE), keep.null = TRUE ) - if (gradient) { + if (spec$flags$gradient) { lgnd_labs_tmp = na.omit(fklgnd.args[["legend"]]) if (length(lgnd_labs_tmp) < 5L) { nmore = 5L - length(lgnd_labs_tmp) @@ -149,7 +138,7 @@ measure_fake_legend = function(legend_args, gradient, outer_end) { list(legend = lgnd_labs_tmp), keep.null = TRUE ) - if (outer_end) { + if (spec$flags$outer_end) { fklgnd.args = modifyList( fklgnd.args, list(title = NULL), @@ -162,26 +151,28 @@ measure_fake_legend = function(legend_args, gradient, outer_end) { } # Calculate and apply soma (outer margin size) based on legend dimensions -legend_outer_margins_apply = function(fklgnd, outer_side, outer_end, outer_right, - outer_bottom, lmar, ooma, omar, topmar_epsilon) { +legend_outer_margins_apply = function(spec) { # Calculate size - soma = if (outer_side) { - grconvertX(fklgnd$rect$w, to = "lines") - grconvertX(0, to = "lines") - } else if (outer_end) { - grconvertY(fklgnd$rect$h, to = "lines") - grconvertY(0, to = "lines") + soma = if (spec$flags$outer_side) { + grconvertX(spec$dims$rect$w, to = "lines") - grconvertX(0, to = "lines") + } else if (spec$flags$outer_end) { + grconvertY(spec$dims$rect$h, to = "lines") - grconvertY(0, to = "lines") } else { 0 } - soma = soma + sum(lmar) + soma = soma + sum(spec$margins$lmar) # Apply to appropriate margin - if (outer_side) { - ooma[if (outer_right) 4 else 2] = soma - } else if (outer_end) { - if (outer_bottom) { + ooma = spec$margins$ooma + omar = spec$margins$omar + + if (spec$flags$outer_side) { + ooma[if (spec$flags$outer_right) 4 else 2] = soma + } else if (spec$flags$outer_end) { + if (spec$flags$outer_bottom) { ooma[1] = soma } else { - omar[3] = omar[3] + soma - topmar_epsilon + omar[3] = omar[3] + soma - spec$meta$topmar_epsilon par(mar = omar) } } @@ -191,103 +182,6 @@ legend_outer_margins_apply = function(fklgnd, outer_side, outer_end, outer_right } -# -## Legend Spec Pipeline ----- -# - -#' Calculate legend layout (inset and rasterbox) -#' -#' @description Fourth stage of pipeline: calculates inset for positioning -#' and rasterbox coordinates for gradient legends. -#' -#' @param spec Legend specification object -#' @param draw Logical indicating if this is for actual drawing (vs measurement) -#' -#' @returns Modified spec with layout populated -#' -#' @keywords internal -legend_spec_layout = function(spec, draw = TRUE) { - if (!draw) { - return(spec) - } - - # Calculate and apply soma (outer margin adjustment) - margin_result = legend_outer_margins_apply( - spec$dims, - spec$flags$outer_side, - spec$flags$outer_end, - spec$flags$outer_right, - spec$flags$outer_bottom, - spec$margins$lmar, - spec$margins$ooma, - spec$margins$omar, - spec$meta$topmar_epsilon - ) - spec$margins$ooma = margin_result$ooma - spec$margins$omar = margin_result$omar - - # Calculate inset - spec$layout$inset = calculate_legend_inset( - spec$flags$outer_side, - spec$flags$outer_end, - spec$flags$outer_right, - spec$flags$outer_bottom, - spec$margins$lmar, - spec$margins$omar, - spec$meta$topmar_epsilon - ) - - # Refresh plot area for exact inset spacing - oldhook = getHook("before.plot.new") - setHook("before.plot.new", function() par(new = TRUE), action = "append") - setHook("before.plot.new", function() par(mar = spec$margins$omar), action = "append") - plot.new() - setHook("before.plot.new", oldhook, action = "replace") - - # Set the inset in args - spec$args[["inset"]] = if (spec$flags$user_inset) { - spec$args[["inset"]] + spec$layout$inset - } else { - spec$layout$inset - } - - spec -} - -#' Draw legend from specification -#' -#' @description Final stage of pipeline: draws the actual legend. -#' -#' @param spec Legend specification object -#' -#' @returns NULL (called for side effect of drawing legend) -#' -#' @keywords internal -legend_spec_draw = function(spec) { - if (spec$flags$gradient) { - # Ensure col is set correctly for gradients - if (!more_than_n_unique(spec$args[["col"]], 1)) { - if (!is.null(spec$args[["pt.bg"]]) && length(spec$args[["pt.bg"]]) == 100) { - spec$args[["col"]] = spec$args[["pt.bg"]] - } - } - - draw_gradient_swatch( - legend_args = spec$args, - fklgnd = spec$dims, - lmar = spec$margins$lmar, - outer_side = spec$flags$outer_side, - outer_end = spec$flags$outer_end, - outer_right = spec$flags$outer_right, - outer_bottom = spec$flags$outer_bottom, - user_inset = spec$flags$user_inset - ) - } else { - do.call("legend", spec$args) - } -} - - # ## Input Sanitization ----- # @@ -831,39 +725,64 @@ draw_legend = function( spec$margins$lmar = tpar("lmar") # Adjust margins for outer placement - margin_result = legend_outer_margins_prepare( - spec$flags$outer_side, - spec$flags$outer_end, - spec$flags$outer_right, - spec$flags$outer_bottom, - spec$margins$omar, - spec$margins$ooma, - spec$meta$has_sub, - spec$meta$topmar_epsilon, - spec$meta$type, - spec$margins$lmar, - spec$meta$new_plot, - spec$meta$dynmar - ) + margin_result = legend_outer_margins_prepare(spec) spec$margins = modifyList(spec$margins, margin_result) # Measure dimensions with fake legend - spec$dims = measure_fake_legend( - spec$args, - spec$flags$gradient, - spec$flags$outer_end - ) + spec$dims = measure_fake_legend(spec) if (!draw) { return(spec$dims) } - spec = legend_spec_layout(spec, draw = draw) + # Calculate and apply soma (outer margin adjustment) + margin_result = legend_outer_margins_apply(spec) + spec$margins$ooma = margin_result$ooma + spec$margins$omar = margin_result$omar + + # Calculate inset + spec$layout$inset = measure_legend_inset(spec) + + # Refresh plot area for exact inset spacing + oldhook = getHook("before.plot.new") + setHook("before.plot.new", function() par(new = TRUE), action = "append") + setHook("before.plot.new", function() par(mar = spec$margins$omar), action = "append") + plot.new() + setHook("before.plot.new", oldhook, action = "replace") + + # Set the inset in args + spec$args[["inset"]] = if (spec$flags$user_inset) { + spec$args[["inset"]] + spec$layout$inset + } else { + spec$layout$inset + } # Draw wrapped in recordGraphics() to preserve spacing if plot is resized recordGraphics( - legend_spec_draw(spec), + { + if (spec$flags$gradient) { + # Ensure col is set correctly for gradients + if (!more_than_n_unique(spec$args[["col"]], 1)) { + if (!is.null(spec$args[["pt.bg"]]) && length(spec$args[["pt.bg"]]) == 100) { + spec$args[["col"]] = spec$args[["pt.bg"]] + } + } + + draw_gradient_swatch( + legend_args = spec$args, + fklgnd = spec$dims, + lmar = spec$margins$lmar, + outer_side = spec$flags$outer_side, + outer_end = spec$flags$outer_end, + outer_right = spec$flags$outer_right, + outer_bottom = spec$flags$outer_bottom, + user_inset = spec$flags$user_inset + ) + } else { + do.call("legend", spec$args) + } + }, list = list(spec = spec), env = getNamespace("tinyplot") ) -} \ No newline at end of file +} From baefdfea4d335a120fc8633bab0359015e852d00 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 15:32:50 -0500 Subject: [PATCH 09/14] reorg legend --- R/legend.R | 253 ++++++++++++++----------------- man/build_legend_spec.Rd | 1 + man/legend_spec_apply_margins.Rd | 19 --- man/legend_spec_draw.Rd | 18 --- man/legend_spec_layout.Rd | 21 --- 5 files changed, 115 insertions(+), 197 deletions(-) delete mode 100644 man/legend_spec_apply_margins.Rd delete mode 100644 man/legend_spec_draw.Rd delete mode 100644 man/legend_spec_layout.Rd diff --git a/R/legend.R b/R/legend.R index 592edd68..efe9a2df 100644 --- a/R/legend.R +++ b/R/legend.R @@ -15,20 +15,21 @@ lines_to_user_y = function(val) { grconvertY(val, from = "lines", to = "user") - grconvertY(0, from = "lines", to = "user") } -# Adjust margins for outer legend placement -legend_outer_margins_prepare = function(spec) { - omar = spec$margins$omar - ooma = spec$margins$ooma - lmar = spec$margins$lmar - - if (spec$flags$outer_side) { +# Adjust margins for outer legend placement, measure, and apply soma +legend_outer_margins = function(spec, apply = TRUE) { + omar = spec$omar + ooma = spec$ooma + lmar = spec$lmar + + # Step 1: Prepare margins before measuring + if (spec$outer_side) { # Extra bump for spineplot if outer_right legend (to accommodate secondary y-axis) - if (identical(spec$meta$type, "spineplot")) { + if (identical(spec$type, "spineplot")) { lmar[1] = lmar[1] + 1.1 } # Set inner margins before fake legend is drawn - if (spec$flags$outer_right) { + if (spec$outer_right) { omar[4] = 0 } else { # For outer left we have to account for the y-axis label too @@ -36,12 +37,12 @@ legend_outer_margins_prepare = function(spec) { } par(mar = omar) - if (spec$meta$new_plot) { + if (spec$new_plot) { plot.new() # For themed + dynamic plots, reinstate adjusted plot margins - if (spec$meta$dynmar) { + if (spec$dynmar) { omar = par("mar") - if (spec$flags$outer_right) { + if (spec$outer_right) { omar[4] = 0 } else { omar[2] = par("mgp")[1] + 1 * par("cex.lab") @@ -50,65 +51,95 @@ legend_outer_margins_prepare = function(spec) { } } - } else if (spec$flags$outer_end) { + } else if (spec$outer_end) { # Set inner margins before fake legend is drawn - if (spec$flags$outer_bottom) { + if (spec$outer_bottom) { omar[1] = par("mgp")[1] + 1 * par("cex.lab") - if (spec$meta$has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { + if (spec$has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { omar[1] = omar[1] + 1 * par("cex.sub") } } else { # For "top!", expand existing inner margin rather than outer margin - ooma[3] = ooma[3] + spec$meta$topmar_epsilon + ooma[3] = ooma[3] + spec$topmar_epsilon par(oma = ooma) } par(mar = omar) - if (spec$meta$new_plot) { + if (spec$new_plot) { plot.new() # For themed + dynamic plots, reinstate adjusted plot margins - if (spec$meta$dynmar) { + if (spec$dynmar) { omar = par("mar") - if (spec$flags$outer_bottom) { + if (spec$outer_bottom) { omar[1] = theme_clean$mgp[1] + 1 * par("cex.lab") - if (spec$meta$has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { + if (spec$has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { omar[1] = omar[1] + 1 * par("cex.sub") } } else { - ooma[3] = ooma[3] + spec$meta$topmar_epsilon + ooma[3] = ooma[3] + spec$topmar_epsilon par(oma = ooma) } par(mar = omar) } } } else { - if (spec$meta$new_plot) plot.new() + if (spec$new_plot) plot.new() } - list(omar = omar, ooma = ooma, lmar = lmar) + # Update spec with prepared margins + spec$omar = omar + spec$ooma = ooma + spec$lmar = lmar + + # Step 2: Measure legend dimensions + spec$dims = measure_fake_legend(spec) + + # Step 3: Apply soma if drawing + if (apply) { + soma = if (spec$outer_side) { + grconvertX(spec$dims$rect$w, to = "lines") - grconvertX(0, to = "lines") + } else if (spec$outer_end) { + grconvertY(spec$dims$rect$h, to = "lines") - grconvertY(0, to = "lines") + } else { + 0 + } + soma = soma + sum(spec$lmar) + + if (spec$outer_side) { + spec$ooma[if (spec$outer_right) 4 else 2] = soma + } else if (spec$outer_end) { + if (spec$outer_bottom) { + spec$ooma[1] = soma + } else { + spec$omar[3] = spec$omar[3] + soma - spec$topmar_epsilon + par(mar = spec$omar) + } + } + par(oma = spec$ooma) + } } # Calculate legend inset for outer placement measure_legend_inset = function(spec) { - if (spec$flags$outer_side) { - inset_val = lines_to_npc(spec$margins$lmar[1]) + if (spec$outer_side) { + inset_val = lines_to_npc(spec$lmar[1]) # Extra space needed for "left!" because of lhs inner margin - if (!spec$flags$outer_right) { + if (!spec$outer_right) { inset_val = inset_val + lines_to_npc(par("mar")[2]) } c(1 + inset_val, 0) - } else if (spec$flags$outer_end) { + } else if (spec$outer_end) { # Note: Y-direction uses grconvertY (not lines_to_npc which is X-only) - inset_val = grconvertY(spec$margins$lmar[1], from = "lines", to = "npc") - + inset_val = grconvertY(spec$lmar[1], from = "lines", to = "npc") - grconvertY(0, from = "lines", to = "npc") - if (spec$flags$outer_bottom) { + if (spec$outer_bottom) { # Extra space needed for "bottom!" because of lhs inner margin inset_bump = grconvertY(par("mar")[1], from = "lines", to = "npc") - grconvertY(0, from = "lines", to = "npc") inset_val = inset_val + inset_bump } else { - epsilon_bump = grconvertY(spec$meta$topmar_epsilon, from = "lines", to = "npc") - + epsilon_bump = grconvertY(spec$topmar_epsilon, from = "lines", to = "npc") - grconvertY(0, from = "lines", to = "npc") inset_val = inset_val + epsilon_bump } @@ -127,7 +158,7 @@ measure_fake_legend = function(spec) { keep.null = TRUE ) - if (spec$flags$gradient) { + if (spec$gradient) { lgnd_labs_tmp = na.omit(fklgnd.args[["legend"]]) if (length(lgnd_labs_tmp) < 5L) { nmore = 5L - length(lgnd_labs_tmp) @@ -138,7 +169,7 @@ measure_fake_legend = function(spec) { list(legend = lgnd_labs_tmp), keep.null = TRUE ) - if (spec$flags$outer_end) { + if (spec$outer_end) { fklgnd.args = modifyList( fklgnd.args, list(title = NULL), @@ -150,36 +181,6 @@ measure_fake_legend = function(spec) { do.call("legend", fklgnd.args) } -# Calculate and apply soma (outer margin size) based on legend dimensions -legend_outer_margins_apply = function(spec) { - # Calculate size - soma = if (spec$flags$outer_side) { - grconvertX(spec$dims$rect$w, to = "lines") - grconvertX(0, to = "lines") - } else if (spec$flags$outer_end) { - grconvertY(spec$dims$rect$h, to = "lines") - grconvertY(0, to = "lines") - } else { - 0 - } - soma = soma + sum(spec$margins$lmar) - - # Apply to appropriate margin - ooma = spec$margins$ooma - omar = spec$margins$omar - - if (spec$flags$outer_side) { - ooma[if (spec$flags$outer_right) 4 else 2] = soma - } else if (spec$flags$outer_end) { - if (spec$flags$outer_bottom) { - ooma[1] = soma - } else { - omar[3] = omar[3] + soma - spec$meta$topmar_epsilon - par(mar = omar) - } - } - par(oma = ooma) - - list(ooma = ooma, omar = omar) -} # @@ -377,6 +378,7 @@ prepare_legend = function(settings) { #' #' @keywords internal build_legend_spec = function( + spec, legend, legend_args, by_dep, @@ -510,15 +512,14 @@ build_legend_spec = function( } } - list( - legend_args = legend_args, - mcol_flag = mcol_flag, - user_inset = user_inset, - outer_side = outer_side, - outer_end = outer_end, - outer_right = outer_right, - outer_bottom = outer_bottom - ) + # Populate spec environment + spec$args = legend_args + spec$mcol = mcol_flag + spec$user_inset = user_inset + spec$outer_side = outer_side + spec$outer_end = outer_end + spec$outer_right = outer_right + spec$outer_bottom = outer_bottom } @@ -661,8 +662,27 @@ draw_legend = function( assert_logical(new_plot) assert_logical(draw) - # Build complete legend arguments from inputs - legend_build = build_legend_spec( + # Restore margin defaults + dynmar = isTRUE(.tpar[["dynmar"]]) + restore_margin_outer() + if (!dynmar) { + restore_margin_inner(par("oma"), topmar_epsilon = 0.1) + } + + # Create spec environment + spec = new.env(parent = emptyenv()) + + # Initialize spec with metadata + spec$gradient = gradient + spec$type = type + spec$has_sub = has_sub + spec$new_plot = new_plot + spec$dynmar = dynmar + spec$topmar_epsilon = 0.1 + + # Build legend spec (populates spec$args and positioning flags) + build_legend_spec( + spec = spec, legend = legend, legend_args = legend_args, by_dep = by_dep, @@ -678,89 +698,44 @@ draw_legend = function( gradient = gradient ) - # Restore margin defaults - dynmar = isTRUE(.tpar[["dynmar"]]) - restore_margin_outer() - if (!dynmar) { - restore_margin_inner(par("oma"), topmar_epsilon = 0.1) - } - - # Create spec object and populate from build_legend_spec results - spec = structure( - list( - args = legend_build$legend_args, - flags = list( - outer_side = legend_build$outer_side, - outer_end = legend_build$outer_end, - outer_right = legend_build$outer_right, - outer_bottom = legend_build$outer_bottom, - mcol = legend_build$mcol_flag, - user_inset = legend_build$user_inset, - gradient = gradient - ), - margins = list( - lmar = NULL, - omar = NULL, - ooma = NULL - ), - dims = NULL, - layout = list( - inset = NULL, - rasterbox = NULL - ), - meta = list( - type = type, - has_sub = has_sub, - new_plot = new_plot, - dynmar = dynmar, - topmar_epsilon = 0.1 - ) - ), - class = "legend_spec" - ) - # Initialize margins - spec$margins$omar = par("mar") - spec$margins$ooma = par("oma") - spec$margins$lmar = tpar("lmar") + spec$omar = par("mar") + spec$ooma = par("oma") + spec$lmar = tpar("lmar") - # Adjust margins for outer placement - margin_result = legend_outer_margins_prepare(spec) - spec$margins = modifyList(spec$margins, margin_result) + # Initialize dimensions and layout + spec$dims = NULL + spec$inset = NULL + spec$rasterbox = NULL - # Measure dimensions with fake legend - spec$dims = measure_fake_legend(spec) + # Adjust margins for outer placement, measure, and optionally apply + legend_outer_margins(spec, apply = draw) if (!draw) { return(spec$dims) } - # Calculate and apply soma (outer margin adjustment) - margin_result = legend_outer_margins_apply(spec) - spec$margins$ooma = margin_result$ooma - spec$margins$omar = margin_result$omar - # Calculate inset - spec$layout$inset = measure_legend_inset(spec) + spec$inset = measure_legend_inset(spec) # Refresh plot area for exact inset spacing oldhook = getHook("before.plot.new") setHook("before.plot.new", function() par(new = TRUE), action = "append") - setHook("before.plot.new", function() par(mar = spec$margins$omar), action = "append") + setHook("before.plot.new", function() par(mar = spec$omar), action = "append") plot.new() setHook("before.plot.new", oldhook, action = "replace") # Set the inset in args - spec$args[["inset"]] = if (spec$flags$user_inset) { - spec$args[["inset"]] + spec$layout$inset + spec$args[["inset"]] = if (spec$user_inset) { + spec$args[["inset"]] + spec$inset } else { - spec$layout$inset + spec$inset } # Draw wrapped in recordGraphics() to preserve spacing if plot is resized recordGraphics( { - if (spec$flags$gradient) { + if (spec$gradient) { # Ensure col is set correctly for gradients if (!more_than_n_unique(spec$args[["col"]], 1)) { if (!is.null(spec$args[["pt.bg"]]) && length(spec$args[["pt.bg"]]) == 100) { @@ -771,12 +746,12 @@ draw_legend = function( draw_gradient_swatch( legend_args = spec$args, fklgnd = spec$dims, - lmar = spec$margins$lmar, - outer_side = spec$flags$outer_side, - outer_end = spec$flags$outer_end, - outer_right = spec$flags$outer_right, - outer_bottom = spec$flags$outer_bottom, - user_inset = spec$flags$user_inset + lmar = spec$lmar, + outer_side = spec$outer_side, + outer_end = spec$outer_end, + outer_right = spec$outer_right, + outer_bottom = spec$outer_bottom, + user_inset = spec$user_inset ) } else { do.call("legend", spec$args) diff --git a/man/build_legend_spec.Rd b/man/build_legend_spec.Rd index c9c7fdfc..6ea1bf80 100644 --- a/man/build_legend_spec.Rd +++ b/man/build_legend_spec.Rd @@ -5,6 +5,7 @@ \title{Build legend specification} \usage{ build_legend_spec( + spec, legend, legend_args, by_dep, diff --git a/man/legend_spec_apply_margins.Rd b/man/legend_spec_apply_margins.Rd deleted file mode 100644 index 0d7c646b..00000000 --- a/man/legend_spec_apply_margins.Rd +++ /dev/null @@ -1,19 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/legend.R -\name{legend_spec_apply_margins} -\alias{legend_spec_apply_margins} -\title{Apply margin adjustments for outer legends} -\usage{ -legend_spec_apply_margins(spec) -} -\arguments{ -\item{spec}{Legend specification object} -} -\value{ -Modified spec with margins populated -} -\description{ -Second stage of pipeline: initializes margins and adjusts -them for outer legend placement. -} -\keyword{internal} diff --git a/man/legend_spec_draw.Rd b/man/legend_spec_draw.Rd deleted file mode 100644 index 367e6449..00000000 --- a/man/legend_spec_draw.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/legend.R -\name{legend_spec_draw} -\alias{legend_spec_draw} -\title{Draw legend from specification} -\usage{ -legend_spec_draw(spec) -} -\arguments{ -\item{spec}{Legend specification object} -} -\value{ -NULL (called for side effect of drawing legend) -} -\description{ -Final stage of pipeline: draws the actual legend. -} -\keyword{internal} diff --git a/man/legend_spec_layout.Rd b/man/legend_spec_layout.Rd deleted file mode 100644 index cfb6d5b1..00000000 --- a/man/legend_spec_layout.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/legend.R -\name{legend_spec_layout} -\alias{legend_spec_layout} -\title{Calculate legend layout (inset and rasterbox)} -\usage{ -legend_spec_layout(spec, draw = TRUE) -} -\arguments{ -\item{spec}{Legend specification object} - -\item{draw}{Logical indicating if this is for actual drawing (vs measurement)} -} -\value{ -Modified spec with layout populated -} -\description{ -Fourth stage of pipeline: calculates inset for positioning -and rasterbox coordinates for gradient legends. -} -\keyword{internal} From 28fb772a22809e39028eac220a6cc9f8838ade2a Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 17:59:48 -0500 Subject: [PATCH 10/14] spec -> legend_env --- R/legend.R | 344 +++++++++++++++++++++++++++++------------------------ 1 file changed, 186 insertions(+), 158 deletions(-) diff --git a/R/legend.R b/R/legend.R index efe9a2df..93a39732 100644 --- a/R/legend.R +++ b/R/legend.R @@ -1,3 +1,55 @@ +# +## Input Sanitization ----- +# + +#' Sanitize and normalize legend input +#' +#' @description Converts various legend input formats (NULL, character, list, +#' call) into a standardized legend_args list with an "x" position element. +#' +#' @param legend Legend specification (NULL, character, list, or call) +#' @param legend_args Existing legend_args list to merge with +#' +#' @returns Normalized legend_args list with at least an "x" element +#' +#' @keywords internal +sanitize_legend = function(legend, legend_args) { + if (is.null(legend_args[["x"]])) { + + # Normalize legend to a list + largs = if (is.null(legend)) { + list(x = "right!") + } else if (is.character(legend)) { + list(x = legend) + } else if (is.list(legend)) { + # Handle unnamed first element as position + if (length(legend) >= 1 && is.character(legend[[1]]) && + (is.null(names(legend)) || names(legend)[1] == "")) { + names(legend)[1] = "x" + } + legend + } else if (inherits(legend, c("call", "name"))) { + # Convert call to list and handle unnamed first arg as position + new_legend = as.list(legend)[-1] # Remove function name + if (length(new_legend) >= 1 && (is.null(names(new_legend)) || names(new_legend)[1] == "")) { + names(new_legend)[1] = "x" + } + new_legend + } else { + list(x = "right!") # Fallback + } + + # Ensure position exists + if (is.null(largs[["x"]])) largs[["x"]] = "right!" + + # Merge + legend_args = modifyList(legend_args, largs, keep.null = TRUE) + } + + legend_args +} + + # ## Helper Functions ----- # @@ -15,21 +67,22 @@ lines_to_user_y = function(val) { grconvertY(val, from = "lines", to = "user") - grconvertY(0, from = "lines", to = "user") } + # Adjust margins for outer legend placement, measure, and apply soma -legend_outer_margins = function(spec, apply = TRUE) { - omar = spec$omar - ooma = spec$ooma - lmar = spec$lmar +legend_outer_margins = function(legend_env, apply = TRUE) { + omar = legend_env$omar + ooma = legend_env$ooma + lmar = legend_env$lmar # Step 1: Prepare margins before measuring - if (spec$outer_side) { + if (legend_env$outer_side) { # Extra bump for spineplot if outer_right legend (to accommodate secondary y-axis) - if (identical(spec$type, "spineplot")) { + if (identical(legend_env$type, "spineplot")) { lmar[1] = lmar[1] + 1.1 } # Set inner margins before fake legend is drawn - if (spec$outer_right) { + if (legend_env$outer_right) { omar[4] = 0 } else { # For outer left we have to account for the y-axis label too @@ -37,12 +90,12 @@ legend_outer_margins = function(spec, apply = TRUE) { } par(mar = omar) - if (spec$new_plot) { + if (legend_env$new_plot) { plot.new() # For themed + dynamic plots, reinstate adjusted plot margins - if (spec$dynmar) { + if (legend_env$dynmar) { omar = par("mar") - if (spec$outer_right) { + if (legend_env$outer_right) { omar[4] = 0 } else { omar[2] = par("mgp")[1] + 1 * par("cex.lab") @@ -51,95 +104,96 @@ legend_outer_margins = function(spec, apply = TRUE) { } } - } else if (spec$outer_end) { + } else if (legend_env$outer_end) { # Set inner margins before fake legend is drawn - if (spec$outer_bottom) { + if (legend_env$outer_bottom) { omar[1] = par("mgp")[1] + 1 * par("cex.lab") - if (spec$has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { + if (legend_env$has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { omar[1] = omar[1] + 1 * par("cex.sub") } } else { # For "top!", expand existing inner margin rather than outer margin - ooma[3] = ooma[3] + spec$topmar_epsilon + ooma[3] = ooma[3] + legend_env$topmar_epsilon par(oma = ooma) } par(mar = omar) - if (spec$new_plot) { + if (legend_env$new_plot) { plot.new() # For themed + dynamic plots, reinstate adjusted plot margins - if (spec$dynmar) { + if (legend_env$dynmar) { omar = par("mar") - if (spec$outer_bottom) { + if (legend_env$outer_bottom) { omar[1] = theme_clean$mgp[1] + 1 * par("cex.lab") - if (spec$has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { + if (legend_env$has_sub && (is.null(.tpar[["side.sub"]]) || .tpar[["side.sub"]] == 1)) { omar[1] = omar[1] + 1 * par("cex.sub") } } else { - ooma[3] = ooma[3] + spec$topmar_epsilon + ooma[3] = ooma[3] + legend_env$topmar_epsilon par(oma = ooma) } par(mar = omar) } } } else { - if (spec$new_plot) plot.new() + if (legend_env$new_plot) plot.new() } - # Update spec with prepared margins - spec$omar = omar - spec$ooma = ooma - spec$lmar = lmar + # Update legend environment with prepared margins + legend_env$omar = omar + legend_env$ooma = ooma + legend_env$lmar = lmar # Step 2: Measure legend dimensions - spec$dims = measure_fake_legend(spec) + legend_env$dims = measure_fake_legend(legend_env) # Step 3: Apply soma if drawing if (apply) { - soma = if (spec$outer_side) { - grconvertX(spec$dims$rect$w, to = "lines") - grconvertX(0, to = "lines") - } else if (spec$outer_end) { - grconvertY(spec$dims$rect$h, to = "lines") - grconvertY(0, to = "lines") + soma = if (legend_env$outer_side) { + grconvertX(legend_env$dims$rect$w, to = "lines") - grconvertX(0, to = "lines") + } else if (legend_env$outer_end) { + grconvertY(legend_env$dims$rect$h, to = "lines") - grconvertY(0, to = "lines") } else { 0 } - soma = soma + sum(spec$lmar) + soma = soma + sum(legend_env$lmar) - if (spec$outer_side) { - spec$ooma[if (spec$outer_right) 4 else 2] = soma - } else if (spec$outer_end) { - if (spec$outer_bottom) { - spec$ooma[1] = soma + if (legend_env$outer_side) { + legend_env$ooma[if (legend_env$outer_right) 4 else 2] = soma + } else if (legend_env$outer_end) { + if (legend_env$outer_bottom) { + legend_env$ooma[1] = soma } else { - spec$omar[3] = spec$omar[3] + soma - spec$topmar_epsilon - par(mar = spec$omar) + legend_env$omar[3] = legend_env$omar[3] + soma - legend_env$topmar_epsilon + par(mar = legend_env$omar) } } - par(oma = spec$ooma) + par(oma = legend_env$ooma) } } + # Calculate legend inset for outer placement -measure_legend_inset = function(spec) { - if (spec$outer_side) { - inset_val = lines_to_npc(spec$lmar[1]) +measure_legend_inset = function(legend_env) { + if (legend_env$outer_side) { + inset_val = lines_to_npc(legend_env$lmar[1]) # Extra space needed for "left!" because of lhs inner margin - if (!spec$outer_right) { + if (!legend_env$outer_right) { inset_val = inset_val + lines_to_npc(par("mar")[2]) } c(1 + inset_val, 0) - } else if (spec$outer_end) { + } else if (legend_env$outer_end) { # Note: Y-direction uses grconvertY (not lines_to_npc which is X-only) - inset_val = grconvertY(spec$lmar[1], from = "lines", to = "npc") - + inset_val = grconvertY(legend_env$lmar[1], from = "lines", to = "npc") - grconvertY(0, from = "lines", to = "npc") - if (spec$outer_bottom) { + if (legend_env$outer_bottom) { # Extra space needed for "bottom!" because of lhs inner margin inset_bump = grconvertY(par("mar")[1], from = "lines", to = "npc") - grconvertY(0, from = "lines", to = "npc") inset_val = inset_val + inset_bump } else { - epsilon_bump = grconvertY(spec$topmar_epsilon, from = "lines", to = "npc") - + epsilon_bump = grconvertY(legend_env$topmar_epsilon, from = "lines", to = "npc") - grconvertY(0, from = "lines", to = "npc") inset_val = inset_val + epsilon_bump } @@ -150,15 +204,16 @@ measure_legend_inset = function(spec) { } } + # Measure legend dimensions using a fake (non-plotted) legend -measure_fake_legend = function(spec) { +measure_fake_legend = function(legend_env) { fklgnd.args = modifyList( - spec$args, + legend_env$args, list(plot = FALSE), keep.null = TRUE ) - if (spec$gradient) { + if (legend_env$gradient) { lgnd_labs_tmp = na.omit(fklgnd.args[["legend"]]) if (length(lgnd_labs_tmp) < 5L) { nmore = 5L - length(lgnd_labs_tmp) @@ -169,7 +224,7 @@ measure_fake_legend = function(spec) { list(legend = lgnd_labs_tmp), keep.null = TRUE ) - if (spec$outer_end) { + if (legend_env$outer_end) { fklgnd.args = modifyList( fklgnd.args, list(title = NULL), @@ -183,57 +238,6 @@ measure_fake_legend = function(spec) { -# -## Input Sanitization ----- -# - -#' Sanitize and normalize legend input -#' -#' @description Converts various legend input formats (NULL, character, list, -#' call) into a standardized legend_args list with an "x" position element. -#' -#' @param legend Legend specification (NULL, character, list, or call) -#' @param legend_args Existing legend_args list to merge with -#' -#' @returns Normalized legend_args list with at least an "x" element -#' -#' @keywords internal -sanitize_legend = function(legend, legend_args) { - if (is.null(legend_args[["x"]])) { - - # Normalize legend to a list - largs = if (is.null(legend)) { - list(x = "right!") - } else if (is.character(legend)) { - list(x = legend) - } else if (is.list(legend)) { - # Handle unnamed first element as position - if (length(legend) >= 1 && is.character(legend[[1]]) && - (is.null(names(legend)) || names(legend)[1] == "")) { - names(legend)[1] = "x" - } - legend - } else if (inherits(legend, c("call", "name"))) { - # Convert call to list and handle unnamed first arg as position - new_legend = as.list(legend)[-1] # Remove function name - if (length(new_legend) >= 1 && (is.null(names(new_legend)) || names(new_legend)[1] == "")) { - names(new_legend)[1] = "x" - } - new_legend - } else { - list(x = "right!") # Fallback - } - - # Ensure position exists - if (is.null(largs[["x"]])) largs[["x"]] = "right!" - - # Merge - legend_args = modifyList(legend_args, largs, keep.null = TRUE) - } - - legend_args -} - # ## Legend Context & Preparation ----- @@ -355,10 +359,12 @@ prepare_legend = function(settings) { #' Build legend specification #' #' @description Constructs a complete legend_args list by: +#' - Creating and initializing the legend environment #' - Sanitizing legend input #' - Setting defaults for all legend parameters #' - Computing positioning flags (outer_side, outer_right, etc.) #' - Adjusting for special cases (gradient, horizontal, multi-column) +#' - Initializing margins and dimensions #' #' @param legend Legend placement keyword or list #' @param legend_args Additional legend arguments @@ -373,17 +379,24 @@ prepare_legend = function(settings) { #' @param bg Background fill color(s) #' @param cex Character expansion(s) #' @param gradient Logical indicating gradient legend +#' @param lmar Legend margins (inner, outer) +#' @param has_sub Logical indicating presence of sub-caption +#' @param new_plot Logical indicating if plot.new should be called #' -#' @returns List with legend_args and positioning flags +#' @returns Environment with complete legend specification #' #' @keywords internal build_legend_spec = function( - spec, + # Legend specification legend, legend_args, + + # Labels and grouping by_dep, lgnd_labs, labeller = NULL, + + # Visual aesthetics type, pch, lty, @@ -391,8 +404,23 @@ build_legend_spec = function( col, bg, cex, - gradient + + # Configuration + gradient, + lmar, + has_sub = FALSE, + new_plot = TRUE ) { + # Create legend environment + legend_env = new.env(parent = emptyenv()) + + # Initialize metadata + legend_env$gradient = gradient + legend_env$type = type + legend_env$has_sub = has_sub + legend_env$new_plot = new_plot + legend_env$dynmar = isTRUE(.tpar[["dynmar"]]) + legend_env$topmar_epsilon = 0.1 legend_args = sanitize_legend(legend, legend_args) # Set defaults @@ -512,14 +540,26 @@ build_legend_spec = function( } } - # Populate spec environment - spec$args = legend_args - spec$mcol = mcol_flag - spec$user_inset = user_inset - spec$outer_side = outer_side - spec$outer_end = outer_end - spec$outer_right = outer_right - spec$outer_bottom = outer_bottom + # Populate legend environment + legend_env$args = legend_args + legend_env$mcol = mcol_flag + legend_env$user_inset = user_inset + legend_env$outer_side = outer_side + legend_env$outer_end = outer_end + legend_env$outer_right = outer_right + legend_env$outer_bottom = outer_bottom + + # Initialize margins + legend_env$omar = par("mar") + legend_env$ooma = par("oma") + legend_env$lmar = lmar + + # Initialize dimensions and layout + legend_env$dims = NULL + legend_env$inset = NULL + legend_env$rasterbox = NULL + + return(legend_env) } @@ -669,25 +709,18 @@ draw_legend = function( restore_margin_inner(par("oma"), topmar_epsilon = 0.1) } - # Create spec environment - spec = new.env(parent = emptyenv()) - - # Initialize spec with metadata - spec$gradient = gradient - spec$type = type - spec$has_sub = has_sub - spec$new_plot = new_plot - spec$dynmar = dynmar - spec$topmar_epsilon = 0.1 - - # Build legend spec (populates spec$args and positioning flags) - build_legend_spec( - spec = spec, + # Build legend environment + legend_env = build_legend_spec( + # Legend specification legend = legend, legend_args = legend_args, + + # Labels and grouping by_dep = by_dep, lgnd_labs = lgnd_labs, labeller = labeller, + + # Visual aesthetics type = type, pch = pch, lty = lty, @@ -695,69 +728,64 @@ draw_legend = function( col = col, bg = bg, cex = cex, - gradient = gradient - ) - # Initialize margins - spec$omar = par("mar") - spec$ooma = par("oma") - spec$lmar = tpar("lmar") - - # Initialize dimensions and layout - spec$dims = NULL - spec$inset = NULL - spec$rasterbox = NULL + # Configuration + gradient = gradient, + lmar = lmar, + has_sub = has_sub, + new_plot = new_plot + ) # Adjust margins for outer placement, measure, and optionally apply - legend_outer_margins(spec, apply = draw) + legend_outer_margins(legend_env, apply = draw) if (!draw) { - return(spec$dims) + return(legend_env$dims) } # Calculate inset - spec$inset = measure_legend_inset(spec) + legend_env$inset = measure_legend_inset(legend_env) # Refresh plot area for exact inset spacing oldhook = getHook("before.plot.new") setHook("before.plot.new", function() par(new = TRUE), action = "append") - setHook("before.plot.new", function() par(mar = spec$omar), action = "append") + setHook("before.plot.new", function() par(mar = legend_env$omar), action = "append") plot.new() setHook("before.plot.new", oldhook, action = "replace") # Set the inset in args - spec$args[["inset"]] = if (spec$user_inset) { - spec$args[["inset"]] + spec$inset + legend_env$args[["inset"]] = if (legend_env$user_inset) { + legend_env$args[["inset"]] + legend_env$inset } else { - spec$inset + legend_env$inset } # Draw wrapped in recordGraphics() to preserve spacing if plot is resized recordGraphics( { - if (spec$gradient) { + if (legend_env$gradient) { # Ensure col is set correctly for gradients - if (!more_than_n_unique(spec$args[["col"]], 1)) { - if (!is.null(spec$args[["pt.bg"]]) && length(spec$args[["pt.bg"]]) == 100) { - spec$args[["col"]] = spec$args[["pt.bg"]] + if (!more_than_n_unique(legend_env$args[["col"]], 1)) { + if (!is.null(legend_env$args[["pt.bg"]]) && length(legend_env$args[["pt.bg"]]) == 100) { + legend_env$args[["col"]] = legend_env$args[["pt.bg"]] } } draw_gradient_swatch( - legend_args = spec$args, - fklgnd = spec$dims, - lmar = spec$lmar, - outer_side = spec$outer_side, - outer_end = spec$outer_end, - outer_right = spec$outer_right, - outer_bottom = spec$outer_bottom, - user_inset = spec$user_inset + legend_args = legend_env$args, + fklgnd = legend_env$dims, + lmar = legend_env$lmar, + outer_side = legend_env$outer_side, + outer_end = legend_env$outer_end, + outer_right = legend_env$outer_right, + outer_bottom = legend_env$outer_bottom, + user_inset = legend_env$user_inset ) } else { - do.call("legend", spec$args) + do.call("legend", legend_env$args) } }, - list = list(spec = spec), + list = list(legend_env = legend_env), env = getNamespace("tinyplot") ) } From ff32f209dbffcc0459f09ef78026107db715e35e Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 18:12:42 -0500 Subject: [PATCH 11/14] legend separation of concerns --- R/legend.R | 153 ++++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 115 insertions(+), 38 deletions(-) diff --git a/R/legend.R b/R/legend.R index 93a39732..5a397c69 100644 --- a/R/legend.R +++ b/R/legend.R @@ -356,15 +356,14 @@ prepare_legend = function(settings) { } -#' Build legend specification +#' Build legend arguments list #' -#' @description Constructs a complete legend_args list by: -#' - Creating and initializing the legend environment +#' @description Constructs and configures the legend_args list by: #' - Sanitizing legend input #' - Setting defaults for all legend parameters -#' - Computing positioning flags (outer_side, outer_right, etc.) +#' - Computing positioning flags from original position (before transformation) +#' - Adjusting position anchors for outer legends #' - Adjusting for special cases (gradient, horizontal, multi-column) -#' - Initializing margins and dimensions #' #' @param legend Legend placement keyword or list #' @param legend_args Additional legend arguments @@ -379,14 +378,12 @@ prepare_legend = function(settings) { #' @param bg Background fill color(s) #' @param cex Character expansion(s) #' @param gradient Logical indicating gradient legend -#' @param lmar Legend margins (inner, outer) -#' @param has_sub Logical indicating presence of sub-caption -#' @param new_plot Logical indicating if plot.new should be called #' -#' @returns Environment with complete legend specification +#' @returns List with: args (legend_args list), mcol, user_inset, outer_side, +#' outer_end, outer_right, outer_bottom #' #' @keywords internal -build_legend_spec = function( +build_legend_args = function( # Legend specification legend, legend_args, @@ -406,21 +403,8 @@ build_legend_spec = function( cex, # Configuration - gradient, - lmar, - has_sub = FALSE, - new_plot = TRUE + gradient ) { - # Create legend environment - legend_env = new.env(parent = emptyenv()) - - # Initialize metadata - legend_env$gradient = gradient - legend_env$type = type - legend_env$has_sub = has_sub - legend_env$new_plot = new_plot - legend_env$dynmar = isTRUE(.tpar[["dynmar"]]) - legend_env$topmar_epsilon = 0.1 legend_args = sanitize_legend(legend, legend_args) # Set defaults @@ -480,11 +464,7 @@ build_legend_spec = function( legend_args[["ncol"]] = NULL } - # Flags - mcol_flag = !is.null(legend_args[["ncol"]]) && legend_args[["ncol"]] > 1 - user_inset = !is.null(legend_args[["inset"]]) - - # Determine positioning + # Determine positioning flags for anchor adjustment outer_side = outer_end = outer_right = outer_bottom = FALSE if (grepl("right!$|left!$", legend_args[["x"]])) { outer_side = TRUE @@ -518,6 +498,9 @@ build_legend_spec = function( } # Additional tweaks for horizontal and/or multi-column legends + mcol_flag = !is.null(legend_args[["ncol"]]) && legend_args[["ncol"]] > 1 + user_inset = !is.null(legend_args[["inset"]]) + if (isTRUE(legend_args[["horiz"]]) || mcol_flag) { # Tighter horizontal labelling if (!gradient) { @@ -540,14 +523,108 @@ build_legend_spec = function( } } - # Populate legend environment - legend_env$args = legend_args - legend_env$mcol = mcol_flag - legend_env$user_inset = user_inset - legend_env$outer_side = outer_side - legend_env$outer_end = outer_end - legend_env$outer_right = outer_right - legend_env$outer_bottom = outer_bottom + # Return args and positioning flags + list( + args = legend_args, + mcol = mcol_flag, + user_inset = user_inset, + outer_side = outer_side, + outer_end = outer_end, + outer_right = outer_right, + outer_bottom = outer_bottom + ) +} + + +#' Build legend environment +#' +#' @description Creates the legend environment by: +#' - Initializing environment with metadata +#' - Calling build_legend_args() to construct legend arguments +#' - Populating environment with arguments and positioning flags +#' - Initializing margins and dimensions +#' +#' @param legend Legend placement keyword or list +#' @param legend_args Additional legend arguments +#' @param by_dep The (deparsed) "by" grouping variable name +#' @param lgnd_labs The legend labels +#' @param labeller Character or function for formatting labels +#' @param type Plot type +#' @param pch Plotting character(s) +#' @param lty Line type(s) +#' @param lwd Line width(s) +#' @param col Color(s) +#' @param bg Background fill color(s) +#' @param cex Character expansion(s) +#' @param gradient Logical indicating gradient legend +#' @param lmar Legend margins (inner, outer) +#' @param has_sub Logical indicating presence of sub-caption +#' @param new_plot Logical indicating if plot.new should be called +#' +#' @returns Environment with complete legend specification +#' +#' @keywords internal +build_legend_env = function( + # Legend specification + legend, + legend_args, + + # Labels and grouping + by_dep, + lgnd_labs, + labeller = NULL, + + # Visual aesthetics + type, + pch, + lty, + lwd, + col, + bg, + cex, + + # Configuration + gradient, + lmar, + has_sub = FALSE, + new_plot = TRUE +) { + # Create legend environment + legend_env = new.env(parent = emptyenv()) + + # Initialize metadata + legend_env$gradient = gradient + legend_env$type = type + legend_env$has_sub = has_sub + legend_env$new_plot = new_plot + legend_env$dynmar = isTRUE(.tpar[["dynmar"]]) + legend_env$topmar_epsilon = 0.1 + + # Build legend arguments and get positioning flags + legend_spec = build_legend_args( + legend = legend, + legend_args = legend_args, + by_dep = by_dep, + lgnd_labs = lgnd_labs, + labeller = labeller, + type = type, + pch = pch, + lty = lty, + lwd = lwd, + col = col, + bg = bg, + cex = cex, + gradient = gradient + ) + + # Populate environment with args and flags + legend_env$args = legend_spec$args + legend_env$mcol = legend_spec$mcol + legend_env$user_inset = legend_spec$user_inset + legend_env$outer_side = legend_spec$outer_side + legend_env$outer_end = legend_spec$outer_end + legend_env$outer_right = legend_spec$outer_right + legend_env$outer_bottom = legend_spec$outer_bottom # Initialize margins legend_env$omar = par("mar") @@ -710,7 +787,7 @@ draw_legend = function( } # Build legend environment - legend_env = build_legend_spec( + legend_env = build_legend_env( # Legend specification legend = legend, legend_args = legend_args, From 4c8b0a5cf200147de4588b92dc23a485a29b1597 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 19:34:22 -0500 Subject: [PATCH 12/14] minor --- R/legend.R | 39 ++++++++++++++++----------------------- 1 file changed, 16 insertions(+), 23 deletions(-) diff --git a/R/legend.R b/R/legend.R index 5a397c69..8cfffff4 100644 --- a/R/legend.R +++ b/R/legend.R @@ -364,7 +364,9 @@ prepare_legend = function(settings) { #' - Computing positioning flags from original position (before transformation) #' - Adjusting position anchors for outer legends #' - Adjusting for special cases (gradient, horizontal, multi-column) +#' - Populating legend_env with args and positioning flags #' +#' @param legend_env Legend environment to populate #' @param legend Legend placement keyword or list #' @param legend_args Additional legend arguments #' @param by_dep The (deparsed) "by" grouping variable name @@ -379,11 +381,12 @@ prepare_legend = function(settings) { #' @param cex Character expansion(s) #' @param gradient Logical indicating gradient legend #' -#' @returns List with: args (legend_args list), mcol, user_inset, outer_side, -#' outer_end, outer_right, outer_bottom +#' @returns NULL (modifies legend_env in-place) #' #' @keywords internal build_legend_args = function( + legend_env, + # Legend specification legend, legend_args, @@ -523,16 +526,14 @@ build_legend_args = function( } } - # Return args and positioning flags - list( - args = legend_args, - mcol = mcol_flag, - user_inset = user_inset, - outer_side = outer_side, - outer_end = outer_end, - outer_right = outer_right, - outer_bottom = outer_bottom - ) + # Populate legend environment with args and flags + legend_env$args = legend_args + legend_env$mcol = mcol_flag + legend_env$user_inset = user_inset + legend_env$outer_side = outer_side + legend_env$outer_end = outer_end + legend_env$outer_right = outer_right + legend_env$outer_bottom = outer_bottom } @@ -600,8 +601,9 @@ build_legend_env = function( legend_env$dynmar = isTRUE(.tpar[["dynmar"]]) legend_env$topmar_epsilon = 0.1 - # Build legend arguments and get positioning flags - legend_spec = build_legend_args( + # Build legend arguments (modifies legend_env in-place) + build_legend_args( + legend_env = legend_env, legend = legend, legend_args = legend_args, by_dep = by_dep, @@ -617,15 +619,6 @@ build_legend_env = function( gradient = gradient ) - # Populate environment with args and flags - legend_env$args = legend_spec$args - legend_env$mcol = legend_spec$mcol - legend_env$user_inset = legend_spec$user_inset - legend_env$outer_side = legend_spec$outer_side - legend_env$outer_end = legend_spec$outer_end - legend_env$outer_right = legend_spec$outer_right - legend_env$outer_bottom = legend_spec$outer_bottom - # Initialize margins legend_env$omar = par("mar") legend_env$ooma = par("oma") From 7531267bf46f84f6e84e6849b86f8858d04dc5d8 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 20:44:14 -0500 Subject: [PATCH 13/14] man --- ...ld_legend_spec.Rd => build_legend_args.Rd} | 20 +++--- man/build_legend_env.Rd | 71 +++++++++++++++++++ 2 files changed, 83 insertions(+), 8 deletions(-) rename man/{build_legend_spec.Rd => build_legend_args.Rd} (68%) create mode 100644 man/build_legend_env.Rd diff --git a/man/build_legend_spec.Rd b/man/build_legend_args.Rd similarity index 68% rename from man/build_legend_spec.Rd rename to man/build_legend_args.Rd index 6ea1bf80..1e1ea297 100644 --- a/man/build_legend_spec.Rd +++ b/man/build_legend_args.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/legend.R -\name{build_legend_spec} -\alias{build_legend_spec} -\title{Build legend specification} +\name{build_legend_args} +\alias{build_legend_args} +\title{Build legend arguments list} \usage{ -build_legend_spec( - spec, +build_legend_args( + legend_env, legend, legend_args, by_dep, @@ -22,6 +22,8 @@ build_legend_spec( ) } \arguments{ +\item{legend_env}{Legend environment to populate} + \item{legend}{Legend placement keyword or list} \item{legend_args}{Additional legend arguments} @@ -49,15 +51,17 @@ build_legend_spec( \item{gradient}{Logical indicating gradient legend} } \value{ -List with legend_args and positioning flags +NULL (modifies legend_env in-place) } \description{ -Constructs a complete legend_args list by: +Constructs and configures the legend_args list by: \itemize{ \item Sanitizing legend input \item Setting defaults for all legend parameters -\item Computing positioning flags (outer_side, outer_right, etc.) +\item Computing positioning flags from original position (before transformation) +\item Adjusting position anchors for outer legends \item Adjusting for special cases (gradient, horizontal, multi-column) +\item Populating legend_env with args and positioning flags } } \keyword{internal} diff --git a/man/build_legend_env.Rd b/man/build_legend_env.Rd new file mode 100644 index 00000000..e4b2cccb --- /dev/null +++ b/man/build_legend_env.Rd @@ -0,0 +1,71 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/legend.R +\name{build_legend_env} +\alias{build_legend_env} +\title{Build legend environment} +\usage{ +build_legend_env( + legend, + legend_args, + by_dep, + lgnd_labs, + labeller = NULL, + type, + pch, + lty, + lwd, + col, + bg, + cex, + gradient, + lmar, + has_sub = FALSE, + new_plot = TRUE +) +} +\arguments{ +\item{legend}{Legend placement keyword or list} + +\item{legend_args}{Additional legend arguments} + +\item{by_dep}{The (deparsed) "by" grouping variable name} + +\item{lgnd_labs}{The legend labels} + +\item{labeller}{Character or function for formatting labels} + +\item{type}{Plot type} + +\item{pch}{Plotting character(s)} + +\item{lty}{Line type(s)} + +\item{lwd}{Line width(s)} + +\item{col}{Color(s)} + +\item{bg}{Background fill color(s)} + +\item{cex}{Character expansion(s)} + +\item{gradient}{Logical indicating gradient legend} + +\item{lmar}{Legend margins (inner, outer)} + +\item{has_sub}{Logical indicating presence of sub-caption} + +\item{new_plot}{Logical indicating if plot.new should be called} +} +\value{ +Environment with complete legend specification +} +\description{ +Creates the legend environment by: +\itemize{ +\item Initializing environment with metadata +\item Calling build_legend_args() to construct legend arguments +\item Populating environment with arguments and positioning flags +\item Initializing margins and dimensions +} +} +\keyword{internal} From 423bcf745acf29436748c929b9181dca6e388b69 Mon Sep 17 00:00:00 2001 From: Vincent Arel-Bundock Date: Sun, 14 Dec 2025 20:51:47 -0500 Subject: [PATCH 14/14] namespace --- NAMESPACE | 1 + R/zzz.R | 11 +++++++++++ 2 files changed, 12 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 2be33118..30d3736e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -79,6 +79,7 @@ importFrom(graphics,boxplot) importFrom(graphics,grconvertX) importFrom(graphics,grconvertY) importFrom(graphics,hist) +importFrom(graphics,legend) importFrom(graphics,lines) importFrom(graphics,mtext) importFrom(graphics,par) diff --git a/R/zzz.R b/R/zzz.R index fa359b63..730dcd31 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -1,5 +1,6 @@ #' Operations on package load #' @importFrom utils globalVariables +#' @importFrom graphics legend #' @param libname library name #' @param pkgname package name name #' @keywords internal @@ -57,7 +58,17 @@ "null_facet", "null_palette", "null_xlim", + "multi_legend", + "legend", + "lgnd_labs", + "lgnd_cex", + "has_sub", + "legend_draw_flag", + "multi_legend", + "legend_args", "null_ylim", + "lgby", + "lgbub", "oxaxis", "oyaxis", "pch",