Adding prefix and suffix args to style_*() functions

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: gtsummary
 Title: Presentation-Ready Data Summary and Analytic Result Tables
-Version: 2.0.2.9008
+Version: 2.0.2.9009
 Authors@R: c(
     person("Daniel D.", "Sjoberg", , "danield.sjoberg@gmail.com", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0003-0862-2018")),

NEWS.md

@@ -1,5 +1,7 @@
 # gtsummary (development version)
 
+* Adding the `style_*(prefix, suffix)` and  `label_style_*(prefix, suffix)` for adding a string before or after the formatted results. These arguments have not been added to the p-value formatting functions. (#1690)
+
 * Bug fix in `add_p.tbl_survfit()` when the original call included `tbl_survfit(type)` specification. (#2002)
 
 * Migrated the `tbl_survfit.list(conf.level)` up to `tbl_survfit.data.frame(conf.level)` where the confidence level is passed to `survival::survfit()`.

R/add_difference.R

@@ -34,8 +34,6 @@ add_difference <- function(x, ...) {
 #' @param estimate_fun ([`formula-list-selector`][syntax])\cr
 #'   List of formulas specifying the functions
 #'   to round and format differences and confidence limits.
-#'   Default is
-#'   `list(c(all_continuous(), all_categorical(FALSE)) ~ label_style_sigfig(), all_categorical() ~ \(x) paste0(style_sigfig(x, scale = 100), "%"))`
 #' @param conf.level (`numeric`)\cr
 #'   a scalar in the interval `(0, 1)` indicating the confidence level. Default is 0.95
 #' @inheritParams  add_p.tbl_summary
@@ -81,7 +79,7 @@ add_difference.tbl_summary <- function(x,
                                        pvalue_fun = label_style_pvalue(digits = 1),
                                        estimate_fun = list(
                                          c(all_continuous(), all_categorical(FALSE)) ~ label_style_sigfig(),
-                                         all_dichotomous() ~ function(x) ifelse(is.na(x), NA_character_, paste0(style_sigfig(x, scale = 100), "%")),
+                                         all_dichotomous() ~ label_style_sigfig(scale = 100, suffix = "%"),
                                          all_tests("smd") ~ label_style_sigfig()
                                        ),
                                        ...) {

R/add_difference.tbl_svysummary.R

@@ -35,7 +35,7 @@ add_difference.tbl_svysummary <- function(x,
                                           pvalue_fun = label_style_pvalue(digits = 1),
                                           estimate_fun = list(
                                             c(all_continuous(), all_categorical(FALSE)) ~ label_style_sigfig(),
-                                            all_dichotomous() ~ function(x) ifelse(is.na(x), NA_character_, paste0(style_sigfig(x, scale = 100), "%")),
+                                            all_dichotomous() ~ label_style_sigfig(scale = 100, suffix = "%"),
                                             all_tests("smd") ~ label_style_sigfig()
                                           ),
                                           ...) {

R/deprecated.R

@@ -8,22 +8,25 @@
 #' @keywords internal
 NULL
 
-# tentative deprecation schedule, `Sys.Date() - months(18)`
-# "warn" for 18 months
-#   2.0.0 TARGET 2024-07-01 TODO: Update this
-#   1.7.2 2023-07-13
-#   1.7.1 2023-04-27
+# "soft" deprecation for 6 months: (Sys.Date() - lubridate::dmonths(6)) |> as.Date()
+#  v2.0.2 2024-09-05
+#  v2.0.1 2024-08-01
+#  v2.0.0 2024-07-23
 
+# "warn" deprecation for 18 months: (Sys.Date() - lubridate::dmonths(24)) |> as.Date()
+#   v1.7.2 2023-07-13
+#   v1.7.1 2023-04-27
+
+# "stop" deprecation for 12 months: (Sys.Date() - lubridate::dmonths(36)) |> as.Date()
+#   v1.7.0 2023-01-13
+#   v1.6.3 2022-12-06
+#   v1.6.2 2022-09-30
+#   v1.6.1 2022-06-22
+#   v1.6.0 2022-04-25
+#   v1.5.2 2022-01-29
+#   v1.5.1 2022-01-20
+#   v1.5.0 2021-10-16
 
-# "stop" for 18 months, then delete from pkg, `Sys.Date() - months(36)`
-#   1.7.0 2023-01-13
-#   1.6.3 2022-12-06
-#   1.6.2 2022-09-30
-#   1.6.1 2022-06-22
-#   1.6.0 2022-04-25
-#   1.5.2 2022-01-29
-#   1.5.1 2022-01-20
-#   1.5.0 2021-10-16
 
 # v1.6.1 ----------------------------------------------------------
 #' @rdname deprecated

R/label_style.R

@@ -3,7 +3,7 @@
 #' Similar to the `style_*()` family of functions, but these functions return
 #' a `style_*()` **function** rather than performing the styling.
 #'
-#' @param digits,big.mark,decimal.mark,scale,prepend_p,symbol,... arguments
+#' @param digits,big.mark,decimal.mark,scale,prepend_p,prefix,suffix,... arguments
 #' passed to the `style_*()` functions
 #'
 #' @return a function
@@ -21,6 +21,8 @@ label_style_number <- function(digits = 0,
                                big.mark = ifelse(decimal.mark == ",", " ", ","),
                                decimal.mark = getOption("OutDec"),
                                scale = 1,
+                               prefix = "",
+                               suffix = "",
                                ...) {
   # setting defaults -----------------------------------------------------------
   if (missing(decimal.mark)) {
@@ -32,7 +34,7 @@ label_style_number <- function(digits = 0,
       get_theme_element("style_number-arg:big.mark", default = ifelse(decimal.mark == ",", "\U2009", ","))
   }
 
-  function(x) style_number(x, digits = digits, big.mark = big.mark, decimal.mark = decimal.mark, scale = scale, ...)
+  function(x) style_number(x, digits = digits, big.mark = big.mark, decimal.mark = decimal.mark, scale = scale, prefix = prefix, suffix = suffix, ...)
 }
 
 #' @rdname label_style
@@ -41,6 +43,8 @@ label_style_sigfig <- function(digits = 2,
                                scale = 1,
                                big.mark = ifelse(decimal.mark == ",", " ", ","),
                                decimal.mark = getOption("OutDec"),
+                               prefix = "",
+                               suffix = "",
                                ...) {
   # setting defaults -----------------------------------------------------------
   if (missing(decimal.mark)) {
@@ -52,7 +56,7 @@ label_style_sigfig <- function(digits = 2,
       get_theme_element("style_number-arg:big.mark", default = ifelse(decimal.mark == ",", "\U2009", ","))
   }
 
-  function(x) style_sigfig(x, digits = digits, scale = scale, big.mark = big.mark, decimal.mark = decimal.mark, ...)
+  function(x) style_sigfig(x, digits = digits, scale = scale, big.mark = big.mark, decimal.mark = decimal.mark, prefix = prefix, suffix = suffix, ...)
 }
 
 #' @rdname label_style
@@ -80,6 +84,8 @@ label_style_pvalue <- function(digits = 1,
 label_style_ratio <- function(digits = 2,
                               big.mark = ifelse(decimal.mark == ",", " ", ","),
                               decimal.mark = getOption("OutDec"),
+                              prefix = "",
+                              suffix = "",
                               ...) {
   # setting defaults -----------------------------------------------------------
   if (missing(decimal.mark)) {
@@ -91,12 +97,13 @@ label_style_ratio <- function(digits = 2,
       get_theme_element("style_number-arg:big.mark", default = ifelse(decimal.mark == ",", "\U2009", ","))
   }
 
-  function(x) style_ratio(x, digits = digits, big.mark = big.mark, decimal.mark = decimal.mark, ...)
+  function(x) style_ratio(x, digits = digits, big.mark = big.mark, decimal.mark = decimal.mark, prefix = prefix, suffix = suffix, ...)
 }
 
 #' @rdname label_style
 #' @export
-label_style_percent <- function(symbol = FALSE,
+label_style_percent <- function(prefix = "",
+                                suffix = "",
                                 digits = 0,
                                 big.mark = ifelse(decimal.mark == ",", " ", ","),
                                 decimal.mark = getOption("OutDec"),
@@ -111,5 +118,5 @@ label_style_percent <- function(symbol = FALSE,
       get_theme_element("style_number-arg:big.mark", default = ifelse(decimal.mark == ",", "\U2009", ","))
   }
 
-  function(x) style_percent(x, symbol = symbol, digits = digits, big.mark = big.mark, decimal.mark = decimal.mark, ...)
+  function(x) style_percent(x, prefix = prefix, suffix = suffix, digits = digits, big.mark = big.mark, decimal.mark = decimal.mark, ...)
 }

R/style_number.R

@@ -15,6 +15,10 @@
 #'   Default is `"."`  or `getOption("OutDec")`
 #' @param scale (scalar `numeric`)\cr
 #'   A scaling factor: `x` will be multiplied by scale before formatting.
+#' @param prefix (`string`)\cr
+#'   Additional text to display before the number.
+#' @param suffix (`string`)\cr
+#'   Additional text to display after the number.
 #' @param ... Arguments passed on to `base::format()`
 #'
 #' @return formatted character vector
@@ -27,8 +31,16 @@ style_number <- function(x,
                          digits = 0,
                          big.mark = ifelse(decimal.mark == ",", " ", ","),
                          decimal.mark = getOption("OutDec"),
-                         scale = 1, ...) {
+                         scale = 1,
+                         prefix = "",
+                         suffix = "", ...) {
   set_cli_abort_call()
+  if (!is_string(prefix) || !is_string(suffix)) {
+    cli::cli_abort(
+      "Arguments {.arg prefix} and {.arg suffix} must be strings.",
+      call = get_cli_abort_call()
+    )
+  }
 
   # setting defaults -----------------------------------------------------------
   if (missing(decimal.mark)) {
@@ -53,6 +65,7 @@ style_number <- function(x,
         scientific = FALSE, trim = TRUE, ...
       )
   }
+  ret <- paste0(prefix, ret, suffix)
   ret[is.na(x)] <- NA_character_
   attributes(ret) <- attributes(unclass(x))
 

R/style_percent.R

@@ -15,15 +15,27 @@
 #' @examples
 #' percent_vals <- c(-1, 0, 0.0001, 0.005, 0.01, 0.10, 0.45356, 0.99, 1.45)
 #' style_percent(percent_vals)
-#' style_percent(percent_vals, symbol = TRUE, digits = 1)
+#' style_percent(percent_vals, suffix = "%", digits = 1)
 style_percent <- function(x,
-                          symbol = FALSE,
                           digits = 0,
                           big.mark = ifelse(decimal.mark == ",", " ", ","),
                           decimal.mark = getOption("OutDec"),
+                          prefix = "",
+                          suffix = "",
+                          symbol,
                           ...) {
   set_cli_abort_call()
 
+  # deprecated arguments -------------------------------------------------------
+  if (!missing(symbol)) {
+    lifecycle::deprecate_soft(
+      when = "2.0.3",
+      what = "gtsummary::style_percent(symbol)",
+      with = I("style_percent(suffix='%')")
+    )
+    if (isTRUE(symbol)) suffix = "%" # styler: off
+  }
+
   # setting defaults -----------------------------------------------------------
   if (missing(decimal.mark)) {
     decimal.mark <-
@@ -35,17 +47,15 @@ style_percent <- function(x,
   }
 
   y <- dplyr::case_when(
-    x * 100 >= 10 ~ style_number(x * 100, digits = digits, big.mark = big.mark, decimal.mark = decimal.mark, ...),
-    x * 100 >= 10^(-(digits + 1)) ~ style_number(x * 100, digits = digits + 1, big.mark = big.mark, decimal.mark = decimal.mark, ...),
+    x * 100 >= 10 ~ style_number(x * 100, digits = digits, big.mark = big.mark, decimal.mark = decimal.mark, prefix = prefix, suffix = suffix, ...),
+    x * 100 >= 10^(-(digits + 1)) ~ style_number(x * 100, digits = digits + 1, big.mark = big.mark, decimal.mark = decimal.mark, prefix = prefix, suffix = suffix, ...),
     x > 0 ~ paste0("<", style_number(
       x = 10^(-(digits + 1)), digits = digits + 1, big.mark = big.mark,
-      decimal.mark = decimal.mark, ...
+      decimal.mark = decimal.mark, prefix = prefix, suffix = suffix, ...
     )),
-    x == 0 ~ "0"
+    x == 0 ~ paste0(prefix, "0", suffix)
   )
 
-  # adding percent symbol if requested
-  if (symbol == TRUE) y <- ifelse(!is.na(y), paste0(y, "%"), y)
   attributes(y) <- attributes(unclass(x))
   return(y)
 }

R/style_ratio.R

@@ -26,6 +26,8 @@ style_ratio <- function(x,
                         digits = 2,
                         big.mark = ifelse(decimal.mark == ",", " ", ","),
                         decimal.mark = getOption("OutDec"),
+                        prefix = "",
+                        suffix = "",
                         ...) {
   set_cli_abort_call()
 
@@ -42,11 +44,11 @@ style_ratio <- function(x,
   x_fmt <-
     dplyr::case_when(
       cards::round5(abs(x), digits = digits) < 1 ~
-        style_sigfig(x, digits = digits, big.mark = big.mark, decimal.mark = decimal.mark, ...),
+        style_sigfig(x, digits = digits, big.mark = big.mark, decimal.mark = decimal.mark, prefix = prefix, suffix = suffix, ...),
       x > 0 ~
-        style_sigfig(pmax(1, x), digits = digits + 1, big.mark = big.mark, decimal.mark = decimal.mark, ...),
+        style_sigfig(pmax(1, x), digits = digits + 1, big.mark = big.mark, decimal.mark = decimal.mark, prefix = prefix, suffix = suffix, ...),
       x < 0 ~
-        style_sigfig(pmin(-1, x), digits = digits + 1, big.mark = big.mark, decimal.mark = decimal.mark, ...),
+        style_sigfig(pmin(-1, x), digits = digits + 1, big.mark = big.mark, decimal.mark = decimal.mark, prefix = prefix, suffix = suffix, ...),
     )
 
   attributes(x_fmt) <- attributes(unclass(x))

R/style_sigfig.R

@@ -36,6 +36,8 @@ style_sigfig <- function(x,
                          scale = 1,
                          big.mark = ifelse(decimal.mark == ",", " ", ","),
                          decimal.mark = getOption("OutDec"),
+                         prefix = "",
+                         suffix = "",
                          ...) {
   set_cli_abort_call()
 
@@ -62,5 +64,5 @@ style_sigfig <- function(x,
     eval()
 
   # formatting number
-  style_number(x, digits = d, scale = scale, big.mark = big.mark, decimal.mark = decimal.mark, ...)
+  style_number(x, digits = d, scale = scale, big.mark = big.mark, decimal.mark = decimal.mark, prefix = prefix, suffix = suffix, ...)
 }

R/tbl_survfit.R

@@ -165,7 +165,7 @@ tbl_survfit.list <- function(x,
                              statistic = "{estimate} ({conf.low}, {conf.high})",
                              label = NULL,
                              label_header = ifelse(!is.null(times), "**Time {time}**", "**{style_sigfig(prob, scale=100)}% Percentile**"),
-                             estimate_fun = ifelse(!is.null(times), label_style_percent(symbol=TRUE), label_style_sigfig()),
+                             estimate_fun = ifelse(!is.null(times), label_style_percent(suffix = "%"), label_style_sigfig()),
                              missing = "--",
                              type = NULL,
                              reverse = FALSE,