Merge pull request #42 from hcraT/refactor_bytes

Reimplementation of the bytes formatter

DESCRIPTION

@@ -12,7 +12,8 @@ Authors@R: c(
       person("ProPublica", role="dtc", comment="StateFace font"),
       person("Aditya", "Kothari", role=c("aut", "ctb"), comment="Core functionality of horizon plots"),
       person("Ather", role="dtc", comment="Core functionality of horizon plots"),
-      person("Jonathan","Sidi", role=c("aut","ctb"), comment="Annotation ticks")
+      person("Jonathan","Sidi", role=c("aut","ctb"), comment="Annotation ticks"),
+      person("Tarcisio","Fedrizzi", role="ctb", comment="Bytes formatter")
     )
 Description: A compendium of new geometries, coordinate systems, statistical 
     transformations, scales and fonts for 'ggplot2', including splines, 1d and 2d densities, 

R/formatters.r

@@ -1,9 +1,9 @@
 #' Bytes formatter: convert to byte measurement and display symbol.
 #'
 #' @return a function with three parameters, \code{x}, a numeric vector that
-#'   returns a character vector, \code{symbol} the byte symbol (e.g. "\code{Kb}")
+#'   returns a character vector, \code{symbol} a single or a vector of byte
-#'   desired and the measurement \code{units} (traditional \code{binary} or
+#' symbol(s) (e.g. "\code{Kb}") desired and the measurement \code{units}
-#'   \code{si} for ISI metric units).
+#' (traditional \code{binary} or \code{si} for ISI metric units).
 #' @param x a numeric vector to format
 #' @param symbol byte symbol to use. If "\code{auto}" the symbol used will be
 #'   determined by the maximum value of \code{x}. Valid symbols are
@@ -12,6 +12,8 @@
 #'   equivalents and "\code{iB}" equivalents.
 #' @param units which unit base to use, "\code{binary}" (1024 base) or
 #'   "\code{si}" (1000 base) for ISI units.
+#' @param only_highest Whether to use the unit of the highest number or
+#'   each number uses its own unit.
 #' @references Units of Information (Wikipedia) :
 #'   \url{http://en.wikipedia.org/wiki/Units_of_information}
 #' @export
@@ -21,8 +23,8 @@
 #' Kb(sample(3000000000, 10))
 #' Mb(sample(3000000000, 10))
 #' Gb(sample(3000000000, 10))
-byte_format <- function(symbol="auto", units="binary") {
+byte_format <- function (symbol = "auto", units = "binary", only_highest = TRUE) {
-  function(x) bytes(x, symbol, units)
+  function(x) bytes(x, symbol, units, only_highest)
 }
 
 #' @export
@@ -39,47 +41,40 @@ Gb <- byte_format("Gb", "binary")
 
 #' @export
 #' @rdname byte_format
-bytes <- function(x, symbol="auto", units=c("binary", "si")) {
+bytes <- function (x, symbol = "auto", units = c("binary", "si"),
-
+                   only_highest = FALSE) {
-  symbol <- match.arg(symbol, c("auto",
+  bin_names <- c("bytes", "Kb", "Mb", "Gb", "Tb", "Pb", "Eb", "Zb", "Yb")
-        "b",  "Kb",  "Mb",  "Gb",  "Tb",  "Pb",  "Eb",  "Zb",  "Yb",
+  si_names  <- c("bytes", "KiB", "MiB", "GiB", "TiB", "PiB", "EiB", "ZiB", "YiB")
-				"B",  "KB",  "MB",  "GB",  "TB",  "PB",  "EB",  "ZB",  "YB",
+  units     <- match.arg(units, c("binary", "si"))
-				     "KiB", "MiB", "GiB", "TiB", "PiB", "EiB", "ZiB", "YiB"))
+  valid_names <- c("auto", if (units == "binary") {
-
+    c(bin_names, toupper(bin_names))
-  units <- match.arg(units, c("binary", "si"))
+  } else {
-
+    si_names
-  base <- switch(units, `binary`=1024, `si`=1000)
+  })
-
+  symbol    <- valid_names[pmatch(symbol, valid_names, duplicates.ok = TRUE)]
-  if (symbol == "auto") {
+  if (any(is.na(symbol))) {
-    symbol <-
+    stop(gettextf("Symbol must be one of %s", paste(dQuote(valid_names), collapse = ", ")))
-      if      (max(x) >= (base^5)) { "Pb" }
-      else if (max(x) >= (base^4)) { "Tb" }
-      else if (max(x) >= (base^3)) { "Gb" }
-      else if (max(x) >= (base^2)) { "Kb" }
-      else if (max(x) >= (base^1)) { "Mb" }
-      else                         {  "b" }
   }
+  base      <- switch(units, binary = 1024,      si = 1000)
+  out_names <- switch(units, binary = bin_names, si = si_names)
+  sym_len   <- length(symbol)
+  inp_len   <- length(x)
+  if (sym_len == 1) {
+    symbol  <- rep(symbol, inp_len)
+    sym_len <- inp_len
+  }
+  if (sym_len != inp_len) {
+    stop("Symbols argument must be either long 1 or of the same length as the input vector.")
+  }
+  symbol <- ifelse(symbol == "auto",
+    pmax(floor(log(x, base)), 0),
+    match(tolower(symbol), tolower(out_names)) - 1)
+  if (only_highest) {
+    symbol <- max(symbol, na.rm = TRUE)
+  }
+  res <- paste(scales::comma(round(x / base^symbol, 1L)),
+               out_names[symbol + 1])
+  ifelse(!is.na(x), res, x)
+}
 
-  switch(symbol,
-	   "b" =,  "B"  = paste(x,                                 "bytes"),
-
-	   "Kb" =, "KB" = paste(scales::comma(round(x/(base^1), 1L)), "Kb"),
-	   "Mb" =, "MB" = paste(scales::comma(round(x/(base^2), 1L)), "Mb"),
-	   "Gb" =, "GB" = paste(scales::comma(round(x/(base^3), 1L)), "Gb"),
-	   "Tb" =, "TB" = paste(scales::comma(round(x/(base^4), 1L)), "Tb"),
-	   "Pb" =, "PB" = paste(scales::comma(round(x/(base^5), 1L)), "Pb"),
-	   "Eb" =, "EB" = paste(scales::comma(round(x/(base^6), 1L)), "Eb"),
-	   "Zb" =, "ZB" = paste(scales::comma(round(x/(base^7), 1L)), "Zb"),
-	   "Yb" =, "YB" = paste(scales::comma(round(x/(base^8), 1L)), "Yb"),
-
-	   "KiB"        = paste(scales::comma(round(x/(base^1), 1L)), "KiB"),
-	   "MiB"        = paste(scales::comma(round(x/(base^2), 1L)), "MiB"),
-	   "GiB"        = paste(scales::comma(round(x/(base^3), 1L)), "GiB"),
-	   "TiB"        = paste(scales::comma(round(x/(base^4), 1L)), "TiB"),
-	   "PiB"        = paste(scales::comma(round(x/(base^5), 1L)), "PiB"),
-	   "EiB"        = paste(scales::comma(round(x/(base^6), 1L)), "EiB"),
-	   "ZiB"        = paste(scales::comma(round(x/(base^7), 1L)), "ZiB"),
-	   "YiB"        = paste(scales::comma(round(x/(base^8), 1L)), "YiB")
-  )
 
-}