\n1<\/sup> n (%); Median (Q1, Q3)<\/td><\/tr>\n\n2<\/sup> test footnote<\/td><\/tr>\n<\/tfoot>\n<\/table>"
---
- "<\/tbody>\n\n\n1<\/sup> n (%); Median (Q1, Q3)<\/td><\/tr>\n\n2<\/sup> N = number of observations<\/td><\/tr>\n\n3<\/sup> test footnote<\/td><\/tr>\n<\/tfoot>\n<\/table>"
+ "<\/tbody>\n\n<\/sup> Abbreviation: N = number of observations<\/td><\/tr><\/tfoot>\n\n\n1<\/sup> n (%); Median (Q1, Q3)<\/td><\/tr>\n\n2<\/sup> test footnote<\/td><\/tr>\n<\/tfoot>\n<\/table>"
---
diff --git a/tests/testthat/_snaps/modify_abbreviation.md b/tests/testthat/_snaps/modify_abbreviation.md
new file mode 100644
index 000000000..42853909d
--- /dev/null
+++ b/tests/testthat/_snaps/modify_abbreviation.md
@@ -0,0 +1,17 @@
+# remove_abbreviation() messaging
+
+ Code
+ remove_abbreviation(tbl_summary(trial, include = marker), "Q3 = Third Quartile")
+ Condition
+ Error in `remove_abbreviation()`:
+ ! There are no abbreviations to remove.
+
+---
+
+ Code
+ remove_abbreviation(modify_abbreviation(tbl_summary(trial, include = marker),
+ "Q1 = First Quartile"), "Q3 = Third Quartile")
+ Condition
+ Error in `remove_abbreviation()`:
+ ! The `abbreviation` argument must be one of "Q1 = First Quartile".
+
diff --git a/tests/testthat/_snaps/modify_footnote_body.md b/tests/testthat/_snaps/modify_footnote_body.md
new file mode 100644
index 000000000..2eb825e93
--- /dev/null
+++ b/tests/testthat/_snaps/modify_footnote_body.md
@@ -0,0 +1,9 @@
+# modify_footnote_body(rows) messaging
+
+ Code
+ modify_footnote_body(base_tbl_summary, footnote = "this will not appear",
+ columns = label, rows = not_a_predicate)
+ Condition
+ Error in `modify_footnote_body()`:
+ ! The `rows` argument must be an expression that evaluates to a logical vector in `x$table_body`.
+
diff --git a/tests/testthat/_snaps/separate_p_footnotes.md b/tests/testthat/_snaps/separate_p_footnotes.md
index fe28646e9..b3c9ba694 100644
--- a/tests/testthat/_snaps/separate_p_footnotes.md
+++ b/tests/testthat/_snaps/separate_p_footnotes.md
@@ -1,39 +1,26 @@
# separate_p_footnotes()
Code
- as.data.frame(dplyr::mutate(dplyr::filter(getElement(getElement(
- separate_p_footnotes(add_p(tbl, test = list(age = function(data, variable, by,
- ...) broom::tidy(t.test(data[[variable]] ~ data[[by]]))))), "table_styling"),
- "footnote"), dplyr::row_number() %in% c(dplyr::n(), dplyr::n() - 1L)), rows = map_chr(
- rows, ~ expr_deparse(quo_squash(.x)))))
+ as.data.frame(dplyr::mutate(dplyr::filter(getElement(getElement(separate_p_footnotes(add_p(tbl, test = list(age = function(data,
+ variable, by, ...) broom::tidy(t.test(data[[variable]] ~ data[[by]]))))), "table_styling"), "footnote_body"), dplyr::row_number() %in%
+ c(dplyr::n(), dplyr::n() - 1L)), rows = map_chr(rows, ~ expr_deparse(quo_squash(.x)))))
Output
- column rows
- 1 p.value .data$variable %in% "age" & .data$row_type %in% "label"
- 2 p.value .data$variable %in% "grade" & .data$row_type %in% "label"
- text_interpret footnote
- 1 gt::md Welch Two Sample t-test
- 2 gt::md Pearson's Chi-squared test
+ column rows footnote text_interpret replace remove
+ 1 p.value .data$variable %in% "age" & .data$row_type %in% "label" Welch Two Sample t-test gt::md TRUE FALSE
+ 2 p.value .data$variable %in% "grade" & .data$row_type %in% "label" Pearson's Chi-squared test gt::md TRUE FALSE
---
Code
- as.data.frame(dplyr::mutate(dplyr::filter(getElement(getElement(
- separate_p_footnotes(add_difference(tbl)), "table_styling"), "footnote"),
- dplyr::row_number() %in% seq(dplyr::n(), dplyr::n() - 4L)), rows = map_chr(rows,
- ~ expr_deparse(quo_squash(.x)))))
+ as.data.frame(dplyr::mutate(dplyr::filter(getElement(getElement(separate_p_footnotes(add_difference(tbl)), "table_styling"),
+ "footnote_body"), dplyr::row_number() %in% seq(dplyr::n(), dplyr::n() - 4L)), rows = map_chr(rows, ~ expr_deparse(quo_squash(.x)))))
Output
- column rows
- 1 estimate .data$variable %in% "age" & .data$row_type %in% "label"
- 2 conf.low .data$variable %in% "age" & .data$row_type %in% "label"
- 3 p.value .data$variable %in% "age" & .data$row_type %in% "label"
- 4 estimate .data$variable %in% "grade" & .data$row_type %in% "label"
- 5 conf.low .data$variable %in% "grade" & .data$row_type %in% "label"
- text_interpret footnote
- 1 gt::md Welch Two Sample t-test
- 2 gt::md Welch Two Sample t-test
- 3 gt::md Welch Two Sample t-test
- 4 gt::md Standardized Mean Difference
- 5 gt::md Standardized Mean Difference
+ column rows footnote text_interpret replace remove
+ 1 estimate .data$variable %in% "age" & .data$row_type %in% "label" Welch Two Sample t-test gt::md TRUE FALSE
+ 2 conf.low .data$variable %in% "age" & .data$row_type %in% "label" Welch Two Sample t-test gt::md TRUE FALSE
+ 3 p.value .data$variable %in% "age" & .data$row_type %in% "label" Welch Two Sample t-test gt::md TRUE FALSE
+ 4 estimate .data$variable %in% "grade" & .data$row_type %in% "label" Standardized Mean Difference gt::md TRUE FALSE
+ 5 conf.low .data$variable %in% "grade" & .data$row_type %in% "label" Standardized Mean Difference gt::md TRUE FALSE
# separate_p_footnotes() messaging
diff --git a/tests/testthat/test-as_flex_table.R b/tests/testthat/test-as_flex_table.R
index 083a1bdec..6fe690262 100644
--- a/tests/testthat/test-as_flex_table.R
+++ b/tests/testthat/test-as_flex_table.R
@@ -222,9 +222,9 @@ test_that("as_flex_table passes table column alignment correctly", {
)
})
-test_that("as_flex_table passes table footnotes & footnote abbreviations correctly", {
+test_that("as_flex_table passes table footnotes & abbreviations correctly", {
tbl_fn <- my_tbl_summary |>
- modify_table_styling(columns = label, footnote = "test footnote", rows = variable == "age")
+ modify_footnote_body(columns = label, footnote = "test footnote", rows = variable == "age")
ft_tbl_fn <- tbl_fn |> as_flex_table()
# footnote
@@ -234,12 +234,16 @@ test_that("as_flex_table passes table footnotes & footnote abbreviations correct
expect_equal(nrow(ft_tbl_fn$footer$content$data), 2) # correct number of footnotes
expect_equal(c(fn1[1], fn2[1]), c("1", "2")) # correct ordering
expect_equal(
- tbl_fn$table_styling$footnote$footnote, # correct labels
- c(fn1[2], fn2[2])
+ tbl_fn$table_styling$footnote_header$footnote, # correct labels
+ fn1[2]
+ )
+ expect_equal(
+ tbl_fn$table_styling$footnote_body$footnote, # correct labels
+ fn2[2]
)
tbl_fa <- tbl_fn |>
- modify_footnote(stat_0 = "N = number of observations", abbreviation = TRUE)
+ modify_abbreviation("N = number of observations")
ft_tbl_fa <- tbl_fa |> as_flex_table()
# footnote_abbrev
@@ -248,18 +252,12 @@ test_that("as_flex_table passes table footnotes & footnote abbreviations correct
fn3 <- ft_tbl_fa$footer$content$data[3, ]$label$txt
expect_equal(nrow(ft_tbl_fa$footer$content$data), 3) # correct number of footnotes
- expect_equal(c(fn1[1], fn2[1], fn3[1]), c("1", "2", "3")) # correct ordering
- expect_equal(
- c("n (%); Median (Q1, Q3)", "N = number of observations", "test footnote"), # correct labels
- c(fn1[2], fn2[2], fn3[2])
- )
+ expect_equal(c(fn1[1], fn2[1], fn3[1]), c("1", "2", "Abbreviation: N = number of observations")) # correct ordering and label for abbreviation is correct
# customized footnotes
tbl <- my_tbl_summary |>
- modify_footnote(
- all_stat_cols() ~ "replace old footnote",
- label = "another new footnote"
- )
+ modify_footnote_header("replace old footnote", columns = all_stat_cols()) |>
+ modify_footnote_header("another new footnote", columns = label)
ft_tbl <- tbl |> as_flex_table()
fn1 <- ft_tbl$footer$content$data[1, ]$label$txt
@@ -276,8 +274,8 @@ test_that("as_flex_table passes table footnotes & footnote abbreviations correct
test_that("as_flex_table passes multiple table footnotes correctly", {
# testing one footnote passed to multiple columns and rows, addresses issue #2062
out <- my_tbl_summary |>
- modify_footnote(stat_0 = NA) |>
- modify_table_styling(
+ remove_footnote_header(stat_0) |>
+ modify_footnote_body(
columns = c(label, stat_0),
rows = (variable %in% "trt") & (row_type == "level"),
footnote = "my footnote"
@@ -312,17 +310,17 @@ test_that("as_flex_table passes multiple table footnotes correctly", {
by = trt,
include = grade
) |>
- modify_table_styling(
+ modify_footnote_body(
columns = stat_1,
rows = (variable %in% "grade") & (row_type == "level"),
footnote = "my footnote"
) |>
- modify_table_styling(
+ modify_footnote_body(
columns = label,
rows = label == "grade",
footnote = "my footnote"
) |>
- modify_table_styling(
+ modify_footnote_body(
columns = label,
rows = label == "I",
footnote = "my footnote"
diff --git a/tests/testthat/test-as_gt.R b/tests/testthat/test-as_gt.R
index 737eb791f..91b12f6d7 100644
--- a/tests/testthat/test-as_gt.R
+++ b/tests/testthat/test-as_gt.R
@@ -213,48 +213,44 @@ test_that("as_gt passes table text interpreters correctly", {
expect_true(attr(gt_tbl$`_spanners`$spanner_label[[1]], "html"))
})
-test_that("as_gt passes table footnotes & footnote abbreviations correctly", {
+test_that("as_gt passes table footnotes & abbreviations correctly", {
tbl_fn <- my_tbl_summary |>
- modify_table_styling(columns = label, footnote = "test footnote", rows = variable == "age")
+ modify_footnote_body(footnote = "test footnote", columns = label,rows = variable == "age")
gt_tbl_fn <- tbl_fn |> as_gt()
# footnote
expect_equal(
- tbl_fn$table_styling$footnote$column,
+ tbl_fn$table_styling$footnote_header$column |>
+ append(tbl_fn$table_styling$footnote_body$column) |>
+ unique(),
gt_tbl_fn$`_footnotes`$colname |> unique()
)
expect_equal(
- tbl_fn$table_styling$footnote$footnote,
- gt_tbl_fn$`_footnotes`$footnotes |> unlist() |> unique()
+ tbl_fn$table_styling$footnote_header$footnote,
+ gt_tbl_fn$`_footnotes`$footnotes[[1]],
+ ignore_attr = TRUE
+ )
+ expect_equal(
+ tbl_fn$table_styling$footnote_body$footnote,
+ gt_tbl_fn$`_footnotes`$footnotes[-1] |> unlist() |> unique(),
+ ignore_attr = TRUE
)
tbl_fa <- tbl_fn |>
- modify_footnote(stat_0 = "N = number of observations", abbreviation = TRUE)
+ modify_abbreviation("N = number of observations")
gt_tbl_fa <- tbl_fa |> as_gt()
- # footnote_abbrev
+ # abbreviation
expect_equal(
- gt_tbl_fa$`_footnotes` |>
- dplyr::distinct(pick(!any_of("rownum"))) |>
- dplyr::arrange(locnum) |>
- dplyr::pull(colname),
- c("stat_0", "stat_0", "label")
- )
- expect_equal(
- gt_tbl_fa$`_footnotes` |>
- dplyr::distinct(pick(!any_of("rownum"))) |>
- dplyr::arrange(locnum) |>
- dplyr::pull(footnotes) |>
+ gt_tbl_fa$`_source_notes` |>
unlist(),
- c("n (%); Median (Q1, Q3)", "N = number of observations", "test footnote")
+ "Abbreviation: N = number of observations"
)
# customized footnotes
tbl <- my_tbl_summary |>
- modify_footnote(
- all_stat_cols() ~ "replace old footnote",
- label = "another new footnote"
- )
+ modify_footnote_header("replace old footnote", columns = all_stat_cols()) |>
+ modify_footnote_header("another new footnote", columns = label)
gt_tbl <- tbl |> as_gt()
expect_equal(
@@ -269,8 +265,8 @@ test_that("as_gt passes table footnotes & footnote abbreviations correctly", {
# 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") |>
+ modify_footnote_body(columns = label, rows = TRUE, footnote = "my footnote") |>
+ modify_footnote_body(columns = stat_0, rows = row_type == "label", footnote = "my footnote") |>
as_gt() |>
getElement("_footnotes") |>
dplyr::filter(footnotes == "my footnote") |>
@@ -318,7 +314,7 @@ test_that("as_gt passes appended glance statistics correctly", {
)
expect_equal(
tbl$table_styling$source_note$source_note,
- gt_tbl$`_source_notes`[[1]],
+ gt_tbl$`_source_notes`[[2]],
ignore_attr = "class"
)
expect_equal(
diff --git a/tests/testthat/test-as_hux_table.R b/tests/testthat/test-as_hux_table.R
index 4e9014b80..8e94e9da5 100644
--- a/tests/testthat/test-as_hux_table.R
+++ b/tests/testthat/test-as_hux_table.R
@@ -1,5 +1,5 @@
skip_on_cran()
-skip_if_not(is_pkg_installed("huxtable"))
+skip_if_not(is_pkg_installed(c("huxtable", "withr")))
my_tbl_summary <- trial |>
select(trt, age, death) |>
@@ -25,13 +25,15 @@ test_that("as_hux_table(return_calls) works as expected", {
# correct elements are returned
expect_equal(
names(ht),
- c("tibble", "fmt", "cols_merge", "cols_hide", "huxtable", "set_left_padding", "add_footnote", "source_note",
- "set_bold", "set_italic", "fmt_missing", "insert_row", "set_markdown", "align", "set_number_format")
+ c("tibble", "fmt", "cols_merge", "cols_hide", "huxtable", "set_left_padding",
+ "add_footnote", "abbreviations", "source_note", "set_bold", "set_italic",
+ "fmt_missing", "insert_row", "set_markdown", "align", "set_number_format")
)
})
test_that("as_hux_table works with tbl_merge", {
skip_if_not(is_pkg_installed("survival"))
+ withr::local_options(list(width = 120))
t1 <- glm(response ~ trt + grade + age, trial, family = binomial) |>
tbl_regression(exponentiate = TRUE)
@@ -108,9 +110,9 @@ test_that("as_hux_table passes table column alignment correctly", {
)
})
-test_that("as_hux_table passes table footnotes & footnote abbreviations correctly", {
+test_that("as_hux_table passes table footnotes & abbreviations correctly", {
tbl_fn <- my_tbl_summary |>
- modify_table_styling(columns = label, footnote = "test footnote", rows = variable == "age")
+ modify_footnote_body(columns = label, footnote = "test footnote", rows = variable == "age")
ht_fn <- tbl_fn |> as_hux_table()
# footnote
@@ -124,21 +126,20 @@ test_that("as_hux_table passes table footnotes & footnote abbreviations correctl
)
tbl_fa <- tbl_fn |>
- modify_footnote(stat_0 = "N = number of observations", abbreviation = TRUE)
+ modify_abbreviation("N = number of observations")
ht_fa <- tbl_fa |> as_hux_table()
# footnote_abbrev
expect_equal(
- ht_fa[9, 1] |> unlist(use.names = FALSE),
- "N = number of observations"
+ ht_fa[10, 1] |> unlist(use.names = FALSE),
+ "Abbreviation: N = number of observations"
)
# customized footnotes
tbl <- my_tbl_summary |>
- modify_footnote(
- all_stat_cols() ~ "replace old footnote",
- label = "another new footnote"
- )
+ modify_footnote_header("replace old footnote", columns = all_stat_cols()) |>
+ modify_footnote_header("another new footnote", columns = label)
+
ht <- tbl |> as_hux_table()
expect_equal(
@@ -162,7 +163,7 @@ test_that("as_hux_table passes appended glance statistics correctly", {
# correct row ordering
expect_equal(
ht$label,
- c("**Characteristic**", "Age", "R²", "BIC", "CI = Confidence Interval", "R² = 0.000; BIC = 471")
+ c("**Characteristic**", "Age", "R²", "BIC", "Abbreviation: CI = Confidence Interval", "R² = 0.000; BIC = 471")
)
})
diff --git a/tests/testthat/test-as_kable_extra.R b/tests/testthat/test-as_kable_extra.R
index 9555eda0b..41857baaa 100644
--- a/tests/testthat/test-as_kable_extra.R
+++ b/tests/testthat/test-as_kable_extra.R
@@ -28,7 +28,7 @@ test_that("as_kable_extra(return_calls) works as expected", {
expect_equal(
names(kbl),
c("tibble", "fmt", "cols_merge", "fmt_missing", "cols_hide", "remove_line_breaks",
- "escape_table_body", "bold_italic", "kable", "add_indent", "footnote")
+ "escape_table_body", "bold_italic", "kable", "add_indent", "source_note", "abbreviations", "footnote")
)
})
@@ -167,9 +167,9 @@ test_that("as_kable_extra passes table column alignment correctly", {
)
})
-test_that("as_kable_extra passes table footnotes & footnote abbreviations correctly", {
+test_that("as_kable_extra passes table footnotes & abbreviations correctly", {
tbl_fn <- my_tbl_summary |>
- modify_table_styling(columns = label, footnote = "test footnote", rows = variable == "age")
+ modify_footnote_body(columns = label, footnote = "test footnote", rows = variable == "age")
kbl_fn <- tbl_fn |> as_kable_extra()
# footnote
@@ -178,7 +178,7 @@ test_that("as_kable_extra passes table footnotes & footnote abbreviations correc
)
tbl_fa <- tbl_fn |>
- modify_footnote(stat_0 = "N = number of observations", abbreviation = TRUE)
+ modify_abbreviation("N = number of observations")
kbl_fa <- tbl_fa |> as_kable_extra()
# footnote_abbrev
@@ -188,10 +188,8 @@ test_that("as_kable_extra passes table footnotes & footnote abbreviations correc
# customized footnotes
tbl <- my_tbl_summary |>
- modify_footnote(
- all_stat_cols() ~ "replace old footnote",
- label = "another new footnote"
- )
+ modify_footnote_header("replace old footnote", columns = all_stat_cols()) |>
+ modify_footnote_header("another new footnote", columns = label)
kbl <- tbl |> as_kable_extra()
expect_snapshot_value(
diff --git a/tests/testthat/test-modify_abbreviation.R b/tests/testthat/test-modify_abbreviation.R
new file mode 100644
index 000000000..a3f528fa7
--- /dev/null
+++ b/tests/testthat/test-modify_abbreviation.R
@@ -0,0 +1,52 @@
+skip_on_cran()
+skip_if_not(is_pkg_installed(c("cardx", "broom", "broom.helpers")))
+
+test_that("modify_abbreviation()", {
+ expect_silent(
+ tbl <-
+ tbl_summary(trial, include = marker) |>
+ modify_abbreviation("Q1 = First Quartile") |>
+ modify_abbreviation("Q3 = Third Quartile")
+ )
+ expect_equal(
+ tbl$table_styling$abbreviation,
+ dplyr::tribble(
+ ~column, ~abbreviation, ~text_interpret,
+ NA_character_, "Q1 = First Quartile", "gt::md",
+ NA_character_, "Q3 = Third Quartile", "gt::md"
+ )
+ )
+})
+
+
+test_that("remove_abbreviation()", {
+ expect_silent(
+ tbl <-
+ tbl_summary(trial, include = marker) |>
+ modify_abbreviation("Q1 = First Quartile") |>
+ modify_abbreviation("Q3 = Third Quartile") |>
+ remove_abbreviation("Q3 = Third Quartile")
+ )
+ expect_equal(
+ tbl$table_styling$abbreviation,
+ dplyr::tribble(
+ ~column, ~abbreviation, ~text_interpret,
+ NA_character_, "Q1 = First Quartile", "gt::md",
+ )
+ )
+})
+
+test_that("remove_abbreviation() messaging", {
+ expect_snapshot(
+ error = TRUE,
+ tbl_summary(trial, include = marker) |>
+ remove_abbreviation("Q3 = Third Quartile")
+ )
+
+ expect_snapshot(
+ error = TRUE,
+ tbl_summary(trial, include = marker) |>
+ modify_abbreviation("Q1 = First Quartile") |>
+ remove_abbreviation("Q3 = Third Quartile")
+ )
+})
diff --git a/tests/testthat/test-modify_footnote.R b/tests/testthat/test-modify_footnote.R
index 0ae75c8c9..77f6cf7d1 100644
--- a/tests/testthat/test-modify_footnote.R
+++ b/tests/testthat/test-modify_footnote.R
@@ -33,7 +33,7 @@ test_that("modify_footnote(...) works", {
tbl |>
modify_footnote(label = "Variable") |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::filter(column %in% "label") |>
dplyr::pull("footnote"),
"Variable",
@@ -44,7 +44,7 @@ test_that("modify_footnote(...) works", {
tbl |>
modify_footnote(label = "Variable", stat_0 = "Overall") |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::slice_tail(by = "column", n = 1) |>
dplyr::filter(column %in% c("label", "stat_0")) |>
dplyr::pull("footnote"),
@@ -56,10 +56,10 @@ test_that("modify_footnote(...) works", {
tbl |>
modify_footnote(label = "Variable", stat_0 = "Overall", abbreviation = TRUE) |>
getElement("table_styling") |>
- getElement("footnote_abbrev") |>
+ getElement("abbreviation") |>
dplyr::slice_tail(by = "column", n = 1) |>
dplyr::filter(column %in% c("label", "stat_0")) |>
- dplyr::pull("footnote"),
+ dplyr::pull("abbreviation"),
c("Variable", "Overall"),
ignore_attr = TRUE
)
@@ -73,7 +73,7 @@ test_that("modify_footnote(...) dynamic headers work with `tbl_summary()`", {
tbl |>
modify_footnote(!!!list(label = "Variable", stat_0 = "Overall")) |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::slice_tail(by = "column", n = 1) |>
dplyr::filter(column %in% c("label", "stat_0")) |>
dplyr::pull("footnote"),
@@ -86,7 +86,7 @@ test_that("modify_footnote(...) dynamic headers work with `tbl_summary()`", {
tbl |>
modify_footnote(stat_0 = "{level} | N = {N} | n = {n} | p = {style_percent(p)}%") |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::slice_tail(by = "column", n = 1) |>
dplyr::filter(column %in% "stat_0") |>
dplyr::pull("footnote"),
@@ -98,7 +98,7 @@ test_that("modify_footnote(...) dynamic headers work with `tbl_summary()`", {
tbl_summary(trial, by = trt, include = marker) |>
modify_footnote(all_stat_cols() ~ "{level} | N = {N} | n = {n} | p = {style_percent(p)}%") |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::slice_tail(by = "column", n = 1) |>
dplyr::filter(startsWith(column, "stat_")) |>
dplyr::pull("footnote"),
@@ -112,7 +112,7 @@ test_that("modify_footnote(...) dynamic headers work with `tbl_summary()`", {
add_overall() |>
modify_footnote(all_stat_cols() ~ "{level} | N = {N} | n = {n} | p = {style_percent(p)}%") |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::slice_tail(by = "column", n = 1) |>
dplyr::filter(startsWith(column, "stat_")) |>
dplyr::pull("footnote"),
@@ -134,7 +134,7 @@ test_that("modify_footnote(text_interpret) works", {
tbl_summary(trial, include = marker) |>
modify_footnote(label = "Variable", text_interpret = "html") |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::slice_tail(by = "column", n = 1) |>
dplyr::filter(column %in% "label") |>
dplyr::pull(text_interpret),
@@ -147,7 +147,7 @@ test_that("modify_footnote() with tbl_svysummary()", {
tbl_summary(trial, include = marker) |>
modify_footnote(label = "Variable", text_interpret = "html") |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::slice_tail(by = "column", n = 1) |>
dplyr::filter(column %in% "label") |>
dplyr::pull(text_interpret),
@@ -164,7 +164,7 @@ test_that("modify_footnote() works with tbl_svysummary()", {
add_overall() |>
modify_footnote(all_stat_cols() ~ "{level} | N = {N} | n = {n} | p = {style_percent(p)}%") |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::slice_tail(by = "column", n = 1) |>
dplyr::filter(startsWith(column, "stat_")) |>
dplyr::pull("footnote"),
@@ -175,18 +175,20 @@ test_that("modify_footnote() works with tbl_svysummary()", {
})
test_that("modify_footnote() works with tbl_continuous()", {
- expect_equal(tbl_continuous(data = trial, variable = age, by = trt, include = grade)|>
- add_overall() |>
- modify_footnote(all_stat_cols() ~ "{level} | N = {N} | n = {n} | p = {style_percent(p)}%") |>
- getElement("table_styling") |>
- getElement("footnote") |>
- dplyr::slice_tail(by = "column", n = 1) |>
- dplyr::filter(startsWith(column, "stat_")) |>
- dplyr::pull("footnote"),
- c("Drug A | N = 200 | n = 98 | p = 49%",
- "Drug B | N = 200 | n = 102 | p = 51%",
- "Overall | N = 200 | n = 200 | p = 100%"),
- ignore_attr = TRUE)
+ expect_equal(
+ tbl_continuous(data = trial, variable = age, by = trt, include = grade) |>
+ add_overall() |>
+ modify_footnote(all_stat_cols() ~ "{level} | N = {N} | n = {n} | p = {style_percent(p)}%") |>
+ getElement("table_styling") |>
+ getElement("footnote_header") |>
+ dplyr::slice_tail(by = "column", n = 1) |>
+ dplyr::filter(startsWith(column, "stat_")) |>
+ dplyr::pull("footnote"),
+ c("Drug A | N = 200 | n = 98 | p = 49%",
+ "Drug B | N = 200 | n = 102 | p = 51%",
+ "Overall | N = 200 | n = 200 | p = 100%"),
+ ignore_attr = TRUE
+ )
})
@@ -194,7 +196,7 @@ test_that("modify_footnote() works with tbl_cross()", {
expect_equal(tbl_cross(data = trial, row = trt, col = response) |>
modify_footnote(stat_0 = "Total Response") |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::slice_tail(by = "column", n = 1) |>
dplyr::filter(column == "stat_0") |>
dplyr::pull("footnote"),
@@ -209,7 +211,7 @@ test_that("modify_footnote() works with tbl_regression()", {
tbl_regression(exponentiate = TRUE) |>
modify_footnote(estimate = "Estimate") |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::slice_tail(by = "column", n = 1) |>
dplyr::filter(column == "estimate") |>
dplyr::pull("footnote"),
@@ -222,7 +224,7 @@ test_that("modify_footnote() works with tbl_uvregression()", {
exponentiate = TRUE, include = c("age", "grade")) |>
modify_footnote(estimate = "Estimate") |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::slice_tail(by = "column", n = 1) |>
dplyr::filter(column == "estimate") |>
dplyr::pull("footnote"),
diff --git a/tests/testthat/test-modify_footnote_body.R b/tests/testthat/test-modify_footnote_body.R
new file mode 100644
index 000000000..1f18e9465
--- /dev/null
+++ b/tests/testthat/test-modify_footnote_body.R
@@ -0,0 +1,68 @@
+skip_on_cran()
+
+base_tbl_summary <-
+ tbl_summary(trial, include = marker) |>
+ remove_footnote_header(columns = everything())
+
+test_that("modify_footnote_body(footnote)", {
+ # test we can easily replace an existing header
+ expect_silent(
+ tbl <- base_tbl_summary |>
+ modify_footnote_body(
+ footnote = "this will not appear",
+ columns = label,
+ rows = row_type == "label"
+ ) |>
+ modify_footnote_body(
+ footnote = "this _will_ appear; N = {N}",
+ columns = label,
+ rows = row_type == "label"
+ )
+ )
+ expect_equal(
+ tbl$table_styling$footnote_body,
+ dplyr::tribble(
+ ~column, ~rows, ~footnote, ~text_interpret, ~replace, ~remove,
+ "label", ~row_type == "label", "this will not appear", "gt::md", TRUE, FALSE,
+ "label", ~row_type == "label", "this _will_ appear; N = 200", "gt::md", TRUE, FALSE
+ ),
+ ignore_attr = TRUE
+ )
+})
+
+test_that("modify_footnote_body(rows) messaging", {
+ expect_snapshot(
+ error = TRUE,
+ base_tbl_summary |>
+ modify_footnote_body(
+ footnote = "this will not appear",
+ columns = label,
+ rows = not_a_predicate
+ )
+ )
+})
+
+test_that("remove_footnote_body(footnote)", {
+ # test we can remove footnotes from the cells
+ expect_silent(
+ tbl <- base_tbl_summary |>
+ modify_footnote_body(
+ footnote = "this will not appear",
+ columns = label,
+ rows = row_type == "label"
+ ) |>
+ remove_footnote_body(
+ columns = label,
+ rows = row_type == "label"
+ )
+ )
+ expect_equal(
+ tbl$table_styling$footnote_body,
+ dplyr::tribble(
+ ~column, ~rows, ~footnote, ~text_interpret, ~replace, ~remove,
+ "label", ~row_type == "label", "this will not appear", "gt::md", TRUE, FALSE,
+ "label", ~row_type == "label", NA, "gt::md", TRUE, TRUE
+ ),
+ ignore_attr = TRUE
+ )
+})
diff --git a/tests/testthat/test-modify_footnote_header.R b/tests/testthat/test-modify_footnote_header.R
new file mode 100644
index 000000000..2d0e2acfa
--- /dev/null
+++ b/tests/testthat/test-modify_footnote_header.R
@@ -0,0 +1,62 @@
+skip_on_cran()
+
+base_tbl_summary <- tbl_summary(trial, include = marker)
+test_that("modify_footnote_header(footnote)", {
+ # test we can easily replace an existing header footnote
+ expect_equal(base_tbl_summary$table_styling$footnote_header$footnote, "Median (Q1, Q3)")
+ expect_silent(
+ tbl <- base_tbl_summary |>
+ modify_footnote_header(
+ footnote = "testing N={N}; n={n}; p={p}",
+ columns = all_stat_cols()
+ )
+ )
+ expect_equal(
+ tbl$table_styling$footnote_header,
+ dplyr::tribble(
+ ~column, ~footnote, ~text_interpret, ~replace, ~remove,
+ "stat_0", "Median (Q1, Q3)", "gt::md", TRUE, FALSE,
+ "stat_0", "testing N=200; n=200; p=1", "gt::md", TRUE, FALSE
+ )
+ )
+
+ # test that two footnotes can be placed in the same header
+ expect_silent(
+ tbl <- base_tbl_summary |>
+ modify_footnote_header(
+ footnote = "testing N={N}; n={n}; p={p}",
+ columns = all_stat_cols(),
+ replace = FALSE
+ )
+ )
+ expect_equal(
+ tbl$table_styling$footnote_header,
+ dplyr::tribble(
+ ~column, ~footnote, ~text_interpret, ~replace, ~remove,
+ "stat_0", "Median (Q1, Q3)", "gt::md", TRUE, FALSE,
+ "stat_0", "testing N=200; n=200; p=1", "gt::md", FALSE, FALSE
+ )
+ )
+})
+
+test_that("remove_footnote_header(footnote)", {
+ # test we can remove footnotes from the headers
+ expect_silent(
+ tbl <- base_tbl_summary |>
+ modify_footnote_header(
+ footnote = "testing",
+ columns = all_stat_cols(),
+ replace = FALSE
+ ) |>
+ remove_footnote_header(columns = all_stat_cols())
+ )
+ expect_equal(
+ tbl$table_styling$footnote_header,
+ dplyr::tribble(
+ ~column, ~footnote, ~text_interpret, ~replace, ~remove,
+ "stat_0", "Median (Q1, Q3)", "gt::md", TRUE, FALSE,
+ "stat_0", "testing", "gt::md", FALSE, FALSE,
+ "stat_0", NA, "gt::md", TRUE, TRUE
+ )
+ )
+})
diff --git a/tests/testthat/test-modify_table_styling.R b/tests/testthat/test-modify_table_styling.R
index af591143e..9757b3830 100644
--- a/tests/testthat/test-modify_table_styling.R
+++ b/tests/testthat/test-modify_table_styling.R
@@ -152,7 +152,7 @@ test_that("modify_table_styling(footnote)", {
footnote = "testing footnote"
) |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::filter(column == "stat_0") |>
dplyr::slice_tail(n = 1L) |>
dplyr::pull(footnote),
@@ -169,10 +169,8 @@ test_that("modify_table_styling(footnote_abbrev)", {
footnote_abbrev = "testing footnote_abbrev"
) |>
getElement("table_styling") |>
- getElement("footnote_abbrev") |>
- dplyr::filter(column == "stat_0") |>
- dplyr::slice_tail(n = 1L) |>
- dplyr::pull(footnote),
+ getElement("abbreviation") |>
+ dplyr::pull(abbreviation),
"testing footnote_abbrev"
)
})
diff --git a/tests/testthat/test-separate_p_footnotes.R b/tests/testthat/test-separate_p_footnotes.R
index 7072e8f3d..ecb63ed1f 100644
--- a/tests/testthat/test-separate_p_footnotes.R
+++ b/tests/testthat/test-separate_p_footnotes.R
@@ -1,7 +1,8 @@
skip_on_cran()
-skip_if_not(is_pkg_installed(c("cardx", "broom", "smd")))
+skip_if_not(is_pkg_installed(c("cardx", "broom", "smd", "withr")))
test_that("separate_p_footnotes()", {
+ withr::local_options(list(width = 130))
tbl <- trial |>
tbl_summary(
by = trt,
@@ -13,7 +14,7 @@ test_that("separate_p_footnotes()", {
add_p(tbl, test = list(age = \(data, variable, by, ...) t.test(data[[variable]] ~ data[[by]]) |> broom::tidy())) |>
separate_p_footnotes() |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_body") |>
dplyr::filter(dplyr::row_number() %in% c(dplyr::n(), dplyr::n() - 1L)) |>
dplyr::mutate(rows = map_chr(rows, ~quo_squash(.x) |> expr_deparse())) |>
as.data.frame()
@@ -23,7 +24,7 @@ test_that("separate_p_footnotes()", {
add_difference(tbl) |>
separate_p_footnotes() |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_body") |>
dplyr::filter(dplyr::row_number() %in% seq(dplyr::n(), dplyr::n() - 4L)) |>
dplyr::mutate(rows = map_chr(rows, ~quo_squash(.x) |> expr_deparse())) |>
as.data.frame()
diff --git a/tests/testthat/test-tbl_custom_summary.R b/tests/testthat/test-tbl_custom_summary.R
index e7048cc00..530f3c8c8 100644
--- a/tests/testthat/test-tbl_custom_summary.R
+++ b/tests/testthat/test-tbl_custom_summary.R
@@ -16,7 +16,7 @@ test_that("tbl_custom_summary() basics", {
digits = ~1
) |>
add_overall(last = TRUE) |>
- modify_footnote(all_stat_cols() ~ "Mean age") |>
+ modify_footnote_header("Mean age", columns = all_stat_cols()) |>
modify_column_unhide(everything()) |>
as.data.frame(col_labels = FALSE),
NA
diff --git a/tests/testthat/test-theme_gtsummary.R b/tests/testthat/test-theme_gtsummary.R
index 6ff9aedaf..f5e1d0fec 100644
--- a/tests/testthat/test-theme_gtsummary.R
+++ b/tests/testthat/test-theme_gtsummary.R
@@ -132,7 +132,7 @@ test_that("theme_gtsummary_journal('lancet') works", {
expr = trial |>
tbl_summary(by = trt, include = marker, label = marker ~ "marker", missing = "no") |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
dplyr::filter(.by = "column", dplyr::n() == dplyr::row_number(), column %in% c("stat_1", "stat_2")) |>
dplyr::pull("footnote") |>
unique()
@@ -174,7 +174,7 @@ test_that("theme_gtsummary_journal('nejm') works", {
expr = trial |>
tbl_summary(by = trt, include = age, label = age ~ "Age", missing = "no") |>
getElement("table_styling") |>
- getElement("footnote") |>
+ getElement("footnote_header") |>
getElement("footnote") |>
dplyr::last()
),
@@ -215,7 +215,7 @@ test_that("theme_gtsummary_journal('jama') works", {
# check that we get
# - pvalues are rounded to 2 places
# - CI separator is " to "
- # - estimate and CI are in the same cell with approriate header
+ # - estimate and CI are in the same cell with appropriate header
expect_snapshot(
with_gtsummary_theme(
theme_gtsummary_journal("jama"),
diff --git a/vignettes/articles/gallery.Rmd b/vignettes/articles/gallery.Rmd
index e1939f244..e24955e5d 100644
--- a/vignettes/articles/gallery.Rmd
+++ b/vignettes/articles/gallery.Rmd
@@ -275,7 +275,7 @@ trial |>
missing = "no"
) |>
modify_header(stat_0 = "**Mean (SD)**") |>
- modify_footnote(stat_0 = NA) |>
+ remove_footnote_header(stat_0) |>
add_ci()
```
@@ -341,7 +341,7 @@ gt_t1 <- trial |>
tbl_summary(include = c(trt, grade), missing = "no") |>
add_n() |>
modify_header(stat_0 = "**n (%)**") |>
- modify_footnote(stat_0 = NA_character_)
+ remove_footnote_header(stat_0)
theme_gtsummary_compact()
tbl_merge(
@@ -387,7 +387,7 @@ trial |>
) |>
modify_header(label = "**Model Outcome**",
estimate = "**Treatment Coef.**") |>
- modify_footnote(estimate = "Values larger than 0 indicate larger values in the Drug B group.")
+ modify_footnote_header("Values larger than 0 indicate larger values in the Drug B group.", columns = estimate)
```
diff --git a/vignettes/articles/tbl_regression.Rmd b/vignettes/articles/tbl_regression.Rmd
index 3538acad9..ba70a176d 100644
--- a/vignettes/articles/tbl_regression.Rmd
+++ b/vignettes/articles/tbl_regression.Rmd
@@ -165,7 +165,8 @@ The {gtsummary} package comes with functions specifically made to modify and for
dplyr::tribble(
~Function, ~Description,
"`modify_header()`", "update column headers",
- "`modify_footnote()`", "update column footnote",
+ "`modify_footnote_header()`", "update column header footnote",
+ "`modify_footnote_body()`", "update table body footnote",
"`modify_spanning_header()`", "update spanning headers",
"`modify_caption()`", "update table caption/title",
"`bold_labels()`", "bold variable labels",
diff --git a/vignettes/articles/tbl_summary.Rmd b/vignettes/articles/tbl_summary.Rmd
index 915b4df29..b6762258c 100644
--- a/vignettes/articles/tbl_summary.Rmd
+++ b/vignettes/articles/tbl_summary.Rmd
@@ -214,7 +214,8 @@ The {gtsummary} package comes with functions specifically made to modify and for
dplyr::tribble(
~Function, ~Description,
"`modify_header()`", "update column headers",
- "`modify_footnote()`", "update column footnote",
+ "`modify_footnote_header()`", "update column header footnote",
+ "`modify_footnote_body()`", "update table body footnote",
"`modify_spanning_header()`", "update spanning headers",
"`modify_caption()`", "update table caption/title",
"`bold_labels()`", "bold variable labels",
@@ -238,9 +239,7 @@ trial2 |>
add_n() |>
modify_header(label ~ "**Variable**") |>
modify_spanning_header(c("stat_1", "stat_2") ~ "**Treatment Received**") |>
- modify_footnote(
- all_stat_cols() ~ "Median (IQR) or Frequency (%)"
- ) |>
+ modify_footnote_header("Median (IQR) or Frequency (%)", columns = all_stat_cols()) |>
modify_caption("**Table 1. Patient Characteristics**") |>
bold_labels()
```
diff --git a/vignettes/gtsummary_definition.Rmd b/vignettes/gtsummary_definition.Rmd
index 7a59048ab..5a7443a6e 100644
--- a/vignettes/gtsummary_definition.Rmd
+++ b/vignettes/gtsummary_definition.Rmd
@@ -27,14 +27,13 @@ Here, we review those characteristics, and provide instructions on how to constr
library(gtsummary)
tbl_regression_ex <-
- lm(age ~ grade + marker, trial) %>%
- tbl_regression() %>%
+ lm(age ~ grade + marker, trial) |>
+ tbl_regression() |>
bold_p(t = 0.5)
tbl_summary_ex <-
- trial %>%
- select(trt, age, grade, response) %>%
- tbl_summary(by = trt)
+ trial |>
+ tbl_summary(by = trt, include = c(trt, age, grade, response))
```
## Structure of a {gtsummary} object
@@ -58,7 +57,7 @@ tbl_summary_ex$table_body
#### table_styling
The `.$table_styling` object is a list of data frames containing information about how `.$table_body` is printed, formatted, and styled.
-The list contains the following data frames `header`, `footnote`, `footnote_abbrev`, `fmt_fun`, `text_format`, `fmt_missing`, `cols_merge` and the following objects `source_note`, `caption`, `horizontal_line_above`.
+The list contains the following data frames `header`, `footnote_header`, `footnote_body`, `abbreviation`, `source_note`, `fmt_fun`, `text_format`, `fmt_missing`, `cols_merge` and the following objects `caption` and `horizontal_line_above`.
**`header`**
@@ -91,19 +90,98 @@ dplyr::tribble(
)
```
-**`footnote` & `footnote_abbrev`**
+**`footnote_header`**
-Each {gtsummary} table may contain a single footnote per header and cell within the table.
-Footnotes and footnote abbreviations are handled separately.
+Each {gtsummary} table may contain footnotes in the column headers.
+Updates/changes to footnote are appended to the bottom of the tibble.
+
+```{r, echo=FALSE}
+dplyr::tribble(
+ ~Column, ~Description,
+ "column", "Column name from `.$table_body`",
+ "footnote", "string containing footnote to add to column/row",
+ "text_interpret", "the {gt} function that is used to interpret the source note, `gt::md()` or `gt::html()`",
+ "replace", "logical indicating whether this footnote should replace any existing footnote in that header (TRUE) or be added to any existing (FALSE)",
+ "remove", "logical indicating whether to remove all footnotes in the column header"
+) %>%
+ gt::gt() %>%
+ gt::fmt_markdown(columns = everything()) %>%
+ gt::tab_options(
+ table.font.size = "small",
+ data_row.padding = gt::px(1),
+ summary_row.padding = gt::px(1),
+ grand_summary_row.padding = gt::px(1),
+ footnotes.padding = gt::px(1),
+ source_notes.padding = gt::px(1),
+ row_group.padding = gt::px(1)
+ )
+```
+
+**`footnote_body`**
+
+Each {gtsummary} table may include footnotes in the body of the table.
Updates/changes to footnote are appended to the bottom of the tibble.
-A footnote of `NA_character_` deletes an existing footnote.
```{r, echo=FALSE}
dplyr::tribble(
~Column, ~Description,
"column", "Column name from `.$table_body`",
"rows", "expression selecting rows in `.$table_body`, `NA` indicates to add footnote to header",
- "footnote", "string containing footnote to add to column/row"
+ "footnote", "string containing footnote to add to column/row",
+ "text_interpret", "the {gt} function that is used to interpret the source note, `gt::md()` or `gt::html()`",
+ "replace", "logical indicating whether this footnote should replace any existing footnote in that header (TRUE) or be added to any existing (FALSE)",
+ "remove", "logical indicating whether to remove all footnotes in the column header",
+) %>%
+ gt::gt() %>%
+ gt::fmt_markdown(columns = everything()) %>%
+ gt::tab_options(
+ table.font.size = "small",
+ data_row.padding = gt::px(1),
+ summary_row.padding = gt::px(1),
+ grand_summary_row.padding = gt::px(1),
+ footnotes.padding = gt::px(1),
+ source_notes.padding = gt::px(1),
+ row_group.padding = gt::px(1)
+ )
+```
+
+**`abbreviation`**
+
+Abbreviations are added one at a time, and at the time of table rendering, the are coalesced into a single source note.
+
+```{r, echo=FALSE}
+dplyr::tribble(
+ ~Column, ~Description,
+ "column", "Optional column name from `.$table_body`. When present, the abbreviation is only printed when the column appears in the rendered table",
+ "abbreviation", "string containing the abbreviation to add",
+ "text_interpret", "the {gt} function that is used to interpret the source note, `gt::md()` or `gt::html()`",
+) %>%
+ gt::gt() %>%
+ gt::fmt_markdown(columns = everything()) %>%
+ gt::tab_options(
+ table.font.size = "small",
+ data_row.padding = gt::px(1),
+ summary_row.padding = gt::px(1),
+ grand_summary_row.padding = gt::px(1),
+ footnotes.padding = gt::px(1),
+ source_notes.padding = gt::px(1),
+ row_group.padding = gt::px(1)
+ )
+```
+
+**`source_note`**
+
+A tibble with the source notes to include.
+Each source note is assigned an ID based on the order it is added to the table.
+Source notes are added one at a time and present much like footnotes, but are not linked to a header or cell in the table.
+
+```{r, echo=FALSE}
+dplyr::tribble(
+ ~Column, ~Description,
+ "id", "Integer idenitfying the source note",
+ "source_note", "string containing the abbreviation to add",
+ "text_interpret", "the {gt} function that is used to interpret the source note, `gt::md()` or `gt::html()`",
+ "remove", "logical indicating whether the source note should be included or removed from final table"
) %>%
gt::gt() %>%
gt::fmt_markdown(columns = everything()) %>%
@@ -224,31 +302,6 @@ dplyr::tribble(
)
```
-**`source_note`**
-
-A tibble with the source notes to include.
-Each source note is assigned an ID based on the order it is added to the table.
-
-```{r, echo=FALSE}
-dplyr::tribble(
- ~Column, ~Description,
- "id", "ID of the source note",
- "sounrce_note", "string containing the source note",
- "text_interpret", "the {gt} function that is used to interpret the source note, `gt::md()` or `gt::html()`",
- "remove", "logical indicating whether the source note should be removed from the table"
-) %>%
- gt::gt() %>%
- gt::fmt_markdown(columns = everything()) %>%
- gt::tab_options(
- table.font.size = "small",
- data_row.padding = gt::px(1),
- summary_row.padding = gt::px(1),
- grand_summary_row.padding = gt::px(1),
- footnotes.padding = gt::px(1),
- source_notes.padding = gt::px(1),
- row_group.padding = gt::px(1)
- )
-```
**`caption`**
String that is made into the table caption.
| | | | | | | |