Fix dropped second-level strata headers in tbl_strata_nested_stack() (#2418)

NEWS.md

@@ -1,5 +1,7 @@
 # gtsummary (development version)
 
+* Fixed bug in `tbl_strata_nested_stack()` where second-level strata headers were dropped in all but the first group when using three or more strata levels. (#2418)
+
 * Added `save_flex_docx()` to save a gtsummary table or a flextable to a Word (`.docx`) file via flextable. The `header` and `footer` arguments place the table caption in the Word document's page header and the footnotes, source notes, and abbreviations in the page footer. The `page` and `page_location` arguments add a page-number line (e.g. `"Page {PAGE} of {NUMPAGES}"`) to a chosen header/footer region and alignment. A collection of tables is also accepted—a `tbl_split` object (from `tbl_split_by_rows()`/`tbl_split_by_columns()`) or a plain list of flextables—writing each table to its own Word section and page. For a flextable, its caption (`flextable::set_caption()`) is relocated to the Word header and its footer part (`flextable::add_footer_lines()`) to the Word footer. The caption, footnotes, source notes, abbreviations, and page-number line in the Word header/footer match the table body font (family and size) instead of the Word template default. Each Word region also inherits the styling applied to the corresponding flextable part, so e.g. `flextable::fontsize(size = 6, part = "footer")` yields a size-6 Word footer. The `pr_section` argument (and the `save_flex_docx-lst:pr_section` theme element) accepts an `officer::prop_section()` object for fine-grained control of the Word section—page margins, page size, orientation, and columns—while the header/footer regions remain managed by `save_flex_docx()`; for a collection the same section is applied to every table with the paging `type` fixed to `"nextPage"`.
 
 * `modify_abbreviation()` and `remove_abbreviation()` now accept a character vector of abbreviations, allowing multiple abbreviations to be added or removed in a single call. `modify_abbreviation()` also gains `prefix`, `sep1`, and `sep2` arguments to customize the abbreviation source note's leading text (e.g. `c("Abbr.", "Abbrs.")`), the separator between the prefix and the abbreviations (e.g. `": "`), and the separator between abbreviations (e.g. `"; "`). Defaults are also configurable via the `modify_abbreviation-arg:prefix`, `modify_abbreviation-arg:sep1`, and `modify_abbreviation-arg:sep2` theme elements. (#2172)

R/tbl_strata_nested_stack.R

@@ -129,12 +129,26 @@ tbl_strata_nested_stack <- function(data, strata, .tbl_fun, ..., row_header = "{
     ) |>
     dplyr::pull(".....strata.....")
 
+  # NA-out repeated header values so that the later `pivot_longer() |> drop_na()`
+  # keeps only the first occurrence of each value at each level. The
+  # first-occurrence masks must be computed against the *original* strata values,
+  # otherwise NAs introduced for an outer level would corrupt the grouping used
+  # for inner levels and drop valid headers in later groups (#2418).
+  first_occurrence <-
+    map(
+      seq_along(strata[-1]),
+      \(i) {
+        df_headers |>
+          dplyr::mutate(
+            .by = all_of(strata[seq_len(i)]),
+            ...keep... = dplyr::row_number() == 1L
+          ) |>
+          dplyr::pull("...keep...")
+      }
+    )
   for (i in seq_along(strata[-1])) {
-    df_headers <- df_headers |>
-      dplyr::mutate(
-        .by = all_of(strata[seq_len(i)]),
-        "{strata[i]}" := ifelse(dplyr::row_number() == 1, .data[[strata[i]]], NA)
-      )
+    df_headers[[strata[i]]] <-
+      ifelse(first_occurrence[[i]], df_headers[[strata[i]]], NA)
   }
 
   first_non_hidden_col <- .first_unhidden_column(tbls[[1]])

tests/testthat/test-tbl_strata_nested_stack.R

@@ -234,3 +234,54 @@ test_that("tbl_strata_nested_stack() works with tables without prior indentation
     c(4L, 4L)
   )
 })
+
+test_that("tbl_strata_nested_stack() keeps second-level headers in all groups with 3+ strata levels (#2418)", {
+  df <- tidyr::expand_grid(
+    SEX     = c("Female", "Male"),
+    PARAMCD = c("A", "C", "W", "Y"),
+    VISIT   = c("D01", "D31", "D31/D01")
+  ) |>
+    dplyr::mutate(
+      SEX     = factor(SEX,     c("Female", "Male")),
+      PARAMCD = factor(PARAMCD, c("A", "C", "W", "Y")),
+      VISIT   = factor(VISIT,   c("D01", "D31", "D31/D01"))
+    ) |>
+    tidyr::crossing(
+      USUBJID = sprintf("S-%03d", 1:4),
+      TRT     = c("G1", "G2")
+    ) |>
+    dplyr::mutate(AVAL = seq_len(dplyr::n()))
+
+  expect_silent(
+    tbl <-
+      tbl_strata_nested_stack(
+        data     = df,
+        strata   = c(SEX, PARAMCD, VISIT),
+        .tbl_fun = function(d) tbl_summary(d, by = TRT, include = AVAL),
+        quiet    = TRUE
+      )
+  )
+
+  # extract the nesting header rows (those without an associated variable)
+  hdr <- tbl$table_body[is.na(tbl$table_body$variable), "label", drop = TRUE] |>
+    as.character()
+
+  # the second-level (PARAMCD) headers must appear under BOTH SEX groups, not
+  # just the first one. Previously, only the first PARAMCD header rendered under
+  # the second SEX group.
+  expect_equal(sum(hdr == "Female"), 1L)
+  expect_equal(sum(hdr == "Male"), 1L)
+  expect_equal(sum(hdr == "A"), 2L)
+  expect_equal(sum(hdr == "C"), 2L)
+  expect_equal(sum(hdr == "W"), 2L)
+  expect_equal(sum(hdr == "Y"), 2L)
+
+  # the header structure should be symmetric across the two SEX groups: each
+  # SEX section contains the same sequence of nested headers
+  female_idx <- which(hdr == "Female")
+  male_idx <- which(hdr == "Male")
+  expect_equal(female_idx, 1L)
+  female_section <- hdr[female_idx:(male_idx - 1L)]
+  male_section <- hdr[male_idx:length(hdr)]
+  expect_equal(female_section[-1], male_section[-1])
+})