Number options (#453)

Author: teunbrand

NAMESPACE

@@ -155,6 +155,7 @@ export(number)
 export(number_bytes)
 export(number_bytes_format)
 export(number_format)
+export(number_options)
 export(oob_censor)
 export(oob_censor_any)
 export(oob_discard)

R/label-currency.R

@@ -48,8 +48,11 @@
 #'   scale_cut = c(0, k = 1e3, m = 1e6, bn = 1e9, tn = 1e12)
 #' )
 #' demo_log10(c(1, 1e12), breaks = log_breaks(5, 1e3), labels = gbp)
-label_currency <- function(accuracy = NULL, scale = 1, prefix = "$",
-                           suffix = "", big.mark = ",", decimal.mark = ".",
+label_currency <- function(accuracy = NULL, scale = 1,
+                           prefix = NULL,
+                           suffix = NULL,
+                           big.mark = NULL,
+                           decimal.mark = NULL,
                            trim = TRUE, largest_with_fractional = 100000,
                            ...) {
   force_all(
@@ -144,13 +147,17 @@ dollar_format <- function(accuracy = NULL, scale = 1, prefix = "$",
 #' @export
 #' @rdname dollar_format
 #' @param x A numeric vector
-dollar <- function(x, accuracy = NULL, scale = 1, prefix = "$",
-                   suffix = "", big.mark = ",", decimal.mark = ".",
+dollar <- function(x, accuracy = NULL, scale = 1, prefix = NULL,
+                   suffix = NULL, big.mark = NULL, decimal.mark = NULL,
                    trim = TRUE, largest_with_cents = 100000,
                    negative_parens = deprecated(),
                    style_negative = c("hyphen", "minus", "parens"),
                    scale_cut = NULL,
                    ...) {
+  prefix <- prefix %||% getOption("scales.currency.prefix", default = "$")
+  suffix <- suffix %||% getOption("scales.currency.suffix", default = "")
+  big.mark <- big.mark %||% getOption("scales.currency.big.mark", default = ",")
+  decimal.mark <- decimal.mark %||% getOption("scales.currency.decimal.mark", default = ".")
   if (length(x) == 0) {
     return(character())
   }

R/label-number.R

@@ -28,8 +28,11 @@
 #'   processed so that `prefix = "$"` will yield (e.g.) `-$1` and `($1)`.
 #' @param suffix Additional text to display after the number.
 #' @param big.mark Character used between every 3 digits to separate thousands.
+#'   The default (`NULL`) retrieves the setting from the
+#'   [number options][number_options].
 #' @param decimal.mark The character to be used to indicate the numeric
-#'   decimal point.
+#'   decimal point.  The default (`NULL`) retrieves the setting from the
+#'   [number options][number_options].
 #' @param style_positive A string that determines the style of positive numbers:
 #'
 #'   * `"none"` (the default): no change, e.g. `1`.
@@ -38,13 +41,19 @@
 #'     as wide as a number or `+`. Compared to `"none"`, adding a figure space
 #'     can ensure numbers remain properly aligned when they are left- or
 #'     right-justified.
+#'
+#'   The default (`NULL`) retrieves the setting from the
+#'   [number options][number_options].
 #' @param style_negative A string that determines the style of negative numbers:
 #'
 #'   * `"hyphen"` (the default): preceded by a standard hypen `-`, e.g. `-1`.
 #'   * `"minus"`, uses a proper Unicode minus symbol. This is a typographical
 #'      nicety that ensures `-` aligns with the horizontal bar of the
 #'      the horizontal bar of `+`.
 #'   * `"parens"`, wrapped in parentheses, e.g. `(1)`.
+#'
+#'   The default (`NULL`) retrieves the setting from the
+#'   [number options][number_options].
 #' @param scale_cut Named numeric vector that allows you to rescale large
 #'   (or small) numbers and add a prefix. Built-in helpers include:
 #'   * `cut_short_scale()`: [10^3, 10^6) = K, [10^6, 10^9) = M, [10^9, 10^12) = B, [10^12, Inf) = T.
@@ -109,9 +118,9 @@
 #' demo_continuous(c(32, 212), labels = label_number(suffix = "\u00b0F"))
 #' demo_continuous(c(0, 100), labels = label_number(suffix = "\u00b0C"))
 label_number <- function(accuracy = NULL, scale = 1, prefix = "",
-                         suffix = "", big.mark = " ", decimal.mark = ".",
-                         style_positive = c("none", "plus", "space"),
-                         style_negative = c("hyphen", "minus", "parens"),
+                         suffix = "", big.mark = NULL, decimal.mark = NULL,
+                         style_positive = NULL,
+                         style_negative = NULL,
                          scale_cut = NULL,
                          trim = TRUE, ...) {
   force_all(
@@ -225,17 +234,21 @@ comma_format <- label_comma
 #' @inheritParams label_number
 #' @return A character vector of `length(x)`.
 number <- function(x, accuracy = NULL, scale = 1, prefix = "",
-                   suffix = "", big.mark = " ", decimal.mark = ".",
-                   style_positive = c("none", "plus", "space"),
-                   style_negative = c("hyphen", "minus", "parens"),
+                   suffix = "", big.mark = NULL, decimal.mark = NULL,
+                   style_positive = NULL,
+                   style_negative = NULL,
                    scale_cut = NULL,
                    trim = TRUE, ...) {
   if (length(x) == 0) {
     return(character())
   }
+  big.mark <- big.mark %||% getOption("scales.big.mark", default = " ")
+  decimal.mark <- decimal.mark %||% getOption("scales.decimal.mark", default = ".")
+  style_positive <- style_positive %||% getOption("scales.style_positive", default = "none")
+  style_negative <- style_negative %||% getOption("scales.style_negative", default = "hyphen")
 
-  style_positive <- arg_match(style_positive)
-  style_negative <- arg_match(style_negative)
+  style_positive <- arg_match(style_positive, c("none", "plus", "space"))
+  style_negative <- arg_match(style_negative, c("hyphen", "minus", "parens"))
 
   if (!is.null(scale_cut)) {
     cut <- scale_cut(x,
@@ -298,6 +311,58 @@ number <- function(x, accuracy = NULL, scale = 1, prefix = "",
   ret
 }
 
+#' Number options
+#'
+#' Control the settings for formatting numbers globally.
+#'
+#' @inheritParams label_number
+#' @param currency.prefix,currency.suffix,currency.decimal.mark,currency.big.mark
+#'   Settings for [`label_currency()`] passed on without the `currency.`-prefix.
+#' @param ordinal.rules Setting for [`label_ordinal()`] passed on without the
+#'   `ordinal.`-prefix.
+#'
+#' @return The old options invisibly
+#' @export
+#'
+#' @examples
+#' # Default number formatting
+#' x <- c(0.1, 1, 1000)
+#' label_number()(x)
+#'
+#' # Now again with new options set
+#' number_options(style_positive = "plus", decimal.mark = ",")
+#' label_number()(x)
+#'
+#' # The options are the argument names with a 'scales.'-prefix
+#' options("scales.style_positive")
+#'
+#' # Resetting the options to their defaults
+#' number_options()
+#' label_number()(x)
+number_options <- function(
+  decimal.mark = ".",
+  big.mark = " ",
+  style_positive = c("none", "plus", "space"),
+  style_negative = c("hyphen", "minus", "parens"),
+  currency.prefix = "$",
+  currency.suffix = "",
+  currency.decimal.mark = decimal.mark,
+  currency.big.mark = setdiff(c(".", ","), currency.decimal.mark)[1],
+  ordinal.rules = ordinal_english()
+) {
+  opts <- options(
+    scales.decimal.mark          = decimal.mark,
+    scales.big.mark              = big.mark,
+    scales.style_positive        = arg_match(style_positive),
+    scales.style_negative        = arg_match(style_negative),
+    scales.currency.prefix       = currency.prefix,
+    scales.currency.suffix       = currency.suffix,
+    scales.currency.decimal.mark = currency.decimal.mark,
+    scales.currency.big.mark     = currency.big.mark,
+    scales.ordinal.rules         = ordinal.rules
+  )
+  invisible(opts)
+}
 
 # Helpers -----------------------------------------------------------------
 

R/label-ordinal.R

@@ -28,8 +28,8 @@
 #'   labels = label_ordinal(),
 #'   breaks = breaks_width(2)
 #' )
-label_ordinal <- function(prefix = "", suffix = "", big.mark = " ",
-                          rules = ordinal_english(), ...) {
+label_ordinal <- function(prefix = "", suffix = "", big.mark = NULL,
+                          rules = NULL, ...) {
   force_all(prefix, suffix, big.mark, rules, ...)
   function(x) {
     ordinal(
@@ -96,7 +96,9 @@ ordinal_format <- label_ordinal
 #' @export
 #' @rdname ordinal_format
 ordinal <- function(x, prefix = "", suffix = "", big.mark = " ",
-                    rules = ordinal_english(), ...) {
+                    rules = NULL, ...) {
+
+  rules <- rules %||% getOption("scales.ordinal.rules", default = ordinal_english())
   na_idx <- is.na(x)
   x <- round(x, digits = 0)
   x[na_idx] <- 1 # replace NAs with dummy value

R/label-percent.R

@@ -15,7 +15,7 @@
 #' )
 #' demo_continuous(c(0, .01), labels = french_percent)
 label_percent <- function(accuracy = NULL, scale = 100, prefix = "",
-                          suffix = "%", big.mark = " ", decimal.mark = ".",
+                          suffix = "%", big.mark = NULL, decimal.mark = NULL,
                           trim = TRUE, ...) {
   number_format(
     accuracy = accuracy,
@@ -45,7 +45,7 @@ percent_format <- label_percent
 #' @export
 #' @rdname percent_format
 percent <- function(x, accuracy = NULL, scale = 100, prefix = "",
-                    suffix = "%", big.mark = " ", decimal.mark = ".",
+                    suffix = "%", big.mark = NULL, decimal.mark = NULL,
                     trim = TRUE, ...) {
   number(
     x = x,

R/label-pvalue.R

@@ -18,7 +18,7 @@
 #' # Or provide your own prefixes
 #' prefix <- c("p < ", "p = ", "p > ")
 #' demo_continuous(c(0, 1), labels = label_pvalue(prefix = prefix))
-label_pvalue <- function(accuracy = .001, decimal.mark = ".", prefix = NULL, add_p = FALSE) {
+label_pvalue <- function(accuracy = .001, decimal.mark = NULL, prefix = NULL, add_p = FALSE) {
   force_all(accuracy, decimal.mark, add_p)
   function(x) {
     pvalue(
@@ -49,9 +49,10 @@ pvalue_format <- label_pvalue
 #' @export
 pvalue <- function(x,
                    accuracy = .001,
-                   decimal.mark = ".",
+                   decimal.mark = NULL,
                    prefix = NULL,
                    add_p = FALSE) {
+  decimal.mark <- decimal.mark %||% getOption("scales.decimal.mark", default = ".")
   out <- number(x, accuracy, decimal.mark = decimal.mark)
   below <- number(accuracy, accuracy, decimal.mark = decimal.mark)
   above <- number(1 - accuracy, accuracy, decimal.mark = decimal.mark)

R/label-scientific.R

@@ -14,7 +14,7 @@
 #'
 #' demo_log10(c(1, 1e9))
 label_scientific <- function(digits = 3, scale = 1, prefix = "", suffix = "",
-                             decimal.mark = ".", trim = TRUE, ...) {
+                             decimal.mark = NULL, trim = TRUE, ...) {
   force_all(digits, scale, prefix, suffix, decimal.mark, trim, ...)
   function(x) {
     scientific(
@@ -45,11 +45,12 @@ scientific_format <- label_scientific
 #' @export
 #' @rdname scientific_format
 scientific <- function(x, digits = 3, scale = 1, prefix = "", suffix = "",
-                       decimal.mark = ".", trim = TRUE, ...) {
+                       decimal.mark = NULL, trim = TRUE, ...) {
   if (length(x) == 0) {
     return(character())
   }
   x <- signif(x * scale, digits)
+  decimal.mark <- decimal.mark %||% getOption("scales.decimal.mark", default = ".")
   ret <- paste0(
     prefix,
     format(x, decimal.mark = decimal.mark, trim = trim, scientific = TRUE, ...),

R/labels-retired.R

@@ -111,7 +111,7 @@ trans_format <- function(trans, format = scientific_format()) {
 #' demo_continuous(c(0, 2500), labels = km)
 unit_format <- function(accuracy = NULL, scale = 1, prefix = "",
                         unit = "m", sep = " ", suffix = paste0(sep, unit),
-                        big.mark = " ", decimal.mark = ".",
+                        big.mark = NULL, decimal.mark = NULL,
                         trim = TRUE, ...) {
   number_format(
     accuracy = accuracy,

_pkgdown.yml

@@ -19,6 +19,7 @@ reference:
   contents:
   - starts_with("label_")
   - matches("format")
+  - number_options
 
 - title:  Axis breaks
   desc: >