Merge pull request #2129 from shannonhaughton/gt_group_list

Gt group list

Author: rich-iannone

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

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:<gt_tbl>` // (`optional`)
+#'   `obj:<gt_tbl|gt_group>` // (`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)
   }

man/gt_group.Rd

@@ -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