fix in gt

ddsjoberg · Nov 20, 2024 · 01b4a75 · 01b4a75
1 parent 2827f91
commit 01b4a75
Show file tree

Hide file tree

Showing 3 changed files with 25 additions and 13 deletions.
diff --git a/R/as_gt.R b/R/as_gt.R
@@ -245,13 +245,11 @@ table_styling_to_gt_calls <- function(x, ...) {
         x$table_styling$footnote,
         x$table_styling$footnote_abbrev
       ) |>
-      tidyr::nest(data = c("column", "row_numbers")) %>%
-      dplyr::rowwise() %>%
+      tidyr::nest(row_numbers = "row_numbers") %>%
       dplyr::mutate(
-        columns = .data$data %>% dplyr::pull("column") %>% unique() %>% list(),
-        rows = .data$data %>% dplyr::pull("row_numbers") %>% unique() %>% list()
-      ) |>
-      dplyr::ungroup()
+        # columns = .data$data %>% dplyr::pull("column") %>% list(),
+        rows = map(.data$row_numbers, \(x) unlist(x) |> unname())
+      )
     df_footnotes$footnote_exp <-
       map2(
         df_footnotes$text_interpret,
@@ -264,22 +262,22 @@ table_styling_to_gt_calls <- function(x, ...) {
       pmap(
         list(
           df_footnotes$tab_location, df_footnotes$footnote_exp,
-          df_footnotes$columns, df_footnotes$rows
+          df_footnotes$column, df_footnotes$rows
         ),
-        function(tab_location, footnote, columns, rows) {
+        function(tab_location, footnote, column, rows) {
           if (tab_location == "header") {
             return(expr(
               gt::tab_footnote(
                 footnote = !!footnote,
-                locations = gt::cells_column_labels(columns = !!columns)
+                locations = gt::cells_column_labels(columns = !!column)
               )
             ))
           }
           if (tab_location == "body") {
             return(expr(
               gt::tab_footnote(
                 footnote = !!footnote,
-                locations = gt::cells_body(columns = !!columns, rows = !!rows)
+                locations = gt::cells_body(columns = !!column, rows = !!rows)
               )
             ))
           }

diff --git a/tests/testthat/test-add_glance.R b/tests/testthat/test-add_glance.R
@@ -132,9 +132,8 @@ test_that("add_glance_table(glance_fun) for mice models", {
   tbl <- mice::mice(mice::nhanes2, print = FALSE, maxit = 1) |>
     with(lm(bmi ~ age)) |>
     tbl_regression()
-  glance <- tbl$inputs$x |>
-    mice::pool() |>
-    broom::glance() |>
+  glance <- tbl$inputs$x %>%
+    {suppressWarnings(broom::glance(mice::pool(.)))} |>
     dplyr::mutate(
       across(c(nimp, nobs), label_style_number()),
       across(c(r.squared, adj.r.squared), label_style_number(digits = 3))

diff --git a/tests/testthat/test-as_gt.R b/tests/testthat/test-as_gt.R
@@ -265,6 +265,21 @@ test_that("as_gt passes table footnotes & footnote abbreviations correctly", {
     gt_tbl$`_footnotes`$footnotes |> unlist(),
     c("replace old footnote", "another new footnote")
   )
+
+  # footnotes in the body of the table
+  expect_equal(
+    tbl_summary(trial, include = "age") |>
+      modify_table_styling(columns = label, rows = TRUE, footnote = "my footnote") |>
+      modify_table_styling(columns = stat_0, rows = row_type == "label", footnote = "my footnote") |>
+      as_gt() |>
+      getElement("_footnotes") |>
+      dplyr::filter(footnotes == "my footnote") |>
+      dplyr::select(colname, rownum),
+    data.frame(
+      colname = c("label", "label", "stat_0"),
+      rownum = c(1, 2, 1)
+    )
+  )
 })
 
 test_that("as_gt passes table indentation correctly", {