Skip to content

Commit

Permalink
Merge branch 'main' into 1861-tbl_merge-vars
Browse files Browse the repository at this point in the history
  • Loading branch information
ddsjoberg authored Jan 10, 2025
2 parents 17aa618 + d9f6fd3 commit 0adc608
Showing 24 changed files with 159 additions and 34 deletions.
2 changes: 1 addition & 1 deletion DESCRIPTION
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
Package: gtsummary
Title: Presentation-Ready Data Summary and Analytic Result Tables
Version: 2.0.4.9008
Version: 2.0.4.9009
Authors@R: c(
person("Daniel D.", "Sjoberg", , "danield.sjoberg@gmail.com", role = c("aut", "cre"),
comment = c(ORCID = "0000-0003-0862-2018")),
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
@@ -168,6 +168,7 @@ export(modify_footnote_body)
export(modify_footnote_header)
export(modify_footnote_spanning_header)
export(modify_header)
export(modify_missing_symbol)
export(modify_source_note)
export(modify_spanning_header)
export(modify_table_body)
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -12,6 +12,8 @@

* The `modify_footnote_spanning_header()` function has been added to ease adding footnotes to spanning headers. A companion function, `remove_footnote_spanning_header()`, has been added to remove spanning headers.

* Added new function `modify_missing_symbol()` to update how a missing value is displayed in a table. (#2121)

* Language translations have been updated with a handful of missing translations. (#2100)

* The `modify_caption(caption)` argument now accepts a vector of captions, instead of just a string. Note, however, that not all print engines support a vector of captions. (#2107)
2 changes: 1 addition & 1 deletion R/as_gt.R
Original file line number Diff line number Diff line change
@@ -7,7 +7,7 @@
#' available via the [gt package](https://gt.rstudio.com/index.html).
#'
#' @param x (`gtsummary`)\cr
#' An object of class `"gtsummary"
#' An object of class `"gtsummary"`
#' @param include Commands to include in output. Input may be a vector of
#' quoted or unquoted names. tidyselect and gtsummary select helper
#' functions are also accepted.
58 changes: 58 additions & 0 deletions R/modify_missing_symbol.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,58 @@
#' Modify Missing Substitution
#'
#' Specify how missing values will be represented in the printed table.
#' By default, a blank space is printed for all `NA` values.
#'
#' @inheritParams modify_footnote2
#' @param symbol (`string`)\cr
#' string indicating how missing values are formatted.
#' @param columns ([`tidy-select`][dplyr::dplyr_tidy_select])\cr
#' columns to add missing symbol.
#'
#' @return Updated gtsummary object
#' @export
#'
#' @examplesIf identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")
#' # Use the abbreivation "Ref." for reference rows instead of the em-dash
#' lm(marker ~ trt, data = trial) |>
#' tbl_regression() |>
#' modify_missing_symbol(
#' symbol = "Ref.",
#' columns = c(estimate, conf.low, conf.high),
#' rows = reference_row == TRUE
#' )
modify_missing_symbol <- function(x, symbol, columns, rows) {
set_cli_abort_call()

# check inputs ---------------------------------------------------------------
check_not_missing(x)
check_not_missing(columns)
check_not_missing(rows)
check_not_missing(symbol)
check_class(x, "gtsummary")
check_string(symbol)
.check_rows_input(x, {{ rows }})

# process columns ------------------------------------------------------------
cards::process_selectors(
scope_header(x$table_body, x$table_styling$header),
columns = {{ columns }}
)

.modify_missing_symbol(x = x, symbol = symbol, columns = columns, rows = {{ rows }})
}

.modify_missing_symbol <- function(x, symbol, columns, rows) {
# add updates to `x$table_styling$fmt_missing` -----------------------------
x$table_styling$fmt_missing <- x$table_styling$fmt_missing |>
dplyr::bind_rows(
tidyr::expand_grid(
column = columns,
rows = list(enquo(rows)),
symbol = symbol
)
)

# return table ---------------------------------------------------------------
x
}
16 changes: 7 additions & 9 deletions R/modify_table_styling.R
Original file line number Diff line number Diff line change
@@ -7,7 +7,7 @@
#' [`modify_spanning_header()`], `[modify_column_hide()]`, [`modify_column_unhide()`],
#' [`modify_footnote_header()`], [`modify_footnote_body()`], [`modify_abbreviation()`],
#' [`modify_column_alignment()`], [`modify_fmt_fun()`], `[modify_column_indent()]`,
#' [`modify_column_merge()`].
#' [`modify_column_merge()`], [`modify_missing_symbol()`].
#'
#'
#' This is a function meant for advanced users to gain
@@ -338,14 +338,12 @@ modify_table_styling <- function(x,

# missing_symbol -------------------------------------------------------------
if (!is_empty(missing_symbol)) {
x$table_styling$fmt_missing <-
list(
column = columns,
rows = list(rows),
symbol = missing_symbol
) %>%
{tidyr::expand_grid(!!!.)} %>% # styler: off
{dplyr::bind_rows(x$table_styling$fmt_missing, .)} # styler: off
x <- x |>
.modify_missing_symbol(
symbol = missing_symbol,
columns = columns,
rows = !!rows
)
}

# cols_merge_pattern ---------------------------------------------------------
6 changes: 5 additions & 1 deletion R/rows_argument.R
Original file line number Diff line number Diff line change
@@ -8,12 +8,16 @@
#' evaluated in `x$table_body`. For example, to apply formatting to the age rows
#' pass `rows = variable == "age"`. A vector of row numbers is NOT acceptable.
#'
#' The `x$table_body` contains columns that are hidden in the final print of
#' a table that are often useful for defining these expressions; print the table
#' to view all column available.
#'
#' A couple of things to note when using the `rows` argument.
#' 1. You can use saved objects to create the predicate argument, e.g.
#' `rows = variable == letters[1]`.
#' 2. The saved object cannot share a name with a column in `x$table_body`.
#' The reason for this is that in `tbl_merge()` the columns are renamed,
#' and the renaming process cannot disambiguate the `variable` column from
#' an external object named `variable` in the following expression
#' `rows = .data$variable = .env$variable`.
#' `rows = .data$variable == .env$variable`.
NULL
16 changes: 8 additions & 8 deletions R/utils-tbl_regression.R
Original file line number Diff line number Diff line change
@@ -91,10 +91,10 @@ tidy_prep <- function(x, tidy_fun, exponentiate, conf.level, intercept, label,
footnote_abbrev = glue("{estimate_column_labels$footnote}") %>% as.character(),
fmt_fun = estimate_fun
) |>
modify_table_styling(
modify_missing_symbol(
columns = any_of("estimate"),
rows = .data$reference_row == TRUE,
missing_symbol = get_theme_element("tbl_regression-str:ref_row_text", default = "\U2014")
symbol = get_theme_element("tbl_regression-str:ref_row_text", default = "\U2014")
)

# N --------------------------------------------------------------------------
@@ -124,10 +124,10 @@ tidy_prep <- function(x, tidy_fun, exponentiate, conf.level, intercept, label,
translate_string("CI = Confidence Interval")
)
) |>
modify_table_styling(
modify_missing_symbol(
columns = any_of("conf.low"),
rows = .data$reference_row == TRUE,
missing_symbol = get_theme_element("tbl_regression-str:ref_row_text", default = "\U2014")
symbol = get_theme_element("tbl_regression-str:ref_row_text", default = "\U2014")
) |>
modify_table_styling(
columns = any_of("conf.low"),
@@ -184,10 +184,10 @@ tidy_prep <- function(x, tidy_fun, exponentiate, conf.level, intercept, label,
fmt_fun = label_style_sigfig(digits = 3),
hide = !"std.error" %in% tidy_columns_to_report
) |>
modify_table_styling(
modify_missing_symbol(
columns = any_of("std.error"),
rows = .data$reference_row == TRUE,
missing_symbol = get_theme_element("tbl_regression-str:ref_row_text", default = "\U2014")
symbol = get_theme_element("tbl_regression-str:ref_row_text", default = "\U2014")
)

# statistic ------------------------------------------------------------------
@@ -199,10 +199,10 @@ tidy_prep <- function(x, tidy_fun, exponentiate, conf.level, intercept, label,
fmt_fun = label_style_sigfig(digits = 3),
hide = !"statistic" %in% tidy_columns_to_report
) |>
modify_table_styling(
modify_missing_symbol(
columns = any_of("statistic"),
rows = .data$reference_row == TRUE,
missing_symbol = get_theme_element("tbl_regression-str:ref_row_text", default = "\U2014")
symbol = get_theme_element("tbl_regression-str:ref_row_text", default = "\U2014")
)

# finally adding style_sigfig(x, digits = 3) as default for all other columns
2 changes: 1 addition & 1 deletion man/as_flex_table.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/as_gt.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/as_hux_table.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/as_tibble.gtsummary.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

41 changes: 41 additions & 0 deletions man/modify_missing_symbol.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion man/modify_table_styling.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

6 changes: 5 additions & 1 deletion man/rows_argument.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

1 change: 1 addition & 0 deletions pkgdown/_pkgdown.yml
Original file line number Diff line number Diff line change
@@ -190,6 +190,7 @@ reference:
- modify_fmt_fun
- modify_column_merge
- modify_column_indent
- modify_missing_symbol
- subtitle: Select Helpers
- contents:
- select_helpers
2 changes: 1 addition & 1 deletion tests/testthat/test-as_flex_table.R
Original file line number Diff line number Diff line change
@@ -465,7 +465,7 @@ test_that("as_flex_table passes missing symbols correctly", {

# specify missing symbol
tbl <- tbl |>
modify_table_styling(stat_0, rows = !is.na(label), missing_symbol = "n / a")
modify_missing_symbol(stat_0, rows = !is.na(label), symbol = "n / a")
ft_tbl <- tbl |> as_flex_table()

# correct substitution for missing values
2 changes: 1 addition & 1 deletion tests/testthat/test-as_gt.R
Original file line number Diff line number Diff line change
@@ -399,7 +399,7 @@ test_that("as_gt passes missing symbols correctly", {

# specify missing symbol
tbl <- tbl |>
modify_table_styling(stat_0, rows = !is.na(label), missing_symbol = "n / a")
modify_missing_symbol(stat_0, rows = !is.na(label), symbol = "n / a")
gt_tbl <- tbl |> as_gt()

# correct substitution for missing values
2 changes: 1 addition & 1 deletion tests/testthat/test-as_hux_table.R
Original file line number Diff line number Diff line change
@@ -243,7 +243,7 @@ test_that("as_hux_table passes missing symbols correctly", {

# specify missing symbol
tbl <- tbl |>
modify_table_styling(stat_0, rows = !is.na(label), missing_symbol = "n / a")
modify_missing_symbol(stat_0, rows = !is.na(label), symbol = "n / a")
ht <- tbl |> as_hux_table()

# correct substitution for missing values
2 changes: 1 addition & 1 deletion tests/testthat/test-as_kable.R
Original file line number Diff line number Diff line change
@@ -172,7 +172,7 @@ test_that("as_kable works with tbl_stack", {
test_that("as_kable passes missing symbols correctly", {
tbl <- my_tbl_summary |>
modify_table_body(~ .x |> mutate(stat_0 = NA_character_)) |>
modify_table_styling(stat_0, rows = !is.na(label), missing_symbol = "n / a")
modify_missing_symbol(stat_0, rows = !is.na(label), symbol = "n / a")
kbl <- tbl |> as_kable()

expect_true(
2 changes: 1 addition & 1 deletion tests/testthat/test-as_kable_extra.R
Original file line number Diff line number Diff line change
@@ -288,7 +288,7 @@ test_that("as_kable_extra passes missing symbols correctly", {

# specify missing symbol
tbl <- tbl |>
modify_table_styling(stat_0, rows = !is.na(label), missing_symbol = "n / a")
modify_missing_symbol(stat_0, rows = !is.na(label), symbol = "n / a")
kbl <- tbl |> as_kable_extra()

# correct substitution for missing values
2 changes: 1 addition & 1 deletion tests/testthat/test-as_tibble.R
Original file line number Diff line number Diff line change
@@ -207,7 +207,7 @@ test_that("as_tibble(fmt_missing) works", {
modify_table_body(
~ .x |> mutate(stat_0 = NA_character_)
) |>
modify_table_styling(stat_0, rows = !is.na(label), missing_symbol = "n / a") |>
modify_missing_symbol(stat_0, rows = !is.na(label), symbol = "n / a") |>
as_tibble(fmt_missing = TRUE, col_labels = FALSE) |>
dplyr::pull(stat_0),
c("n / a", "n / a")
16 changes: 16 additions & 0 deletions tests/testthat/test-modify_missing_symbol.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,16 @@
test_that("modify_missing_symbol()", {
expect_equal(
lm(marker ~ trt, data = trial) |>
tbl_regression() |>
modify_missing_symbol(
symbol = "Ref.",
columns = c(estimate, conf.low, conf.high),
rows = reference_row == TRUE
) |>
as.data.frame(fmt_missing = TRUE, col_labels = FALSE) %>%
`[`(2, c("estimate", "conf.low")) |>
unlist() |>
unique(),
"Ref."
)
})
4 changes: 2 additions & 2 deletions tests/testthat/test-tbl_stack.R
Original file line number Diff line number Diff line change
@@ -225,7 +225,7 @@ test_that("tbl_stack works with missing symbols", {
modify_table_body(
~ .x |> mutate(stat_0 = NA_character_)
) |>
modify_table_styling(stat_0, rows = !is.na(label), missing_symbol = "n / a")
modify_missing_symbol(stat_0, rows = !is.na(label), symbol = "n / a")

t2 <- t2_summary |>
modify_table_body(
@@ -249,7 +249,7 @@ test_that("tbl_stack works with missing symbols", {
)

t2 <- t2 |>
modify_table_styling(stat_0, rows = !is.na(label), missing_symbol = "miss")
modify_missing_symbol(stat_0, rows = !is.na(label), symbol = "miss")

expect_silent(tbl <- tbl_stack(list(t1, t2)))

0 comments on commit 0adc608

Please sign in to comment.