Allow an empty table with zero rows to create an empty gt table (#283)

* Modify linebreaks

* Transform all tbl contents to NA if there are rows

* Ensure that all table cells are `NA_character_`

* Use functions that check if row count is > 0

* Only execute statement if number of rows >0

* Remove a line break

* Create a dummy row for an zero-row table

* Return NULL if output_df has a zero row count

* If tbl formally has no rows, assign it a single row

* Modify a conditional statement

* Move util functions to a separate file

* Add roxygen documentation for two util fcns

* Create zero-row `rows_df` if `data_tbl` is empty

* Account for grouped cols when making `final_df`

* Add several testthat tests

* Stop function if table has zero columns

* Create `boxh_df` from matrix object

* Use `seq_len()` instead of `seq()`

* Add missing closing bracket

* Make code review changes

Author: rich-iannone

R/build_data.R

@@ -166,15 +166,11 @@ build_data <- function(data, context) {
 
   # Replace NA values in the `groupname` column if there is a reserved
   # label for the unlabeled group
-  groups_df[is.na(groups_df[, "groupname"]), "groupname"] <- others_group
+  groups_df <- replace_na_groups_df(groups_df, others_group)
 
   # Replace NA values in the `group` and `group_label` columns of
   # `group_rows_df`
-  if (!is.na(others_group)) {
-    groups_rows_df[
-      is.na(groups_rows_df[, "group"]),
-      c("group", "group_label")] <- others_group
-  }
+  groups_rows_df <- replace_na_groups_rows_df(groups_rows_df, others_group)
 
   data_attr$boxh_df <- boxh_df
   data_attr$stub_df <- stub_df

R/gt.R

@@ -76,13 +76,17 @@ gt <- function(data,
                id = random_id(),
                stub_group.sep = getOption("gt.stub_group.sep", " - ")) {
 
+  # Stop if input `data` has no columns
+  if (ncol(data) == 0) {
+    stop("The input `data` table must have at least one column.",
+         call. = FALSE)
+  }
+
   opts_df <- gt_options_default()
 
   # Add the table ID to the `id` parameter
   if (!is.null(id)) {
-
-    opts_df <- opts_df_set(
-      opts_df, "table_id", id)
+    opts_df <- opts_df_set(opts_df, "table_id", id)
   }
 
   # If the option to place rownames in the stub
@@ -150,6 +154,13 @@ gt <- function(data,
     data[[groupname_col]] <- NULL
   }
 
+  # Stop if input `data` has no columns (after modifying
+  # `data` for groups)
+  if (ncol(data) == 0) {
+    stop("The `data` must have at least one column that isn't a 'group' column.",
+         call. = FALSE)
+  }
+
   # Take the input data and convert to a
   # data frame
   data_tbl <-
@@ -182,7 +193,11 @@ gt <- function(data,
     )[-1, ]
 
   # Create a prepopulated `rows_df` data frame
-  rows_df <- dplyr::tibble(rownums_start = seq(nrow(data_tbl)))
+  if (nrow(data_tbl) > 0) {
+    rows_df <- dplyr::tibble(rownums_start = seq(nrow(data_tbl)))
+  } else {
+    rows_df <- dplyr::tibble(rownums_start = NA_integer_)[-1, ]
+  }
 
   # Create a prepopulated `cols_df` data frame
   cols_df <- dplyr::tibble(colnames_start = colnames(data_tbl))
@@ -192,17 +207,19 @@ gt <- function(data,
   # data frames that contain specialized formatting
   # directives that will be used during render time
   empty_df <- data_tbl
-  empty_df[] <- NA_character_
+  if (nrow(data_tbl) > 0) {
+    empty_df[] <- NA_character_
+  }
 
   # Create a data frame that represents the table's
   # columns (`boxh_df`); each row has a special
   # meaning and this will be used during render time
-  boxh_df <- empty_df[c(), , drop = FALSE]
-  boxh_df[1:3, ] = list(NA_character_)
-
-  # Assign rownames to the `boxh_df` for easier
-  # manipulation of rows
-  rownames(boxh_df) <- c("group_label", "column_label", "column_align")
+  boxh_df <-
+    matrix(data = NA_character_, nrow = 3, ncol = ncol(data_tbl)) %>%
+    as.data.frame() %>%
+    dplyr::mutate_all(as.character) %>%
+    magrittr::set_names(names(data_tbl)) %>%
+    magrittr::set_rownames(c("group_label", "column_label", "column_align"))
 
   # Apply initialized data frames as attributes
   # within the object

R/utils_render_common.R

@@ -53,7 +53,11 @@ rownum_translation <- function(output_df,
 initialize_output_df <- function(data_df) {
 
   output_df <- data_df
+
+  if (nrow(output_df) > 0) {
   output_df[] <- NA_character_
+  }
+
   output_df
 }
 
@@ -832,3 +836,35 @@ create_summary_rows <- function(n_rows,
     unlist() %>%
     unname()
 }
+
+#' Suitably replace `NA` values in the `groups_df` data frame
+#'
+#' @param groups_df The `groups_df` data frame.
+#' @param others_group The `others_group` vector.
+#' @noRd
+replace_na_groups_df <- function(groups_df,
+                                 others_group) {
+
+  if (nrow(groups_df) > 0) {
+    groups_df[is.na(groups_df[, "groupname"]), "groupname"] <- others_group
+  }
+
+  groups_df
+}
+
+#' Suitably replace `NA` values in the `groups_rows_df` data frame
+#'
+#' @param groups_rows_df The `groups_rows_df` data frame.
+#' @param others_group The `others_group` vector.
+#' @noRd
+replace_na_groups_rows_df <- function(groups_rows_df,
+                                      others_group) {
+
+  if (nrow(groups_rows_df) > 0) {
+    groups_rows_df[
+      is.na(groups_rows_df[, "group"]),
+      c("group", "group_label")] <- others_group
+  }
+
+  groups_rows_df
+}

R/utils_render_html.R

@@ -12,28 +12,6 @@ footnote_glyph_to_html <- function(footnote_glyph) {
     as.character()
 }
 
-#' Split the body content vector into a list structure
-#'
-#' Taking the `body_content` vector, split into list components with one item
-#' per row in the output table
-#' @noRd
-split_body_content <- function(body_content,
-                               n_cols) {
-
-  split(body_content, ceiling(seq_along(body_content) / n_cols))
-}
-
-#' Split the body content vector into a list structure
-#'
-#' Taking the `body_content` vector, split into list components with one item
-#' per row in the output table
-#' @noRd
-split_body_content <- function(body_content,
-                               n_cols) {
-
-  split(body_content, ceiling(seq_along(body_content) / n_cols))
-}
-
 styles_to_html <- function(styles) {
 
   style_list <-

R/utils_render_rtf.R

@@ -350,3 +350,18 @@ rtf_last_body_row <- function(content) {
 
   output
 }
+
+#' Split the body content vector into a list structure
+#'
+#' Taking the `body_content` vector, split into list components with one item
+#' per row in the output table
+#' @noRd
+split_body_content <- function(body_content,
+                               n_cols) {
+
+  if (length(body_content) == 0) {
+    return(list(rep("", n_cols)))
+  }
+
+  split(body_content, ceiling(seq_along(body_content) / n_cols))
+}

tests/testthat/helper-gt_attr_expectations.R

@@ -70,8 +70,18 @@ expect_tab <- function(tab,
 
   # Expect that the attribute objects are of the
   # correct dimensions
+  if (dplyr::is_grouped_df(df)) {
 
-  final_df <- df
+    non_group_cols <- base::setdiff(colnames(df), dplyr::group_vars(df))
+
+    final_df <-
+      df %>%
+      dplyr::ungroup() %>%
+      dplyr::select(non_group_cols)
+
+  } else {
+    final_df <- df
+  }
 
   if (has_rownames) {
     final_df$rowname <- NULL

tests/testthat/test-gt_object.R

@@ -5,13 +5,26 @@ test_that("a gt table object contains the correct components", {
   # Create a `gt_tbl` object with `gt()`
   tab <- gt(data = iris)
 
+  # Expect that the `gt_tbl` object has all of the
+  # usual components and that they have all of the
+  # expected dimensions and features
   expect_tab(tab, iris)
 
+  # Expect that the `stub_df` data frame is correctly
+  # formed given the input rownames and groupnames
   expect_tab_colnames(
     tab, df = iris,
     rowname = "NA",
     groupname_is_na = TRUE)
 
+  # Create a `gt_tbl` object with `gt()` and a
+  # grouped version of the `iris` dataset
+  tab <- gt(data = iris %>% dplyr::group_by(Species))
+
+  # Expect that the `gt_tbl` object has all of the
+  # usual components and that they have all of the
+  # expected dimensions and features
+  expect_tab(tab, df = iris %>% dplyr::group_by(Species))
 })
 
 test_that("a gt table can be made to use the rownames of a data frame", {
@@ -20,8 +33,13 @@ test_that("a gt table can be made to use the rownames of a data frame", {
   # data frame's row names as row names in the stub
   tab <- gt(data = mtcars, rownames_to_stub = TRUE)
 
+  # Expect that the `gt_tbl` object has all of the
+  # usual components and that they have all of the
+  # expected dimensions and features
   expect_tab(tab, mtcars)
 
+  # Expect that the `stub_df` data frame is correctly
+  # formed given the input rownames and groupnames
   expect_tab_colnames(
     tab, df = mtcars,
     rowname = "tibble",
@@ -42,8 +60,13 @@ test_that("a gt table can be made with the stub partially or fully populated", {
   # `data_r` dataset
   tab <- gt(data = data_r)
 
+  # Expect that the `gt_tbl` object has all of the
+  # usual components and that they have all of the
+  # expected dimensions and features
   expect_tab(tab, data_r, has_rownames = TRUE)
 
+  # Expect that the `stub_df` data frame is correctly
+  # formed given the input rownames and groupnames
   expect_tab_colnames(
     tab, df = data_r,
     rowname = "col",
@@ -62,11 +85,46 @@ test_that("a gt table can be made with the stub partially or fully populated", {
   # `data_rg` dataset
   tab <- gt(data = data_rg)
 
+  # Expect that the `gt_tbl` object has all of the
+  # usual components and that they have all of the
+  # expected dimensions and features
   expect_tab(
     tab, data_rg, has_groupnames = TRUE, has_rownames = TRUE)
 
+  # Expect that the `stub_df` data frame is correctly
+  # formed given the input rownames and groupnames
   expect_tab_colnames(
     tab, df = data_rg,
     rowname = "col",
     groupname_is_na = FALSE)
 })
+
+test_that("a gt table can be made from a table with no rows", {
+
+  # Create an input data frame based on the exibble
+  # dataset, except with no rows
+  data_e <- exibble %>% head(0)
+
+  # Create a `gt_tbl` object with `gt()` and the
+  # `data_e` dataset
+  tab <- gt(data = data_e)
+
+  # Expect that the `gt_tbl` object has all of the
+  # usual components and that they have all of the
+  # expected dimensions and features
+  expect_tab(tab, data_e)
+
+  # Expect that the `stub_df` data frame is empty
+  attr(tab, "stub_df") %>%
+    nrow() %>%
+    expect_equal(0)
+
+  # Create a `gt_tbl` object with `gt()` and a
+  # grouped version of the `data_e` dataset
+  tab <- gt(data = data_e %>% dplyr::group_by(group))
+
+  # Expect that the `gt_tbl` object has all of the
+  # usual components and that they have all of the
+  # expected dimensions and features
+  expect_tab(tab, df = data_e %>% dplyr::group_by(group))
+})