[H5r-commits] r34 - inst tests

[noreply at r-forge.r-project.org]

Author: extemporaneousb
Date: 2010-06-15 17:32:24 +0200 (Tue, 15 Jun 2010)
New Revision: 34

Added:
   inst/performance.py
   tests/tinyTestHarness.R
Log:
Performance Enhancements

Added: inst/performance.py
===================================================================
--- inst/performance.py	                        (rev 0)
+++ inst/performance.py	2010-06-15 15:32:24 UTC (rev 34)
@@ -0,0 +1,31 @@
+from h5py import *
+from numpy import *
+import time
+
+h5 = File("/home/NANOFLUIDICS/jbullard/local/big.h5")
+ds = h5["cdata_1e3"]
+N  = 100
+
+def f(ds, N):
+    start = random.randint(0, len(ds), N)
+    end   = start + random.exponential(1000, N) + 1
+    end[end > len(ds)] = len(ds)
+    
+    for j in zip(start, end):
+        z = ds[j[0]:j[1]]
+    return True
+
+
+def myTime(K, ds, N):
+    res = [0]*K
+
+    for i in range(0, K):
+        s = time.time()
+        f(ds, N)
+        res[i] = time.time() - s
+    return res
+
+times = myTime(100, ds, N = 1000)
+o     = file('pyres.txt', 'w')
+o.write(" ".join(map(str, times)))
+o.close()

Added: tests/tinyTestHarness.R
===================================================================
--- tests/tinyTestHarness.R	                        (rev 0)
+++ tests/tinyTestHarness.R	2010-06-15 15:32:24 UTC (rev 34)
@@ -0,0 +1,51 @@
+assertError <- function(expr) {
+  tryCatch({{expr}; FALSE}, simpleError = function(e) {
+    return(TRUE)
+  })
+}
+
+TestHarness <- function() {
+  tests <- list()
+
+  getTime <- function(elt) {
+    elt[["time"]][3]
+  }
+  getResult <- function(elt) {
+    elt[["result"]]
+  }
+  printResults <- function() {
+    mwidth <- max(nchar(names(tests))) + 5
+    fmtString <- paste("\t%-", mwidth, "s %-10g %-10s\n", sep = "")
+
+    cat(sprintf("%s Results for %d tests %s \n\n", paste(rep("-", 30), collapse = ""), length(tests),
+                paste(rep("-", 30), collapse = "")))
+    
+    for (elt in names(tests)) {
+      cat(sprintf(fmtString, elt, getTime(tests[[elt]]), getResult(tests[[elt]])))
+    }
+  }
+  
+  function(nm, test, action = c("test", "print", "throw")) {
+    action <- match.arg(action)
+    switch(action,
+           test = {
+             tm <- system.time({
+               b <- tryCatch(test, simpleError = function(e) {
+                 return(FALSE)
+               }, simpleWarning = function(e) return(FALSE))
+             })
+             tests[[nm]] <<- list("result" = b, "time" = tm)
+           },
+           print = {
+             printResults()
+           },
+           throw = {
+             errs <- ! sapply(tests, getResult)
+             if (any(errs)) {
+               stop(simpleError(paste("Tests in error:\n", paste(paste("\t", names(tests)[errs], sep = ""),
+                                                                 collapse = "\n"),
+                                      sep = "")))
+             }
+           })
+  }
+}