diff --git a/R/as_kable_extra.R b/R/as_kable_extra.R index 448267737..ea43c539b 100644 --- a/R/as_kable_extra.R +++ b/R/as_kable_extra.R @@ -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( @@ -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 } diff --git a/R/modify_abbreviation.R b/R/modify_abbreviation.R index edde312b6..f736adc9d 100644 --- a/R/modify_abbreviation.R +++ b/R/modify_abbreviation.R @@ -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, @@ -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 @@ -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() ) } diff --git a/R/tbl_continuous.R b/R/tbl_continuous.R index daa5189ac..431f57842 100644 --- a/R/tbl_continuous.R +++ b/R/tbl_continuous.R @@ -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, diff --git a/R/tbl_regression.R b/R/tbl_regression.R index b594d004d..ff327076e 100644 --- a/R/tbl_regression.R +++ b/R/tbl_regression.R @@ -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) diff --git a/man/modify_abbreviation.Rd b/man/modify_abbreviation.Rd index 83e9f2585..8a857d867 100644 --- a/man/modify_abbreviation.Rd +++ b/man/modify_abbreviation.Rd @@ -29,6 +29,7 @@ All abbreviations will be coalesced when printing the final table into a single source note. } \examples{ +# Example 1 ---------------------------------- tbl_summary( trial, by = trt, @@ -37,4 +38,9 @@ tbl_summary( ) |> 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") } diff --git a/tests/testthat/_snaps/as_kable_extra.md b/tests/testthat/_snaps/as_kable_extra.md index 9a9210891..9e0d1f535 100644 --- a/tests/testthat/_snaps/as_kable_extra.md +++ b/tests/testthat/_snaps/as_kable_extra.md @@ -75,7 +75,7 @@ [9] "\n II \n 0.85 \n 0.39, 1.85 \n 0.7 \n 1.21 \n 0.73, 1.99 \n 0.5 \n " [10] "\n III \n 1.01 \n 0.47, 2.15 \n >0.9 \n 1.79 \n 1.12, 2.86 \n 0.014 \n " [11] "\n Age \n 1.02 \n 1.00, 1.04 \n 0.10 \n 1.01 \n 0.99, 1.02 \n 0.3 \n " - [12] "\n\n1 Abbreviations: CI = Confidence Interval, HR = Hazard Ratio, OR = Odds Ratio\n" + [12] "\n\n Abbreviations: CI = Confidence Interval, HR = Hazard Ratio, OR = Odds Ratio\n" # as_kable_extra works with tbl_stack @@ -103,7 +103,7 @@ --- - "<\/tbody>\n\n\n1<\/sup> n (%); Median (Q1, Q3)<\/td><\/tr>\n\n2<\/sup> test footnote<\/td><\/tr>\n<\/tfoot>\n\n1<\/sup> Abbreviation: N = number of observations<\/td><\/tr><\/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/test-as_kable_extra.R b/tests/testthat/test-as_kable_extra.R index 21a15365b..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", "abbreviations", "source_note") + "escape_table_body", "bold_italic", "kable", "add_indent", "source_note", "abbreviations", "footnote") ) }) 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") + ) +})