Merge pull request #1801 from olivroy/incorrect-stub

`row_group_as_column = TRUE` + 2 group variables

Author: rich-iannone

NEWS.md

@@ -16,6 +16,8 @@
 
 * Improved width calculations in `as_gtable()` (@teunbrand, #1923)
 
+* `gt(row_group_as_column = TRUE)` now works if multiple groups are supplied (@olivroy, #1552).
+
 # gt 0.11.1
 
 ## Breaking changes

R/dt_boxhead.R

@@ -264,6 +264,10 @@ dt_boxhead_get_alignments_in_stub <- function(data) {
           var = grp_vars
         )
 
+    if (length(grp_vars) > 1) {
+      grp_alignment <- grp_alignment[1]
+    }
+
     alignments <- c(alignments, grp_alignment)
   }
 
@@ -294,6 +298,13 @@ dt_boxhead_get_vars_align_default <- function(data) {
 
 dt_boxhead_get_alignment_by_var <- function(data, var) {
   boxhead <- dt_boxhead_get(data = data)
+  if (length(var) > 1L) {
+    # return multiple alignments in case of multiple variables
+    # requested. #1552
+    return(
+      boxhead$column_align[boxhead$var %in% var]
+    )
+  }
   boxhead$column_align[boxhead$var == var]
 }
 

R/dt_groups_rows.R

@@ -105,6 +105,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 {
 
@@ -132,5 +137,6 @@ dt_groups_rows_build <- function(data, context) {
     }
   }
 
+  # print(groups_rows)
   dt_groups_rows_set(data = data, groups_rows = groups_rows)
 }

tests/testthat/test-stub.R

@@ -429,3 +429,25 @@ test_that("The stub can be formatted with `fmt_*()` functions and `stub()", {
     selection_text(selection = "[class='gt_footnote']") %>%
     expect_equal(c("1 footnote `3`", "2 footnote `4`"))
 })
+
+test_that("gt(row_group_as_column = TRUE) works with multiple `groupname_col` (#1552)", {
+  many_grps <- gt(
+    utils::head(gtcars, n = 8),
+    groupname_col = c("ctry_origin", "mfr"),
+    row_group_as_column = TRUE
+  )
+  stub_look <- xml2::read_xml(render_as_html(many_grps))
+  row_groups <- stub_look %>%
+    selection_text(
+      "[class='gt_row_group_first']"
+    )
+  # we expect 2 groups here
+  expect_match(
+    row_groups[1],
+    "United States.+Ford"
+  )
+  expect_match(
+    row_groups[2],
+    "Italy.+Ferrari"
+  )
+})

tests/testthat/test-utils_render_grid.R

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