Skip to content

Fast-path cell drawing + position-based tokenizer #39

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
billdenney wants to merge 3 commits into
base: main
Choose a base branch
from
Open

Fast-path cell drawing + position-based tokenizer #39

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
7fcf208
Fast-path cell drawing + position-based tokenizer
billdenney May 12, 2026
61bd26a
Share clip-width cache across all pages of one tfl_table
billdenney May 12, 2026
b196ca3
Consolidate width+height measurement into one cache during pagination
billdenney May 12, 2026
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
18 changes: 13 additions & 5 deletions R/table_columns.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -96,14 +96,16 @@ compute_col_widths <- function(resolved_cols, data, content_width_in,
tbl, pg_width, pg_height, margins,
overflow_action = c("error", "warn"),
validate_overflow = TRUE,
floor_overrides = NULL) {
floor_overrides = NULL,
cache = NULL) {
overflow_action <- match.arg(overflow_action)
strategy <- tbl$col_split_strategy %||% "balanced"

# Shared setup: compute natural widths, resolve relative weights,
# auto-detect wrap eligibility, and measure col_cont_label_half_w.
setup <- .resolve_natural_widths(
resolved_cols, data, content_width_in, tbl, pg_width, pg_height, margins
resolved_cols, data, content_width_in, tbl, pg_width, pg_height, margins,
cache = cache
)

# Dispatch. Each strategy returns list(resolved_cols, col_groups).
Expand Down Expand Up @@ -162,7 +164,8 @@ compute_col_widths <- function(resolved_cols, data, content_width_in,
# The scratch device used for text measurement is opened, used, and
# closed inside this function so neither strategy has to manage it.
.resolve_natural_widths <- function(resolved_cols, data, content_width_in,
tbl, pg_width, pg_height, margins) {
tbl, pg_width, pg_height, margins,
cache = NULL) {
n_cols <- length(resolved_cols)
n_grp <- length(tbl$group_vars)
min_in <- .width_in(tbl$min_col_width)
Expand All @@ -171,6 +174,7 @@ compute_col_widths <- function(resolved_cols, data, content_width_in,
.width_in(cell_pad[["left"]])
na_str <- tbl$na_string
max_rows <- tbl$max_measure_rows
hdr_gp_key <- paste0("header_row_lh", tbl$line_height)

scratch_file <- tempfile(fileext = ".pdf")
grDevices::pdf(scratch_file, width = pg_width, height = pg_height)
Expand Down Expand Up @@ -198,8 +202,12 @@ compute_col_widths <- function(resolved_cols, data, content_width_in,
.resolve_table_gp(tbl$gp, "header_row"), tbl$line_height
)
parts <- .split_col_strings(data[[cs$col]], cs$label, na_str, max_rows)
w_data <- .measure_max_string_width(parts$data, cell_gp)
w_hdr <- .measure_max_string_width(parts$header, hdr_gp)
cell_key <- paste0(if (cs$is_group_col) "group_col" else "data_row",
"_lh", tbl$line_height)
w_data <- .measure_max_string_width(parts$data, cell_gp,
gp_key = cell_key, cache = cache)
w_hdr <- .measure_max_string_width(parts$header, hdr_gp,
gp_key = hdr_gp_key, cache = cache)
max(min_in, max(w_data, w_hdr) + h_pad_in)
}
}, numeric(1L))
Expand Down
82 changes: 62 additions & 20 deletions R/table_draw.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -66,7 +66,8 @@ build_table_grob <- function(row_page, col_group_idx, n_group_cols,
cell_heights_in_mat = NULL,
cont_row_h_in = NULL,
is_first_col_page = TRUE,
is_last_col_page = TRUE) {
is_last_col_page = TRUE,
clip_width_caches = NULL) {
# Subset to display columns for this page
page_cols <- resolved_cols[col_group_idx]

Expand All @@ -81,6 +82,11 @@ build_table_grob <- function(row_page, col_group_idx, n_group_cols,
cont_row_h_in = cont_row_h_in, # cached from paginate phase
is_first_col_page = is_first_col_page, # FALSE when prior col pages exist
is_last_col_page = is_last_col_page, # FALSE when more col pages follow
clip_width_caches = clip_width_caches, # shared across all pages of
# this tfl_table; NULL means
# drawDetails will create
# per-page envs (e.g. grobs
# assembled outside pipeline)
cl = "tfl_table_grob"
)
}
Expand Down Expand Up @@ -300,12 +306,22 @@ drawDetails.tfl_table_grob <- function(x, recording) {
})

# Per-column clip-width memo: many cells in a column share identical text
# (numeric formats like "5.1", category labels), and the clip-width
# computation otherwise re-measures each one. Cache scoped to this
# drawDetails call and to one column, so a single (text -> width) key is
# enough.
clip_width_cache_by_col <- lapply(page_cols, function(cs) {
new.env(hash = TRUE, parent = emptyenv())
# (numeric formats like "5.1", category labels). When the parent
# tfl_table_to_pagelist() built a shared cache list, reuse those envs --
# they persist across every row-page and col-group of this table, so the
# cache hits accumulate over all pages. Otherwise fall back to per-page
# envs (e.g. for grobs built outside the normal pipeline).
clip_width_cache_by_col <- if (!is.null(x$clip_width_caches)) {
lapply(x$col_group_idx, function(k) x$clip_width_caches[[k]])
} else {
lapply(page_cols, function(cs) new.env(hash = TRUE, parent = emptyenv()))
}

# Pre-extract and pre-format each column's cell strings for the rows on
# this page. Replaces a per-cell `.fmt_cell(data[[cs$col]][i], na_str)`
# with a single vectorised `.fmt_cell_vec()` per column.
cell_strs_by_col <- lapply(page_cols, function(cs) {
.fmt_cell_vec(data[[cs$col]][rows], na_str)
})

# Hoist row/group-rule gpars too -- they don't change between rows. Only
Expand Down Expand Up @@ -358,9 +374,8 @@ drawDetails.tfl_table_grob <- function(x, recording) {

# Draw data row
for (j in seq_len(n_disp_cols)) {
cs <- page_cols[[j]]
raw_val <- data[[cs$col]][i]
cell_str <- .fmt_cell(raw_val, na_str)
cs <- page_cols[[j]]
cell_str <- cell_strs_by_col[[j]][[ri]]

# Group repeat suppression and span detection
clip_h <- row_h
Expand Down Expand Up @@ -590,10 +605,38 @@ drawDetails.tfl_table_grob <- function(x, recording) {
# call; the optional per-column cache lets the caller deduplicate.
text_w <- .measure_text_width_in(text, gp, width_cache)
needed <- text_w + h_lft_in + h_rgt_in
bleed_tol_in <- 0.05
clip_w <- min(col_width_in + bleed_tol_in, max(col_width_in, needed))

# Clip to column width by using a clipping viewport
# X position in parent-viewport inches.
x_in <- if (identical(align, "left")) {
x_left + h_lft_in
} else if (identical(align, "right")) {
x_right - h_rgt_in
} else {
(x_left + x_right) / 2
}
y_in <- y_top_in + v_top_in

if (needed <= col_width_in) {
# Fast path: the text fits inside its column, so the column width
# already clips by construction. Draw directly into the parent
# viewport and skip the per-cell clip viewport push/pop entirely --
# for tables of all-fits cells (numeric columns, short categoricals)
# this saves a viewport per cell.
grid::grid.text(
label = text,
x = grid::unit(x_in / vp_w, "npc"),
y = grid::unit(1 - y_in / vp_h, "npc"),
just = just,
gp = gp
)
return(invisible(NULL))
}

# Slow path: text exceeds the column. Push a clipping viewport so the
# overflow is clipped at the column edge plus a small tolerance,
# instead of bleeding into the neighbour.
bleed_tol_in <- 0.05
clip_w <- min(col_width_in + bleed_tol_in, needed)
vp_clip <- grid::viewport(
x = grid::unit(x_left / vp_w, "npc"),
y = grid::unit(1 - (y_top_in + row_h) / vp_h, "npc"),
Expand All @@ -604,18 +647,17 @@ drawDetails.tfl_table_grob <- function(x, recording) {
)
grid::pushViewport(vp_clip)

# Re-express x, y relative to clip viewport
vp_w2 <- .width_in(grid::unit(1, "npc"))
vp_h2 <- .height_in(grid::unit(1, "npc"))

# vp_clip was just constructed with width = clip_w inches and
# height = row_h inches, so npc=1 inside it is exactly that many inches --
# no need to convertUnit() to recover those numbers.
x_local_in <- if (identical(align, "left")) {
h_lft_in
} else if (identical(align, "right")) {
vp_w2 - h_rgt_in
clip_w - h_rgt_in
} else {
vp_w2 / 2
clip_w / 2
}
y_local_in <- vp_h2 - v_top_in
y_local_in <- row_h - v_top_in

grid::grid.text(
label = text,
Expand Down
33 changes: 28 additions & 5 deletions R/table_pagelist.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -150,6 +150,15 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
wrap_extra_pad_in <- if (!is.null(tbl$wrap_extra_padding)) {
.height_in(tbl$wrap_extra_padding)
} else 0

# Per-pagination text-dimension cache. Spans the natural-width pass,
# the row-height pass, and the header-height pass. Each (gp_key, string)
# is constructed via grid::textGrob exactly once; both dimensions are read
# from that grob and cached together. Different passes typically need
# only one dimension, so the cache amortises the other for free. All
# those passes open PDF scratch devices with the same pg_width/pg_height
# so font metrics are stable across the cache's lifetime.
text_dim_cache <- new.env(hash = TRUE, parent = emptyenv())
strategy <- tbl$col_split_strategy %||% "balanced"
max_retries <- as.integer(tbl$row_overflow_max_retries %||% 5L)
use_retry_loop <- identical(strategy, "balanced") && max_retries > 0L
Expand Down Expand Up @@ -178,14 +187,16 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
header_row_h <- if (tbl$show_col_names) {
.measure_header_row_height(resolved_cols, tbl$gp, tbl$cell_padding,
tbl$line_height, breaks = breaks,
wrap_extra_pad_in = wrap_extra_pad_in)
wrap_extra_pad_in = wrap_extra_pad_in,
cache = text_dim_cache)
} else 0

cell_h_mat <- measure_row_heights_tbl(
tbl$data, resolved_cols, tbl$gp, tbl$cell_padding,
tbl$na_string, tbl$line_height, tbl$max_measure_rows,
breaks = breaks,
wrap_extra_pad_in = wrap_extra_pad_in
wrap_extra_pad_in = wrap_extra_pad_in,
cache = text_dim_cache
)

cont_row_h <- max(
Expand Down Expand Up @@ -217,7 +228,8 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
col_result <- compute_col_widths(
resolved_cols_0, tbl$data, cw, tbl, pg_width, pg_height, margins,
overflow_action = overflow_action,
floor_overrides = floor_overrides
floor_overrides = floor_overrides,
cache = text_dim_cache
)
resolved_cols <- col_result$resolved_cols
col_groups <- col_result$col_groups
Expand All @@ -239,7 +251,8 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
resolved_cols_0, tbl$data, cw_adj, tbl, pg_width, pg_height, margins,
overflow_action = overflow_action,
validate_overflow = FALSE,
floor_overrides = floor_overrides
floor_overrides = floor_overrides,
cache = text_dim_cache
)
resolved_cols <- col_result$resolved_cols
col_groups <- col_result$col_groups
Expand Down Expand Up @@ -287,6 +300,15 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
pages <- vector("list", n_rp * n_cg)
idx <- 1L

# Shared per-resolved_cols clip-width cache. Every page-grob built below
# holds a reference to the SAME list of envs, so .draw_cell_text() can
# reuse measurements across pages of the same tfl_table (one entry per
# unique cell text per column). Envs are reference-typed, so memory is
# not duplicated per grob.
clip_width_caches <- lapply(seq_along(resolved_cols), function(k) {
new.env(hash = TRUE, parent = emptyenv())
})

for (rp in seq_len(n_rp)) {
for (cg in seq_len(n_cg)) {
grob <- build_table_grob(
Expand All @@ -298,7 +320,8 @@ tfl_table_to_pagelist <- function(tbl, pg_width, pg_height, dots,
cell_heights_in_mat = cell_h_mat,
cont_row_h_in = cont_row_h,
is_first_col_page = (cg == 1L),
is_last_col_page = (cg == n_cg)
is_last_col_page = (cg == n_cg),
clip_width_caches = clip_width_caches
)
page_spec <- list(content = grob)
pages[[idx]] <- page_spec
Expand Down
22 changes: 9 additions & 13 deletions R/table_rows.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -26,25 +26,21 @@
#' @keywords internal
measure_row_heights_tbl <- function(data, resolved_cols, gp_tbl, cell_padding,
na_string, line_height, max_measure_rows,
breaks = NULL, wrap_extra_pad_in = 0) {
breaks = NULL, wrap_extra_pad_in = 0,
cache = NULL) {
n_rows <- nrow(data)
n_cols <- length(resolved_cols)
v_pad_in <- .height_in(cell_padding[["top"]]) +
.height_in(cell_padding[["bottom"]])
h_lft_in <- .width_in(cell_padding[["left"]])
h_rgt_in <- .width_in(cell_padding[["right"]])

# Memoised per-cell-text-height function: (string, gp_key) -> height_in
memo <- new.env(hash = TRUE, parent = emptyenv())
.memo_str_height <- function(s, gp_key, gp) {
key <- paste0(gp_key, "\x01", s)
if (!exists(key, envir = memo, inherits = FALSE)) {
grob <- grid::textGrob(s, gp = gp)
h <- .height_in(grid::grobHeight(grob))
assign(key, h, envir = memo)
}
get(key, envir = memo, inherits = FALSE)
}
# When the caller supplied a shared cache, reuse it across columns so that
# any (string, gp) measured during the natural-width pass earlier in
# pagination is served from the cache here. Otherwise create a local
# height-only memo (preserves the pre-cache behaviour for the few callers
# that exercise this function directly).
if (is.null(cache)) cache <- new.env(hash = TRUE, parent = emptyenv())

# Limit rows sampled for height estimation
sample_rows <- if (is.finite(max_measure_rows) && n_rows > max_measure_rows) {
Expand Down Expand Up @@ -83,7 +79,7 @@ measure_row_heights_tbl <- function(data, resolved_cols, gp_tbl, cell_padding,
cell_str
}
nlines <- max(1L, length(strsplit(display_str, "\n", fixed = TRUE)[[1L]]))
h_grob <- .memo_str_height(display_str, gp_key, cell_gp)
h_grob <- .measure_text_dims_in(display_str, cell_gp, gp_key, cache)$h
h_line <- nlines * .height_in(grid::stringHeight("M"))
extra <- if (nlines > 1L) wrap_extra_pad_in else 0
cell_h_mat[i, j] <- max(h_grob, h_line) + v_pad_in + extra
Expand Down
47 changes: 43 additions & 4 deletions R/table_utils.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -52,13 +52,15 @@
# between the header row and the first data row is more obvious.
.measure_header_row_height <- function(resolved_cols, gp_tbl, cell_padding,
line_height, breaks = NULL,
wrap_extra_pad_in = 0) {
wrap_extra_pad_in = 0,
cache = NULL) {
v_pad_in <- .height_in(cell_padding[["top"]]) +
.height_in(cell_padding[["bottom"]])
h_lft_in <- .width_in(cell_padding[["left"]])
h_rgt_in <- .width_in(cell_padding[["right"]])
hdr_gp <- .gp_with_lineheight(.resolve_table_gp(gp_tbl, "header_row"),
line_height)
gp_key <- paste0("header_row_lh", line_height)

max(vapply(resolved_cols, function(cs) {
label <- cs$label
Expand All @@ -67,8 +69,7 @@
h_lft_in + h_rgt_in, hdr_gp, breaks)
}
nlines <- max(1L, length(strsplit(label, "\n", fixed = TRUE)[[1L]]))
grob <- grid::textGrob(label, gp = hdr_gp)
h_grob <- .height_in(grid::grobHeight(grob))
h_grob <- .measure_text_dims_in(label, hdr_gp, gp_key, cache)$h
h_line <- nlines * .height_in(grid::stringHeight("M"))
extra <- if (nlines > 1L) wrap_extra_pad_in else 0
max(h_grob, h_line) + extra
Expand Down Expand Up @@ -255,15 +256,53 @@
# Text measurement helpers
# ---------------------------------------------------------------------------

# Look up or measure (width, height) for `s` under `gp`, caching both when
# an environment is supplied. `gp_key` is a stable structural key for `gp`
# (e.g. paste0("data_row_lh", line_height)) so callers using the same gp
# share entries without hashing the gpar field-by-field per lookup.
#
# When the cache misses we build the textGrob once and read BOTH dimensions
# from it -- consolidating what would otherwise be two separate textGrob
# constructions if a later caller needs the other dimension of the same
# (gp, string). Each construction re-runs grid's gpar validation, which
# is the dominant cost; avoiding the duplicate is the point.
.measure_text_dims_in <- function(s, gp, gp_key, cache = NULL) {
if (!nzchar(s)) return(list(w = 0, h = 0))
if (!is.null(cache)) {
key <- paste0(gp_key, "\x01", s)
if (exists(key, envir = cache, inherits = FALSE)) {
return(get(key, envir = cache, inherits = FALSE))
}
}
g <- grid::textGrob(s, gp = gp)
out <- list(w = .width_in(grid::grobWidth(g)),
h = .height_in(grid::grobHeight(g)))
if (!is.null(cache)) assign(key, out, envir = cache)
out
}

# Measure the maximum rendered text width (in inches) for a vector of strings.
# Uses textGrob rather than stringWidth() because stringWidth() does not
# accept a gp argument in all grid versions.
.measure_max_string_width <- function(strings, gp) {
#
# When a `cache` env and `gp_key` are supplied, lookups go through the
# consolidated (string -> (w, h)) cache from `.measure_text_dims_in()` so a
# later height query for the same (string, gp) reuses the textGrob.
.measure_max_string_width <- function(strings, gp, gp_key = NULL,
cache = NULL) {
if (length(strings) == 0L) return(0)
# Dedupe up front: real-world callers pass cell-string vectors where the
# same value typically appears in many rows (e.g. category labels, NA
# strings), so this saves grid round-trips with no behaviour change.
uniq <- unique(strings)
if (!is.null(cache) && !is.null(gp_key)) {
return(max(vapply(uniq, function(s) {
lines <- strsplit(s, "\n", fixed = TRUE)[[1L]]
max(vapply(lines,
function(ln) .measure_text_dims_in(ln, gp, gp_key, cache)$w,
numeric(1L)))
}, numeric(1L))))
}
max(vapply(uniq, function(s) {
lines <- strsplit(s, "\n", fixed = TRUE)[[1L]]
max(vapply(lines, function(ln) {
Expand Down
Loading
Loading