diff --git a/DESCRIPTION b/DESCRIPTION index 26204cbae..8db33898f 100644 --- a/DESCRIPTION +++ b/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.17.0.2 +Version: 0.17.0.3 Imports: methods Depends: diff --git a/R/build_tt.R b/R/build_tt.R index aa7a53212..d88fe6d52 100644 --- a/R/build_tt.R +++ b/R/build_tt.R @@ -137,17 +137,26 @@ build_tt <- function(x, output = NULL) { x@style_other <- rect - # apply style_tt() and theme_*() after all group operations + # apply style_tt() and theme_*() after all group operations. + # style_tt_lazy() exposes only the current call's settings frame in @style; + # collect those frames here and rbind() them once. This replaces the previous + # pattern where every style_tt() call grew @style with an incremental rbind(), + # an O(N^2) cost that dominated on tables with many style_tt() calls. lazy_style <- x@lazy_style x@lazy_style <- list() - for (p in lazy_style) { + style_frames <- vector("list", length(lazy_style)) + for (k in seq_along(lazy_style)) { + p <- lazy_style[[k]] o <- attr(p, "output") if (is.null(o) || x@output %in% o) { p[["x"]] <- x x <- eval(p) + if (nrow(x@style) > 0L) style_frames[[k]] <- x@style } } + style_frames <- style_frames[!vapply(style_frames, is.null, logical(1))] + x@style <- if (length(style_frames)) do.call(rbind, style_frames) else data.frame() # Fix colspan that exceeds column count after lazy styles are evaluated if (nrow(x@style) > 0) { diff --git a/R/expand_style.R b/R/expand_style.R index 4f9f77768..6d6e7b891 100644 --- a/R/expand_style.R +++ b/R/expand_style.R @@ -94,10 +94,12 @@ append_lines_to_rect <- function(style_lines, style_row, rect) { #' #' This is functionally equivalent to (and produces value-identical output as) #' the per-row loop: +#' ```r #' 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 diff --git a/R/style_tt.R b/R/style_tt.R index a0dd6f847..14016c228 100644 --- a/R/style_tt.R +++ b/R/style_tt.R @@ -143,6 +143,10 @@ style_tt_lazy <- function( ...) { out <- x + # Each lazy call exposes only its own settings frame for build_tt() to + # collect. In particular, notes and caption styling return early below and + # must not expose the preceding call's frame again. + out@style <- data.frame() # Set default line_color if NULL if (is.null(line_color) && !is.null(line)) { @@ -340,14 +344,12 @@ style_tt_lazy <- function( cols <- unique(c("i", "j", sort(colnames(settings)))) settings <- settings[, cols, drop = FALSE] - # Only add settings if there are rows to add - if (nrow(settings) > 0) { - if (nrow(out@style) == 0) { - out@style <- settings - } else { - out@style <- rbind(out@style, settings) - } - } + # Expose this call's settings frame in @style. build_tt() collects the + # per-call frames and rbind()s them once at the end of the lazy loop, instead + # of growing @style with an incremental rbind() on every style_tt() call. + # That per-call rbind() was O(N^2) and dominated the lazy-style evaluation + # phase on tables with many style_tt() calls (e.g. per-cell heat-maps). + out@style <- settings if (is.function(finalize)) { out@lazy_finalize <- c(out@lazy_finalize, list(finalize)) @@ -549,7 +551,6 @@ assert_style_tt <- function( #' @template limitations_word_markdown #' @export #' @examplesIf knitr::is_html_output() -#' @examples #' if (knitr::is_html_output()) options(tinytable_print_output = "html") #' #' library(tinytable) @@ -725,5 +726,3 @@ style_tt <- function( return(x) } - - diff --git a/README.md b/README.md index 108d69a19..8dc2fe006 100644 --- a/README.md +++ b/README.md @@ -135,7 +135,7 @@ tt(x, ## Tutorial -The `tinytable` 0.16.0.14 tutorial will take you much further. It is +The `tinytable` 0.17.0.2 tutorial will take you much further. It is available in HTML and PDF formats at: diff --git a/inst/tinytest/test-style.R b/inst/tinytest/test-style.R index 3856c5391..8e270cdeb 100644 --- a/inst/tinytest/test-style.R +++ b/inst/tinytest/test-style.R @@ -89,6 +89,27 @@ expect_snapshot_print(t[["typst"]], "style-smallcap.typ") expect_snapshot_print(t[["markdown"]], "style-smallcap.md") +# Caption and notes styles must not duplicate the preceding cell style frame +tab <- tt( + data.frame(a = 1:2), + caption = "Caption", + notes = "Note") |> + style_tt(i = 1, line = "b", line_color = "red", line_width = 0.123) |> + style_tt(i = "caption", bold = TRUE) |> + style_tt(i = "notes", italic = TRUE) +tab <- tinytable:::build_tt(tab, output = "typst") +user_lines <- tab@style_lines[ + tab@style_lines$line_color == "red" & tab@style_lines$line_width == 0.123, + , + drop = FALSE] +expect_equal(nrow(user_lines), 1L) +line_matches <- gregexpr( + 'stroke: 0.123em + rgb("#FF0000")', + tab@table_string, + fixed = TRUE)[[1]] +expect_equal(sum(line_matches > 0L), 1L) + + # partial align tab <- tt(mtcars[1:5, 1:6]) |> style_tt(j = c(2, 4), align = "cr") t <- expect_table(tab) diff --git a/man/style_tt.Rd b/man/style_tt.Rd index 5312def9f..c9bf78461 100644 --- a/man/style_tt.Rd +++ b/man/style_tt.Rd @@ -167,6 +167,7 @@ going through a text-only intermediate format. } \examples{ +\dontshow{if (knitr::is_html_output()) withAutoprint(\{ # examplesIf} if (knitr::is_html_output()) options(tinytable_print_output = "html") library(tinytable) @@ -272,5 +273,5 @@ tt(head(iris), alignv = "m", align = "c", line = "tblr") |> style_tt("colnames", italic = TRUE) |> style_tt("caption", smallcap = TRUE) - +\dontshow{\}) # examplesIf} }