MINOR FEATURES

* `f_denom` family of functions picks up a `less.than.replace` argument to
  replace values that say zero with a less than signg folowed by a one and then
  the denomination.  For example, in `c(2, 1234)` the digit 2 becomes "<1K".

* `f_denom` picks up a `mix.denom` argument to allow for the mixing of
  denominations.  This is useful for tables with a total row that is a
  denomination higher than the rest of the column.

CHANGES

* The argument `less_than_replace` in `f_prop2percent` & `f_percent` has been
  replaced with `less.than.replace` to make dot case consistent for arguments
  across the package.

DESCRIPTION

@@ -9,7 +9,7 @@ Description: Format numbers and plots for publication; includes the removal of l
              named in a way that is consistent with usage, making their names easy to remember and easy to deploy.
 Depends: R (>= 3.2.0)
 Suggests: testthat
-Date: 2017-12-18
+Date: 2017-12-19
 License: GPL-2
 LazyData: TRUE
 Roxygen: list(wrap = FALSE)

NEWS

@@ -27,10 +27,23 @@ NEW FEATURES
 
 MINOR FEATURES
 
+* `f_denom` family of functions picks up a `less.than.replace` argument to
+  replace values that say zero with a less than signg folowed by a one and then
+  the denomination.  For example, in `c(2, 1234)` the digit 2 becomes "<1K".
+
+* `f_denom` picks up a `mix.denom` argument to allow for the mixing of
+  denominations.  This is useful for tables with a total row that is a
+  denomination higher than the rest of the column.
+
+
 IMPROVEMENTS
 
 CHANGES
 
+* The argument `less_than_replace` in `f_prop2percent` & `f_percent` has been
+  replaced with `less.than.replace` to make dot case consistent for arguments
+  across the package.
+
 
 
 

NEWS.md

@@ -27,10 +27,23 @@ numform 0.4.1 -
 
 **MINOR FEATURES**
 
+* `f_denom` family of functions picks up a `less.than.replace` argument to
+  replace values that say zero with a less than signg folowed by a one and then
+  the denomination.  For example, in `c(2, 1234)` the digit 2 becomes "<1K".
+
+* `f_denom` picks up a `mix.denom` argument to allow for the mixing of
+  denominations.  This is useful for tables with a total row that is a
+  denomination higher than the rest of the column.
+
+
 **IMPROVEMENTS**
 
 **CHANGES**
 
+* The argument `less_than_replace` in `f_prop2percent` & `f_percent` has been
+  replaced with `less.than.replace` to make dot case consistent for arguments
+  across the package.
+
 
 
 

R/alignment.R

@@ -74,7 +74,7 @@
 #'     print(include.rownames = FALSE)
 #' }
 alignment <- function(x, left = 'left', right = ifelse(left == 'l', 'r', 'right'),
-    additional.numeric = "^((<b>(&ndash;|\\+)</b>)|<[0-9.%-]+)$", sep = NULL, ...){
+    additional.numeric = "^((<b>(&ndash;|\\+)</b>)|<[0-9.%-]+)|(<?\\$?\\s*\\d+[KBM]))$", sep = NULL, ...){
 
     stopifnot(is.data.frame(x))
 

R/f_denom.R

@@ -14,6 +14,14 @@
 #' @param prefix A string to append to the front of elements.
 #' @param pad.char A character to use for leading padding if lengths of output
 #' are unequal.  Use \code{NA} to forgo padding.
+#' @param less.than.replace logical.  If \code{TRUE} values lower than lowest
+#' place value will be replaced with a less than sign followed by the
+#' \code{integer} representation of the place value.  For example, if \code{"$0K"}
+#' then replacement will be \code{"<1K"}.
+#' @param mix.denom logical.  If \code{TRUE} then denominations can be mixed.
+#' Typically this is not a good idea for the sake of comparison.  It is most
+#' useful when there is a total row which is a sum of the column and this value's
+#' denomination exceeds the denomination of the rest of the column.
 #' @param \ldots ignored.
 #' @return Returns an abbreviated vector of numbers.
 #' @export
@@ -24,6 +32,8 @@
 ## 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, 123436, 122126763, 1291673919), prefix = '$', mix.denom = TRUE)
+## f_denom(c(NA, 2, 12343676215, 122126763563, 1291673919), prefix = '$', pad.char = '')
 ## f_denom(c(NA, 2, 12343676215, 122126763563, 1291673919), relative = 1, prefix = '$')
 ## f_denom(c(NA, 2, 12343676215, 122126763563, 1291673919), relative = 9, prefix = '$')
 #'
@@ -89,21 +99,70 @@
 #'         geom_jitter(width = .2, height = 0, alpha = .2) +
 #'         scale_y_continuous(label = ff_thous(prefix = '$'))+
 #'         facet_wrap(~site)
+#'
+#' set.seed(10)
+#' data_frame(
+#'     w = paste(constant_months, rep(2016:2017, each = 12))[1:20] ,
+#'     x = rnorm(20, 200000, 75000)
+#' ) %>%
+#'     {
+#'         a <- .
+#'         rbind(
+#'             a,
+#'             a %>%
+#'                 mutate(w = 'Total') %>%
+#'                 group_by(w) %>%
+#'                 summarize(x = sum(x))
+#'         )
+#'     } %>%
+#'     mutate(
+#'         y = f_denom(x, prefix = '$'),
+#'         z = f_denom(x, mix.denom = TRUE, prefix = '$')
+#'     )  %>%
+#'     data.frame(stringsAsFactors = FALSE, check.names = FALSE) %>%
+#'     pander::pander(split.tables = Inf, justify = alignment(.))
 #' }
-f_denom <- function(x, relative = 0, prefix = "", pad.char = ifelse(prefix == "", NA, " "), ...) {
+f_denom <- function(x, relative = 0, prefix = "", pad.char = ifelse(prefix == "", NA, " "),
+    less.than.replace = FALSE, mix.denom = FALSE, ...) {
 
     #if (missing(pad.char)) pad.char <- ifelse(prefix == "", NA, " ")
 
+    if (mix.denom) {
+
+        nas <- is.na(x)
+        ## recurse the function on individual elements
+        out <- unlist(lapply(x, f_denom))
+        out <- gsub('(^[^0-9]*\\s*)(\\d+[MBK])', '\\2', out)
+        chars <- nchar(out)
+        m <- max(chars, na.rm = TRUE)
+        out <- paste0(
+            prefix,
+            sapply(chars, function(x) {
+                if (is.na(x)) return(NA)
+                paste(rep(pad.char, m - x), collapse = '')
+            }),
+            out
+        )
+        out[nas] <- NA
+
+        if (isTRUE(less.than.replace)){
+            out <- gsub('(^[^0-9]*\\s*)(\\d+)($)', '<\\11K', out)
+        }
+        return(out)
+    }
+
+    if (length(x) == 1 && is.na(x)) return(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.")
 
-    if (max(x,na.rm =TRUE) < 1e3) return(x)
+    if (max(x, na.rm = TRUE) < 1e3) return(x)
 
     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)}
+        thous = {ff_thous(relative = relative, prefix =prefix, pad.char = pad.char, less.than.replace = less.than.replace)},
+        mills = {ff_mills(relative = relative, prefix =prefix, pad.char = pad.char, less.than.replace = less.than.replace)},
+        bills = {ff_bills(relative = relative, prefix =prefix, pad.char = pad.char, less.than.replace = less.than.replace)}
     )
 
     fun(x)
@@ -122,7 +181,7 @@ ff_denom <- functionize(f_denom)
 #' @include utils.R
 #' @rdname f_denom
 f_bills <- function(x, relative = 0, digits = -9, prefix = "",
-    pad.char = ifelse(prefix == '', NA, ' '), ...) {
+    pad.char = ifelse(prefix == '', NA, ' '), less.than.replace = FALSE, ...) {
 
     #if (missing(pad.char)) pad.char <- ifelse(prefix == '', NA, ' ')
 
@@ -139,6 +198,11 @@ f_bills <- function(x, relative = 0, digits = -9, prefix = "",
     x <- ifelse(x == '.', '0B', x)
     if (!is.na(pad.char)) x <- f_pad_zero(x, width = max(nchar(x)), pad.char = pad.char)
     out <- paste0(prefix, x)
+
+    if (isTRUE(less.than.replace)){
+        gsub('(^[^0-9]*\\s*)(0.?0*)([KBM])', '<\\11\\3', out)
+    }
+
     out[nas] <- NA
     out
 }
@@ -154,7 +218,7 @@ ff_bills <- functionize(f_bills)
 #' @export
 #' @rdname f_denom
 f_mills <- function(x, relative = 0, digits = -6, prefix = "",
-    pad.char = ifelse(prefix == '', NA, ' '), ...) {
+    pad.char = ifelse(prefix == '', NA, ' '), less.than.replace = FALSE, ...) {
 
     #if (missing(pad.char)) pad.char <- ifelse(prefix == '', NA, ' ')
 
@@ -173,6 +237,11 @@ f_mills <- function(x, relative = 0, digits = -6, prefix = "",
     x <- ifelse(x == '.', '0M', x)
     if (!is.na(pad.char)) x <- f_pad_zero(x, width = max(nchar(x)), pad.char = pad.char)
     out <- paste0(prefix, x)
+
+    if (isTRUE(less.than.replace)){
+        gsub('(^[^0-9]*\\s*)(0.?0*)([KBM])', '<\\11\\3', out)
+    }
+
     out[nas] <- NA
     out
 }
@@ -189,7 +258,7 @@ ff_mills <- functionize(f_mills)
 #' @export
 #' @rdname f_denom
 f_thous <- function(x, relative = 0, digits = -3, prefix = "",
-    pad.char = ifelse(prefix == '', NA, ' '), ...) {
+    pad.char = ifelse(prefix == '', NA, ' '), less.than.replace = FALSE, ...) {
 
     #if (missing(pad.char)) pad.char <- ifelse(prefix == '', NA, ' ')
 
@@ -205,9 +274,15 @@ f_thous <- function(x, relative = 0, digits = -3, prefix = "",
 
     digit_warn(x, 'f_mills', 3)
 
-    x <- ifelse(x == '.', '0k', x)
+    x <- ifelse(x == '.', '0K', x)
+
     if (!is.na(pad.char)) x <- f_pad_zero(x, width = max(nchar(x)), pad.char = pad.char)
     out <- paste0(prefix, x)
+
+    if (isTRUE(less.than.replace)){
+        gsub('(^[^0-9]*\\s*)(0.?0*)([KBM])', '<\\11\\3', out)
+    }
+
     out[nas] <- NA
     out
 }

R/f_percent.R

@@ -7,8 +7,8 @@
 #' @param digits The number of digits to use.  Defaults to 1.  Can be set
 #' globally via: \code{options(numformdigits = n)} where n is the number of
 #' digits beyond the decimal point to include.
-#' @param less_than_replace logical.  If \code{TRUE} values lower than lowest
-#' place value, specified by \code{digits}, will be replaces with a less than
+#' @param less.than.replace logical.  If \code{TRUE} values lower than lowest
+#' place value, specified by \code{digits}, will be replaced with a less than
 #' sign followed by the \code{double} representation of the place value
 #' specified by \code{digits}.  For example, if \code{digits = 0} then
 #' replacement will be \code{"<1\%"} or if \code{digits = 2} then replacement will
@@ -24,9 +24,9 @@
 #' f_percent(c(0.0, 0, .2, -00.02, 1.122222, pi))
 #' f_prop2percent(c(.30, 1, 1.01, .33, .222, .01))
 #'
-#' f_percent(c(30, 33.45, .1), digits = 0, less_than_replace = TRUE)
+#' f_percent(c(30, 33.45, .1), digits = 0, less.than.replace = TRUE)
 #' f_prop2percent(c(.30, 1, 1.01, .33, .222, .01, .0001, NA), digits = 0,
-#'     less_than_replace = TRUE)
+#'     less.than.replace = TRUE)
 #'
 #' \dontrun{
 #' if (!require("pacman")) install.packages("pacman")
@@ -41,11 +41,11 @@
 #'         facet_wrap(~cyl, ncol = 1) +
 #'         scale_y_continuous(labels = ff_prop2percent(digits = 0))
 #' }
-f_percent <- function(x, digits = getOption("numformdigits"), less_than_replace = FALSE, ...) {
+f_percent <- function(x, digits = getOption("numformdigits"), less.than.replace = FALSE, ...) {
 
     out <- f_num(x, digits = digits, s="%", ...)
 
-    if (isTRUE(less_than_replace)){
+    if (isTRUE(less.than.replace)){
         if (is.null(digits)) digits <- 1
         repl <- replace_less_than(digits, percent = TRUE)
         out[x < repl[['prop_cut']]] <- repl[['replacement']]
@@ -67,11 +67,11 @@ ff_percent <- functionize(f_percent)
 #'
 #' @rdname f_percent
 #' @export
-f_prop2percent <- function(x, digits = getOption("numformdigits"), less_than_replace = FALSE, ...) {
+f_prop2percent <- function(x, digits = getOption("numformdigits"), less.than.replace = FALSE, ...) {
 
     out <- f_num(100*x, digits = digits, s="%", ...)
 
-    if (isTRUE(less_than_replace)){
+    if (isTRUE(less.than.replace)){
         if (is.null(digits)) digits <- 1
         repl <- replace_less_than(digits, percent = FALSE)
         out[x < repl[['prop_cut']]] <- repl[['replacement']]

README.md

@@ -74,7 +74,7 @@ to **ggplot2** `scale_x/y_type` functions (see [Plotting](#plotting) for
 usage).
 
 <!-- html table generated in R 3.4.2 by xtable 1.8-2 package -->
-<!-- Fri Dec 15 22:57:04 2017 -->
+<!-- Tue Dec 19 08:51:04 2017 -->
 <table>
 <tr>
 <td>
@@ -455,7 +455,7 @@ alignment.
 <th align="right">PropWon</th>
 <th align="right">PropLost</th>
 <th align="right">%ΔWinLoss</th>
-<th align="right">ΔWinLoss</th>
+<th align="left">ΔWinLoss</th>
 </tr>
 </thead>
 <tbody>
@@ -469,7 +469,7 @@ alignment.
 <td align="right">17%</td>
 <td align="right">9%</td>
 <td align="right">0%</td>
-<td align="right"><b>+</b></td>
+<td align="left"><b>+</b></td>
 </tr>
 <tr class="even">
 <td align="left"></td>
@@ -481,7 +481,7 @@ alignment.
 <td align="right">33%</td>
 <td align="right">20%</td>
 <td align="right">-13%</td>
-<td align="right"><b>+</b></td>
+<td align="left"><b>+</b></td>
 </tr>
 <tr class="odd">
 <td align="left"></td>
@@ -493,7 +493,7 @@ alignment.
 <td align="right">87%</td>
 <td align="right">48%</td>
 <td align="right">11%</td>
-<td align="right"><b>+</b></td>
+<td align="left"><b>+</b></td>
 </tr>
 <tr class="even">
 <td align="left"></td>
@@ -505,7 +505,7 @@ alignment.
 <td align="right">30%</td>
 <td align="right">19%</td>
 <td align="right">-13%</td>
-<td align="right"><b>+</b></td>
+<td align="left"><b>+</b></td>
 </tr>
 <tr class="odd">
 <td align="left">East Coast</td>
@@ -517,7 +517,7 @@ alignment.
 <td align="right">9%</td>
 <td align="right">18%</td>
 <td align="right">0%</td>
-<td align="right"><b>–</b></td>
+<td align="left"><b>–</b></td>
 </tr>
 <tr class="even">
 <td align="left"></td>
@@ -529,7 +529,7 @@ alignment.
 <td align="right">15%</td>
 <td align="right">16%</td>
 <td align="right">86%</td>
-<td align="right"><b>–</b></td>
+<td align="left"><b>–</b></td>
 </tr>
 <tr class="odd">
 <td align="left"></td>
@@ -541,7 +541,7 @@ alignment.
 <td align="right">74%</td>
 <td align="right">9%</td>
 <td align="right">811%</td>
-<td align="right"><b>+</b></td>
+<td align="left"><b>+</b></td>
 </tr>
 <tr class="even">
 <td align="left"></td>
@@ -553,7 +553,7 @@ alignment.
 <td align="right">30%</td>
 <td align="right">26%</td>
 <td align="right">-86%</td>
-<td align="right"><b>+</b></td>
+<td align="left"><b>+</b></td>
 </tr>
 </tbody>
 </table>