From 6897d1aad348b678505ec395d3be5a3345b62f3d Mon Sep 17 00:00:00 2001 From: Bill Denney Date: Mon, 23 Mar 2026 09:42:35 -0400 Subject: [PATCH] Add table1 connector for export_tfl() Support passing table1 objects directly to export_tfl(). The connector converts via t1flex() to flextable, preserving column labels, bold variable names, indented summary statistics, and stratification headers. Caption and footnote are extracted from the table1 object's internal structure. Pagination is group-aware: page breaks fall between variable groups rather than splitting a group mid-way. - New R/table1.R with S3 method, converter, and group-aware pagination - New tests/testthat/test-table1.R (101 tests, 100% coverage) - New vignettes/v08-table1.Rmd - Updated export_tfl.list() for lists of table1 objects - Updated README.md, main vignette, and design docs Co-Authored-By: Claude Opus 4.6 --- CLAUDE.md | 12 +- DESCRIPTION | 1 + NAMESPACE | 1 + R/export_tfl.R | 23 +- R/table1.R | 248 ++++++++++++++ README.md | 36 +- design/ARCHITECTURE.md | 30 ++ design/DECISIONS.md | 39 +++ design/TESTING.md | 1 + man/dot-extract_table1_annotations.Rd | 20 ++ man/dot-paginate_oversized_group.Rd | 27 ++ man/dot-paginate_table1.Rd | 27 ++ man/dot-table1_variable_groups.Rd | 22 ++ man/export_tfl.Rd | 11 +- man/table1_to_pagelist.Rd | 34 ++ tests/testthat/test-table1.R | 467 ++++++++++++++++++++++++++ vignettes/v08-table1.Rmd | 236 +++++++++++++ vignettes/writetfl.Rmd | 40 ++- 18 files changed, 1268 insertions(+), 7 deletions(-) create mode 100644 R/table1.R create mode 100644 man/dot-extract_table1_annotations.Rd create mode 100644 man/dot-paginate_oversized_group.Rd create mode 100644 man/dot-paginate_table1.Rd create mode 100644 man/dot-table1_variable_groups.Rd create mode 100644 man/table1_to_pagelist.Rd create mode 100644 tests/testthat/test-table1.R create mode 100644 vignettes/v08-table1.Rmd diff --git a/CLAUDE.md b/CLAUDE.md index 78707ac..735f1f6 100644 --- a/CLAUDE.md +++ b/CLAUDE.md @@ -50,7 +50,7 @@ annotation zones, and content areas must be independently sized and never overla | Type | R package (roxygen2, testthat) | | License | AGPL-3 | | R deps | `dplyr`, `ggplot2`, `grid`, `glue`, `rlang` | -| Suggests | `flextable`, `formatters`, `gt`, `rtables`, `testthat (>= 3.0.0)`, `withr`, `knitr`, `rmarkdown`, `tibble` | +| Suggests | `flextable`, `formatters`, `gt`, `rtables`, `table1`, `testthat (>= 3.0.0)`, `withr`, `knitr`, `rmarkdown`, `tibble` | | Namespace | All helpers unexported except `export_tfl`, `export_tfl_page`, `tfl_table`, `tfl_colspec` | --- @@ -314,6 +314,12 @@ writetfl/ │ │ .clean_flextable(), │ │ .flextable_to_grob(), │ │ .paginate_flextable() +│ ├── table1.R ← export_tfl.table1(), +│ │ table1_to_pagelist(), +│ │ .extract_table1_annotations(), +│ │ .table1_variable_groups(), +│ │ .paginate_table1(), +│ │ .paginate_oversized_group() │ ├── reexports.R ← re-exports unit, gpar from grid │ ├── table_columns.R ← resolve_col_specs(), compute_col_widths(), │ │ paginate_cols() @@ -340,6 +346,7 @@ writetfl/ │ ├── test-gt.R │ ├── test-rtables.R │ ├── test-flextable.R +│ ├── test-table1.R │ └── test-integration.R ├── vignettes/ │ ├── writetfl.Rmd @@ -349,7 +356,8 @@ writetfl/ │ ├── v04-troubleshooting.Rmd │ ├── v05-gt_tables.Rmd │ ├── v06-rtables.Rmd -│ └── v07-flextable.Rmd +│ ├── v07-flextable.Rmd +│ └── v08-table1.Rmd └── design/ ├── DESIGN.md ├── ARCHITECTURE.md diff --git a/DESCRIPTION b/DESCRIPTION index 48bf04a..a60b7ec 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,6 +31,7 @@ Suggests: ggtibble, gt, rtables, + table1, testthat (>= 3.0.0), withr, knitr, diff --git a/NAMESPACE b/NAMESPACE index f7ff157..735282b 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -7,6 +7,7 @@ S3method(export_tfl,flextable) S3method(export_tfl,ggtibble) S3method(export_tfl,gt_tbl) S3method(export_tfl,list) +S3method(export_tfl,table1) S3method(export_tfl,tfl_table) S3method(print,tfl_table) export(export_tfl) diff --git a/R/export_tfl.R b/R/export_tfl.R index d872a5e..b74452e 100644 --- a/R/export_tfl.R +++ b/R/export_tfl.R @@ -53,6 +53,15 @@ #' [flextable::add_footer_lines()]) are extracted as the footnote. The #' table is rendered via [flextable::gen_grob()]. A list of `flextable` #' objects produces one page (or more, with pagination) per table. +#' +#' When `x` is a `table1` object (from the \pkg{table1} package), the +#' caption and footnote are extracted from the table1 object's internal +#' structure. The table is converted to a flextable via [table1::t1flex()], +#' preserving column labels, bold variable names, and indented summary +#' statistics. Pagination is group-aware: page breaks fall between +#' variable groups (label + summary rows) rather than splitting a group +#' mid-way. A list of `table1` objects produces one page (or more, with +#' pagination) per table. #' @param file Path to the output PDF file. Must be a single character string #' ending in `".pdf"`. Not required when `preview` is not `FALSE`. #' @param pg_width Page width in inches. @@ -189,7 +198,19 @@ export_tfl.list <- function( pages <- unlist(lapply(x, flextable_to_pagelist, pg_width, pg_height, dots, page_num), recursive = FALSE) } else { - pages <- coerce_x_to_pagelist(x) + # Check if this is a list of table1 objects + all_table1 <- length(x) > 0L && + all(vapply(x, inherits, logical(1L), "table1")) + if (all_table1) { + rlang::check_installed("table1", + reason = "to export table1 tables") + rlang::check_installed("flextable", + reason = "to export table1 tables") + pages <- unlist(lapply(x, table1_to_pagelist, pg_width, pg_height, + dots, page_num), recursive = FALSE) + } else { + pages <- coerce_x_to_pagelist(x) + } } } } diff --git a/R/table1.R b/R/table1.R new file mode 100644 index 0000000..ad45ed5 --- /dev/null +++ b/R/table1.R @@ -0,0 +1,248 @@ +# table1.R — S3 method and conversion for table1 objects +# +# Functions: +# export_tfl.table1() — S3 method dispatched by export_tfl() +# table1_to_pagelist() — convert a table1 to a list of page specs +# .extract_table1_annotations() — extract caption and footnote +# .table1_variable_groups() — identify variable-group row boundaries +# .paginate_table1() — group-aware greedy pagination + +#' @export +export_tfl.table1 <- function( + x, + file = NULL, + pg_width = 11, + pg_height = 8.5, + page_num = "Page {i} of {n}", + preview = FALSE, + ... +) { + rlang::check_installed("table1", reason = "to export table1 tables") + rlang::check_installed("flextable", reason = "to export table1 tables") + dots <- list(...) + .validate_export_args(page_num, preview, file) + pages <- table1_to_pagelist(x, pg_width, pg_height, dots, page_num) + .export_tfl_pages(pages, file, pg_width, pg_height, page_num, preview, dots) +} + +#' Convert a table1 object to a list of page specification lists +#' +#' Extracts caption and footnote from the table1 object's internal structure, +#' converts to a flextable via [table1::t1flex()], then renders via +#' [flextable::gen_grob()]. When the rendered table exceeds the available +#' content height, rows are split across multiple pages using group-aware +#' pagination that keeps each variable's label and summary statistics together. +#' +#' @param t1_obj A `table1` object. +#' @param pg_width,pg_height Page dimensions in inches. +#' @param dots Named list of additional arguments from `...`. +#' @param page_num Glue template for page numbering (used for height calc). +#' @return A list of page spec lists, each with at least `$content`. +#' @keywords internal +table1_to_pagelist <- function(t1_obj, pg_width = 11, pg_height = 8.5, + dots = list(), page_num = "Page {i} of {n}") { + annot <- .extract_table1_annotations(t1_obj) + groups <- .table1_variable_groups(t1_obj) + + # Convert to flextable — t1flex() preserves bold labels, indentation, etc. + ft <- table1::t1flex(t1_obj) + + # Clean: remove footer rows (we already extracted footnote) + ft <- .clean_flextable(ft) + # Clear caption (we already extracted it) + ft$caption <- list(value = NULL) + + # Measure available content area + content_h <- .flextable_content_height(pg_width, pg_height, dots, page_num, + annot) + content_w <- .flextable_content_width(pg_width, dots) + + # Convert to grob and measure height + grob <- .flextable_to_grob(ft, content_w) + grob_h <- .flextable_grob_height(grob) + + # If the table fits on a single page, return immediately + if (grob_h <= content_h) { + page_spec <- list(content = grob) + if (!is.null(annot$caption)) page_spec$caption <- annot$caption + if (!is.null(annot$footnote)) page_spec$footnote <- annot$footnote + return(list(page_spec)) + } + + # Paginate: group-aware splitting + ft_pages <- .paginate_table1(ft, groups, content_h, content_w) + + lapply(ft_pages, function(ft_page) { + page_grob <- .flextable_to_grob(ft_page, content_w) + page_spec <- list(content = page_grob) + if (!is.null(annot$caption)) page_spec$caption <- annot$caption + if (!is.null(annot$footnote)) page_spec$footnote <- annot$footnote + page_spec + }) +} + +#' Extract annotations from a table1 object +#' +#' Extracts caption and footnote from the internal `"obj"` attribute of a +#' table1 object. +#' +#' @param t1_obj A `table1` object. +#' @return A list with `$caption` (character or NULL) and `$footnote` +#' (character or NULL). +#' @keywords internal +.extract_table1_annotations <- function(t1_obj) { + obj <- attr(t1_obj, "obj", exact = TRUE) + + caption <- obj$caption + if (!is.null(caption) && (!nzchar(caption) || all(is.na(caption)))) { + caption <- NULL + } + + footnote <- obj$footnote + if (!is.null(footnote)) { + footnote <- footnote[nzchar(footnote) & !is.na(footnote)] + if (length(footnote) == 0L) { + footnote <- NULL + } else { + footnote <- paste(footnote, collapse = "\n") + } + } + + list(caption = caption, footnote = footnote) +} + +#' Identify variable-group row boundaries in a table1 object +#' +#' Each variable in a table1 output forms a "group" consisting of a bold +#' variable-label row followed by indented summary-statistic rows. This +#' function returns the flextable body row indices for each group, derived +#' from the `contents` matrices in the table1 object's internal structure. +#' +#' @param t1_obj A `table1` object. +#' @return A list of integer vectors, each containing the body row indices +#' for one variable group (label row + summary rows). +#' @keywords internal +.table1_variable_groups <- function(t1_obj) { + obj <- attr(t1_obj, "obj", exact = TRUE) + contents <- obj$contents + + groups <- list() + cumrow <- 0L + for (i in seq_along(contents)) { + nr <- nrow(contents[[i]]) + rows <- seq(cumrow + 1L, cumrow + nr) + groups <- c(groups, list(rows)) + cumrow <- cumrow + nr + } + groups +} + +#' Group-aware greedy pagination for table1 flextables +#' +#' Splits a table1-derived flextable across pages, keeping each variable's +#' label and summary statistic rows together. If a single variable group +#' exceeds the page height, falls back to row-by-row splitting within that +#' group. +#' +#' @param ft_obj A cleaned `flextable` (converted from table1, no footer rows). +#' @param groups List of integer vectors from [.table1_variable_groups()]. +#' @param content_h Available content height in inches. +#' @param content_w Available content width in inches. +#' @return A list of `flextable` objects (one per page). +#' @keywords internal +.paginate_table1 <- function(ft_obj, groups, content_h, content_w) { + pages <- list() + current_rows <- integer(0L) + + for (grp_idx in seq_along(groups)) { + candidate_rows <- c(current_rows, groups[[grp_idx]]) + sub_ft <- .rebuild_flextable_subset(ft_obj, candidate_rows) + sub_grob <- .flextable_to_grob(sub_ft, content_w) + h <- .flextable_grob_height(sub_grob) + + if (h > content_h && length(current_rows) > 0L) { + # Current group doesn't fit — finalize current page + pages <- c(pages, list(.rebuild_flextable_subset(ft_obj, current_rows))) + # Try the group alone + grp_ft <- .rebuild_flextable_subset(ft_obj, groups[[grp_idx]]) + grp_grob <- .flextable_to_grob(grp_ft, content_w) + grp_h <- .flextable_grob_height(grp_grob) + + if (grp_h > content_h) { + # Oversized group: fall back to row-by-row within this group + row_pages <- .paginate_oversized_group(ft_obj, groups[[grp_idx]], + content_h, content_w) + # All but the last sub-page are complete pages + for (rp_idx in seq_along(row_pages)) { + if (rp_idx < length(row_pages)) { + pages <- c(pages, list(row_pages[[rp_idx]])) + } else { + # Last sub-page becomes the start of the next accumulation + current_rows <- row_pages[[rp_idx]]$body_rows + } + } + } else { + current_rows <- groups[[grp_idx]] + } + } else if (h > content_h && length(current_rows) == 0L) { + # First group on an empty page and it still doesn't fit + row_pages <- .paginate_oversized_group(ft_obj, groups[[grp_idx]], + content_h, content_w) + for (rp_idx in seq_along(row_pages)) { + if (rp_idx < length(row_pages)) { + pages <- c(pages, list(row_pages[[rp_idx]])) + } else { + current_rows <- row_pages[[rp_idx]]$body_rows + } + } + } else { + current_rows <- candidate_rows + } + } + + if (length(current_rows) > 0L) { + pages <- c(pages, list(.rebuild_flextable_subset(ft_obj, current_rows))) + } + + pages +} + +#' Paginate an oversized variable group row-by-row +#' +#' When a single variable group (label + summary rows) exceeds the available +#' content height, falls back to row-by-row greedy splitting. +#' +#' @param ft_obj The full flextable object. +#' @param grp_rows Integer vector of body row indices for the oversized group. +#' @param content_h Available content height in inches. +#' @param content_w Available content width in inches. +#' @return A list of objects. Complete sub-pages are `flextable` objects. +#' The last element is a list with `$body_rows` (integer vector of remaining +#' row indices) for further accumulation. +#' @keywords internal +.paginate_oversized_group <- function(ft_obj, grp_rows, content_h, content_w) { + results <- list() + current_rows <- integer(0L) + + for (row_idx in grp_rows) { + candidate <- c(current_rows, row_idx) + sub_ft <- .rebuild_flextable_subset(ft_obj, candidate) + sub_grob <- .flextable_to_grob(sub_ft, content_w) + h <- .flextable_grob_height(sub_grob) + + if (h > content_h && length(current_rows) > 0L) { + results <- c(results, list(.rebuild_flextable_subset(ft_obj, + current_rows))) + current_rows <- row_idx + } else { + current_rows <- candidate + } + } + + # Last batch: return as a list with body_rows for further accumulation + if (length(current_rows) > 0L) { + results <- c(results, list(list(body_rows = current_rows))) + } + + results +} diff --git a/README.md b/README.md index c3fb5c0..65b0528 100644 --- a/README.md +++ b/README.md @@ -8,7 +8,8 @@ **Standardized table, figure, and listing output for clinical trial reporting.** `writetfl` produces multi-page PDF files from `ggplot2` figures, data-frame -tables, `gt` tables, `rtables` tables, `flextable` tables, and other grid content with the precise, +tables, `gt` tables, `rtables` tables, `flextable` tables, `table1` tables, +and other grid content with the precise, composable page layouts required for clinical trial TFL deliverables and regulatory submissions. Each page is divided into up to five vertical sections — header, caption, content, @@ -378,3 +379,36 @@ export_tfl(ft, file = "flextable_table.pdf", A list of `flextable` objects produces a multi-page PDF. See `vignette("v07-flextable")` for full details. +### table1 tables + +Pass a `table1` object directly to `export_tfl()`. Column labels, bold +variable names, indented summary statistics, and stratification headers are +preserved via `t1flex()` conversion. Caption and footnote are extracted into +writetfl's annotation zones. Pagination is group-aware: variable labels and +their summary rows are kept together across page breaks. + +```r +library(table1) + +dat <- data.frame( + age = rnorm(100, 50, 10), + sex = sample(c("Male", "Female"), 100, replace = TRUE), + trt = rep(c("Treatment", "Placebo"), each = 50) +) +label(dat$age) <- "Age (years)" +label(dat$sex) <- "Sex" + +tbl <- table1(~ age + sex | trt, data = dat, + caption = "Table 1. Baseline Demographics", + footnote = "ITT Population") + +export_tfl(tbl, file = "table1.pdf", + header_left = "Study Report", + header_rule = TRUE, + footer_rule = TRUE +) +``` + +A list of `table1` objects produces a multi-page PDF. See +`vignette("v08-table1")` for full details. + diff --git a/design/ARCHITECTURE.md b/design/ARCHITECTURE.md index b6c9459..3116252 100644 --- a/design/ARCHITECTURE.md +++ b/design/ARCHITECTURE.md @@ -250,6 +250,35 @@ export_tfl(x = list_of_flextable, ...) [exported] ├── detects all elements are flextable ├── lapply(x, flextable_to_pagelist, ...) |> unlist(recursive = FALSE) └── .export_tfl_pages(...) + +export_tfl(x = table1_obj, ...) [exported] + └── export_tfl.table1() — table1.R + └── table1_to_pagelist(x, ...) — table1.R + ├── .extract_table1_annotations(x) — table1.R + │ attr(x, "obj")$caption → caption + │ attr(x, "obj")$footnote → footnote + ├── .table1_variable_groups(x) — table1.R + │ identifies row boundaries per variable from obj$contents + ├── table1::t1flex(x) → flextable + ├── .clean_flextable(ft) — flextable.R (reused) + ├── .flextable_content_height(...) — flextable.R (reused) + ├── .flextable_content_width(...) — flextable.R (reused) + ├── .flextable_to_grob(ft, w) — flextable.R (reused) + ├── .flextable_grob_height(grob) — flextable.R (reused) + ├── if too tall: + │ .paginate_table1(ft, groups, h, w) — table1.R + │ group-aware greedy pagination + │ .paginate_oversized_group(ft, rows, h, w) + │ .rebuild_flextable_subset(ft, rows) — flextable.R (reused) + └── for each page: + .flextable_to_grob(page, w) + → page spec with $content, $caption, $footnote + +export_tfl(x = list_of_table1, ...) [exported] + └── export_tfl.list() + ├── detects all elements are table1 + ├── lapply(x, table1_to_pagelist, ...) |> unlist(recursive = FALSE) + └── .export_tfl_pages(...) ``` --- @@ -272,6 +301,7 @@ export_tfl(x = list_of_flextable, ...) [exported] | `R/gt.R` | `export_tfl.gt_tbl()`, `gt_to_pagelist()`, `.extract_gt_annotations()`, `.clean_gt()`, `.gt_content_height()`, `.gt_grob_height()`, `.gt_row_groups()`, `.paginate_gt()`, `.rebuild_gt_subset()` | | `R/rtables.R` | `export_tfl.VTableTree()`, `rtables_to_pagelist()`, `.extract_rtables_annotations()`, `.clean_rtables()`, `.rtables_content_height()`, `.rtables_content_width()`, `.rtables_lpp_cpp()`, `.rtables_to_grob()` | | `R/flextable.R` | `export_tfl.flextable()`, `flextable_to_pagelist()`, `.extract_flextable_annotations()`, `.clean_flextable()`, `.flextable_content_height()`, `.flextable_content_width()`, `.flextable_grob_height()`, `.flextable_to_grob()`, `.flextable_set_pdf_font()`, `.paginate_flextable()`, `.rebuild_flextable_subset()` | +| `R/table1.R` | `export_tfl.table1()`, `table1_to_pagelist()`, `.extract_table1_annotations()`, `.table1_variable_groups()`, `.paginate_table1()`, `.paginate_oversized_group()` | | `R/reexports.R` | `%||%` from rlang | | `R/tfl_table.R` | `tfl_colspec()`, `tfl_table()`, `print.tfl_table()`, `.check_named_subset()` | | `R/table_columns.R` | `resolve_col_specs()`, `compute_col_widths()`, `.apply_col_wrapping()`, `paginate_cols()` | diff --git a/design/DECISIONS.md b/design/DECISIONS.md index f6b4f34..202e04f 100644 --- a/design/DECISIONS.md +++ b/design/DECISIONS.md @@ -618,6 +618,45 @@ flextable-related method. --- +## D-35: table1 connector — t1flex() conversion strategy + +**Decision:** Convert `table1` objects to grid grobs via +`table1::t1flex()` → `flextable::gen_grob()`. Extract caption and +footnote from the table1 object's internal `"obj"` attribute (not from +the flextable) since `t1flex()` may or may not carry these through +consistently. + +**Alternatives considered:** +- Use `as.data.frame()` and build a custom grob — loses all formatting + (bold labels, indentation, borders, merged header cells). +- Parse the `obj$contents` matrices directly — would require rebuilding + all visual formatting that `t1flex()` already handles. + +**Chosen because:** `t1flex()` is the officially supported conversion path +from the table1 package. It faithfully reproduces the HTML formatting as +a flextable, including bold variable labels, indented summary statistics, +stratification headers with column spans, and borders. The existing +flextable infrastructure (`.flextable_to_grob()`, `.flextable_set_pdf_font()`, +`.rebuild_flextable_subset()`) is reused without modification. + +**Annotation extraction:** `attr(t1_obj, "obj")$caption` → writetfl +caption zone; `attr(t1_obj, "obj")$footnote` → writetfl footnote zone. +Extracted before conversion to flextable for reliability. + +**Group-aware pagination:** table1 output has a natural grouping structure +where each variable forms a "group" (bold label row + indented summary +rows). Pagination splits between groups rather than at arbitrary row +boundaries. Group boundaries are identified from the `obj$contents` +matrices (one matrix per variable, `nrow()` gives the row count per group). +If a single group exceeds the page height, falls back to row-by-row +splitting within that group. + +**Both table1 and flextable are soft dependencies** (Suggests only). +`rlang::check_installed()` is called for both at the top of each +table1-related method. + +--- + ## Open questions / future work - Support for `recordedPlot` in `draw_content()` (requires `gridGraphics`) diff --git a/design/TESTING.md b/design/TESTING.md index 011f3ac..3394c87 100644 --- a/design/TESTING.md +++ b/design/TESTING.md @@ -30,6 +30,7 @@ One test file per source file — `tests/testthat/test-.R` covers | `test-gt.R` | `.extract_gt_annotations()`, `.clean_gt()`, `gt_to_pagelist()`, `.rebuild_gt_subset()` (row groups, formats, styles, substitutions, transforms, locale, stubhead, options, summary), `export_tfl.gt_tbl()`, `export_tfl.list()` with gt_tbl objects, S3 dispatch | | `test-rtables.R` | `.extract_rtables_annotations()`, `.clean_rtables()`, `.rtables_to_grob()`, `.rtables_lpp_cpp()`, `.rtables_content_height()`, `.rtables_content_width()`, `rtables_to_pagelist()`, `export_tfl.VTableTree()`, `export_tfl.list()` with VTableTree objects, pagination, S3 dispatch | | `test-flextable.R` | `.extract_flextable_annotations()`, `.clean_flextable()`, `.flextable_to_grob()`, `.flextable_grob_height()`, `.flextable_content_height()`, `.flextable_content_width()`, `flextable_to_pagelist()`, `.rebuild_flextable_subset()`, `.paginate_flextable()`, `export_tfl.flextable()`, `export_tfl.list()` with flextable objects, S3 dispatch | +| `test-table1.R` | `.extract_table1_annotations()`, `.table1_variable_groups()`, `table1_to_pagelist()`, `.paginate_table1()`, `.paginate_oversized_group()`, `export_tfl.table1()`, `export_tfl.list()` with table1 objects, group-aware pagination, S3 dispatch | | `test-integration.R` | Multi-file end-to-end smoke tests spanning the full pipeline | --- diff --git a/man/dot-extract_table1_annotations.Rd b/man/dot-extract_table1_annotations.Rd new file mode 100644 index 0000000..6c87bda --- /dev/null +++ b/man/dot-extract_table1_annotations.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/table1.R +\name{.extract_table1_annotations} +\alias{.extract_table1_annotations} +\title{Extract annotations from a table1 object} +\usage{ +.extract_table1_annotations(t1_obj) +} +\arguments{ +\item{t1_obj}{A \code{table1} object.} +} +\value{ +A list with \verb{$caption} (character or NULL) and \verb{$footnote} +(character or NULL). +} +\description{ +Extracts caption and footnote from the internal \code{"obj"} attribute of a +table1 object. +} +\keyword{internal} diff --git a/man/dot-paginate_oversized_group.Rd b/man/dot-paginate_oversized_group.Rd new file mode 100644 index 0000000..f16ba25 --- /dev/null +++ b/man/dot-paginate_oversized_group.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/table1.R +\name{.paginate_oversized_group} +\alias{.paginate_oversized_group} +\title{Paginate an oversized variable group row-by-row} +\usage{ +.paginate_oversized_group(ft_obj, grp_rows, content_h, content_w) +} +\arguments{ +\item{ft_obj}{The full flextable object.} + +\item{grp_rows}{Integer vector of body row indices for the oversized group.} + +\item{content_h}{Available content height in inches.} + +\item{content_w}{Available content width in inches.} +} +\value{ +A list of objects. Complete sub-pages are \code{flextable} objects. +The last element is a list with \verb{$body_rows} (integer vector of remaining +row indices) for further accumulation. +} +\description{ +When a single variable group (label + summary rows) exceeds the available +content height, falls back to row-by-row greedy splitting. +} +\keyword{internal} diff --git a/man/dot-paginate_table1.Rd b/man/dot-paginate_table1.Rd new file mode 100644 index 0000000..c54e54b --- /dev/null +++ b/man/dot-paginate_table1.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/table1.R +\name{.paginate_table1} +\alias{.paginate_table1} +\title{Group-aware greedy pagination for table1 flextables} +\usage{ +.paginate_table1(ft_obj, groups, content_h, content_w) +} +\arguments{ +\item{ft_obj}{A cleaned \code{flextable} (converted from table1, no footer rows).} + +\item{groups}{List of integer vectors from \code{\link[=.table1_variable_groups]{.table1_variable_groups()}}.} + +\item{content_h}{Available content height in inches.} + +\item{content_w}{Available content width in inches.} +} +\value{ +A list of \code{flextable} objects (one per page). +} +\description{ +Splits a table1-derived flextable across pages, keeping each variable's +label and summary statistic rows together. If a single variable group +exceeds the page height, falls back to row-by-row splitting within that +group. +} +\keyword{internal} diff --git a/man/dot-table1_variable_groups.Rd b/man/dot-table1_variable_groups.Rd new file mode 100644 index 0000000..239234a --- /dev/null +++ b/man/dot-table1_variable_groups.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/table1.R +\name{.table1_variable_groups} +\alias{.table1_variable_groups} +\title{Identify variable-group row boundaries in a table1 object} +\usage{ +.table1_variable_groups(t1_obj) +} +\arguments{ +\item{t1_obj}{A \code{table1} object.} +} +\value{ +A list of integer vectors, each containing the body row indices +for one variable group (label row + summary rows). +} +\description{ +Each variable in a table1 output forms a "group" consisting of a bold +variable-label row followed by indented summary-statistic rows. This +function returns the flextable body row indices for each group, derived +from the \code{contents} matrices in the table1 object's internal structure. +} +\keyword{internal} diff --git a/man/export_tfl.Rd b/man/export_tfl.Rd index 5baa8d0..1429e41 100644 --- a/man/export_tfl.Rd +++ b/man/export_tfl.Rd @@ -58,7 +58,16 @@ the caption (from \code{\link[flextable:set_caption]{flextable::set_caption()}}) caption, and footer rows (from \code{\link[flextable:footnote]{flextable::footnote()}} or \code{\link[flextable:add_footer_lines]{flextable::add_footer_lines()}}) are extracted as the footnote. The table is rendered via \code{\link[flextable:gen_grob]{flextable::gen_grob()}}. A list of \code{flextable} -objects produces one page (or more, with pagination) per table.} +objects produces one page (or more, with pagination) per table. + +When \code{x} is a \code{table1} object (from the \pkg{table1} package), the +caption and footnote are extracted from the table1 object's internal +structure. The table is converted to a flextable via \code{\link[table1:t1flex]{table1::t1flex()}}, +preserving column labels, bold variable names, and indented summary +statistics. Pagination is group-aware: page breaks fall between +variable groups (label + summary rows) rather than splitting a group +mid-way. A list of \code{table1} objects produces one page (or more, with +pagination) per table.} \item{file}{Path to the output PDF file. Must be a single character string ending in \code{".pdf"}. Not required when \code{preview} is not \code{FALSE}.} diff --git a/man/table1_to_pagelist.Rd b/man/table1_to_pagelist.Rd new file mode 100644 index 0000000..d201207 --- /dev/null +++ b/man/table1_to_pagelist.Rd @@ -0,0 +1,34 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/table1.R +\name{table1_to_pagelist} +\alias{table1_to_pagelist} +\title{Convert a table1 object to a list of page specification lists} +\usage{ +table1_to_pagelist( + t1_obj, + pg_width = 11, + pg_height = 8.5, + dots = list(), + page_num = "Page {i} of {n}" +) +} +\arguments{ +\item{t1_obj}{A \code{table1} object.} + +\item{pg_width, pg_height}{Page dimensions in inches.} + +\item{dots}{Named list of additional arguments from \code{...}.} + +\item{page_num}{Glue template for page numbering (used for height calc).} +} +\value{ +A list of page spec lists, each with at least \verb{$content}. +} +\description{ +Extracts caption and footnote from the table1 object's internal structure, +converts to a flextable via \code{\link[table1:t1flex]{table1::t1flex()}}, then renders via +\code{\link[flextable:gen_grob]{flextable::gen_grob()}}. When the rendered table exceeds the available +content height, rows are split across multiple pages using group-aware +pagination that keeps each variable's label and summary statistics together. +} +\keyword{internal} diff --git a/tests/testthat/test-table1.R b/tests/testthat/test-table1.R new file mode 100644 index 0000000..650f72d --- /dev/null +++ b/tests/testthat/test-table1.R @@ -0,0 +1,467 @@ +# Tests for R/table1.R — table1 connector + +skip_if_not_installed("table1") +skip_if_not_installed("flextable") + +# --------------------------------------------------------------------------- +# Helpers +# --------------------------------------------------------------------------- + +make_test_data <- function(n = 30) { + set.seed(42) + dat <- data.frame( + age = rnorm(n, 50, 10), + sex = sample(c("Male", "Female"), n, replace = TRUE), + bmi = rnorm(n, 25, 4), + trt = rep(c("Treatment", "Placebo"), length.out = n), + stringsAsFactors = FALSE + ) + table1::label(dat$age) <- "Age (years)" + table1::label(dat$sex) <- "Sex" + table1::label(dat$bmi) <- "BMI (kg/m\u00b2)" + dat +} + +make_simple_t1 <- function(caption = NULL, footnote = NULL) { + dat <- make_test_data() + table1::table1(~ age + sex, data = dat, + caption = caption, footnote = footnote) +} + +make_stratified_t1 <- function(caption = NULL, footnote = NULL) { + dat <- make_test_data() + table1::table1(~ age + sex | trt, data = dat, + caption = caption, footnote = footnote) +} + +# --------------------------------------------------------------------------- +# .extract_table1_annotations() +# --------------------------------------------------------------------------- + +test_that(".extract_table1_annotations extracts caption only", { + t1 <- make_simple_t1(caption = "Table 1. Demographics") + annot <- .extract_table1_annotations(t1) + expect_equal(annot$caption, "Table 1. Demographics") + expect_null(annot$footnote) +}) + +test_that(".extract_table1_annotations extracts footnote only", { + t1 <- make_simple_t1(footnote = "ITT Population") + annot <- .extract_table1_annotations(t1) + expect_null(annot$caption) + expect_equal(annot$footnote, "ITT Population") +}) + +test_that(".extract_table1_annotations extracts both caption and footnote", { + t1 <- make_simple_t1(caption = "Demographics", footnote = "Note 1") + annot <- .extract_table1_annotations(t1) + expect_equal(annot$caption, "Demographics") + expect_equal(annot$footnote, "Note 1") +}) + +test_that(".extract_table1_annotations handles no annotations", { + t1 <- make_simple_t1() + annot <- .extract_table1_annotations(t1) + expect_null(annot$caption) + expect_null(annot$footnote) +}) + +test_that(".extract_table1_annotations handles multiple footnotes", { + t1 <- make_simple_t1(footnote = c("Note 1", "Note 2")) + annot <- .extract_table1_annotations(t1) + expect_equal(annot$footnote, "Note 1\nNote 2") +}) + +test_that(".extract_table1_annotations handles empty caption", { + t1 <- make_simple_t1(caption = "") + annot <- .extract_table1_annotations(t1) + expect_null(annot$caption) +}) + +test_that(".extract_table1_annotations handles empty footnote", { + t1 <- make_simple_t1(footnote = "") + annot <- .extract_table1_annotations(t1) + expect_null(annot$footnote) +}) + +# --------------------------------------------------------------------------- +# .table1_variable_groups() +# --------------------------------------------------------------------------- + +test_that(".table1_variable_groups identifies two-variable groups", { + t1 <- make_simple_t1() + groups <- .table1_variable_groups(t1) + expect_length(groups, 2L) + # Each group should start at the right row + expect_equal(groups[[1]][1], 1L) + # Groups should be contiguous and cover all rows + all_rows <- unlist(groups) + expect_equal(all_rows, seq_along(all_rows)) +}) + +test_that(".table1_variable_groups identifies three-variable groups", { + dat <- make_test_data() + t1 <- table1::table1(~ age + sex + bmi, data = dat) + groups <- .table1_variable_groups(t1) + expect_length(groups, 3L) + all_rows <- unlist(groups) + expect_equal(all_rows, seq_along(all_rows)) +}) + +test_that(".table1_variable_groups works with stratification", { + t1 <- make_stratified_t1() + groups <- .table1_variable_groups(t1) + expect_length(groups, 2L) + # Stratification doesn't affect the number of variable groups +}) + +# --------------------------------------------------------------------------- +# table1_to_pagelist() — single page +# --------------------------------------------------------------------------- + +test_that("table1_to_pagelist returns single page for small table", { + t1 <- make_simple_t1(caption = "Demographics") + pages <- table1_to_pagelist(t1) + expect_length(pages, 1L) + expect_true(inherits(pages[[1]]$content, "grob")) + expect_equal(pages[[1]]$caption, "Demographics") +}) + +test_that("table1_to_pagelist includes footnote in page spec", { + t1 <- make_simple_t1(caption = "Demographics", footnote = "Safety set") + pages <- table1_to_pagelist(t1) + expect_length(pages, 1L) + expect_equal(pages[[1]]$caption, "Demographics") + expect_equal(pages[[1]]$footnote, "Safety set") +}) + +test_that("table1_to_pagelist works without annotations", { + t1 <- make_simple_t1() + pages <- table1_to_pagelist(t1) + expect_length(pages, 1L) + expect_true(inherits(pages[[1]]$content, "grob")) + expect_null(pages[[1]]$caption) + expect_null(pages[[1]]$footnote) +}) + +test_that("table1_to_pagelist preserves column labels", { + # Verify the flextable grob is created — column labels are part of the + + # flextable header, which t1flex() preserves + dat <- make_test_data() + t1 <- table1::table1(~ age + sex | trt, data = dat) + pages <- table1_to_pagelist(t1) + expect_length(pages, 1L) + expect_true(inherits(pages[[1]]$content, "grob")) +}) + +# --------------------------------------------------------------------------- +# End-to-end: export_tfl() with table1 input +# --------------------------------------------------------------------------- + +test_that("export_tfl writes PDF from table1 object", { + t1 <- make_stratified_t1(caption = "Table 1. Demographics") + tmp <- withr::local_tempfile(fileext = ".pdf") + result <- export_tfl(t1, file = tmp) + expect_true(file.exists(tmp)) + expect_gt(file.size(tmp), 0) + expect_equal(result, normalizePath(tmp, mustWork = FALSE)) +}) + +test_that("export_tfl preview mode works with table1", { + t1 <- make_stratified_t1(caption = "Demographics") + grDevices::pdf(NULL, width = 11, height = 8.5) + on.exit(grDevices::dev.off(), add = TRUE) + result <- export_tfl(t1, preview = TRUE, + header_left = "Study Report", + header_rule = TRUE, footer_rule = TRUE) + expect_null(result) +}) + +test_that("export_tfl preview = c(1) works with table1", { + t1 <- make_stratified_t1(caption = "Demographics") + grDevices::pdf(NULL, width = 11, height = 8.5) + on.exit(grDevices::dev.off(), add = TRUE) + result <- export_tfl(t1, preview = 1, + header_left = "Study Report") + expect_null(result) +}) + +test_that("export_tfl passes page layout args for table1", { + t1 <- make_stratified_t1() + tmp <- withr::local_tempfile(fileext = ".pdf") + result <- export_tfl(t1, file = tmp, + header_left = "Protocol XY-001", + header_right = "2025-01-01", + footnote = "Safety population", + header_rule = TRUE, + footer_rule = TRUE) + expect_true(file.exists(tmp)) +}) + +# --------------------------------------------------------------------------- +# List of table1 objects +# --------------------------------------------------------------------------- + +test_that("export_tfl handles list of table1 objects", { + dat <- make_test_data() + t1a <- table1::table1(~ age | trt, data = dat, caption = "Age Summary") + t1b <- table1::table1(~ sex | trt, data = dat, caption = "Sex Summary") + tmp <- withr::local_tempfile(fileext = ".pdf") + result <- export_tfl(list(t1a, t1b), file = tmp) + expect_true(file.exists(tmp)) + expect_gt(file.size(tmp), 0) +}) + +test_that("export_tfl preview with list of table1 objects", { + dat <- make_test_data() + t1a <- table1::table1(~ age, data = dat) + t1b <- table1::table1(~ sex, data = dat) + grDevices::pdf(NULL, width = 11, height = 8.5) + on.exit(grDevices::dev.off(), add = TRUE) + result <- export_tfl(list(t1a, t1b), preview = TRUE) + expect_null(result) +}) + +# --------------------------------------------------------------------------- +# S3 dispatch +# --------------------------------------------------------------------------- + +test_that("S3 dispatch works for table1 class", { + t1 <- make_simple_t1() + expect_true(inherits(t1, "table1")) + # Verify it dispatches to export_tfl.table1 (not default) + tmp <- withr::local_tempfile(fileext = ".pdf") + # Should not error — default method would fail since table1 is not grob/ggplot + + expect_no_error(export_tfl(t1, file = tmp)) +}) + +test_that("S3 dispatch works for list of table1 objects", { + dat <- make_test_data() + t1_list <- list( + table1::table1(~ age, data = dat), + table1::table1(~ sex, data = dat) + ) + tmp <- withr::local_tempfile(fileext = ".pdf") + expect_no_error(export_tfl(t1_list, file = tmp)) +}) + +# --------------------------------------------------------------------------- +# Pagination +# --------------------------------------------------------------------------- + +test_that("table1_to_pagelist paginates tall tables", { + # Create a table with many variables to force pagination + set.seed(42) + dat <- data.frame( + v01 = rnorm(50), v02 = rnorm(50), v03 = rnorm(50), + v04 = rnorm(50), v05 = rnorm(50), v06 = rnorm(50), + v07 = rnorm(50), v08 = rnorm(50), v09 = rnorm(50), + v10 = rnorm(50), v11 = rnorm(50), v12 = rnorm(50), + v13 = rnorm(50), v14 = rnorm(50), v15 = rnorm(50), + v16 = rnorm(50), v17 = rnorm(50), v18 = rnorm(50), + v19 = rnorm(50), v20 = rnorm(50) + ) + for (v in names(dat)) table1::label(dat[[v]]) <- paste("Variable", v) + t1 <- table1::table1( + ~ v01 + v02 + v03 + v04 + v05 + v06 + v07 + v08 + v09 + v10 + + v11 + v12 + v13 + v14 + v15 + v16 + v17 + v18 + v19 + v20, + data = dat, + caption = "Big Table", + footnote = "Test footnote" + ) + + # Use small page to force pagination + pages <- table1_to_pagelist(t1, pg_height = 5) + expect_gt(length(pages), 1L) + # All pages should have content, caption, and footnote + for (pg in pages) { + expect_true(inherits(pg$content, "grob")) + expect_equal(pg$caption, "Big Table") + expect_equal(pg$footnote, "Test footnote") + } +}) + +test_that("table1_to_pagelist end-to-end PDF with pagination", { + set.seed(42) + dat <- data.frame( + v01 = rnorm(50), v02 = rnorm(50), v03 = rnorm(50), + v04 = rnorm(50), v05 = rnorm(50), v06 = rnorm(50), + v07 = rnorm(50), v08 = rnorm(50), v09 = rnorm(50), + v10 = rnorm(50), v11 = rnorm(50), v12 = rnorm(50) + ) + for (v in names(dat)) table1::label(dat[[v]]) <- paste("Var", v) + t1 <- table1::table1( + ~ v01 + v02 + v03 + v04 + v05 + v06 + v07 + v08 + v09 + v10 + + v11 + v12, + data = dat, caption = "Many Variables" + ) + tmp <- withr::local_tempfile(fileext = ".pdf") + result <- export_tfl(t1, file = tmp, pg_height = 5) + expect_true(file.exists(tmp)) + expect_gt(file.size(tmp), 0) +}) + +# --------------------------------------------------------------------------- +# Stratification features +# --------------------------------------------------------------------------- + +test_that("table1_to_pagelist handles stratified tables", { + t1 <- make_stratified_t1(caption = "Stratified Table") + pages <- table1_to_pagelist(t1) + expect_length(pages, 1L) + expect_equal(pages[[1]]$caption, "Stratified Table") +}) + +test_that("table1_to_pagelist handles overall column", { + dat <- make_test_data() + t1 <- table1::table1(~ age + sex | trt, data = dat, overall = "Total") + pages <- table1_to_pagelist(t1) + expect_length(pages, 1L) + expect_true(inherits(pages[[1]]$content, "grob")) +}) + +# --------------------------------------------------------------------------- +# .paginate_table1() — direct tests +# --------------------------------------------------------------------------- + +test_that(".paginate_table1 splits between variable groups", { + # Use a table with many variables and convert to flextable + set.seed(42) + dat <- data.frame( + v01 = rnorm(50), v02 = rnorm(50), v03 = rnorm(50), + v04 = rnorm(50), v05 = rnorm(50), v06 = rnorm(50), + v07 = rnorm(50), v08 = rnorm(50), v09 = rnorm(50), + v10 = rnorm(50) + ) + for (v in names(dat)) table1::label(dat[[v]]) <- paste("Var", v) + t1 <- table1::table1( + ~ v01 + v02 + v03 + v04 + v05 + v06 + v07 + v08 + v09 + v10, + data = dat + ) + + groups <- .table1_variable_groups(t1) + ft <- table1::t1flex(t1) + ft <- .clean_flextable(ft) + ft$caption <- list(value = NULL) + + # Small content_h to force multiple pages + content_w <- 10 + content_h <- 2.5 + + ft_pages <- .paginate_table1(ft, groups, content_h, content_w) + expect_gt(length(ft_pages), 1L) + # Each page should be a flextable + for (pg in ft_pages) { + expect_true(inherits(pg, "flextable")) + } +}) + +test_that(".paginate_table1 keeps small table as single page", { + t1 <- make_simple_t1() + groups <- .table1_variable_groups(t1) + ft <- table1::t1flex(t1) + ft <- .clean_flextable(ft) + ft$caption <- list(value = NULL) + + content_w <- 10 + content_h <- 10 # Very large — everything fits + + ft_pages <- .paginate_table1(ft, groups, content_h, content_w) + expect_length(ft_pages, 1L) +}) + +# --------------------------------------------------------------------------- +# .paginate_oversized_group() — direct tests +# --------------------------------------------------------------------------- + +test_that(".paginate_oversized_group splits a large group row-by-row", { + # Create a table with one variable that has many categories + set.seed(42) + # Use a factor with many levels for a single variable + dat <- data.frame( + category = factor(sample(LETTERS[1:20], 100, replace = TRUE)) + ) + table1::label(dat$category) <- "Category" + t1 <- table1::table1(~ category, data = dat) + + groups <- .table1_variable_groups(t1) + ft <- table1::t1flex(t1) + ft <- .clean_flextable(ft) + ft$caption <- list(value = NULL) + + content_w <- 10 + + # Very small content_h to force oversized group splitting + content_h <- 1.5 + + # The single group should be split + results <- .paginate_oversized_group(ft, groups[[1]], content_h, content_w) + expect_gt(length(results), 1L) + # All but the last should be flextable objects + for (i in seq_along(results)) { + if (i < length(results)) { + expect_true(inherits(results[[i]], "flextable")) + } else { + # Last element is a list with $body_rows + expect_true(is.list(results[[i]])) + expect_true("body_rows" %in% names(results[[i]])) + } + } +}) + +test_that(".paginate_table1 handles oversized first group", { + # Create a table where the first variable has many categories + set.seed(42) + dat <- data.frame( + big_cat = factor(sample(LETTERS[1:20], 100, replace = TRUE)), + small = rnorm(100) + ) + table1::label(dat$big_cat) <- "Big Category" + table1::label(dat$small) <- "Small Variable" + t1 <- table1::table1(~ big_cat + small, data = dat) + + groups <- .table1_variable_groups(t1) + ft <- table1::t1flex(t1) + ft <- .clean_flextable(ft) + ft$caption <- list(value = NULL) + + content_w <- 10 + content_h <- 1.5 # Very small to force oversized first group + + ft_pages <- .paginate_table1(ft, groups, content_h, content_w) + expect_gt(length(ft_pages), 1L) + for (pg in ft_pages) { + expect_true(inherits(pg, "flextable")) + } +}) + +test_that(".paginate_table1 handles oversized group after accumulated rows", { + # Mix: first groups fit, then an oversized group appears + set.seed(42) + dat <- data.frame( + small1 = rnorm(100), + small2 = rnorm(100), + big_cat = factor(sample(LETTERS[1:15], 100, replace = TRUE)) + ) + table1::label(dat$small1) <- "Small 1" + table1::label(dat$small2) <- "Small 2" + table1::label(dat$big_cat) <- "Big Category" + t1 <- table1::table1(~ small1 + small2 + big_cat, data = dat) + + groups <- .table1_variable_groups(t1) + ft <- table1::t1flex(t1) + ft <- .clean_flextable(ft) + ft$caption <- list(value = NULL) + + content_w <- 10 + # Just enough for the two small groups but not big_cat + content_h <- 2.0 + + ft_pages <- .paginate_table1(ft, groups, content_h, content_w) + expect_gt(length(ft_pages), 1L) + for (pg in ft_pages) { + expect_true(inherits(pg, "flextable")) + } +}) diff --git a/vignettes/v08-table1.Rmd b/vignettes/v08-table1.Rmd new file mode 100644 index 0000000..7f11819 --- /dev/null +++ b/vignettes/v08-table1.Rmd @@ -0,0 +1,236 @@ +--- +title: "Exporting table1 Tables" +output: rmarkdown::html_vignette +vignette: > + %\VignetteIndexEntry{Exporting table1 Tables} + %\VignetteEngine{knitr::rmarkdown} + %\VignetteEncoding{UTF-8} +--- + +```{r setup, include = FALSE} +knitr::opts_chunk$set( + collapse = TRUE, + comment = "#>" +) +``` + +```{r load} +library(writetfl) +library(table1) +``` + +The [table1](https://cran.r-project.org/package=table1) package creates +publication-ready "Table 1" summary tables commonly used in clinical and +epidemiological reporting. `writetfl` accepts `table1` objects directly in +`export_tfl()`, preserving column labels, bold variable names, indented +summary statistics, and stratification headers. + +--- + +## Basic usage + +Pass a `table1` object directly to `export_tfl()`: + +```{r basic, fig.width = 11, fig.height = 8.5, out.width = "100%"} +dat <- data.frame( + age = c(45, 52, 61, 38, 55, 47, 63, 41, 58, 50), + sex = c("Male", "Female", "Male", "Female", "Male", + "Female", "Male", "Female", "Male", "Female") +) + +tbl <- table1(~ age + sex, data = dat) + +export_tfl(tbl, preview = TRUE, + header_left = "Study Report", + header_rule = TRUE, + footer_rule = TRUE +) +``` + +--- + +## Column labels + +Use `table1::label()` to set variable labels. These are used as the bold +row headers in the output: + +```{r labels, fig.width = 11, fig.height = 8.5, out.width = "100%"} +label(dat$age) <- "Age (years)" +label(dat$sex) <- "Sex" + +tbl <- table1(~ age + sex, data = dat) + +export_tfl(tbl, preview = TRUE, + header_left = "Labeled Variables" +) +``` + +Variable labels appear as bold row headings with the summary statistics +indented beneath them. + +--- + +## Caption and footnote + +The `caption` and `footnote` arguments to `table1()` are automatically +extracted into writetfl's caption and footnote zones: + +```{r caption-footnote, fig.width = 11, fig.height = 8.5, out.width = "100%"} +tbl <- table1(~ age + sex, data = dat, + caption = "Table 1. Baseline Demographics", + footnote = "ITT Population (N = 10)") + +export_tfl(tbl, preview = TRUE, + header_left = "Protocol XY-001", + header_right = "2025-01-15", + header_rule = TRUE, + footer_rule = TRUE +) +``` + +--- + +## Stratification + +Use the formula interface with `|` to stratify by a grouping variable. +Column headers show the stratum labels and sample sizes: + +```{r stratified, fig.width = 11, fig.height = 8.5, out.width = "100%"} +dat$trt <- c(rep("Treatment", 5), rep("Placebo", 5)) + +label(dat$age) <- "Age (years)" +label(dat$sex) <- "Sex" + +tbl <- table1(~ age + sex | trt, data = dat, + caption = "Table 1. Demographics by Treatment Group") + +export_tfl(tbl, preview = TRUE, + header_left = "Study Report", + header_rule = TRUE, + footer_rule = TRUE +) +``` + +The `overall` argument adds a combined column: + +```{r overall, fig.width = 11, fig.height = 8.5, out.width = "100%"} +tbl <- table1(~ age + sex | trt, data = dat, overall = "Total", + caption = "Table 1. Demographics with Overall") + +export_tfl(tbl, preview = TRUE, + header_left = "Study Report", + header_rule = TRUE +) +``` + +--- + +## Page layout + +All `export_tfl_page()` layout arguments work with table1 tables: + +```{r layout, fig.width = 11, fig.height = 8.5, out.width = "100%"} +tbl <- table1(~ age + sex | trt, data = dat, + caption = "Table 1. Demographics") + +export_tfl(tbl, preview = TRUE, + header_left = "Protocol XY-001", + header_center = "CONFIDENTIAL", + header_right = "2025-01-15", + footnote = "Percentages based on non-missing values.", + footer_left = "Sponsor: Acme Corp", + header_rule = TRUE, + footer_rule = TRUE, + gp = list( + header = grid::gpar(fontsize = 11, fontface = "bold"), + caption = grid::gpar(fontsize = 9, fontface = "italic"), + footer = grid::gpar(fontsize = 8) + ) +) +``` + +--- + +## Multiple tables + +Pass a list of `table1` objects to create a multi-page PDF: + +```{r multi, fig.width = 11, fig.height = 8.5, out.width = "100%"} +tbl_age <- table1(~ age | trt, data = dat, + caption = "Table 1a. Age by Treatment") +tbl_sex <- table1(~ sex | trt, data = dat, + caption = "Table 1b. Sex by Treatment") + +export_tfl( + list(tbl_age, tbl_sex), + preview = TRUE, + header_left = "Study Report", + header_rule = TRUE, + footer_rule = TRUE +) +``` + +--- + +## Automatic pagination + +When a table has too many variables to fit on a single page, `export_tfl()` +paginates automatically. Page breaks fall between variable groups (a variable +label and its summary rows are kept together). + +```{r pagination, fig.width = 11, fig.height = 5, out.width = "100%"} +set.seed(42) +big_dat <- data.frame( + v01 = rnorm(50), v02 = rnorm(50), v03 = rnorm(50), + v04 = rnorm(50), v05 = rnorm(50), v06 = rnorm(50), + v07 = rnorm(50), v08 = rnorm(50), v09 = rnorm(50), + v10 = rnorm(50), v11 = rnorm(50), v12 = rnorm(50) +) +for (v in names(big_dat)) label(big_dat[[v]]) <- paste("Variable", v) + +big_tbl <- table1( + ~ v01 + v02 + v03 + v04 + v05 + v06 + v07 + v08 + v09 + v10 + v11 + v12, + data = big_dat, + caption = "Table 2. Many Variables" +) + +export_tfl(big_tbl, + preview = 1:2, + pg_height = 5, + header_left = "Study Report", + header_rule = TRUE, + footer_rule = TRUE +) +``` + +--- + +## Preserved features + +| Feature | How it's handled | +|---------|-----------------| +| Column labels (`label()`) | Bold variable-name rows in the table body | +| Indented summary statistics | Spaces preserved from `t1flex()` conversion | +| Stratification (`\| group`) | Column headers with stratum labels and N counts | +| Overall column | Included when `overall` is set | +| Caption | Extracted to writetfl caption zone | +| Footnote | Extracted to writetfl footnote zone | +| Custom render functions | Applied before conversion; output preserved | +| Variable units (`units()`) | Displayed in variable labels | +| Row label heading | Header for the first column | +| CSS styles | Translated to flextable formatting via `t1flex()` | +| Group-aware pagination | Variable groups kept together across page breaks | + +--- + +## How it works + +Under the hood, `export_tfl()` uses `table1::t1flex()` to convert the table1 +object to a [flextable](https://davidgohel.github.io/flextable/), then renders +the flextable to a grid grob via `flextable::gen_grob()`. This preserves all +visual formatting including bold labels, indented statistics, borders, and +spanning headers. + +Caption and footnote are extracted from the table1 object's internal structure +(not the flextable) to ensure they appear in writetfl's annotation zones +rather than being duplicated inside the table. diff --git a/vignettes/writetfl.Rmd b/vignettes/writetfl.Rmd index 5895978..dbd3409 100644 --- a/vignettes/writetfl.Rmd +++ b/vignettes/writetfl.Rmd @@ -21,8 +21,8 @@ library(dplyr) ``` `writetfl` produces multi-page PDF files from `ggplot2` figures, data-frame -tables, `gt` tables, `rtables` tables, `flextable` tables, and other grid -content with precise, +tables, `gt` tables, `rtables` tables, `flextable` tables, `table1` tables, +and other grid content with precise, composable page layouts required for clinical trial TFL deliverables and regulatory submissions. @@ -267,6 +267,41 @@ pagination, preserved features, and more — see --- +## table1 tables + +Pass a `table1` object directly to `export_tfl()`. Caption and footnote are +extracted into writetfl's annotation zones. Column labels (`label()`), +bold variable names, indented summary statistics, and stratification headers +are all preserved via `t1flex()` conversion. + +```{r table1-basic, fig.width = 11, fig.height = 8.5, out.width = "100%"} +library(table1) + +dat <- data.frame( + age = c(45, 52, 61, 38, 55, 47, 63, 41, 58, 50), + sex = c("Male", "Female", "Male", "Female", "Male", + "Female", "Male", "Female", "Male", "Female"), + trt = c(rep("Treatment", 5), rep("Placebo", 5)) +) +label(dat$age) <- "Age (years)" +label(dat$sex) <- "Sex" + +tbl <- table1(~ age + sex | trt, data = dat, + caption = "Table 1. Baseline Demographics") + +export_tfl(tbl, preview = TRUE, + header_left = "Study Report", + header_rule = TRUE, + footer_rule = TRUE +) +``` + +A list of `table1` objects produces a multi-page PDF. Pagination is +group-aware: variable labels and their summary rows are kept together. +For the full reference see `vignette("v08-table1")`. + +--- + ## Multi-page reports `export_tfl()` accepts a list of page specifications, so different figures can @@ -359,3 +394,4 @@ export_tfl_page( | `vignette("v05-gt_tables")` | Exporting `gt` tables: annotation extraction, pagination, preserved features | | `vignette("v06-rtables")` | Exporting `rtables` tables: annotation mapping, pagination, font control | | `vignette("v07-flextable")` | Exporting `flextable` tables: caption/footnote extraction, pagination, preserved features | +| `vignette("v08-table1")` | Exporting `table1` tables: column labels, indentation, stratification, group-aware pagination |