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 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"))