[H5r-commits] r19 - / inst/h5_files tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon May 3 19:57:03 CEST 2010
Author: extemporaneousb
Date: 2010-05-03 19:57:02 +0200 (Mon, 03 May 2010)
New Revision: 19
Added:
tests/
tests/.Rhistory
tests/testall.R
Modified:
inst/h5_files/ex_1.h5
inst/h5_files/makeH5.py
Log:
Added a proper test harness.
Modified: inst/h5_files/ex_1.h5
===================================================================
(Binary files differ)
Modified: inst/h5_files/makeH5.py
===================================================================
--- inst/h5_files/makeH5.py 2010-04-30 17:04:56 UTC (rev 18)
+++ inst/h5_files/makeH5.py 2010-05-03 17:57:02 UTC (rev 19)
@@ -19,34 +19,14 @@
a = random.randint(0, int(1e6), 3 * 7 * 9)
a = a.reshape((3, 7, 9))
-g.create_dataset("ds_3", data = a, maxshape = (None, None, None))
+g.create_dataset("ds_3", data = a, maxshape = (None, None, None))
g.create_dataset("ds_4", data = s.reshape((2, 10)))
-
g.create_dataset("ds_5", data = a.reshape(21, 9))
-
-
g.create_dataset("ds_6", data = random.randint(0, int(1e4), int(1e5)), dtype = "uint32")
+a = random.rand(1000 * 10 * 5) * 10000
+a = a.reshape(1000, 10, 5)
+g.create_dataset("ds_7", data = a, maxshape = (None, None, None))
f.close()
-
-##
-## some reading and testing.
-##
-f = h5py.File("ex_1.h5")
-g = f["group_1"]
-d = g["ds_6"]
-
-import time
-
-s = time.time()
-k = 100000
-n = 100
-
-for i in xrange(0, n):
- b = random.randint(0, d.shape[0] - k)
- e = b + k
- print len(d[b:e])
-
-print "total time %d" % int(time.time() - s)
Added: tests/.Rhistory
===================================================================
--- tests/.Rhistory (rev 0)
+++ tests/.Rhistory 2010-05-03 17:57:02 UTC (rev 19)
@@ -0,0 +1,148 @@
+files
+g
+slotNames(g)
+getName(g)
+name(g)
+g at name
+for (i,j in c(1,2,3), c(3,4,5)) {
+system.time({1:100})
+system.time({1:100})[1]
+system.time({1:100})[2]
+system.time({1:100})[4]
+TH()
+TH()
+f
+d
+TH()
+dim(d)
+TH()
+assertError(d[,1:12])
+TH()
+ds2
+ds2
+ds2
+ds2[]
+ds2[] == ds2M[]
+all(ds2[] == ds2M[])
+ds2[1:5]
+ds2[1:5] == ds2[1:5]
+ds2M[1:5] == ds2[1:5]
+TH()
+TH
+TH()
+a
+b
+c
+a
+a[]
+b[]
+b[] == 1:7
+oc
+c
+c[]
+c[]
+ds2
+ds2[]
+ds3
+ds3
+ds3[]
+ds3
+ds3[]
+ds3M[]
+xx = ds3[]
+xx[]
+id3
+id3
+f()
+f()
+TH()
+TH()
+TH()
+TH("gg", FALSE)
+TH()
+TH("throw-error")
+source("/home/NANOFLUIDICS/jbullard/projects/software/R/common/h5r/tests/testall.R")
+TH()
+TH(throw-error = TRUE)
+TH(throwError = TRUE)
+TH("a", FALSE)
+TH(throwError = TRUE)
+TH("a", FALSE)
+TH(throwError = TRUE)
+TH
+TH("a", TRUE)
+TH()
+TH(action = "print")
+TH("b", FALSE)
+TH(action = "print")
+TH(action = "throw")
+?tryCatch
+TH("b", FALSE)
+TH(action = "throw")
+TH("b", FALSE)
+TH(action = "throw")
+simpleError()
+simpleError("sdf")
+TH("b", FALSE)
+TH(action = "throw")
+q()
+n
+source("/home/NANOFLUIDICS/jbullard/projects/software/R/common/h5r/tests/testall.R")
+source("/home/NANOFLUIDICS/jbullard/projects/software/R/common/h5r/tests/testall.R")
+TH("aa", FALSE)
+TH(action = "throw")
+TH()
+TH(action = "print")
+dim(ds6
+)
+ds6
+TH(action = "print")
+runif(3, c(1,2,3), c(2,3,4))
+ls()
+b
+d
+ds2
+ds4
+ds4[1:3, 1:2]
+ds4[1:2, 1]
+call(ds4[1:2, 1])
+expression(ds4[1:2, 1])
+substitute(ds4[1:2, 1])
+as.call(ds4[1:2, 1])
+?call
+call("[", ds4, 1:2, 1)
+eval(call("[", ds4, 1:2, 1))
+eval(call("[", ds4, list(1:2, 1)))
+eval(call("[", ds4, 1:2, 1))
+call("[", ds4, 1:2, 1)
+as.call(call("[", ds4, 1:2, 1))
+as.list(call("[", ds4, 1:2, 1))
+as.call(as.list(call("[", ds4, 1:2, 1)))
+as.list(call("[", ds4))
+xx = as.list(call("[", ds4))
+xx[[3]] <- 1:2
+xx[[4]] <- 1
+xx
+as.call(xx)
+eval(as.call(xx))
+randomSlice(ds2)
+randomSlice(ds2)
+randomSlice(ds2)
+n
+dims
+ds2
+Q
+ls()
+ds4
+randomSlice(ds4)
+c
+randomSlice(ds4)
+randomSlice(ds4)
+randomSlice(ds4)
+randomSlice(ds4)
+randomSlice(ds4)
+randomSlice(ds4)
+replicate(100, randomSlice(ds4))
+q()
+n
+ds7
Added: tests/testall.R
===================================================================
--- tests/testall.R (rev 0)
+++ tests/testall.R 2010-05-03 17:57:02 UTC (rev 19)
@@ -0,0 +1,174 @@
+require(h5r)
+
+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() {
+ cat(sprintf("Results for %d tests:\n", length(tests)))
+ for (elt in names(tests)) {
+ cat(sprintf("\t Test: %s Time: %g Result: %s\n", elt,
+ round(getTime(tests[[elt]]), 3),
+ getResult(tests[[elt]])))
+ }
+ }
+
+ function(nm, test, action = c("test", "print", "throw")) {
+ action <- match.arg(action)
+ switch(action,
+ test = {
+ tm <- system.time(b <- test)
+ tests[[nm]] <<- list("result" = b, "time" = tm)
+ },
+ print = {
+ printResults()
+ },
+ throw = {
+ errs <- ! sapply(tests, getResult)
+ if (any(errs))
+ stop(simpleError(paste("Tests in error:", paste(names(tests)[errs], collapse = ", "))))
+ })
+ }
+}
+
+##
+## Make a new TestHarness.
+##
+TH <- TestHarness()
+
+##
+## The tests.
+##
+file <- system.file("h5_files", "ex_1.h5", package = 'h5r')
+
+## ex_1
+f <- H5File(file)
+g <- getH5Group(f, "group_1")
+
+TH("group name", g at name == "group_1")
+
+ds1 <- getH5Dataset(g, "ds_1", inMemory = T)
+
+TH("ds_1 dim, 1", all(dim(ds1) == c(1000, 10)))
+TH("ds_1 dim, 2", all(dim(ds1[1:10, 1:10]) == c(10, 10)))
+TH("ds_1 dim, 3", all(dim(ds1[1:10, ]) == c(10, 10)))
+TH("ds_1 dim, 4", is.null(dim(ds1[, 1])))
+TH("ds_1 dim, 5", assertError(ds1[,1:12]))
+
+## string dataset
+ds2M <- getH5Dataset(g, "ds_2", inMemory = T)
+ds2 <- getH5Dataset(g, "ds_2", inMemory = F)
+
+TH("ds_2 dim, 1", all(ds2[] == ds2M[]))
+TH("ds_2 dim, 2", all(ds2[1:5] == ds2M[1:5]))
+
+## attributes
+a <- getH5Attribute(ds2, "x")
+b <- getH5Attribute(ds2, "y")
+c <- getH5Attribute(ds2, "z")
+
+TH("attribute 1", all(a[] == 1:3))
+TH("attribute 2", all(b[] == rbind(1:3, 5:7)))
+TH("attribute 3", all(c[] == ds2[]))
+
+## > 2 dimensional data.
+ds3M <- getH5Dataset(g, "ds_3", inMemory = T)
+ds3 <- getH5Dataset(g, "ds_3", inMemory = F)
+
+TH("ds_3 dim", all(dim(ds3[,,]) == dim(ds3)) && all(dim(ds3M[,,]) == dim(ds3M)))
+
+## known inconsistency between two.
+TH("In memory inconsistency (FIXME)", assertError(all(ds3M[] == ds3[])))
+
+## the 3d R object.
+id3 <- ds3M at .data$.data
+
+TH("3d consistency, slabbed", all(id3[,,] == ds3[,,]) &
+ all(id3[,1,,drop=TRUE] == ds3[,1,,drop=TRUE]) &
+ all(id3[1,1,,drop=TRUE] == ds3[1,1,,drop=TRUE]) &
+ all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE]))
+
+TH("3d consistency, memory", all(id3[,,] == ds3M[,,]) &
+ all(id3[,1,,drop=TRUE] == ds3M[,1,,drop=TRUE]) &
+ all(id3[1,1,,drop=TRUE] == ds3M[1,1,,drop=TRUE]) &
+ all(id3[1,,3,drop=TRUE] == ds3M[1,,3,drop=TRUE]))
+
+
+## 2 dimensional string dataset.
+ds4M <- getH5Dataset(g, "ds_4", inMemory = T)
+ds4 <- getH5Dataset(g, "ds_4", inMemory = F)
+
+TH("ds_2 dim", all(dim(ds4[,]) == dim(ds4)) & all(dim(ds4M[,]) == dim(ds4)))
+
+TH("ds_4, memory", (function(n = 100, s = 100) {
+ g1 <- gc()[,1]
+ a <- replicate(n, {
+ replicate(s, getH5Dataset(g, "ds_4", inMemory = FALSE)[1:2,1:2])
+ })
+ rm(a)
+ all(g1 - gc()[,1] <= 0)
+})())
+
+
+##
+## More in-depth testing of slicing.
+##
+ds6 <- getH5Dataset(g, "ds_6", inMemory = FALSE)
+ds6M <- getH5Dataset(g, "ds_6", inMemory = TRUE)
+
+TH("ds6, slicing", all(ds6[,] == ds6M[,]) & all(ds6[2:1001] == ds6M[2:1001]))
+
+timeMe <- function(d) {
+ k <- 1000
+ n <- 1000
+ system.time({
+ for (i in seq.int(1, n)) {
+ b <- runif(1, 1, nrow(d) - k)
+ d[b:(b + k)]
+ }
+ })[3]
+}
+
+TH("slab selection, timing", (mean(replicate(10, timeMe(ds6))) < .25))
+TH("slab selection, timing -- memory", (mean(replicate(10, timeMe(ds6M))) < .15))
+
+randomSlice <- function(d) {
+ dims <- dim(d)
+
+ starts <- floor(runif(length(dims), rep(1, length(dims)), dims))
+ ends <- starts + floor(rexp(length(dims), 1/4))
+ ends <- ifelse(ends > dims, dims, ends)
+
+ lst <- as.list(call("[", d))
+
+ for (i in 1:length(dims)) {
+ lst[[i + 2]] <- starts[i]:ends[i]
+ }
+ eval(as.call(lst))
+}
+
+ds7 <- getH5Dataset(g, "ds_7", inMemory = FALSE)
+ds7M <- getH5Dataset(g, "ds_7", inMemory = TRUE)
+
+TH("random slice", {
+ set.seed(10)
+ system.time({a <- replicate(10000, randomSlice(ds7))})
+ set.seed(10)
+ system.time({b <- replicate(10000, randomSlice(ds7M))})
+ all.equal(a,b)
+})
+
+TH(action = "print")
+TH(action = "throw")
+
More information about the H5r-commits
mailing list