perf(save_tt): vectorize style resolution and typst CSS builder

DESCRIPTION

@@ -2,7 +2,7 @@ Package: tinytable
 Type: Package
 Title: Simple and Configurable Tables in 'HTML', 'LaTeX', 'Markdown', 'Word', 'PNG', 'PDF', and 'Typst' Formats
 Description: Create highly customized tables with this simple and dependency-free package. Data frames can be converted to 'HTML', 'LaTeX', 'Markdown', 'Word', 'PNG', 'PDF', or 'Typst' tables. The user interface is minimalist and easy to learn. The syntax is concise. 'HTML' tables can be customized using the flexible 'Bootstrap' framework, and 'LaTeX' code with the 'tabularray' package.
-Version: 0.16.0.14
+Version: 0.17.0.1
 Imports:
     methods
 Depends:

NEWS.md

@@ -2,6 +2,10 @@
 
 ## Development
 
+* Performance improvements to `style_tt()`. Thanks to @EinMaulwurf for PR #663.
+
+## 0.17.0
+
 * `theme_typst()` no longer emits figure-level center alignment by default. Typst tables now use the document's default alignment unless `align_figure` or the `tinytable_typst_align_figure` option is set.
 * `theme_typst()` gains `resize_width`, `resize_height`, and `resize_direction` arguments to resize wide or tall Typst tables, paralleling `theme_latex()`. Thanks to @tomasrei for feature request #657.
 * `theme_typst(portable = TRUE)` embeds local images directly in generated Typst code using base64 data, avoiding external image paths. Thanks to @jnnkB for the suggestion in Issue #652.

R/build_tt.R

@@ -162,21 +162,23 @@ build_tt <- function(x, output = NULL) {
   x <- style_notes(x)
   x <- style_caption(x)
 
-  # Populate @style_other and @style_lines by applying each entry from @style sequentially
-  # This must happen before build_eval() for backends (like Grid) that apply styles during build
-  x@style_lines <- data.frame()  # Initialize empty line dataframe
-
-  for (idx in seq_len(nrow(x@style))) {
-    style_row <- x@style[idx, , drop = FALSE]
-    # Apply non-line styles (overwrites)
-    x@style_other <- apply_style_to_rect(x@style_other, style_row)
-    # Apply line styles (appends)
-    x@style_lines <- append_lines_to_rect(x@style_lines, style_row, rect)
-  }
+  # Populate @style_other and @style_lines by resolving @style in a single
+  # batched pass. This must happen before build_eval() for backends (like
+  # Grid) that apply styles during build.
+  # The original per-row loop with apply_style_to_rect()/append_lines_to_rect()
+  # is preserved here as a fallback; for non-trivial style counts the batched
+  # resolver in resolve_styles_batch() is dramatically faster because it does
+  # not rescan the entire rectangular grid for every style_tt() entry.
+  resolved <- resolve_styles_batch(x@style_other, x@style)
+  has_style <- resolved$has_style
+  x@style_other <- resolved$other
+  x@style_lines <- resolved$lines
 
   # Sort style_other for consistent ordering (j first, then i within each j)
   # This ensures test snapshots are deterministic
-  x@style_other <- x@style_other[order(x@style_other$j, x@style_other$i), ]
+  ord <- order(x@style_other$j, x@style_other$i)
+  x@style_other <- x@style_other[ord, ]
+  attr(x@style_other, "has_style") <- has_style[ord]
 
   # draw the table
   x <- build_eval(x)

R/expand_style.R

@@ -89,6 +89,164 @@ append_lines_to_rect <- function(style_lines, style_row, rect) {
 }
 
 
+#' Resolve all entries of @style into the rectangular @style_other grid and
+#' the line list @style_lines in a single batched pass.
+#'
+#' This is functionally equivalent to (and produces value-identical output as)
+#' the per-row loop:
+#'   for (idx in seq_len(nrow(x@style))) {
+#'     style_other <- apply_style_to_rect(style_other, x@style[idx,])
+#'     style_lines <- append_lines_to_rect(style_lines, x@style[idx,], rect)
+#'   }
+#' but is O(N + cells) instead of O(N * cells * props) by avoiding the per-row
+#' full-rect mask scan. The naive loop becomes the dominant bottleneck once a
+#' table accumulates more than a few hundred style_tt() entries (which is
+#' common when styling individual cells for heat-map-like effects, alternating
+#' row backgrounds, or per-column alignment).
+#'
+#' @param style_other Rectangular dataframe of (i, j, <props>) initialized with NAs
+#' @param style_df @style data frame (one row per style_tt setting entry)
+#' @return list(other=, lines=) with the populated data frames
+#' @keywords internal
+#' @noRd
+resolve_styles_batch <- function(style_other, style_df) {
+  n <- nrow(style_df)
+  empty_lines <- data.frame(
+    i = integer(0), j = integer(0),
+    line = character(0),
+    line_color = character(0),
+    line_width = numeric(0),
+    line_trim = character(0),
+    stringsAsFactors = FALSE
+  )
+  if (n == 0) {
+    return(list(
+      other = style_other,
+      lines = empty_lines,
+      has_style = rep(FALSE, nrow(style_other))
+    ))
+  }
+
+  style_props <- c("bold", "italic", "underline", "strikeout",
+                   "monospace", "smallcap", "align", "alignv",
+                   "color", "background", "fontsize", "indent",
+                   "html_css", "colspan", "rowspan")
+
+  # Unique i and j present in style_other (used when i or j is NA meaning "all")
+  so_i <- style_other$i
+  so_j <- style_other$j
+  uniq_i <- unique(so_i)
+  uniq_j <- unique(so_j)
+
+  idx_matrix <- matrix(
+    NA_integer_,
+    nrow = length(uniq_i),
+    ncol = length(uniq_j),
+    dimnames = list(as.character(uniq_i), as.character(uniq_j))
+  )
+  idx_matrix[cbind(match(so_i, uniq_i), match(so_j, uniq_j))] <- seq_along(so_i)
+
+  sd_i <- style_df$i
+  sd_j <- style_df$j
+  i_na <- is.na(sd_i)
+  j_na <- is.na(sd_j)
+
+  target_i <- vector("list", n)
+  target_j <- vector("list", n)
+  target_idx <- vector("list", n)
+  for (k in seq_len(n)) {
+    target_i[[k]] <- if (i_na[k]) uniq_i else sd_i[k]
+    target_j[[k]] <- if (j_na[k]) uniq_j else sd_j[k]
+
+    i_pos <- if (i_na[k]) seq_along(uniq_i) else match(sd_i[k], uniq_i)
+    j_pos <- if (j_na[k]) seq_along(uniq_j) else match(sd_j[k], uniq_j)
+    if (anyNA(i_pos) || anyNA(j_pos)) {
+      target_idx[[k]] <- integer(0)
+    } else {
+      idx <- as.vector(idx_matrix[i_pos, j_pos, drop = FALSE])
+      target_idx[[k]] <- idx[!is.na(idx)]
+    }
+  }
+
+  has_style <- rep(FALSE, nrow(style_other))
+
+  # For each property, walk style rows that have a non-NA value, in order,
+  # and write directly into style_other at the matching linear indices.
+  # "Last write wins" semantics is preserved by iterating in source order.
+  for (prop in style_props) {
+    if (!prop %in% names(style_df)) next
+    vals <- style_df[[prop]]
+    has <- which(!is.na(vals))
+    if (length(has) == 0L) next
+    for (k in has) {
+      idx <- target_idx[[k]]
+      if (length(idx)) {
+        style_other[[prop]][idx] <- vals[[k]]
+        has_style[idx] <- TRUE
+      }
+    }
+  }
+
+  # Lines are additive: expand every style_df row that has a non-NA `line`
+  # into one entry per (i, j) cell, then rbind() once at the end.
+  has_line <- which(!is.na(style_df$line))
+  if (length(has_line)) {
+    line_color_col <- if ("line_color" %in% names(style_df)) style_df$line_color else rep(NA_character_, n)
+    line_width_col <- if ("line_width" %in% names(style_df)) style_df$line_width else rep(NA_real_, n)
+    line_trim_col  <- if ("line_trim"  %in% names(style_df)) style_df$line_trim  else rep(NA_character_, n)
+
+    line_entries <- vector("list", length(has_line))
+    for (kp in seq_along(has_line)) {
+      k <- has_line[kp]
+      ri <- target_i[[k]]
+      rj <- target_j[[k]]
+      # cartesian product (preserves append_lines_to_rect ordering)
+      line_entries[[kp]] <- data.frame(
+        i = rep(ri, times = length(rj)),
+        j = rep(rj, each  = length(ri)),
+        line = style_df$line[k],
+        line_color = line_color_col[k],
+        line_width = line_width_col[k],
+        line_trim  = line_trim_col[k],
+        stringsAsFactors = FALSE
+      )
+    }
+    style_lines <- do.call(rbind, line_entries)
+  } else {
+    style_lines <- empty_lines
+  }
+
+  list(other = style_other, lines = style_lines, has_style = has_style)
+}
+
+
+#' Filter a rectangular @style_other grid to rows relevant for a backend
+#' @keywords internal
+#' @noRd
+filter_style_other <- function(style_other, style_cols) {
+  if (is.null(style_other) || nrow(style_other) == 0) {
+    return(style_other)
+  }
+
+  style_cols <- intersect(style_cols, names(style_other))
+  if (length(style_cols) == 0L) {
+    return(style_other[0, , drop = FALSE])
+  }
+
+  has_style <- attr(style_other, "has_style", exact = TRUE)
+  if (!is.null(has_style) && length(has_style) == nrow(style_other)) {
+    style_other <- style_other[has_style, , drop = FALSE]
+  }
+
+  if (nrow(style_other) == 0) {
+    return(style_other)
+  }
+
+  has_backend_style <- rowSums(!is.na(style_other[, style_cols, drop = FALSE])) > 0
+  style_other[has_backend_style, , drop = FALSE]
+}
+
+
 # NOTE: expand_lines() and expand_style() have been removed.
 # Line styles are now handled via @style_lines in build_tt()
 # Other styles are handled via @style_other in build_tt()

R/grid_style.R

@@ -14,10 +14,7 @@ prepare_grid_style <- function(x) {
     return(sty)
   }
 
-  # Select only the columns needed for grid styling
-  sty <- sty[, c(
-    "i",
-    "j",
+  style_cols <- c(
     "bold",
     "italic",
     "strikeout",
@@ -28,13 +25,16 @@ prepare_grid_style <- function(x) {
     "background",
     "colspan",
     "rowspan"
-  ), drop = FALSE]
+  )
+
+  sty <- filter_style_other(sty, style_cols)
 
-  # Filter to only cells that have actual styles
-  has_style <- rowSums(!is.na(sty[, c("bold", "italic", "strikeout", "underline",
-                                       "smallcap", "indent", "color", "background",
-                                       "colspan", "rowspan"), drop = FALSE])) > 0
-  sty <- sty[has_style, , drop = FALSE]
+  # Select only the columns needed for grid styling
+  sty <- sty[, c(
+    "i",
+    "j",
+    style_cols
+  ), drop = FALSE]
 
   return(sty)
 }

R/html_style.R

@@ -185,14 +185,12 @@ setMethod(
     # Use populated @style_other from build_tt()
     other <- x@style_other
 
-    # Filter to only cells that have actual styles (at least one non-NA value)
-    if (nrow(other) > 0) {
-      has_style <- rowSums(!is.na(other[, c("bold", "italic", "underline", "strikeout",
-                                             "monospace", "smallcap", "align", "alignv",
-                                             "color", "background", "fontsize", "indent",
-                                             "html_css", "colspan", "rowspan"), drop = FALSE])) > 0
-      other <- other[has_style, , drop = FALSE]
-    }
+    other <- filter_style_other(other, c(
+      "bold", "italic", "underline", "strikeout",
+      "monospace", "smallcap", "align", "alignv",
+      "color", "background", "fontsize", "indent",
+      "html_css", "colspan", "rowspan"
+    ))
 
     # Use populated @style_lines from build_tt()
     lines <- x@style_lines

R/tabularray_style.R

@@ -677,15 +677,12 @@ setMethod(
     # Use populated @style_other from build_tt()
     other <- x@style_other
 
-    # Filter to only cells that have actual styles
-    if (nrow(other) > 0) {
-      has_style <- rowSums(!is.na(other[, c(
-        "bold", "italic", "underline", "strikeout",
-        "monospace", "smallcap", "align", "alignv",
-        "color", "background", "fontsize", "indent",
-        "colspan", "rowspan"), drop = FALSE])) > 0
-      other <- other[has_style, , drop = FALSE]
-    }
+    other <- filter_style_other(other, c(
+      "bold", "italic", "underline", "strikeout",
+      "monospace", "smallcap", "align", "alignv",
+      "color", "background", "fontsize", "indent",
+      "colspan", "rowspan"
+    ))
 
     # Use populated @style_lines from build_tt()
     lines <- x@style_lines

R/tabulator_style.R

@@ -41,13 +41,11 @@ tabulator_apply_styles <- function(x) {
   # Use populated @style_other from build_tt()
   other <- x@style_other
 
-  # Filter to only cells that have actual styles
-  if (nrow(other) > 0) {
-    has_style <- rowSums(!is.na(other[, c("bold", "italic", "underline", "strikeout",
-                                           "monospace", "smallcap", "align", "alignv",
-                                           "color", "background", "fontsize", "indent"), drop = FALSE])) > 0
-    other <- other[has_style, , drop = FALSE]
-  }
+  other <- filter_style_other(other, c(
+    "bold", "italic", "underline", "strikeout",
+    "monospace", "smallcap", "align", "alignv",
+    "color", "background", "fontsize", "indent"
+  ))
 
   # Precompute field names once (dots/spaces -> underscores)
   field_names <- tabulator_clean_column_name(x@names)