diff --git a/NEWS.md b/NEWS.md index 998affc58..94cf1fa8d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # gt (development version) +* Expand functionality of `gt_group()` to allow `gt_group` objects to be combined with `gt_tbls` (#2128) + # gt 1.3.0 ## New features diff --git a/R/gt_group.R b/R/gt_group.R index 3a84b233a..77358a3fd 100644 --- a/R/gt_group.R +++ b/R/gt_group.R @@ -34,12 +34,12 @@ #' can be printed independently and table separation (usually a page break) #' occurs between each of those. #' -#' @param ... *One or more gt table data objects* +#' @param ... *One or more gt table or gt_group data objects* #' -#' `obj:` // (`optional`) +#' `obj:` // (`optional`) #' -#' One or more **gt** table (`gt_tbl`) objects, typically generated via the -#' [gt()] function. +#' One or more **gt** table (`gt_tbl`) or (`gt_group`) objects, typically +#' generated via the [gt()] function. #' #' @param .list *Alternative to `...`* #' @@ -78,6 +78,35 @@ gt_group <- function( return(init_gt_group_list()) } + # Check if there are any existing gt_groups in the list, if so flatten + group_check <- sapply(gt_tbl_list, function(x) + inherits(x, "gt_group")) + + if (sum(group_check) > 0) { + flattened_list <- lapply(gt_tbl_list, function(x) { + if (inherits(x, "gt_group")) { + no_tbls <- nrow(x[["gt_tbls"]]) + # pull out each gt_tbl + gt_tables <- lapply(seq_len(no_tbls), function(i) { + grp_pull(x, which = i) + }) + } else { + list(x) + } + }) + + gt_tbl_list <- unlist(flattened_list, recursive = FALSE) + } + + # Check that all items in the list are `gt_tbl` objects + is_gt_tbl <- vapply(gt_tbl_list, FUN = inherits, FUN.VALUE = logical(1), "gt_tbl") + + if (!all(is_gt_tbl)) { + cli::cli_abort( + "All objects supplied to {.fn gt_group} must be {.cls gt_tbl} or {.cls gt_group} objects." + ) + } + # Initialize the `gt_group` object and create # an empty `gt_tbl_tbl` object gt_group <- init_gt_group_list() @@ -86,9 +115,7 @@ gt_group <- function( # # Process gt tables and add records to the `gt_tbl_tbl` object # - for (i in seq_along(gt_tbl_list)) { - gt_tbl_tbl_i <- generate_gt_tbl_tbl_i(i = i, gt_tbl = gt_tbl_list[[i]]) gt_tbl_tbl <- dplyr::bind_rows(gt_tbl_tbl, gt_tbl_tbl_i) } diff --git a/man/gt_group.Rd b/man/gt_group.Rd index d8907e01d..4192ef8d7 100644 --- a/man/gt_group.Rd +++ b/man/gt_group.Rd @@ -7,12 +7,12 @@ gt_group(..., .list = list2(...), .use_grp_opts = FALSE) } \arguments{ -\item{...}{\emph{One or more gt table data objects} +\item{...}{\emph{One or more gt table or gt_group data objects} -\verb{obj:} // (\code{optional}) +\verb{obj:} // (\code{optional}) -One or more \strong{gt} table (\code{gt_tbl}) objects, typically generated via the -\code{\link[=gt]{gt()}} function.} +One or more \strong{gt} table (\code{gt_tbl}) or (\code{gt_group}) objects, typically +generated via the \code{\link[=gt]{gt()}} function.} \item{.list}{\emph{Alternative to \code{...}} diff --git a/man/rows_hide.Rd b/man/rows_hide.Rd index a831430b6..244be3594 100644 --- a/man/rows_hide.Rd +++ b/man/rows_hide.Rd @@ -38,11 +38,16 @@ not necessary. \details{ The hiding of rows is internally a rendering directive, so, all rows that are 'hidden' are still accessible and useful in any expression provided to a -\code{columns} argument (for column-level operations). Furthermore, \code{rows_hide()} -(as with many \strong{gt} functions) can be placed anywhere in a pipeline of -\strong{gt} function calls (acting as a promise to hide rows when the timing is -right). However, there's perhaps greater readability when placing this call -closer to the end of such a pipeline. +\code{rows} argument. Furthermore, \code{rows_hide()} (as with many \strong{gt} functions) +can be placed anywhere in a pipeline of \strong{gt} function calls (acting as a +promise to hide rows when the timing is right). However, there's perhaps +greater readability when placing this call closer to the end of such a +pipeline. + +Note that when using \code{\link[=summary_rows]{summary_rows()}} or \code{\link[=grand_summary_rows]{grand_summary_rows()}}, the +aggregation calculations will only include the visible rows. Hidden rows are +excluded from summary computations. This allows summary values to dynamically +reflect the currently visible data. \code{rows_hide()} quietly changes the visible state of a row (much like \code{\link[=rows_unhide]{rows_unhide()}}) and doesn't yield warnings or messages when changing the diff --git a/man/rows_unhide.Rd b/man/rows_unhide.Rd index 2d774cdc7..4f81db96a 100644 --- a/man/rows_unhide.Rd +++ b/man/rows_unhide.Rd @@ -36,10 +36,14 @@ rows and there is motivation to reveal one or more of those. \details{ The hiding and unhiding of rows is internally a rendering directive, so, all rows that are 'hidden' are still accessible and useful in any expression -provided to a \code{columns} argument. The \code{rows_unhide()} function quietly -changes the visible state of a row (much like the \code{\link[=rows_hide]{rows_hide()}} function) and +provided to a \code{rows} argument. The \code{rows_unhide()} function quietly changes +the visible state of a row (much like the \code{\link[=rows_hide]{rows_hide()}} function) and doesn doesn't yield warnings or messages when changing the state of already-visible rows. + +Note that unhiding rows will cause them to be included in any \code{\link[=summary_rows]{summary_rows()}} +or \code{\link[=grand_summary_rows]{grand_summary_rows()}} calculations, as these aggregations only operate on +visible rows. } \section{Examples}{ diff --git a/tests/testthat/test-gt_group.R b/tests/testthat/test-gt_group.R index 8770490d8..57fea8c72 100644 --- a/tests/testthat/test-gt_group.R +++ b/tests/testthat/test-gt_group.R @@ -42,6 +42,64 @@ test_that("gt_group() can be used to contain gt tables", { expect_s3_class(gt_tbls_1[["gt_tbl_options"]], "tbl_df") }) +test_that("gt_group() can be used to contain gt tables and existing gt_groups", { + + # Create two different `gt_tbl` table objects + gt_tbl_1 <- gt(exibble) + gt_tbl_2 <- gt(gtcars) + + # Create a `gt_group` object with `gt_group()` + gt_grp_1 <- gt_group(gt_tbl_1, gt_tbl_2) + + # Create a new gt group from a list of all existing tables - including a gt_group + gt_list <- list(gt_tbl_1, gt_tbl_2, gt_grp_1) + + gt_tbls_1 <- gt_group(.list = gt_list) + + # Expect that the `gt_tbls_1` object produced by `gt_group()` + # has the 'gt_group' class + expect_s3_class(gt_tbls_1, "gt_group") + expect_type(gt_tbls_1, "list") + + # The gt_group should contain 4 tables: + # 2 individual tables + 1 group of 2 tables (flattened) + expect_equal(nrow(gt_tbls_1[["gt_tbls"]]), 4L) + + # Verify that the flattened tables match the originals + expect_equal(grp_pull(gt_tbls_1, 1), gt_tbl_1) + expect_equal(grp_pull(gt_tbls_1, 2), gt_tbl_2) + expect_equal(grp_pull(gt_tbls_1, 3), grp_pull(gt_grp_1, 1)) + expect_equal(grp_pull(gt_tbls_1, 4), grp_pull(gt_grp_1, 2)) + + # Expect that `gt_group()` also works when passing gt_group objects via `...` + gt_tbls_2 <- gt_group(gt_tbl_1, gt_grp_1) + expect_s3_class(gt_tbls_2, "gt_group") + expect_equal(nrow(gt_tbls_2[["gt_tbls"]]), 3L) + + # Setting the option `.use_grp_opts` means that the internal + # component of similar naming is set to that logical value + # Create a `gt_group` object with `gt_group()` + gt_tbls_3 <- gt_group(.list = gt_list, .use_grp_opts = TRUE) + expect_true(gt_tbls_3[["use_grp_opts"]]) + gt_tbls_4 <- gt_group(.list = gt_list, .use_grp_opts = FALSE) + expect_false(gt_tbls_4[["use_grp_opts"]]) + + # Not setting it means it will be FALSE by default + gt_tbls_5 <- gt_group(.list = gt_list) + expect_false(gt_tbls_5[["use_grp_opts"]]) + + # Expect specific components inside of a 'gt_group' object + expect_named( + gt_tbls_1, + c("gt_tbls", "gt_tbl_options", "use_grp_opts") + ) + + # Expect that the 'gt_tbls' and `gt_tbl_options` objects inside of + # 'gt_group' are both tibbles + expect_s3_class(gt_tbls_1[["gt_tbls"]], "tbl_df") + expect_s3_class(gt_tbls_1[["gt_tbl_options"]], "tbl_df") +}) + test_that("grp_pull() can be used to extract a table from a group", { # Create two different `gt_tbl` table objects