Skip to content

Commit

Permalink
Abbreviation updates
Browse files Browse the repository at this point in the history
  • Loading branch information
@ddsjoberg
ddsjoberg committed Dec 10, 2024
1 parent d029a6a commit ed2b328
Show file tree
Hide file tree
Showing 9 changed files with 119 additions and 36 deletions.
60 changes: 31 additions & 29 deletions R/as_kable_extra.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -347,6 +347,37 @@ table_styling_to_kable_extra_calls <- function(x, escape, format, addtl_fmt, ...
)
}

# source note ----------------------------------------------------------------
kable_extra_calls[["source_note"]] <-
map(
seq_len(nrow(x$table_styling$source_note)),
\(i) {
expr(
kableExtra::footnote(number = !!x$table_styling$source_note$source_note[i], escape = !!escape)
)
}
)

# abbreviation ---------------------------------------------------------------
kable_extra_calls[["abbreviations"]] <-
case_switch(
nrow(x$table_styling$abbreviation) > 0L ~
expr(
kableExtra::footnote(
general = !!(x$table_styling$abbreviation$abbreviation |>
paste(collapse = ", ") %>%
paste0(
ifelse(nrow(x$table_styling$abbreviation) > 1L, "Abbreviations", "Abbreviation") |> translate_string(),
": ", .
)),
escape = !!escape,
general_title = "",
footnote_order = c("number", "alphabet", "symbol", "general")
)
),
.default = list()
)

# footnote -------------------------------------------------------------------
vct_footnote <-
dplyr::bind_rows(
Expand All @@ -361,35 +392,6 @@ table_styling_to_kable_extra_calls <- function(x, escape, format, addtl_fmt, ...
expr(kableExtra::footnote(number = !!vct_footnote, escape = !!escape))
}

# abbreviation ---------------------------------------------------------------
kable_extra_calls[["abbreviations"]] <-
case_switch(
nrow(x$table_styling$abbreviation) > 0L ~
expr(
kableExtra::footnote(
number = !!(x$table_styling$abbreviation$abbreviation |>
paste(collapse = ", ") %>%
paste0(
ifelse(nrow(x$table_styling$abbreviation) > 1L, "Abbreviations", "Abbreviation") |> translate_string(),
": ", .
)),
escape = !!escape
)
),
.default = list()
)

# source note ----------------------------------------------------------------
kable_extra_calls[["source_note"]] <-
map(
seq_len(nrow(x$table_styling$source_note)),
\(i) {
expr(
kableExtra::footnote(number = !!x$table_styling$source_note$source_note[i], escape = !!escape)
)
}
)

# return list of calls -------------------------------------------------------
kable_extra_calls
}
Expand Down
10 changes: 8 additions & 2 deletions R/modify_abbreviation.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -10,7 +10,8 @@
#' @return Updated gtsummary object
#' @name modify_abbreviation
#'
#' @examples
#' @examplesIf (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) && gtsummary:::is_pkg_installed(c("cardx", "broom", "broom.helpers"))
#' # Example 1 ----------------------------------
#' tbl_summary(
#' trial,
#' by = trt,
Expand All @@ -19,6 +20,11 @@
#' ) |>
#' modify_table_body(~dplyr::mutate(.x, label = sub("Q1, Q3", "IQR", x = label))) |>
#' modify_abbreviation("IQR = Interquartile Range")
#'
#' # Example 2 ----------------------------------
#' lm(marker ~ trt, trial) |>
#' tbl_regression() |>
#' remove_abbreviation("CI = Confidence Interval")
NULL

#' @export
Expand Down Expand Up @@ -55,7 +61,7 @@ remove_abbreviation <- function(x, abbreviation) {
}
if (!isTRUE(abbreviation %in% x$table_styling$abbreviation$abbreviation)) {
cli::cli_abort(
"The {.arg abbreviation} must be one of {.val {unique(x$table_styling$abbreviation$abbreviation)}}.",
"The {.arg abbreviation} argument must be one of {.val {unique(x$table_styling$abbreviation$abbreviation)}}.",
call = get_cli_abort_call()
)
}
Expand Down
2 changes: 1 addition & 1 deletion R/tbl_continuous.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -20,7 +20,7 @@
#' @return a gtsummary table
#' @export
#'
#' @examples
#' @examplesIf identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")
#' # Example 1 ----------------------------------
#' tbl_continuous(
#' data = trial,
Expand Down
2 changes: 1 addition & 1 deletion R/tbl_regression.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -69,7 +69,7 @@
#' @name tbl_regression
#' @return A `tbl_regression` object
#'
#' @examplesIf gtsummary:::is_pkg_installed(c("cardx", "broom", "broom.helpers"))
#' @examplesIf (identical(Sys.getenv("NOT_CRAN"), "true") || identical(Sys.getenv("IN_PKGDOWN"), "true")) && gtsummary:::is_pkg_installed(c("cardx", "broom", "broom.helpers"))
#' # Example 1 ----------------------------------
#' glm(response ~ age + grade, trial, family = binomial()) |>
#' tbl_regression(exponentiate = TRUE)
Expand Down
6 changes: 6 additions & 0 deletions man/modify_abbreviation.Rd
View file

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

4 changes: 2 additions & 2 deletions tests/testthat/_snaps/as_kable_extra.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -75,7 +75,7 @@
[9] "<tr>\n <td style=\"text-align:left;padding-left: 2em;\" indentlevel=\"1\"> II </td>\n <td style=\"text-align:center;\"> 0.85 </td>\n <td style=\"text-align:center;\"> 0.39, 1.85 </td>\n <td style=\"text-align:center;\"> 0.7 </td>\n <td style=\"text-align:center;\"> 1.21 </td>\n <td style=\"text-align:center;\"> 0.73, 1.99 </td>\n <td style=\"text-align:center;\"> 0.5 </td>\n "
[10] "<tr>\n <td style=\"text-align:left;padding-left: 2em;\" indentlevel=\"1\"> III </td>\n <td style=\"text-align:center;\"> 1.01 </td>\n <td style=\"text-align:center;\"> 0.47, 2.15 </td>\n <td style=\"text-align:center;\"> &gt;0.9 </td>\n <td style=\"text-align:center;\"> 1.79 </td>\n <td style=\"text-align:center;\"> 1.12, 2.86 </td>\n <td style=\"text-align:center;\"> 0.014 </td>\n "
[11] "<tr>\n <td style=\"text-align:left;\"> Age </td>\n <td style=\"text-align:center;\"> 1.02 </td>\n <td style=\"text-align:center;\"> 1.00, 1.04 </td>\n <td style=\"text-align:center;\"> 0.10 </td>\n <td style=\"text-align:center;\"> 1.01 </td>\n <td style=\"text-align:center;\"> 0.99, 1.02 </td>\n <td style=\"text-align:center;\"> 0.3 </td>\n "
[12] "</tbody>\n<tfoot><tr><td style=\"padding: 0; \" colspan=\"100%\">\n<sup>1</sup> Abbreviations: CI = Confidence Interval, HR = Hazard Ratio, OR = Odds Ratio</td></tr></tfoot>\n</table>"
[12] "</tbody>\n<tfoot><tr><td style=\"padding: 0; \" colspan=\"100%\">\n<sup></sup> Abbreviations: CI = Confidence Interval, HR = Hazard Ratio, OR = Odds Ratio</td></tr></tfoot>\n</table>"

# as_kable_extra works with tbl_stack

Expand Down Expand Up @@ -103,7 +103,7 @@

---

"<\/tbody>\n<tfoot>\n<tr><td style=\"padding: 0; \" colspan=\"100%\">\n<sup>1<\/sup> n (%); Median (Q1, Q3)<\/td><\/tr>\n<tr><td style=\"padding: 0; \" colspan=\"100%\">\n<sup>2<\/sup> test footnote<\/td><\/tr>\n<\/tfoot>\n<tfoot><tr><td style=\"padding: 0; \" colspan=\"100%\">\n<sup>1<\/sup> Abbreviation: N = number of observations<\/td><\/tr><\/tfoot>\n<\/table>"
"<\/tbody>\n<tfoot><tr><td style=\"padding: 0; \" colspan=\"100%\">\n<sup><\/sup> Abbreviation: N = number of observations<\/td><\/tr><\/tfoot>\n<tfoot>\n<tr><td style=\"padding: 0; \" colspan=\"100%\">\n<sup>1<\/sup> n (%); Median (Q1, Q3)<\/td><\/tr>\n<tr><td style=\"padding: 0; \" colspan=\"100%\">\n<sup>2<\/sup> test footnote<\/td><\/tr>\n<\/tfoot>\n<\/table>"

---

Expand Down
17 changes: 17 additions & 0 deletions tests/testthat/_snaps/modify_abbreviation.md
View file
Original file line number Diff line number Diff line change
@@ -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".

2 changes: 1 addition & 1 deletion tests/testthat/test-as_kable_extra.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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", "abbreviations", "source_note")
"escape_table_body", "bold_italic", "kable", "add_indent", "source_note", "abbreviations", "footnote")
)
})

Expand Down
52 changes: 52 additions & 0 deletions tests/testthat/test-modify_abbreviation.R
View file
Original file line number Diff line number Diff line change
@@ -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")
)
})

0 comments on commit ed2b328

Please sign in to comment.