added f_denom as generalize f_bills

trinker · Mar 26, 2017 · 3f536f2 · 3f536f2
1 parent 8d09fa9
commit 3f536f2
Show file tree

Hide file tree

Showing 25 changed files with 251 additions and 103 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,25 +1,25 @@
 Package: numform
 Title: Tools to Format Numbers for Publication
 Version: 0.0.1
-Authors@R: c(person("Tyler", "Rinker", email = "tyler.rinker@gmail.com", role = c("aut", "cre")))
+Authors@R: c(person("Tyler", "Rinker", email =
+        "tyler.rinker@gmail.com", role = c("aut", "cre")))
 Maintainer: Tyler Rinker <tyler.rinker@gmail.com>
-Description: Format numbers for publication; includes the removal of leading
-    zeros, standardization of number of digits, and a p-value formatter.
-Depends:
-    R (>= 3.2.0)
-Suggests:
-    testthat
-Date: 2017-03-21
+Description: Format numbers for publication; includes the removal of
+        leading zeros, standardization of number of digits, and a
+        p-value formatter.
+Depends: R (>= 3.2.0)
+Suggests: testthat
+Date: 2017-03-26
 License: GPL-2
 LazyData: TRUE
 Roxygen: list(wrap = FALSE)
-RoxygenNote: 5.0.1
-Collate:
+RoxygenNote: 6.0.1
+Collate: 
     'as_factor.R'
     'utils.R'
     'f_affix.R'
-    'f_bills.R'
     'f_comma.R'
+    'f_denom.R'
     'f_dollar.R'
     'f_month.R'
     'f_num.R'

diff --git a/NAMESPACE b/NAMESPACE
@@ -12,6 +12,7 @@ export(as_factor)
 export(f_affix)
 export(f_bills)
 export(f_comma)
+export(f_denom)
 export(f_dollar)
 export(f_mean_sd)
 export(f_mills)
@@ -32,6 +33,7 @@ export(f_weekday)
 export(ff_affix)
 export(ff_bills)
 export(ff_comma)
+export(ff_denom)
 export(ff_dollar)
 export(ff_mean_sd)
 export(ff_mills)

diff --git a/R/f_bills.R → R/f_denom.R b/R/f_bills.R → R/f_denom.R
@@ -1,6 +1,8 @@
 #' Abbreviate Numbers
 #'
-#' Use the K (thousands), M (millions), and B (billions) with abbreviated numbers.
+#' Use the denomination abbreviations K (thousands), M (millions), and
+#' B (billions) with abbreviated numbers.\cr\code{f_denom} - Auto-detect the
+#' maximum denomination and attempt to use it.
 #'
 #' @param x A vector of large numbers.
 #' @param relative A factor relative to the current \code{digits} being rounded.
@@ -14,8 +16,16 @@
 #' @param \ldots ignored.
 #' @return Returns an abbreviated vector of numbers.
 #' @export
-#' @rdname number_abbreviation
+#' @rdname f_denom
 #' @examples
+## f_denom(c(12345, 12563, 191919), prefix = '$')
+## f_denom(c(12345, 12563, 191919), prefix = '$', pad.char = '')
+## f_denom(c(1234365, 122123563, 12913919), prefix = '$')
+## f_denom(c(12343676215, 122126763563, 1291673919), prefix = '$')
+## f_denom(c(NA, 2, 12343676215, 122126763563, 1291673919), prefix = '$')
+## f_denom(c(NA, 2, 12343676215, 122126763563, 1291673919), relative = 1, prefix = '$')
+## f_denom(c(NA, 2, 12343676215, 122126763563, 1291673919), relative = 9, prefix = '$')
+#'
 #' f_thous(1234)
 #' f_thous(12345)
 #' f_thous(123456)
@@ -79,11 +89,42 @@
 #'         scale_y_continuous(label = ff_thous(prefix = '$'))+
 #'         facet_wrap(~site)
 #' }
-f_bills <- function(x, relative = 0, digits = -9, prefix = "", pad.char, ...) {
+f_denom <- function(x, relative = 0, prefix = "", pad.char = ifelse(prefix == "", NA, " "), ...) {
+
+    #if (missing(pad.char)) pad.char <- ifelse(prefix == "", NA, " ")
+
+    md <- max(nchar(round(x, 0)), na.rm = TRUE)
+    digs <- ifelse(md <= 6, 'thous', ifelse(md <= 9, 'mills', ifelse(md <= 12, 'bills', NA)))
+    if (is.na(digs)) stop("Element(s) in `x` are greater than 12 digits.")
+
+    fun <- switch(digs,
+        thous = {ff_thous(relative = relative, prefix =prefix, pad.char = pad.char)},
+        mills = {ff_mills(relative = relative, prefix =prefix, pad.char = pad.char)},
+        bills = {ff_bills(relative = relative, prefix =prefix, pad.char = pad.char)}
+    )
+
+    fun(x)
+
+}
+
+#' @export
+#' @include utils.R
+#' @rdname f_denom
+ff_denom <- functionize(f_denom)
 
-    if (missing(pad.char)) pad.char <- ifelse(prefix == '', NA, ' ')
+
+#' @description \code{f_bills} - Force the abbreviation to the billions
+#' denomination (B).
+#' @export
+#' @include utils.R
+#' @rdname f_denom
+f_bills <- function(x, relative = 0, digits = -9, prefix = "",
+    pad.char = ifelse(prefix == '', NA, ' '), ...) {
+
+    #if (missing(pad.char)) pad.char <- ifelse(prefix == '', NA, ' ')
 
     digits <- digits + relative
+    nas <- is.na(x)
 
     if (relative > 0) {
         x <- sprintf(paste0("%.", 9 + digits, "f"), round(x, digits)/1e+09)
@@ -94,24 +135,28 @@ f_bills <- function(x, relative = 0, digits = -9, prefix = "", pad.char, ...) {
 
     x <- ifelse(x == '.', '0B', x)
     if (!is.na(pad.char)) x <- f_pad_zero(x, width = max(nchar(x)), pad.char = pad.char)
-    paste0(prefix, x)
-
+    out <- paste0(prefix, x)
+    out[nas] <- NA
+    out
 }
 
 
 #' @export
 #' @include utils.R
-#' @rdname number_abbreviation
+#' @rdname f_denom
 ff_bills <- functionize(f_bills)
 
-
+#' @description \code{f_mills} - Force the abbreviation to the millions
+#' denomination (B).
 #' @export
-#' @rdname number_abbreviation
-f_mills <- function(x, relative = 0, digits = -6, prefix = "", pad.char, ...) {
+#' @rdname f_denom
+f_mills <- function(x, relative = 0, digits = -6, prefix = "",
+    pad.char = ifelse(prefix == '', NA, ' '), ...) {
 
-    if (missing(pad.char)) pad.char <- ifelse(prefix == '', NA, ' ')
+    #if (missing(pad.char)) pad.char <- ifelse(prefix == '', NA, ' ')
 
     digits <- digits + relative
+    nas <- is.na(x)
 
     if (relative > 0) {
         x <- sprintf(paste0("%.", 6 + digits, "f"), round(x, digits)/1e+06)
@@ -124,25 +169,29 @@ f_mills <- function(x, relative = 0, digits = -6, prefix = "", pad.char, ...) {
 
     x <- ifelse(x == '.', '0M', x)
     if (!is.na(pad.char)) x <- f_pad_zero(x, width = max(nchar(x)), pad.char = pad.char)
-    paste0(prefix, x)
-
+    out <- paste0(prefix, x)
+    out[nas] <- NA
+    out
 }
 
 
 #' @export
 #' @include utils.R
-#' @rdname number_abbreviation
+#' @rdname f_denom
 ff_mills <- functionize(f_mills)
 
 
-
+#' @description \code{f_thous} - Force the abbreviation to the thousands
+#' denomination (B).
 #' @export
-#' @rdname number_abbreviation
-f_thous <- function(x, relative = 0, digits = -3, prefix = "", pad.char, ...) {
+#' @rdname f_denom
+f_thous <- function(x, relative = 0, digits = -3, prefix = "",
+    pad.char = ifelse(prefix == '', NA, ' '), ...) {
 
-    if (missing(pad.char)) pad.char <- ifelse(prefix == '', NA, ' ')
+    #if (missing(pad.char)) pad.char <- ifelse(prefix == '', NA, ' ')
 
     digits <- digits + relative
+    nas <- is.na(x)
 
     if (relative > 0) {
         x <- sprintf(paste0("%.", 3 + digits, "f"), round(x, digits)/1e+03)
@@ -155,15 +204,16 @@ f_thous <- function(x, relative = 0, digits = -3, prefix = "", pad.char, ...) {
 
     x <- ifelse(x == '.', '0k', x)
     if (!is.na(pad.char)) x <- f_pad_zero(x, width = max(nchar(x)), pad.char = pad.char)
-    paste0(prefix, x)
-
+    out <- paste0(prefix, x)
+    out[nas] <- NA
+    out
 }
 
 
 
 #' @export
 #' @include utils.R
-#' @rdname number_abbreviation
+#' @rdname f_denom
 ff_thous <- functionize(f_thous)
 
 

diff --git a/README.Rmd b/README.Rmd
@@ -100,6 +100,20 @@ f_bills(12345678912)
 f_bills(123456789123)
 ```
 
+...or auto-detect:
+
+```{r}
+f_denom(1234)
+f_denom(12345)
+f_denom(123456)
+f_denom(1234567)
+f_denom(12345678)
+f_denom(123456789)
+f_denom(1234567891)
+f_denom(12345678912)
+f_denom(123456789123)
+```
+
 ## Commas
 
 ```{r, warn=FALSE}
@@ -122,6 +136,13 @@ f_dollar(c(0.0, 0, .2, -00.02, 1122222, pi)) %>%
     f_comma()
 ```
 
+Sometimes one wants to lop off digits of money in order to see the important digits, the real story.  The `f_denom` family of functions can do job.
+
+```{r, warn=FALSE}
+f_denom(c(12345267, 98765433, 658493021), prefix = '$')
+f_denom(c(12345267, 98765433, 658493021), relative = 1, prefix = '$')
+```
+
 ## Tables
 
 ```{r}
@@ -139,15 +160,13 @@ dat <- data_frame(
     PropLost = Lost/YearStart
 )
 
-thous <- ff_thous(relative = -1, prefix = '$')
-percents <- ff_prop2percent(digits = 0)
 
 dat %>%
     group_by(Team) %>%
     mutate(ChangeWinLoss = fv_percent_diff(WinLossRate, 0)) %>%
     ungroup() %>%
-    mutate_at(vars(Won:Lost), funs(thous)) %>%
-    mutate_at(vars(PropWon, PropLost), funs(percents)) %>%
+    mutate_at(vars(Won:Lost), .funs = ff_thous(relative = -1, prefix = '$')) %>%
+    mutate_at(vars(PropWon, PropLost), .funs = ff_prop2percent(digits = 0)) %>%
     mutate(
         YearStart = f_mills(YearStart, 1, prefix = '$'),
         Team = fv_runs(Team),