Progress

R/dt_groups_rows.R

@@ -108,6 +108,11 @@ dt_groups_rows_build <- function(data, context) {
 
     groups_rows[is.na(groups_rows[, "group_id"]), "group_label"] <-
       others_group
+    if (!is.null(stub_df$group_label)) {
+     # stub_df$group_label[is.null(stub_df$group_label[[1]])] <- others_group
+      #data <- dt_stub_df_set(data, stub_df)
+
+    }
 
   } else {
 
@@ -134,6 +139,6 @@ dt_groups_rows_build <- function(data, context) {
       }
     }
   }
-
+  print(groups_rows)
   dt_groups_rows_set(data = data, groups_rows = groups_rows)
 }

R/dt_stub_df.R

@@ -78,6 +78,10 @@ dt_stub_df_init <- function(
   #
   # Handle column of data specified as the `groupname_col`
   #
+  if (identical(groupname_col, "__GT_GROUPNAME_PRIVATE__")) {
+    data_tbl$`__GT_GROUPNAME_PRIVATE__` <- NA_character_
+  }
+
   if (
     !is.null(groupname_col) &&
     length(groupname_col) > 0L &&

R/gt.R

@@ -320,6 +320,10 @@ gt <- function(
 
   if (length(groupname_col) == 0) {
     groupname_col <- NULL
+    if (rownames_to_stub) {
+      # initialize a stub just in case users want to add them.
+      groupname_col <- "__GT_GROUPNAME_PRIVATE__"
+    }
   }
 
   # Stop function if `rowname_col` and `groupname_col`
@@ -336,11 +340,12 @@ gt <- function(
   }
 
   # Initialize the main objects
+  rownames_to_column <- if (rownames_to_stub) rowname_col else NA_character_
   data <-
     dt_data_init(
       data = list(),
       data_tbl = data,
-      rownames_to_column = if (rownames_to_stub) rowname_col else NA_character_
+      rownames_to_column = rownames_to_column
     )
 
   data <- dt_boxhead_init(data = data)

R/tab_create_modify.R

@@ -1719,12 +1719,6 @@ tab_row_group <- function(
 
   # Get the `stub_df` data frame from `data`
   stub_df <- dt_stub_df_get(data = data)
-  if (all(is.na(stub_df$group_id))) {
-    # FIXME A stub is not properly set if groupname_col didn't exist at first.
-    # what to do if stub group not initialized?
-    # dt_stub_df_init(data, rowname_col = NULL, groupname_col = NA, process_md = FALSE, row_group.sep = "-")
-    # stub_df <- dt_stub_df_get(data = data)
-  }
 
   # If the label is marked as HTML or Markdown and there's no `id` set
   # (assumed when `id` is equal to `label`), strip away HTML tags in the

tests/testthat/test-table_parts.R

@@ -417,15 +417,18 @@ test_that("tab_row_group() works with uninitialized row group (#1552)", {
     row_groups[1],
     "numbered cars"
   )
+
+  # no stub in plot mode, which means the boxhead is
+  # incorrect
+
+  test <- as_gtable(dat)
+  test$layout$name
   skip("the stub is not correctly initialized.")
   # shows as NA.
   expect_match(
     row_groups[2],
     "The other category"
   )
-  # no stub in plot mode, which means the boxhead is
-  # incorrect
-  plot(dat)
 
 })
 

tests/testthat/test-utils_render_grid.R

@@ -10,7 +10,7 @@ has_class <- function(layout, class) {
 
 # Layout tests ------------------------------------------------------------
 
-test_that("create_caption_component_g creates captions", {
+test_that("create_caption_component_g() creates captions", {
 
   df <- data.frame(x = 1:2, y = 3:4)
 
@@ -27,7 +27,7 @@ test_that("create_caption_component_g creates captions", {
   expect_length(test$classes[[1]], 2)
 })
 
-test_that("create_heading_component_g creates headings", {
+test_that("create_heading_component_g() creates headings", {
 
   df <- data.frame(x = 1:2, y = 3:4)
 
@@ -57,7 +57,7 @@ test_that("create_heading_component_g creates headings", {
   expect_match(test$label, "gt_footnote_marks")
 })
 
-test_that("create_columns_component_g creates columns and spanners", {
+test_that("create_columns_component_g() creates columns and spanners", {
 
   df <- data.frame(A = 1:2, B = 3:4, C = 5:6)
   gt <- gt(df)
@@ -114,7 +114,7 @@ test_that("create_columns_component_g creates columns and spanners", {
   expect_snapshot(test)
 })
 
-test_that("group_headings_g creates appropriate group headings", {
+test_that("group_headings_g() creates appropriate group headings", {
 
   df <- data.frame(x = 1:3, y = 4:6)
 
@@ -151,7 +151,7 @@ test_that("group_headings_g creates appropriate group headings", {
   expect_null(test)
 })
 
-test_that("body_cells_g creates appropriate cells", {
+test_that("body_cells_g() creates appropriate cells", {
 
   df <- data.frame(x = 1:3, y = 4:6, row = c("A", "B", "C"))
 
@@ -170,10 +170,16 @@ test_that("body_cells_g creates appropriate cells", {
 
   expect_equal(vctrs::list_sizes(test), c(3, 3, 3))
   test <- vctrs::vec_c(!!!test)
+  # FIXME with row.striping.include_stub = TRUE,
   expect_equal(
     has_class(test, "gt_striped"),
     rep(c(FALSE, TRUE, FALSE), each = 3)
   )
+  # Has the correct class, but is not striped?
+  expect_contains(
+    unlist(test[test$label == "B", ]$classes),
+    c("gt_stub", "gt_striped")
+  )
   expect_equal(
     has_class(test, "gt_stub"),
     rep(c(TRUE, FALSE, FALSE), 3)
@@ -196,6 +202,35 @@ test_that("body_cells_g creates appropriate cells", {
   )
 })
 
+test_that("body_cells_g() creates appropriate cells with row_group_as_column = TRUE (#1552)", {
+
+  df <- data.frame(x = 1:3, y = 4:6, row = c("A", "B", "C"))
+
+  gt <- gt(df, rowname_col = "row", row_group_as_column = T) %>%
+    tab_row_group("X", rows = 1) %>%
+    tab_row_group("Y", rows = 3) %>%
+    row_group_order(c("X", "Y")) %>%
+    tab_options(row_group.default_label = "Z")
+
+  test <- gt %>%
+    tab_options(
+      row.striping.include_table_body = TRUE,
+      row.striping.include_stub = TRUE
+    ) %>%
+    prep_data() %>%
+    body_cells_g()
+
+  expect_equal(vctrs::list_sizes(test), c(4, 4, 4))
+  test <- vctrs::vec_c(!!!test)
+  expect_equal(
+    has_class(test, "gt_striped"),
+    rep(c(FALSE, TRUE, FALSE), each = 4)
+  )
+
+  expect_equal(test$label, c("X", "A", 1, 4, "Y", "C", 3, 6, "Z", "B", 2, 5))
+
+})
+
 test_that("summary_rows_g creates appropriate cells for group summaries", {
 
   df <- data.frame(x = 1:3, y = 4:6)