[H5r-commits] r24 - R inst/h5_files tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Sat May 15 02:17:37 CEST 2010
Author: extemporaneousb
Date: 2010-05-15 02:17:37 +0200 (Sat, 15 May 2010)
New Revision: 24
Modified:
R/h5R.R
inst/h5_files/ex_1.h5
inst/h5_files/makeH5.py
tests/.Rhistory
tests/testall.R
Log:
Modified: R/h5R.R
===================================================================
--- R/h5R.R 2010-05-13 17:41:41 UTC (rev 23)
+++ R/h5R.R 2010-05-15 00:17:37 UTC (rev 24)
@@ -11,7 +11,6 @@
setClass("H5File", contains = "H5Obj", representation(fileName = "character"))
setClass("H5Group", contains = "H5Obj", representation(name = "character"))
-
setClassUnion("envOrNULL", c("environment", "NULL"))
setClass("H5DataContainer", contains = "H5Obj",
representation(name = "character", dims = "integer",
@@ -89,7 +88,7 @@
setMethod("initialize", c("H5File"), function(.Object, fileName) {
## This is obscene. I have to do this because somehow Subclasses
- ## call this on *class* instanteation time.
+ ## call this at *class* instantiation time.
if (missing(fileName))
return(.Object)
@@ -140,12 +139,44 @@
}
}
+.marginCheck <- function(i, d) {
+ if (any(i <= 0))
+ stop("Non-positive selections not allowed when subsetting H5Datasets")
+ if (max(i) > d)
+ stop("Index out of range.")
+}
+
setMethod("[", "H5DataContainer", .internalSlice)
setMethod("[", "H5Dataset", function(x, i, j, ..., drop = TRUE) {
+ iMissing <- TRUE
+ if (! missing(i)) {
+ iMissing <- FALSE
+ .marginCheck(i, nrow(x))
+ }
+ jMissing <- TRUE
+ if (! missing(j)) {
+ jMissing <- FALSE
+ .marginCheck(j, ncol(x))
+ }
+
+ ## Not quite sure why this results in a strange state
+ ## of both missing and !missing(.)
+ extras <- tryCatch(list(...), simpleError = function(e) {
+ return(list())
+ })
+
+ nExtra <- 0
+ if (length(extras) > 0) {
+ for (k in 3:(2 + length(extras))) {
+ nExtra <- nExtra + 1
+ .marginCheck(extras[[k-2]], dim(x)[k])
+ }
+ }
+
if (.inMemory(x)) {
## this is a copy of internal slice, if I don't do it this way
- ## then ... doesn't really stay consistent and I cannot pass it
- ## through to the '[' built-in.
+ ## then the arg '...' doesn't really stay consistent and I cannot
+ ## pass it through to the '[' built-in.
if (!.hasData(x)) {
.putData(x, .loadDataset(x))
}
@@ -161,42 +192,37 @@
}
}
else {
- ##
- ## Currently, This supports only a limited range of slicing.
- ## contiguous chunks
- ##
if (is.null(dim(x))) {
- if (! missing(j))
+ if (! jMissing)
stop("incorrect number of dimensions")
- if (! missing(i))
+ if (! iMissing) {
dta <- readSlab(x, min(i), max(i) - min(i) + 1)
+
+ ## contiguity
+ if (any(diff(i) != 1)) {
+ dta <- dta[i - min(i) + 1]
+ }
+ }
else
dta <- readSlab(x, 1, length(x))
}
else {
## need to specify the dim(x) offset, dim.
sel <- matrix(NA, nrow = length(dim(x)), ncol = 2)
- if (! missing(i))
+ if (! iMissing)
sel[1, ] <- range(i)
else
sel[1, ] <- c(1, dim(x)[1])
- if (! missing(j))
+ if (! jMissing)
sel[2, ] <- range(j)
else
sel[2, ] <- c(1, dim(x)[2])
if (nrow(sel) > 2) {
- ##
- ## Not quite sure why this results in a strange state
- ## of both missing and !missing(.)
- ##
- l <- tryCatch(list(...), simpleError = function(e) {
- return(list())
- })
for (k in 3:nrow(sel)) {
- if (length(l) >= k - 2)
- sel[k, ] <- range(l[[k - 2]]) # the offset into the list.
+ if (length(extras) >= k - 2)
+ sel[k, ] <- range(extras[[k - 2]]) # the offset into the list.
else
sel[k, ] <- c(1, dim(x)[k])
}
@@ -204,7 +230,36 @@
ext <- sel[,2] - sel[,1] + 1
dta <- readSlab(x, sel[,1], ext)
- }
+
+ ## Now I have to fix things up because of the contiguity
+ ## issue. Essentially, if the i,j, ... specified by the user
+ ## aren't contiguous then I have to subselect the dta to conform
+ ## to their selection.
+### kall <- as.list(match.call())
+### kall$x <- dta
+### kallincr <- 0
+
+### if (! iMissing) {
+### kallincr <- kallincr + 1
+### kall$i <- i - min(i) + 1
+### } else {
+
+### }
+
+### if (! jMissing) {
+### kallincr <- kallincr + 1
+### kall$j <- j - min(j) + 1
+### }
+
+### if (length(extras) > 0) {
+### for (w in 1:length(extras)) {
+### kall[[2 + kallincr + 1]] <- extras[[w]] - min(extras[[w]]) + 1
+### kallincr <- kallincr + 1
+### }
+### }
+### dta <- eval(as.call(kall))
+
+ }
if (drop) drop(dta) else dta
}
})
Modified: inst/h5_files/ex_1.h5
===================================================================
(Binary files differ)
Modified: inst/h5_files/makeH5.py
===================================================================
--- inst/h5_files/makeH5.py 2010-05-13 17:41:41 UTC (rev 23)
+++ inst/h5_files/makeH5.py 2010-05-15 00:17:37 UTC (rev 24)
@@ -35,6 +35,8 @@
a = a.reshape(1000, 10, 5)
g.create_dataset("ds_7", data = a, maxshape = (None, None, None))
+g.create_dataset("ds_8", data = array([[1,2,3,4,5], [6,7,8,9,10]], dtype = "uint32"))
+
## create some more intricate group structure.
h = g.create_group("group_2")
i = h.create_group("group_3")
Modified: tests/.Rhistory
===================================================================
--- tests/.Rhistory 2010-05-13 17:41:41 UTC (rev 23)
+++ tests/.Rhistory 2010-05-15 00:17:37 UTC (rev 24)
@@ -1,150 +1,150 @@
-c
-randomSlice(ds4)
-randomSlice(ds4)
-randomSlice(ds4)
-randomSlice(ds4)
-randomSlice(ds4)
-randomSlice(ds4)
-replicate(100, randomSlice(ds4))
+s[]
+s
q()
n
-ds7
-TH(action="print"0
-TH(action="print")
-a
-sapply(a, dim)
-source("/home/NANOFLUIDICS/jbullard/projects/software/R/common/h5r/tests/testall.R")
-.Call("h5R_get_contents", f)
-slotNames(f)
-.Call("h5R_get_contents", f at ePtr)
-.Call("h5R_get_contents", g at ePtr)
-.Call("h5R_get_contents", f at ePtr)
-1
-.Call("h5R_get_contents", f at ePtr)
-.Call("h5R_get_contents", f at ePtr)
-require(h5r)
-.Call("h5R_get_contents", f at ePtr)
-.Call("h5R_get_contents", f at ePtr)
-.Call("h5R_get_contents", f at ePtr)
-require(h5r)
-.Call("h5R_get_contents", f at ePtr)
-.Call("h5R_get_contents", f at ePtr)
-require(h5r)
-.Call("h5R_get_contents", f at ePtr)
-1
-.Call("h5R_get_contents", f at ePtr)
-1
-require(h5r)
-.Call("h5R_get_contents", f at ePtr)
-require(h5r)
-.Call("h5R_get_contents", f at ePtr)
-4
-require(h5r)
-.Call("h5R_get_contents", f at ePtr)
-f
-.Call("h5R_get_contents", f at ePtr)
-.Call("h5R_get_contents", f at ePtr)
-gc()
-x = replicate(10000, .Call("h5R_get_contents", f at ePtr))
-rm(x)
-gc()
-x = replicate(1000000, .Call("h5R_get_contents", f at ePtr))
-rm(x)
-gc()
-.Call("h5R_get_contents", f at ePtr)
-require(h5r)
-.Call("h5R_get_contents", f at ePtr)
-require(h5r)
-.Call("h5R_get_contents", f at ePtr)
-x = .Call("h5R_get_contents", f at ePtr)
-x[[1]]
-x[[1]][[1]]
-as.character(x[[1]][[1]])
-as.string(x[[1]][[1]])
-require(h5r)
-x = .Call("h5R_get_contents", f at ePtr)
-x
-.Call("h5R_get_contents", f at ePtr)
-require(h5r)
-x = getH5Dataset(f, "ds_2")
-1
-require(h5r)
-x = getH5Dataset(f, "ds_2")
-x = getH5Dataset(g, "ds_2")
-x
-.Call(x at ePtr, "h5R_get_attributes")
-x at ePter
-x at ePtr
-.Call(x at ePtr, "h5R_get_attributes")
-x
- getH5Attribute(x, "x")
- getH5Attribute(x, "x")[]
-.Call(x at ePtr, "h5R_get_attributes")
-require(h5r)
-x = getH5Dataset(g, "ds_2")
-.Call(x at ePtr, "h5R_get_attributes")
-.Call(x at ePtr, "h5R_get_attributes", PACKAGE = "h5r")
-x at ePtr
-getH5Dims(x)
-getH5Dim(x)
-.Call("h5R_get_attributes", x at ePtr)
-require(h5r)
-x = getH5Dataset(g, "ds_2")
-.Call("h5R_get_attributes", x at ePtr)
-.Call("h5R_get_attributes", x at ePtr)
-.Call("h5R_get_attributes", x at ePtr)
-x = getH5Dataset(g, "ds_2")
-require(h5r)
-x = getH5Dataset(g, "ds_2")
-x
-getH5Attribute(x, "x")
-.Call("h5R_get_attributes", x at ePtr)
-require(h5r)
-getH5Attribute(x, "x")
-x = getH5Dataset(g, "ds_2")
-.Call("h5R_get_attributes", x at ePtr)
-require(h5r)
-x = getH5Dataset(g, "ds_2")
-.Call("h5R_get_attributes", x at ePtr)
-.Call("h5R_get_attributes", x at ePtr)
-.Call("h5R_get_attributes", x at ePtr)
-.Call("h5R_get_attributes", ds1 at ePtr)
-.Call("h5R_get_attributes", g at ePtr)
-ls
-?ls
-g
-listH5Attributes(g)
listH5Contents(g)
-a[[1]]
-contents
+ds8
+c(1,2,3)[-1]
+! TRUE && 2 = 1
+(! TRUE) && 2 = 1
+(! TRUE) && 2
+(! TRUE) && x
+?"&&"
+(! TRUE) && (3/0)
+3/0
+(! TRUE) && (2/bbb)
+(! TRUE) && ncol(fdds)
+! TRUE && (3/0)
+! TRUE && ncol(sdff)
+if (! TRUE && ncol(sdff))
+3
+debug(.marginCheck)
n
-a[[1]]
-getH5Group(a[[1]])
-getH5Group(f, a[[1]])
+n
+n
+i
Q
+traceback()
+debug(.marginCheck)
+ds3
+ds3M
+traceback()
+all(dim(ds3[,,]) == dim(ds3))
+all(dim(ds3M[,,]) == dim(ds3M))
+all(id3[1,,3,drop=TRUE] == ds3M[1,,3,drop=TRUE])
+traceback()
+debug(.marginCheck)
n
-a[[1]]
-getH5Group(a[[1]], f)
-getH5Group(f, a[[1]])
-a[[2]]
-h5Obj
-h5Obj
+all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE])
+c
+c
+traceback()
+all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE])
+c
+c
+all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE])
+c
+n
+all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE])
+n
+k
+extras
+n
+all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE])
+n
+length(extras)
Q
-lst
-do.call(rbind, lst)
-as.data.frame(do.call(rbind, lst))
-print
-f
+all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE])
+n
+all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE])
+k
+dim(x)
+dim(x)[k]
+extras
+extras[[k-2]]
+3:(2+length(extras))
+n
+all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE])
+n
+all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE])
+k
+debug(.marginCheck)
+n
+n
+max(i)
+d
+dim(x)
+c
+all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE])
+x
+dim(x)
+k
+dim(x)[k]
+extras
+extras[[k-2]]
+.marginCheck(dim(x)[k], extras[[k-2]])
+dim(x)[k]
+Q
+TH(action="throw")
+TH(action="print")
+source("testall.R")
+assertError(ds8[,0:5])
+ds8[,0:5]
+ds8[,0:5]
+c(1,2)[0]
+c(1,2)[0]
+ds8[,0:5]
+v
+b
+{b <- 10}
+b
+system.time({d <- 10})
+d
+TH(action = "throw")
+sprintf("%g.3", pi)
+sprintf("%g3", pi)
+sprintf("%g1", pi)
+?sprintf
+sprintf("%2.g", pi)
+sprintf("%.3f", pi)
+sprintf("%.3g", pi)
+sprintf("%.5g", pi)
+sprintf("%.5s", "jim")
+sprintf("%.10s", "jim")
+sprintf("%10s", "jim")
+sprintf("%5g", pi)
+sprintf("%5g", 0)
+TH(action="print")
+sprintf("%4s", "j")
+sprintf("%#4s", "j")
+sprintf("%-4s", "j")
+TH(action="print")
+TH(action="print")
+TH(action="print")
+n
+fmtString
+cat(sprintf(fmtString, elt, getTime(tests[[elt]]), getResult(tests[[elt]])))
+sprintf("%4g", 0)
+sprintf("%4.g", 0)
+sprintf("%4.1g", 0)
+sprintf("%-4.1g", 0)
+sprintf(fmtString, "jdsfjflkdj", 10, TRUE)
+cat(sprintf(fmtString, "jdsfjflkdj", 10, TRUE))
+cat(sprintf(fmtString, "jdsfjflkdj", 0, TRUE))
+cat(sprintf(fmtString, "jdsfjflkdj", 1000, TRUE))
+cat(sprintf(fmtString, "jdsfjflkdj", 10000, TRUE))
+cat(sprintf(fmtString, "jdsfjflkdj", 10000, TRUE))
+cat(sprintf(fmtString, "jdsfjflkdssdfsfj", 10000, TRUE))
+cat(sprintf(fmtString, "jdsfjflkdssdfsfj", 10000, TRUE))
+cat(sprintf(fmtString, "jsdfsdfsdsfjflkdssdfsfj", 10000, TRUE))
+Q
+TH(action="print")
+TH(action="print")
+TH(action="print")
+TH(action="throw")
+source("/home/NANOFLUIDICS/jbullard/projects/software/R/common/h5r/tests/testall.R")
listH5Contents(f)
-listH5Contents(f)
-f
-listH5Contents(f)
-s = listH5Contents(f)
-s
-s = listH5Contents(f)
-s
-as.list(s)
-s[]
-s
-q()
-n
+listH5Contents(g)
+source("/home/NANOFLUIDICS/jbullard/projects/software/R/common/h5r/tests/testall.R")
+TH(action="throw")
+TH(action="print")
Modified: tests/testall.R
===================================================================
--- tests/testall.R 2010-05-13 17:41:41 UTC (rev 23)
+++ tests/testall.R 2010-05-15 00:17:37 UTC (rev 24)
@@ -16,11 +16,14 @@
elt[["result"]]
}
printResults <- function() {
- cat(sprintf("Results for %d tests:\n", length(tests)))
+ 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("\t Test: %s Time: %g Result: %s\n", elt,
- round(getTime(tests[[elt]]), 3),
- getResult(tests[[elt]])))
+ cat(sprintf(fmtString, elt, getTime(tests[[elt]]), getResult(tests[[elt]])))
}
}
@@ -28,7 +31,11 @@
action <- match.arg(action)
switch(action,
test = {
- tm <- system.time(b <- test)
+ tm <- system.time({
+ b <- tryCatch(test, simpleError = function(e) {
+ return(FALSE)
+ })
+ })
tests[[nm]] <<- list("result" = b, "time" = tm)
},
print = {
@@ -36,8 +43,10 @@
},
throw = {
errs <- ! sapply(tests, getResult)
- if (any(errs))
- stop(simpleError(paste("Tests in error:", paste(names(tests)[errs], collapse = ", "))))
+ if (any(errs)) {
+ stop(simpleError(paste("Tests in error:\n", paste(paste("\t", names(tests)[errs], sep = ""), collapse = "\n"),
+ sep = "")))
+ }
})
}
}
@@ -89,7 +98,7 @@
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[])))
+TH("In memory inconsistency (!! FIXME !!)", assertError(all(ds3M[] == ds3[])))
## the 3d R object.
id3 <- ds3M at .data$.data
@@ -104,6 +113,9 @@
all(id3[1,1,,drop=TRUE] == ds3M[1,1,,drop=TRUE]) &
all(id3[1,,3,drop=TRUE] == ds3M[1,,3,drop=TRUE]))
+TH("3d bounds check 1", assertError(ds3[0:10,,]))
+TH("3d bounds check 2", assertError(ds3[,,0:10]))
+TH("3d bounds check 3", assertError(ds3[1,2,1:1000]))
## 2 dimensional string dataset.
ds4M <- getH5Dataset(g, "ds_4", inMemory = T)
@@ -130,8 +142,8 @@
TH("ds6, slicing", all(ds6[,] == ds6M[,]) & all(ds6[2:1001] == ds6M[2:1001]))
timeMe <- function(d) {
- k <- 1000
- n <- 1000
+ k <- 100
+ n <- 100
system.time({
for (i in seq.int(1, n)) {
b <- runif(1, 1, nrow(d) - k)
@@ -140,8 +152,9 @@
})[3]
}
-TH("slab selection, timing", (mean(replicate(10, timeMe(ds6))) < .25))
-TH("slab selection, timing -- memory", (mean(replicate(10, timeMe(ds6M))) < .15))
+## These are *real* upper-bounds on timing.
+TH("slab selection, timing", (mean(replicate(10, timeMe(ds6))) < 1))
+TH("slab selection, timing -- memory", (mean(replicate(10, timeMe(ds6M))) < 1))
randomSlice <- function(d) {
dims <- dim(d)
@@ -171,14 +184,21 @@
TH("list attributes, file", {
- length(listH5Contents(f)) == 13
+ length(listH5Contents(f)) == 14
})
TH("list attributes, group", {
- length(listH5Contents(g)) == 10
+ length(listH5Contents(g)) == 11
})
+ds8 <- getH5Dataset(g, "ds_8", inMemory = FALSE)
+TH("dim check 1", assertError(ds8[,0:5]))
+TH("dim check 2", assertError(ds8[0,1:5]))
+TH("dim check 3", assertError(ds8[-1,1:5]))
+TH("dim check 4", assertError(ds8[10,1]))
+TH("test 0-vs-1 based", all(ds8[1,1:5] == 1:5))
+
TH(action = "print")
TH(action = "throw")
More information about the H5r-commits
mailing list