Merge pull request #26 from cregouby/master

DESCRIPTION

@@ -3,7 +3,8 @@ Title: Pretty, Human Readable Formatting of Quantities
 Version: 1.1.1.9000
 Authors@R: c(
   person("Gabor", "Csardi", email="csardi.gabor@gmail.com", role=c("aut", "cre")),
-  person("Bill", "Denney", email="wdenney@humanpredictions.com", role=c("ctb"), comment=c(ORCID="0000-0002-5759-428X"))
+  person("Bill", "Denney", email="wdenney@humanpredictions.com", role=c("ctb"), comment=c(ORCID="0000-0002-5759-428X")),
+  person("Christophe", "Regouby", email="christophe.regouby@free.fr", role=c("ctb"))
   )
 Description: Pretty, human readable formatting of quantities.
     Time intervals: '1337000' -> '15d 11h 23m 20s'.
@@ -12,6 +13,7 @@ Description: Pretty, human readable formatting of quantities.
     Rounding: '99' with 3 significant digits -> '99.0'
     p-values: '0.00001' -> '<0.0001'.
     Colors: '#FF0000' -> 'red'.
+    Quantities: '1239437' -> '1.24 M'.
 License: MIT + file LICENSE
 LazyData: true
 URL: https://github.com/gaborcsardi/prettyunits

NAMESPACE

@@ -5,11 +5,13 @@ S3method(pretty_round,default)
 S3method(pretty_signif,data.frame)
 S3method(pretty_signif,default)
 export(compute_bytes)
+export(compute_num)
 export(pretty_bytes)
 export(pretty_color)
 export(pretty_colour)
 export(pretty_dt)
 export(pretty_ms)
+export(pretty_num)
 export(pretty_p_value)
 export(pretty_round)
 export(pretty_sec)

NEWS.md

@@ -1,6 +1,9 @@
 
 # development version
 
+* `pretty_num()` is added with all the [BIPM](https://www.bipm.org) agreed
+  unit prefix (#26, @cregouby).
+
 * New `pretty_round()` and `pretty_signif()` functions preserve the requested
   number of digits as character strings (#14, @billdenney).
 

R/numbers.R

@@ -0,0 +1,128 @@
+
+format_num <- local({
+
+  pretty_num <- function(number, style = c("default", "nopad", "6")) {
+
+    style <- switch(
+      match.arg(style),
+      "default" = pretty_num_default,
+      "nopad" = pretty_num_nopad,
+      "6" = pretty_num_6
+    )
+
+    style(number)
+  }
+
+  compute_num <- function(number, smallest_prefix = "y") {
+    prefixes0 <- c("y","z","a","f","p","n","u","m","", "k", "M", "G", "T", "P", "E", "Z", "Y")
+    zeroshif0 <- 9L
+
+    stopifnot(
+      is.numeric(number),
+      is.character(smallest_prefix),
+      length(smallest_prefix) == 1,
+      !is.na(smallest_prefix),
+      smallest_prefix %in% prefixes0
+    )
+
+    limits <- c( 999950 * 1000 ^ (seq_len(length(prefixes0) ) - (zeroshif0+1L)))
+    nrow <- length(limits)
+    low <- match(smallest_prefix, prefixes0)
+    zeroshift <- zeroshif0 +1L - low
+    prefixes <- prefixes0[low:length(prefixes0)]
+    limits <- limits[low:nrow]
+    nrow <- nrow - low + 1
+
+    neg <- number < 0 & !is.na(number)
+    number <- abs(number)
+    mat <- matrix(
+      rep(number, each = nrow),
+      nrow = nrow,
+      ncol = length(number)
+    )
+    mat2 <- matrix(mat < limits, nrow  = nrow, ncol = length(number))
+    exponent <- nrow - colSums(mat2) - (zeroshift -1L)
+    in_range <- function(exponent) {
+        max(min(exponent,nrow-zeroshift, na.rm = FALSE),1L-zeroshift, na.rm = TRUE)
+    }
+    if (length(exponent)) {
+      exponent <- sapply(exponent, in_range)
+    }
+    res <- number / 1000 ^ exponent
+    prefix <- prefixes[exponent + zeroshift]
+
+    ## Zero number
+    res[number == 0] <- 0
+    prefix[number == 0] <- prefixes[zeroshift]
+
+    ## NA and NaN number
+    res[is.na(number)] <- NA_real_
+    res[is.nan(number)] <- NaN
+    prefix[is.na(number)] <- "" # prefixes0[low] is meaningless    # Includes NaN as well
+
+    data.frame(
+      stringsAsFactors = FALSE,
+      amount = res,
+      prefix = prefix,
+      negative = neg
+    )
+  }
+
+  pretty_num_default <- function(number) {
+    szs <- compute_num(number)
+    amt <- szs$amount
+    sep <- " "
+
+    ## String. For fractions we always show two fraction digits
+    res <- character(length(amt))
+    int <- is.na(amt) | abs(amt - as.integer(amt)) <= .Machine$double.eps
+    res[int] <- format(
+      ifelse(szs$negative[int], -1, 1) * amt[int],
+      scientific = FALSE
+    )
+    res[!int] <- sprintf("%.2f", ifelse(szs$negative[!int], -1, 1) * amt[!int])
+
+    format(paste(res, szs$prefix,sep = sep), justify = "right")
+  }
+
+  pretty_num_nopad <- function(number) {
+    sub("^\\s+", "", pretty_num_default(number))
+  }
+
+  pretty_num_6 <- function(number) {
+    szs <- compute_num(number, smallest_prefix = "y")
+    amt <- round(szs$amount,2)
+    sep <- " "
+
+    na   <- is.na(amt)
+    nan  <- is.nan(amt)
+    neg  <- !na & !nan & szs$negative
+    l10p  <- !na & !nan & !neg & amt < 10
+    l100p <- !na & !nan & !neg & amt >= 10 & amt < 100
+    b100p <- !na & !nan & !neg & amt >= 100
+    l10n  <- !na & !nan & neg & amt < 10
+    l100n <- !na & !nan & neg & amt >= 10 & amt < 100
+    b100n <- !na & !nan & neg & amt >= 100
+
+    famt <- character(length(amt))
+    famt[na] <- "  NA"
+    famt[nan] <- " NaN"
+    famt[l10p] <- sprintf("%.2f", amt[l10p])
+    famt[l100p] <- sprintf("%.1f", amt[l100p])
+    famt[b100p] <- sprintf(" %.0f", amt[b100p])
+    famt[l10n] <- sprintf("-%.1f", amt[l10n])
+    famt[l100n] <- sprintf(" -%.0f", amt[l100n])
+    famt[b100n] <- sprintf("-%.0f", amt[b100n])
+
+    sub(" $","  ",paste0(famt, sep, szs$prefix))
+  }
+
+  structure(
+    list(
+      .internal     = environment(),
+      pretty_num  = pretty_num,
+      compute_num = compute_num
+    ),
+    class = c("standalone_num", "standalone")
+  )
+})

R/pretty-package.R

@@ -1,5 +1,13 @@
 
 #' Prettier formatting of quantities
 #'
+#' Render quantities with a pretty, human-readable formatting.
+#'  - Time intervals: '1337000' -> '15d 11h 23m 20s'.
+#'  - Vague time intervals: '2674000' -> 'about a month ago'.
+#'  - Bytes: '1337' -> '1.34 kB'.
+#'  - p-values: '0.00001' -> '<0.0001'.
+#'  - Colors: '#FF0000' -> 'red'.
+#'  - Quantities: '1239437' -> '1.24 M'.
+#' @docType package
 #' @name prettyunits
 "_PACKAGE"

R/xnumbers-docs.R

@@ -0,0 +1,33 @@
+
+#' Linear quantities in a human readable string
+#'
+#' Use `pretty_num()` to format numbers `compute_num()` is the underlying
+#' engine that may be useful for custom formatting.
+#' 
+#' @param number Numeric vector, number related to a linear quantity.
+#' @param style Formatting style:
+#'   * `"default"` is the original `pretty_num` formatting, and it always
+#'     pads the output, so that all vector elements are of the same width,
+#'   * `"nopad"` is similar, but does not pad the output,
+#'   * `"6"` always uses 6 characters,
+#'   The `"6"` style is useful if it is important that the output always
+#'   has the same width (number of characters), e.g. in progress bars.
+#'   See some examples below.
+#' @return Character vector, the formatted sizes.
+#'   For `compute_num`, a data frame with columns `amount`, `prefix`,
+#'   `negative`.
+#'
+#' @export
+#' @examples
+#' numbers <- c(1337, 1.3333e-5, 13333337, 1333333337, 133333333337)
+#' pretty_num(numbers)
+#' pretty_num(numbers, style = "nopad")
+#' pretty_num(numbers, style = "6")
+
+pretty_num <- format_num$pretty_num
+
+#' @rdname pretty_num
+#' @param smallest_prefix A character scalar, the smallest prefix to use.
+#' @export
+
+compute_num <- format_num$compute_num

README.Rmd

@@ -14,8 +14,14 @@ knitr::opts_chunk$set(
 
 # prettyunits
 
-The `prettyunits` package formats quantities in human readable form. Currently
-time units and information (i.e. bytes) are supported.
+The `prettyunits` package formats quantities in human readable form.
+* Time intervals: '1337000' -> '15d 11h 23m 20s'.
+* Vague time intervals: '2674000' -> 'about a month ago'.
+* Bytes: '1337' -> '1.34 kB'.
+* Rounding: '99' with 3 significant digits -> '99.0'
+* p-values: '0.00001' -> '<0.0001'.
+* Colors: '#FF0000' -> 'red'.
+* Quantities: '1239437' -> '1.24 M'.
 
 ## Installation
 
@@ -25,7 +31,7 @@ You can install the package from CRAN:
 install.packages("prettyunits")
 ```
 
-```{r}
+```{r include=FALSE}
 library(prettyunits)
 library(magrittr)
 ```
@@ -60,6 +66,28 @@ uls <- function(path = ".") {
 uls()
 ```
 
+## Quantities
+
+`pretty_num` formats number related to linear quantities in a human readable way:
+```{r}
+pretty_num(1337)
+pretty_num(-133337)
+pretty_num(1333.37e-9)
+```
+Be aware that the result is wrong in case of surface or volumes, and for any non-linear quantity.
+
+Here is a simple example of how to prettify a entire tibble
+```{r}
+library(tidyverse)
+tdf <- tribble( ~name, ~`size in m`, ~`speed in m/s`,
+                "land snail", 0.075, 0.001,
+                "photon", NA,  299792458,
+                "African plate", 10546330, 0.000000000681)
+tdf %>% mutate(across(where(is.numeric), pretty_num))
+```
+
+
+
 ## Time intervals
 
 `pretty_ms` formats a time interval given in milliseconds. `pretty_sec` does
@@ -126,5 +154,4 @@ names.
 ```{r}
 pretty_color("black")
 pretty_color("#123456")
-pretty_color("#123456", color_set="complete")
 ```