[R-gregmisc-users] SF.net SVN: r-gregmisc:[1933] trunk/gdata

[<wa...@us...>]

Revision: 1933
          http://sourceforge.net/p/r-gregmisc/code/1933
Author:   warnes
Date:     2015-04-22 22:34:53 +0000 (Wed, 22 Apr 2015)
Log Message:
-----------
Modify gdaata:object.size to generate S3 objects of class 'object_sizes' (note the final 's') to avoid conflicts with methods in utils for object_size.

Modified Paths:
--------------
    trunk/gdata/NAMESPACE
    trunk/gdata/R/object.size.R

Modified: trunk/gdata/NAMESPACE
===================================================================
--- trunk/gdata/NAMESPACE	2015-04-22 22:32:01 UTC (rev 1932)
+++ trunk/gdata/NAMESPACE	2015-04-22 22:34:53 UTC (rev 1933)
@@ -52,7 +52,7 @@
        xlsFormats,
 
        ## Object size stuff
-       object.size, as.object_size, is.object_size, humanReadable,
+       object.size, as.object_sizes, is.object_sizes, humanReadable,
 
        ## getDateTime stuff
        getYear, getMonth, getDay, getHour, getMin, getSec,
@@ -129,8 +129,8 @@
 S3method(nobs, lm)      # now provided by stats package
 
 ## Object size stuff
-S3method(print, object_size)
-S3method(c, object_size)
+S3method(print, object_sizes)
+S3method(c, object_sizes)
 
 ## unknown stuff
 S3method(isUnknown, default)

Modified: trunk/gdata/R/object.size.R
===================================================================
--- trunk/gdata/R/object.size.R	2015-04-22 22:32:01 UTC (rev 1932)
+++ trunk/gdata/R/object.size.R	2015-04-22 22:34:53 UTC (rev 1933)
@@ -4,15 +4,15 @@
 ### $Id$
 ### Time-stamp: <2008-12-30 08:05:43 ggorjan>
 ###------------------------------------------------------------------------
-
 object.size <- function(...) 
 {
   structure(sapply(list(...),
                    utils::object.size),
-                   class=c("object_size", "numeric"))
+                   class=c("object_sizes", "numeric"))
 }
 
-print.object_size <- function(x, quote=FALSE, humanReadable, ...)
+print.object_sizes <- function(x, quote=FALSE, units,
+                                  humanReadable, ...)
 {  
   xOrig <- x
   if(missing(humanReadable)) {
@@ -28,37 +28,31 @@
   invisible(xOrig)
 }
 
-is.object_size <- function(x) inherits(x, what="object_size")
+is.object_sizes <- function(x) inherits(x, what="object_sizes")
    
-as.object_size <- function(x)
+as.object_sizes <- function(x)
 {
   if(!is.numeric(x)) stop("'x' must be numeric/integer")
-  class(x) <- c("object_size", "numeric")
+  class(x) <- c("object_sizes", "numeric")
   x
 }
 
-c.object_size <- function(..., recursive=FALSE)
+c.object_sizes <- function(..., recursive=FALSE)
 {
   x <- NextMethod()
-  if(is.numeric(x)) class(x) <- c("object_size", "numeric")
+  if(is.numeric(x)) class(x) <- c("object_sizes", "numeric")
   x
 }
 
-humanReadable <- function(x, standard="SI", digits=1, width=3, sep=" ")
+humanReadable <- function(x, standard="SI", units, digits=1, width=3, sep=" ")
 {
   ## --- Setup ---
 
-  if(any(x < 0)) stop("'x' must be positive")
-  if(standard == "SI") {
-    suffix <- c("B", "kB",  "MB",  "GB",  "TB",  "PB",  "EB",  "ZB",  "YB")
-    base <- 1000
-  } else {
-    suffix <- c("B", "KiB", "MiB", "GiB", "TiB", "PiB", "EiB", "ZiB", "YiB")
-    base <- 1024
-  }
+  suffix.decimal <- c("B", "kB",  "MB",  "GB",  "TB",  "PB",  "EB",  "ZB",  "YB")
+  suffix.binary  <- c("B", "KiB", "MiB", "GiB", "TiB", "PiB", "EiB", "ZiB", "YiB")
+    
+  ## --- Functions ---
 
-  ## --- Apply ---
-
   .applyHuman <- function(x, base, suffix, digits, width, sep)
   {
     ## Which suffix should we use?
@@ -85,8 +79,29 @@
     paste(x, suffix[i], sep=sep)
   }
 
-  sapply(X=x, FUN=".applyHuman", base=base, suffix=suffix, digits=digits,
-         width=width, sep=sep)
+  ## -- Work
+  
+  if(any(x < 0)) stop("'x' must be positive")
+  if(standard == "SI") {
+    suffix <- suffix.decimal
+    base <- 10^3
+  } else {
+    suffix <- suffix.binary
+    base <- 2^10
+  }
+
+  if(!missing(units))
+      {
+          units <- match.arg( units, suffix )
+          power <- which( units %in% suffix ) -1
+          X <- x/(base^power)
+          X <- format.default(round(x=x, digits=digits), nsmall=digits)
+          X <- paste(X, units)
+          X
+      }
+  else
+      sapply(X=x, FUN=".applyHuman", base=base, suffix=suffix, digits=digits,
+             width=width, sep=sep)
 }
 
 ###------------------------------------------------------------------------

This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.