Add the fmt_bytes() formatter function

NAMESPACE

@@ -47,6 +47,7 @@ export(escape_latex)
 export(everything)
 export(extract_summary)
 export(fmt)
+export(fmt_bytes)
 export(fmt_currency)
 export(fmt_date)
 export(fmt_datetime)

R/format_data.R

@@ -242,6 +242,8 @@ fmt_number <- function(data,
 #' argument. See the Arguments section for more information on this.
 #'
 #' @inheritParams fmt_number
+#' @param scale_by A value to scale the input. The default is `1.0`. All numeric
+#'   values will be multiplied by this value first before undergoing formatting.
 #'
 #' @return An object of class `gt_tbl`.
 #'
@@ -769,6 +771,145 @@ fmt_currency <- function(data,
   )
 }
 
+#' Format values as bytes
+#'
+#' With numeric values in a **gt** table, we can transform those to values of
+#' bytes with human readable units. The `fmt_bytes()` function allows for the
+#' formatting of byte sizes to either of two common representations: (1) with
+#' decimal units (powers of 1000, examples being `"kB"` and `"MB"`), and (2)
+#' with binary units (powers of 1024, examples being `"KiB"` and `"MiB"`).
+#'
+#' It is assumed the input numeric values represent the number of bytes and
+#' automatic truncation of values will occur. The numeric values will be scaled
+#' to be in the range of 1 to <1000 and then decorated with the correct unit
+#' symbol according to the standard chosen. For more control over the formatting
+#' of byte sizes, we can use the following options:
+#' \itemize{
+#' \item decimals: choice of the number of decimal places, option to drop
+#' trailing zeros, and a choice of the decimal symbol
+#' \item digit grouping separators: options to enable/disable digit separators
+#' and provide a choice of separator symbol
+#' \item pattern: option to use a text pattern for decoration of the formatted
+#' values
+#' \item locale-based formatting: providing a locale ID will result in number
+#' formatting specific to the chosen locale
+#' }
+#'
+#' @inheritParams fmt_number
+#' @param standard The way to express large byte sizes.
+#' @param decimals An option to specify the exact number of decimal places to
+#'   use. The default number of decimal places is `1`.
+#' @param incl_space An option for whether to include a space between the value
+#'   and the units. The default of `TRUE` uses a space character for separation.
+#'
+#' @return An object of class `gt_tbl`.
+#'
+#' @examples
+#' # Use `exibble` to create a gt table;
+#' # format the `num` column to have
+#' # byte sizes in the binary standard
+#' tab_1 <-
+#'   exibble %>%
+#'   dplyr::select(num) %>%
+#'   gt() %>%
+#'   fmt_bytes(columns = num)
+#'
+#' # Create a similar table with the
+#' # `fmt_bytes()` function, this time
+#' # showing byte sizes as binary values
+#' tab_2 <-
+#'   exibble %>%
+#'   dplyr::select(num) %>%
+#'   gt() %>%
+#'   fmt_bytes(
+#'     columns = num,
+#'     standard = "binary"
+#'   )
+#'
+#' @family Format Data
+#' @section Function ID:
+#' 3-5
+#'
+#' @import rlang
+#' @export
+fmt_bytes <- function(data,
+                      columns,
+                      rows = everything(),
+                      standard = c("decimal", "binary"),
+                      decimals = 1,
+                      n_sigfig = NULL,
+                      drop_trailing_zeros = TRUE,
+                      drop_trailing_dec_mark = TRUE,
+                      use_seps = TRUE,
+                      pattern = "{x}",
+                      sep_mark = ",",
+                      dec_mark = ".",
+                      incl_space = TRUE,
+                      locale = NULL) {
+
+  # Perform input object validation
+  stop_if_not_gt(data = data)
+
+  standard <- match.arg(standard)
+
+  # Use locale-based marks if a locale ID is provided
+  sep_mark <- get_locale_sep_mark(locale, sep_mark, use_seps)
+  dec_mark <- get_locale_dec_mark(locale, dec_mark)
+
+  # Set the `formatC_format` option according to whether number
+  # formatting with significant figures is to be performed
+  if (!is.null(n_sigfig)) {
+
+    # Stop function if `n_sigfig` does not have a valid value
+    validate_n_sigfig(n_sigfig)
+
+    formatC_format <- "fg"
+  } else {
+    formatC_format <- "f"
+  }
+
+  if (standard == "decimal") {
+    base <- 1000
+    byte_units <-
+      c("B", "kB", "MB", "GB", "TB", "PB", "EB", "ZB", "YB")
+  } else {
+    base <- 1024
+    byte_units <-
+      c("B", "KiB", "MiB", "GiB", "TiB", "PiB", "EiB", "ZiB", "YiB")
+  }
+
+  fmt(
+    data = data,
+    columns = {{ columns }},
+    rows = {{ rows }},
+    fns = num_fmt_factory_multi(
+      pattern = pattern,
+      format_fn = function(x, context) {
+
+        # Truncate all byte values
+        x <- trunc(x)
+
+        num_power_idx <- floor(log(abs(x), base = base)) + 1
+        num_power_idx <- pmax(1, pmin(length(byte_units), num_power_idx))
+
+        units_str <- byte_units[num_power_idx]
+        x <- x / base^(num_power_idx-1)
+
+        x %>%
+          # Format numeric values to character-based numbers
+          format_num_to_str(
+            context = context, decimals = decimals, n_sigfig = n_sigfig,
+            sep_mark = sep_mark, dec_mark = dec_mark,
+            drop_trailing_zeros = drop_trailing_zeros,
+            drop_trailing_dec_mark = drop_trailing_dec_mark,
+            format = formatC_format
+          ) %>%
+          paste_right(paste0(if (incl_space) " ", units_str))
+      }
+    )
+  )
+}
+
 #' Format values as dates
 #'
 #' Format input date values that are either of the `Date` type, or, are
@@ -854,7 +995,7 @@ fmt_currency <- function(data,
 #'
 #' @family Format Data
 #' @section Function ID:
-#' 3-5
+#' 3-6
 #'
 #' @import rlang
 #' @export
@@ -983,7 +1124,7 @@ fmt_date <- function(data,
 #'
 #' @family Format Data
 #' @section Function ID:
-#' 3-6
+#' 3-7
 #'
 #' @import rlang
 #' @export
@@ -1102,7 +1243,7 @@ fmt_time <- function(data,
 #'
 #' @family Format Data
 #' @section Function ID:
-#' 3-7
+#' 3-8
 #'
 #' @import rlang
 #' @export
@@ -1242,7 +1383,7 @@ fmt_datetime <- function(data,
 #'
 #' @family Format Data
 #' @section Function ID:
-#' 3-8
+#' 3-9
 #'
 #' @import rlang
 #' @export
@@ -1328,7 +1469,7 @@ fmt_markdown <- function(data,
 #'
 #' @family Format Data
 #' @section Function ID:
-#' 3-9
+#' 3-10
 #'
 #' @import rlang
 #' @export
@@ -1461,7 +1602,7 @@ fmt_passthrough <- function(data,
 #'
 #' @family Format Data
 #' @section Function ID:
-#' 3-10
+#' 3-11
 #'
 #' @import rlang
 #' @export
@@ -1573,7 +1714,7 @@ fmt_missing <- function(data,
 #'
 #' @family Format Data
 #' @section Function ID:
-#' 3-11
+#' 3-12
 #'
 #' @import rlang
 #' @export

R/utils_formatters.R

@@ -265,6 +265,10 @@ format_num_to_str <- function(x,
       decimal.mark = dec_mark
     )
 
+  # Remove `-` for any signed zeros returned by `formatC()`
+  x_str_signed_zero <- grepl("^(-0|-0\\.0*?)$", x_str)
+  x_str[x_str_signed_zero] <- gsub("-", "", x_str[x_str_signed_zero])
+
   # If a trailing decimal mark is to be retained (not the
   # default option but sometimes desirable), affix the `dec_mark`
   # to the right of those figures that are missing this mark

_pkgdown.yml

@@ -52,6 +52,7 @@ reference:
     - fmt_scientific
     - fmt_percent
     - fmt_currency
+    - fmt_bytes
     - fmt_date
     - fmt_time
     - fmt_datetime