diff --git a/NEWS.md b/NEWS.md index 80d02fc..92f9bb5 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,14 @@ # vellumplot (development version) +* **Rotated and wrapping axis tick labels.** `axis.text.x` / `axis.text.y` now + honour an `angle` — `theme(axis.text.x = element_text(angle = 45))` slants the + labels and the gutter reserves the rotated height (an explicit `hjust`/`vjust` + sets the anchor; otherwise the end of the run is pinned at the tick). When the + labels are left horizontal, a long discrete label that would overrun its tick + spacing wraps onto multiple lines instead of colliding with its neighbour, and + the label row grows to fit — the per-tick companion of the title/subtitle/ + caption wrapping already shipped. Labels that already fit are unchanged. + * **Multi-page PDFs and parallel batch export.** `pdf_pages()` writes several plots into one PDF (a report or slide deck), one plot per page — pages may differ in size and each keeps its accessibility tags — or splits a single diff --git a/R/compile-composition.R b/R/compile-composition.R index 292a5a0..f465721 100644 --- a/R/compile-composition.R +++ b/R/compile-composition.R @@ -326,7 +326,14 @@ NULL scene <- vellum::pop(scene) # axes + axis titles scene <- .draw_y_axis(scene, gm$panel_row, gm$ylabels_col, vsc, rt) - scene <- .draw_x_axis(scene, gm$xlabels_row, gm$panel_col, hsc, rt) + scene <- .draw_x_axis( + scene, + gm$xlabels_row, + gm$panel_col, + hsc, + rt, + gm$xwrap_mm + ) scene <- .draw_y_title(scene, gm$panel_row, gm$ytitle_col, vsc$name, rt) scene <- .draw_x_title(scene, gm$xtitle_row, gm$panel_col, hsc$name, rt) # per-sub-plot legend (only when not collecting) diff --git a/R/compile-guides.R b/R/compile-guides.R index f3c484f..fddd814 100644 --- a/R/compile-guides.R +++ b/R/compile-guides.R @@ -277,7 +277,92 @@ NULL # byte-identical but for the small geometry table below (viewport name + scale, # the axis-line segment endpoints and its sketch seed, and the label anchor + # justification), so they are now thin wrappers over this. -.draw_axis <- function(scene, row, col, sc, rt, axis, sec = FALSE) { +# hjust/vjust (0..1) bucketed to a justification word, matching `.band_anchor`. +.just_h <- function(h) { + if (h < 0.25) { + "left" + } else if (h > 0.75) { + "right" + } else { + "centre" + } +} +.just_v <- function(v) { + if (v < 0.25) { + "bottom" + } else if (v > 0.75) { + "top" + } else { + "centre" + } +} + +# The justification a tick label uses. Unrotated labels keep the track's fixed +# anchor (`geom$just`). A rotated label honours the element's own `hjust`/`vjust` +# when set; otherwise it anchors the *end* of the run at the tick so the slanted +# text hangs clear of the panel (down-outward along the bottom, up-outward along +# the top). +.axis_text_just <- function(geom, el, rot) { + if (rot == 0) { + return(geom$just) + } + hj <- el@hjust + vj <- el@vjust + if (!is.null(hj) || !is.null(vj)) { + return(c( + if (!is.null(hj)) .just_h(hj) else geom$just[1], + if (!is.null(vj)) .just_v(vj) else geom$just[2] + )) + } + if (identical(geom$just[2], "top")) { + c(if (rot > 0) "right" else "left", "top") + } else if (identical(geom$just[2], "bottom")) { + c(if (rot > 0) "left" else "right", "bottom") + } else { + geom$just + } +} + +# The `text_grob` for one tick label. When `wrap_mm` (the mm width a single tick +# gets) is finite and the label is unrotated, the text wraps to that width and +# its lines centre under the tick; otherwise it is an ordinary single line drawn +# exactly where the old code placed it. Shared by the draw and the row/gutter +# height measurement (`.track_h_axis`) so the reserved track always matches. +.axis_text_grob <- function( + label, + el, + just, + x = vellum::vl_unit(0.5, "npc"), + y = vellum::vl_unit(0.5, "npc"), + rot = 0, + wrap_mm = NA_real_ +) { + wrap <- length(wrap_mm) == 1L && is.finite(wrap_mm) && wrap_mm > 0 && rot == 0 + # Tabular figures on tick labels: digits keep a constant advance width, so a + # column of numbers does not jitter left/right from tick to tick. Harmless on + # non-numeric labels (only digit glyphs are affected). + vellum::text_grob( + label, + x = x, + y = y, + just = just, + rot = rot, + width = if (wrap) vellum::vl_unit(wrap_mm, "mm") else NULL, + align = if (wrap) "centre" else "left", + gp = .el_gpar_text(el, features = .TNUM) + ) +} + +.draw_axis <- function( + scene, + row, + col, + sc, + rt, + axis, + sec = FALSE, + wrap_mm = NA_real_ +) { is_y <- identical(axis, "y") el <- rt[[if (is_y) "axis.text.y" else "axis.text.x"]] aline <- rt[[if (is_y) "axis.line.y" else "axis.line.x"]] @@ -352,10 +437,8 @@ NULL ) } if (!.is_blank(el)) { - # Tabular figures on tick labels: digits keep a constant advance width, so a - # column of numbers does not jitter left/right from tick to tick. Harmless on - # non-numeric labels (only digit glyphs are affected). - gp <- .el_gpar_text(el, features = .TNUM) + rot <- .el_rot(el) + just <- .axis_text_just(geom, el, rot) for (i in seq_along(sc$breaks)) { x <- if (is_y) { vellum::vl_unit(geom$lx, "npc") @@ -369,7 +452,15 @@ NULL } scene <- vellum::draw( scene, - vellum::text_grob(sc$labels[i], x = x, y = y, just = geom$just, gp = gp) + .axis_text_grob( + sc$labels[i], + el, + just, + x = x, + y = y, + rot = rot, + wrap_mm = wrap_mm + ) ) } } @@ -381,9 +472,12 @@ NULL .draw_axis(scene, row, col, y_sc, rt, "y") } -# x-axis labels for `x_sc`, centred under each gridline. -.draw_x_axis <- function(scene, row, col, x_sc, rt) { - .draw_axis(scene, row, col, x_sc, rt, "x") +# x-axis labels for `x_sc`, centred under each gridline. `wrap_mm` is the mm +# width one tick gets, so a long label wraps to its column instead of colliding +# with its neighbour; `NA` (the default, and every unknown-width path) keeps +# single-line labels. +.draw_x_axis <- function(scene, row, col, x_sc, rt, wrap_mm = NA_real_) { + .draw_axis(scene, row, col, x_sc, rt, "x", wrap_mm = wrap_mm) } # A facet strip: an optional filled background plus a centred label. `rot = 90` diff --git a/R/compile-layout.R b/R/compile-layout.R index 32a92a5..a14de1b 100644 --- a/R/compile-layout.R +++ b/R/compile-layout.R @@ -62,6 +62,23 @@ NULL vellum::vl_unit(pad_mm, "mm") } +# Height (mm) of the x tick-label row. Measured through the *same* grob the axis +# drawer builds (`.axis_text_grob`), so a rotated or wrapped label reserves the +# height it actually draws at. `wrap_mm` is the per-tick mm budget (NA = no wrap). +.track_h_axis <- function(el, label, pad_mm, rot = 0, wrap_mm = NA_real_) { + if (.is_blank(el)) { + return(vellum::vl_unit(0, "mm")) + } + g <- .axis_text_grob( + label, + el, + c("centre", "top"), + rot = rot, + wrap_mm = wrap_mm + ) + vellum::grobheight(g) + vellum::vl_unit(pad_mm, "mm") +} + # Build the panel + gutter layout. In the simplest single-panel case the columns # are [ y-title | y-labels | panel(null) ] and the rows [ panel(null) | x-labels # | x-title ]; faceting, strips, a legend track, and the title/subtitle/tag/ @@ -288,9 +305,19 @@ NULL function(p) (if (flip) p$y_sc else p$x_sc)$labels ))) tick <- rt[["axis.ticks.length"]] + # Tick labels honour the element's rotation (`axis.text.x/y` angle), so the + # gutter/row is sized from the *rotated* extent. The x tick-label row height is + # deferred to below (it also depends on the wrap budget, which needs the legend + # placement resolved first). + xrot <- .el_rot(rt[["axis.text.x"]]) + yrot <- .el_rot(rt[["axis.text.y"]]) yt <- .track_w(rt[["axis.title.y"]], vsc$name, .PAD_MM, rot = 90) - yl <- .track_w(rt[["axis.text.y"]], .longest(v_labs), tick + .PAD_MM) - xl <- .track_h(rt[["axis.text.x"]], .longest(h_labs), tick + .PAD_MM) + yl <- .track_w( + rt[["axis.text.y"]], + .longest(v_labs), + tick + .PAD_MM, + rot = yrot + ) xt <- .track_h(rt[["axis.title.x"]], hsc$name, .PAD_MM) # Secondary axes (opposite edge): a right-column pair for the vertical scale's # sec axis, a top-row pair for the horizontal scale's. Only sized when present, @@ -300,13 +327,23 @@ NULL has_y_sec <- !is.null(y_sec) has_x_sec <- !is.null(x_sec) y2l <- if (has_y_sec) { - .track_w(rt[["axis.text.y"]], .longest(y_sec$labels), tick + .PAD_MM) + .track_w( + rt[["axis.text.y"]], + .longest(y_sec$labels), + tick + .PAD_MM, + rot = yrot + ) } y2t <- if (has_y_sec) { .track_w(rt[["axis.title.y"]], y_sec$name, .PAD_MM, rot = 90) } x2l <- if (has_x_sec) { - .track_h(rt[["axis.text.x"]], .longest(x_sec$labels), tick + .PAD_MM) + .track_h( + rt[["axis.text.x"]], + .longest(x_sec$labels), + tick + .PAD_MM, + rot = xrot + ) } x2t <- if (has_x_sec) .track_h(rt[["axis.title.x"]], x_sec$name, .PAD_MM) # Polar panels carry their axis labels/titles inside the square panel, so the @@ -331,6 +368,75 @@ NULL legend_vert <- show_legend && pos %in% c("left", "right") legend_horiz <- show_legend && pos %in% c("top", "bottom") + # Per-x-tick wrap budget (mm): the panel's mm width shared among its x ticks, so + # a long discrete label wraps to its own column instead of running into its + # neighbour. Only knowable when the page width is set (`band_w`), the labels are + # unrotated, the x scale is shared, and the panel is a plain (unweighted) null + # track -- aspect/fixed/sf/polar/marginal give the panel a weighted null width + # that does not resolve to mm here, so those fall back to single-line labels. + # Panel mm = content box less the fixed flanking columns (y title/labels, any + # secondary y pair, a row strip, a vertical legend) and the inter-panel gaps, + # split across the C panel columns. + xwrap_mm <- NA_real_ + can_wrap_x <- is.finite(band_w) && + xrot == 0 && + !respect && + !polar && + is.null(marginal) && + !free_x && + length(hsc$breaks) > 0L && + !.is_blank(rt[["axis.text.x"]]) + if (can_wrap_x) { + leg_w <- if (legend_vert) { + .legend_width(guides, rt, legend_avail_h) + } else { + vellum::vl_unit(0, "mm") + } + side <- c( + list(yt, yl, leg_w), + if (has_row_strip) list(strip), + if (has_y_sec) list(y2l, y2t) + ) + side_mm <- sum(vapply( + side, + function(u) vellum::vl_convert(u, "mm"), + numeric(1) + )) + gaps_mm <- vellum::vl_convert(gap, "mm") * (C - 1L) + per_panel_mm <- (band_w - side_mm - gaps_mm) / C + # Any track that does not resolve to a plain mm (a null width slipping + # through) leaves `per_panel_mm` non-finite -- fall back to single-line. + if (isTRUE(per_panel_mm > 0)) { + budget <- per_panel_mm / length(hsc$breaks) + # Only engage wrapping when the widest label actually overruns its budget, + # so every plot whose labels already fit keeps its exact single-line layout + # (measured through the same grob the drawer builds). + el_x <- rt[["axis.text.x"]] + natural <- vellum::vl_convert( + vellum::grobwidth(.axis_text_grob( + .longest(h_labs), + el_x, + c("centre", "top") + )), + "mm" + ) + if (isTRUE(natural > budget)) { + xwrap_mm <- budget + } + } + } + # The x tick-label row height, now that the wrap budget is known (deferred from + # the gutter block above). Polar keeps the collapsed zero set earlier. + if (!polar) { + xl <- .track_h_axis( + rt[["axis.text.x"]], + .longest(h_labs), + tick + .PAD_MM, + rot = xrot, + wrap_mm = xwrap_mm + ) + } + # --- columns: [ legend(left)? | ytitle | (ylabels panel gap)xC | # row-strip? | legend(right)? ] --- W <- .tracks() @@ -476,6 +582,7 @@ NULL ncol_total = length(W$u), nrow_total = length(H$u), band_w = band_w, + xwrap_mm = xwrap_mm, respect = respect ) } diff --git a/R/elements.R b/R/elements.R index 4891227..b2b5e93 100644 --- a/R/elements.R +++ b/R/elements.R @@ -202,8 +202,9 @@ element_blank <- S7::new_class( ) } -# Text rotation for a resolved text element (degrees). -.el_rot <- function(el) el@angle %||% 0 +# Text rotation for a resolved text element (degrees). Blank elements draw +# nothing and carry no `angle` property, so they read as unrotated. +.el_rot <- function(el) if (.is_blank(el)) 0 else el@angle %||% 0 # The resolved sketch for a drawn line/rect element: the `vellum_sketch` it (or, # via the theme tree, a parent element) carries, else NULL (crisp). `NA` (forced diff --git a/R/seam.R b/R/seam.R index 882254f..04a6789 100644 --- a/R/seam.R +++ b/R/seam.R @@ -544,7 +544,8 @@ NULL lay$xlabels_row[1], lay$panel_col[cc], warp_h(hshared), - rt + rt, + lay$xwrap_mm ) } } diff --git a/inst/examples/32-axis-labels.R b/inst/examples/32-axis-labels.R new file mode 100644 index 0000000..5667b1a --- /dev/null +++ b/inst/examples/32-axis-labels.R @@ -0,0 +1,33 @@ +# Rotating and wrapping long axis tick labels. + +library(vellumplot) +outdir <- "figures" +dir.create(outdir, showWarnings = FALSE) + +gdp <- data.frame( + country = c( + "United States", "United Kingdom", "United Arab Emirates", + "Republic of Korea", "Czech Republic" + ), + score = c(9, 6, 7, 8, 5) +) + +# Rotate the tick labels: the gutter reserves the rotated height automatically. +render_plot( + vplot(gdp) |> + mark_bar(x = country, y = score) |> + theme(axis.text.x = element_text(angle = 45)) |> + labs(title = "Rotated axis labels"), + file.path(outdir, "32-rotated.png") +) + +# Left horizontal, a label wider than its tick spacing wraps onto more lines and +# the row grows to fit. Labels that already fit are unchanged. +render_plot( + vplot(gdp) |> + mark_bar(x = country, y = score) |> + labs(title = "Wrapped axis labels"), + file.path(outdir, "32-wrapped.png") +) + +message("32-axis-labels: wrote rotated + wrapped bar charts to ", outdir) diff --git a/tests/testthat/test-axis-text.R b/tests/testthat/test-axis-text.R new file mode 100644 index 0000000..8067137 --- /dev/null +++ b/tests/testthat/test-axis-text.R @@ -0,0 +1,118 @@ +# Axis tick-label rotation (axis.text angle) and wrapping/auto-fit of long +# labels to their per-tick width. + +# Bottom edge of the grey panel as a fraction of image height: the last row that +# is *mostly* grey panel. A taller x-label band (rotated or wrapped labels) pushes +# the panel up, so this fraction shrinks. +panel_floor_bar <- function(p) { + img <- render_px(p) + grey <- abs(img[,, 1] - img[,, 2]) < 0.03 & + img[,, 1] > 0.85 & + img[,, 1] < 0.97 + rows <- which(rowMeans(grey) > 0.4) + rows[length(rows)] / dim(img)[1] +} + +longcats <- data.frame( + cat = c( + "Central metropolitan area", + "Isolated island group", + "Northern region", + "Southeastern district", + "Western rural counties" + ), + val = c(9, 6, 8, 5, 4) +) +shortcats <- data.frame( + cat = c("A", "B", "C", "D", "E"), + val = c(9, 6, 8, 5, 4) +) +medcats <- data.frame( + cat = c("alpha", "bravo", "charlie", "delta", "echo"), + val = c(9, 6, 8, 5, 4) +) + +# ---- unit: rotation plumbing ----------------------------------------------- + +test_that(".el_rot reads an angle and is blank-safe", { + expect_identical(vellumplot:::.el_rot(element_text(angle = 45)), 45) + expect_identical(vellumplot:::.el_rot(element_text()), 0) + # element_blank() carries no `angle` property; it must read as unrotated. + expect_identical(vellumplot:::.el_rot(element_blank()), 0) +}) + +test_that("rotated tick labels anchor the end of the run at the tick", { + geom <- list(just = c("centre", "top")) + el <- element_text() + # unrotated keeps the track's fixed anchor (byte-identical path) + expect_identical( + vellumplot:::.axis_text_just(geom, el, 0), + c("centre", "top") + ) + # a positive slant hangs down-left (right/top); a negative one down-right + expect_identical( + vellumplot:::.axis_text_just(geom, el, 45), + c("right", "top") + ) + expect_identical( + vellumplot:::.axis_text_just(geom, el, -45), + c("left", "top") + ) + # an explicit hjust/vjust wins over the default + expect_identical( + vellumplot:::.axis_text_just( + geom, + element_text(hjust = 0, vjust = 0.5), + 90 + ), + c("left", "centre") + ) +}) + +# ---- unit: wrapping stacks a long label ------------------------------------ + +test_that("a wrap width stacks a long label into more vertical space", { + el <- element_text(size = 9) + mm <- function(g) vellum::vl_convert(vellum::grobheight(g), "mm") + tall <- vellumplot:::.axis_text_grob( + "Central metropolitan area", + el, + c("centre", "top"), + wrap_mm = 18 + ) + flat <- vellumplot:::.axis_text_grob( + "Central metropolitan area", + el, + c("centre", "top"), + wrap_mm = NA_real_ + ) + expect_gt(mm(tall), mm(flat)) +}) + +# ---- integration: rotation + wrapping reserve height ----------------------- + +test_that("axis.text.x angle rotates labels and reserves row height", { + base <- vplot(medcats, width = 6, height = 4) |> mark_bar(x = cat, y = val) + rotated <- base |> theme(axis.text.x = element_text(angle = 90)) + # vertical labels make the x-label band taller, so the panel floor rises + expect_lt(panel_floor_bar(rotated), panel_floor_bar(base)) +}) + +test_that("long discrete x labels wrap and reserve more height than short ones", { + long <- vplot(longcats, width = 6, height = 4) |> mark_bar(x = cat, y = val) + short <- vplot(shortcats, width = 6, height = 4) |> mark_bar(x = cat, y = val) + # wrapped multi-line labels push the panel up relative to single-char labels + expect_lt(panel_floor_bar(long), panel_floor_bar(short)) +}) + +test_that("rotated and wrapped axes render without error", { + long <- vplot(longcats, width = 6, height = 4) |> mark_bar(x = cat, y = val) + expect_no_error(vellum::as_vellum_scene(long)) + expect_no_error(vellum::as_vellum_scene( + long |> theme(axis.text.x = element_text(angle = 45)) + )) + # y-axis rotation and a faceted (free-x) case exercise the fallback paths + expect_no_error(vellum::as_vellum_scene( + long |> theme(axis.text.y = element_text(angle = 45)) + )) +}) diff --git a/vignettes/articles/effects-and-themes.qmd b/vignettes/articles/effects-and-themes.qmd index c80bd7f..73ac4af 100644 --- a/vignettes/articles/effects-and-themes.qmd +++ b/vignettes/articles/effects-and-themes.qmd @@ -59,6 +59,37 @@ vplot(mtcars) |> labs(title = "Fuel economy") ``` +### Rotating and wrapping axis labels + +Long category names on a discrete axis are a perennial nuisance: side by side +they collide. Two theme controls handle this. Setting an `angle` on +`axis.text.x` rotates the tick labels, and the gutter reserves the extra height +automatically; an explicit `hjust`/`vjust` sets the anchor, and otherwise the +end of the run is pinned at the tick so the slant clears the panel. + +```{r} +gdp <- data.frame( + country = c( + "United States", "United Kingdom", "United Arab Emirates", + "Republic of Korea", "Czech Republic" + ), + score = c(9, 6, 7, 8, 5) +) +vplot(gdp) |> + mark_bar(x = country, y = score) |> + theme(axis.text.x = element_text(angle = 45)) +``` + +Left horizontal, a long label that would overrun the width of its tick instead +**wraps** onto multiple lines, and the label row grows to fit — the per-tick +companion of the title/subtitle/caption wrapping. Labels that already fit are +untouched, so a plain numeric axis is unchanged. + +```{r} +vplot(gdp) |> + mark_bar(x = country, y = score) +``` + ## Layer effects Effects change how a single mark is painted, and they are passed to a mark's