From 95c370116fc050a6781074b7e0444a6889216aff Mon Sep 17 00:00:00 2001 From: Bill Denney Date: Wed, 25 Mar 2026 09:35:05 -0400 Subject: [PATCH 1/2] Allow table1 objects in new_tab_list() Relaxes the validation in new_tab_list() to accept objects that inherit from "table1" in addition to NULL and data.frame-like objects. This enables storing table1 summary tables directly in a tab_tibble's table column for export via writetfl's export_tfl.table1() S3 method. Adds a test confirming that both new_tab_list() and new_tab_tibble() accept table1 objects without error. Co-Authored-By: Claude Sonnet 4.6 --- R/objects.R | 9 +++++---- tests/testthat/test-objects.R | 16 +++++++++++++++- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/R/objects.R b/R/objects.R index 0450035..8fba0b7 100644 --- a/R/objects.R +++ b/R/objects.R @@ -19,10 +19,11 @@ new_tab_list <- function(x) { if (!inherits(x, "list")) { stop("`x` must be a list") } - x_null <- vapply(X = x, FUN = is.null, FUN.VALUE = TRUE) - x_df <- vapply(X = x, FUN = inherits, "data.frame", FUN.VALUE = TRUE) - if (!all(x_null | x_df)) { - stop("The contents of 'x' must be NULL or a 'data.frame'-like object") + x_null <- vapply(X = x, FUN = is.null, FUN.VALUE = TRUE) + x_df <- vapply(X = x, FUN = inherits, "data.frame", FUN.VALUE = TRUE) + x_table1 <- vapply(X = x, FUN = inherits, "table1", FUN.VALUE = TRUE) + if (!all(x_null | x_df | x_table1)) { + stop("The contents of 'x' must be NULL, a 'data.frame'-like object, or a 'table1' object") } vctrs::new_vctr(x, class = "tab_list") } diff --git a/tests/testthat/test-objects.R b/tests/testthat/test-objects.R index 11f1cca..c2855a0 100644 --- a/tests/testthat/test-objects.R +++ b/tests/testthat/test-objects.R @@ -15,10 +15,24 @@ test_that("new_tab_list", { ) expect_error( new_tab_list(list("A")), - regexp = "The contents of 'x' must be NULL or a 'data.frame'-like object" + regexp = "The contents of 'x' must be NULL, a 'data.frame'-like object, or a 'table1' object" ) }) +test_that("new_tab_list accepts table1 objects", { + skip_if_not_installed("table1") + d <- data.frame(x = c(1, 2, 3), g = c("a", "a", "b")) + t1 <- table1::table1(~ x | g, data = d) + expect_s3_class(t1, "table1") + + new_tl <- new_tab_list(list(t1)) + expect_s3_class(new_tl, "tab_list") + + new_tt <- new_tab_tibble(tibble::tibble(table = list(t1), caption = "Test table1")) + expect_s3_class(new_tt, "tab_tibble") + expect_s3_class(new_tt$table, "tab_list") +}) + test_that("vctrs methods", { d_tab_prep <- tidyr::nest(mtcars, table = !"cyl") d_tab_prep <- dplyr::mutate(d_tab_prep, caption = glue::glue("Cars with {cyl} cylinders")) From 8fc614bc0761ca0aa2325d3eb83597f3cacb9ef7 Mon Sep 17 00:00:00 2001 From: Bill Denney Date: Wed, 25 Mar 2026 10:07:39 -0400 Subject: [PATCH 2/2] Add table1 to Suggests in DESCRIPTION table1 is now listed as a suggested package to indicate that tabtibble supports storing table1 objects in the table column of a tab_tibble. Co-Authored-By: Claude Sonnet 4.6 --- DESCRIPTION | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index b31b39e..12e9a40 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -13,12 +13,13 @@ RoxygenNote: 7.3.2 Imports: knitr, vctrs -Suggests: +Suggests: dplyr, glue, pander, rmarkdown, spelling, + table1, testthat (>= 3.0.0), tibble, tidyr