[H5r-commits] r27 - R inst inst/h5_files tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed May 26 03:58:19 CEST 2010
Author: extemporaneousb
Date: 2010-05-26 03:58:17 +0200 (Wed, 26 May 2010)
New Revision: 27
Added:
inst/index.R
Modified:
R/h5R.R
inst/h5_files/ex_1.h5
inst/h5_files/makeH5.py
tests/.Rhistory
tests/testall.R
Log:
Added code to deal with arbitrary indexing -- In R at this point.
Modified: R/h5R.R
===================================================================
--- R/h5R.R 2010-05-24 17:31:11 UTC (rev 26)
+++ R/h5R.R 2010-05-26 01:58:17 UTC (rev 27)
@@ -207,58 +207,50 @@
dta <- readSlab(x, 1, length(x))
}
else {
- ## need to specify the dim(x) offset, dim.
+ ## need to specify the range to select.
sel <- matrix(NA, nrow = length(dim(x)), ncol = 2)
- if (! iMissing)
+ lst <- list(`[`, x = quote(dta))
+
+ if (! iMissing) {
sel[1, ] <- range(i)
- else
+ lst$i <- i - min(i) + 1
+ } else {
+ ## retain original dimensions.
sel[1, ] <- c(1, dim(x)[1])
+ lst$i <- seq.int(sel[1,1], sel[1,2])
+ }
- if (! jMissing)
+ if (! jMissing) {
sel[2, ] <- range(j)
- else
+ lst$j <- j - min(j) + 1
+ }
+ else {
+ ## retain original dimensions.
sel[2, ] <- c(1, dim(x)[2])
+ lst$j <- seq.int(sel[2,1], sel[2,2])
+ }
if (nrow(sel) > 2) {
for (k in 3:nrow(sel)) {
- if (length(extras) >= k - 2)
+ if (length(extras) >= k - 2) {
sel[k, ] <- range(extras[[k - 2]]) # the offset into the list.
- else
+ lst[[k+2]] <- extras[[k-2]] - min(extras[[k-2]]) + 1
+ }
+ else {
sel[k, ] <- c(1, dim(x)[k])
+ lst[[k+2]] <- seq.int(sel[k,1], sel[k,2])
+ }
}
}
-
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
+ ## 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 {
-
-### }
+ dta <- eval(as.call(lst))
-### 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-24 17:31:11 UTC (rev 26)
+++ inst/h5_files/makeH5.py 2010-05-26 01:58:17 UTC (rev 27)
@@ -44,4 +44,8 @@
j = f.create_group("group_4")
j.create_dataset("ds_1", data = a, maxshape = (None, None, None))
+## create a 5-dimensional dataset for the hell of it.
+a = random.randint(1, 10000, prod([10]*5)).reshape(tuple([10]*5))
+g.create_dataset("ds_9", data = a, maxshape = tuple([None]*5))
+
f.close()
Added: inst/index.R
===================================================================
--- inst/index.R (rev 0)
+++ inst/index.R 2010-05-26 01:58:17 UTC (rev 27)
@@ -0,0 +1,160 @@
+require(methods)
+
+VERBOSE <- TRUE
+
+setClass('myExample', representation = representation(x = "array"))
+setClassUnion('index', members = c("numeric", "character", "logical"))
+
+setGeneric('toNumeric', function(x) standardGeneric('toNumeric'))
+setMethod('toNumeric', 'numeric', function(x) x)
+setMethod('toNumeric', 'logical', function(x) which(x))
+
+
+myExample <- function(dims = c(1,2)) {
+ a <- array(rnorm(prod(dims)))
+ dim(a) <- dims
+ obj <- new("myExample")
+ obj at x <- a
+ return(obj)
+}
+
+setMethod("dim", "myExample", function(x) if (length(dim(x at x))) NULL else dim(x at x))
+
+printCall <- function(cl, f, i) {
+ cat("call: ", toString(cl), "\n")
+ cat("arguments:", paste(names(f[1:i]), collapse = ", "), "\n\n")
+}
+
+setMethod("[", c("myExample", "index", "missing", "ANY"), function(x, i, j, ..., drop = TRUE) {
+ if (VERBOSE) printCall(match.call(), formals(), nargs())
+ if (is.null(dim(x))) {
+ if (nargs() > 2)
+ stop("incorrect number of dimensions")
+ x at x[toNumeric(i)]
+ } else {
+ callGeneric(x, i, j = seq.int(1, dim(x)[2]), ..., drop = drop)
+ }
+})
+
+setMethod("[", c("myExample", "missing", "missing", "ANY"), function(x, i, j, ..., drop = TRUE) {
+ if (VERBOSE) printCall(match.call(), formals(), nargs())
+ if (nargs() >= 4) {
+ callGeneric(x, i = seq.int(1, dim(x)[1]), j = seq.int(1, dim(x)[2]), ..., drop = drop)
+ } else {
+ x at x[]
+ }
+})
+
+setMethod("[", c("myExample", "index", "index", "ANY"), function(x, i, j, ..., drop = TRUE) {
+ if (VERBOSE) printCall(match.call(), formals(), nargs())
+ x at x[toNumeric(i), toNumeric(j), ..., drop = drop]
+})
+
+m1 <- myExample(10)
+m2 <- myExample(c(10,10))
+m3 <- myExample(c(10,10,10))
+m4 <- myExample(c(10,10,10,10))
+
+m1[]
+m1[1:3]
+m1[1,]
+m1 at x[1,]
+m1[-1]
+
+m4[1:2, 1:2, 1:2, 1:2] == m4 at x[1:2, 1:2, 1:2, 1:2]
+m4 at x[1:2, 1:2, , ]
+m4 at x[1:2, , , ]
+
+## ############### 2-D
+m <- myExample(c(10, 10))
+m at x[c(1,5), c(1,5)] == m[c(1,5), c(1,5)]
+m at x[c(5, 2),] == m[c(5,2),]
+
+## ############### 3-D
+m <- myExample(c(1,3,4))
+
+
+
+
+
+
+
+
+
+
+## functionThatCanOnlyGrabContiguous <- function(x, m, kall) {
+## kall$x <- x at x
+## for (i in 1:nrow(m)) {
+## kall[[i+2]] <- seq.int(m[i,1], m[i,2])
+## }
+## print(as.list(kall))
+## return(eval(kall))
+## }
+
+## setMethod("[", "myExample", function(x, i, j, ..., drop = TRUE) {
+## if (nargs() >
+
+## m <- matrix(nrow = length(dim(x)), ncol = 2)
+
+## if (missing(i))
+## m[1,] <- c(1, dim(x)[1])
+## else
+## m[1,] <- range(i)
+
+## if (length(dim(x)) > 1) {
+## if (missing(j))
+## m[2,] <- c(1, dim(x)[2])
+## else
+## m[2,] <- range(j)
+
+## k <- 3
+## while (k <= nrow(m)) {
+## if (k-2 <= length(e))
+## m[k,] <- range(e[[k-2]])
+## else
+## m[k,] <- c(1, dim(x)[k])
+## k <- k + 1
+## }
+## }
+## kall <- match.call()
+## d <- functionThatCanOnlyGrabContiguous(x, m, kall)
+
+## kall$x <- d
+## if (! missing(i)) {
+## kall[[3]] <- i - min(i) + 1
+## }
+## if (! missing(j)) {
+## kall[[4]] <- j - min(j) + 1
+## } else {
+## if (length(dim(x)) > 1)
+## kall[[4]] <- seq.int(1, dim(x)[2])
+## }
+## ## XXX: Have to handle remaining dimensions, but since I can't
+## ## really get a clean '...' it is on hold.
+
+## eval(kall)
+## })
+
+## ## ############### 1-D
+## m <- myExample(10)
+## m at x[c(1,5)] == m[c(1, 5)]
+
+## ## ############### 2-D
+## m <- myExample(c(10, 10))
+## m at x[c(1,5), c(1,5)] == m[c(1,5), c(1,5)]
+## m at x[c(5, 2),] == m[c(5,2),]
+
+## ## ############### 3-D
+## m <- myExample(c(1,3,4))
+
+## ## (A) doesn't work
+
+## m at x[1,1:2,] == m[1,1:2,]
+
+## ## (B) nor does this for different reasons.
+## m[1,,1]
+## m at x[1,,1]
+
+
+
+
Modified: tests/.Rhistory
===================================================================
--- tests/.Rhistory 2010-05-24 17:31:11 UTC (rev 26)
+++ tests/.Rhistory 2010-05-26 01:58:17 UTC (rev 27)
@@ -1,150 +1,150 @@
+showMethods("[", "nonStructure")
+showMethod("[", "nonStructure")
+getMethod("[", "nonStructure")
+f = function(a, ...) list(...)
+f(a = 1, ... = 3)
+f(a = 1, ... = list(1,2))
+1
+ds4[1, c(1,3,5)]
+nargs()
+formals()
+match.call()
+ext
+sel[,1]
+i
+j
+sel[,1] - ext + 1
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)
+ds4[1, c(2,3,5)]
n
-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
+ext
+length(i)
+length(j)
extras
+ext
+sapply(list(i, j, extras), length)
+dta
+i
+j
+"["(dta, i, j, ... = ..., drop = drop)
+"["(dta, i, j-1, ... = ..., drop = drop)
+"["(dta, i, j-1, ... = list(), drop = drop)
+...
+list(...)
+"["(dta, i, j-1, drop = drop)
+"["(dta, i, j-1, drop = drop)
+"["(dta, i, j-1, ... = NA, drop = drop)
+"["(dta, i, j-1, ... = , drop = drop)
+"["(dta, i, j-1, ... , drop = drop)
+class(...)
+class(list(...))
+is.missing(...)
+missing(...)
+Q
+ds4[1, c(2,3,5)]
n
-all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE])
n
-length(extras)
+lst
+match.call()
+diff(sel[2,])
+length(j)
+lst
+lst
+lst
Q
-all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE])
+ds4[1, c(2,3,5)]
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))
+lst
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)
+dta
+match.call()
+as.list(match.call())
+match.call()
+as.list(match.call())
+as.call(list("[", x = substitute(dta), i = lst$i, j = lst$j))
+list("[", x = substitute(dta), i = lst$i, j = lst$j)
+list("[", x = deparse(dta), i = lst$i, j = lst$j)
+list("[", x = quote(dta), i = lst$i, j = lst$j)
+as.call(list("[", x = quote(dta), i = lst$i, j = lst$j))
+eval(as.call(list("[", x = quote(dta), i = lst$i, j = lst$j)))
+eval(as.call(list(`[`, x = quote(dta), i = lst$i, j = lst$j)))
+ds4[1, c(2,3,5)]
+Q
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")
+ds3[,,]
+ds3[,1,]
+?debug
+trace("[", browser)
+trace("[", browser, signature = "H5Dataset")
+untrace("[")
+trace("[", browser, signature = "H5Dataset")
+ds3[,1,]
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))
+n
+eval(as.call(list(`[`, x = quote(dta), i = lst$i, j = lst$j, lst[[3]])))
+lst[[3]]
+lst
Q
+ds3[]
+n
+lst
+as.call(list(`[`, x = quote(dta), i = lst$i, j = lst$j, lst[[3]][[1]])
+)
+eval(as.call(list(`[`, x = quote(dta), i = lst$i, j = lst$j, lst[[3]][[1]])))
+Q
TH(action="print")
+ds3[]
+n
+n
+lst
+lst[[3]]
+lst[-(1:2)]
+lst
+dta
+lst[-(1:2)
+]
+Q
TH(action="print")
+ ds3[]
+c
+ ds3[,1]
+c
+ ds3[,,1]
+c
TH(action="print")
-TH(action="throw")
-source("/home/NANOFLUIDICS/jbullard/projects/software/R/common/h5r/tests/testall.R")
-listH5Contents(f)
-listH5Contents(g)
-source("/home/NANOFLUIDICS/jbullard/projects/software/R/common/h5r/tests/testall.R")
-TH(action="throw")
-TH(action="print")
-ds1
-head(ds1)
-head
-colnames
-?colnames
-myExample(c(1,3,4))
-myExample(c(1,3,4))
-dim
-getMethod(dim)
-getMethods(dim)
-findMethod(dim)
-findMethods(dim)
-)
-dim(m)
-traceback()
+ds3[,,]
+ds3
+all(id3[1,,3,drop=TRUE] == ds3[1,,3,drop=TRUE])
+id3[1,,3]
+ds3[1,,3]
+trace("[", browser, signature = "H5Dataset")
+ds3[1,,3,drop=TRUE]
n
+sel
+lst
n
-e
n
-n
-findMethods("[")
-showMethods("[")
-showMethods("[", "nonStructure")
-showMethod("[", "nonStructure")
-getMethod("[", "nonStructure")
+dta
+lst
+eval(as.call(lst))
+dim(dta)
+dta[1,1:7,3]
+diff(sel[1,])
+diff(sel[3,])
+sel
+Q
+TH(action="print")
+TH(action="print")
+ds4M[1, c(1,3,5)]
+ds4[1, c(2,3,5)]
+TH(action="print")
+TH(action="print")
+listH5Contents(f)
+listH5Contents(f)
+1
Modified: tests/testall.R
===================================================================
--- tests/testall.R 2010-05-24 17:31:11 UTC (rev 26)
+++ tests/testall.R 2010-05-26 01:58:17 UTC (rev 27)
@@ -1,5 +1,7 @@
require(h5r)
+## gctorture(TRUE)
+
assertError <- function(expr) {
tryCatch({{expr}; FALSE}, simpleError = function(e) {
return(TRUE)
@@ -56,6 +58,7 @@
##
TH <- TestHarness()
+
##
## The tests.
##
@@ -132,7 +135,32 @@
all(g1 - gc()[,1] <= 0)
})())
+## contiguity problem.
+TH("contiguity", all(ds4M[1, c(2,3,5)] == ds4[1, c(2,3,5)]))
+TH("contiguity - 1D", all(ds2M[c(1, 7, 13)] == ds2[c(1, 7, 13)]))
+ds5 <- getH5Dataset(g, "ds_5")
+ds5M <- ds5[]
+
+all(ds5[10:1, ] == ds5M[ 10:1, ])
+all(ds5[10:1, 2] == ds5M[ 10:1, 2])
+all(ds5[seq(1, 10, by = 3), 2] == ds5M[ seq(1, 10, by = 3), 2])
+
+
+## 5-d object
+ds9M <- getH5Dataset(g, "ds_9", inMemory = T)
+ds9 <- getH5Dataset(g, "ds_9", inMemory = F)
+
+id9 <- ds9M[,,,,]
+all(id9[] == ds9M[,,,,])
+all(id9[] == ds9[])
+
+all(id9[c(7, 10), c(3, 4), , , ] == ds9[ c(7, 10), c(3, 4), , , ])
+all(id9[c(7, 10), c(3, 4), c(1, 5), , ] == ds9[ c(7, 10), c(3, 4), c(1, 5), , ])
+dim(id9[c(7, 10), c(3, 4), 1:5, , ] == ds9[ c(7, 10), c(3, 4), 1:5, , ])
+all(dim(id9[c(7, 10), c(3, 4), , , ]) == dim(ds9[ c(7, 10), c(3, 4), , , ]))
+all(dim(id9[c(10, 7), 10:1, , , ]) == dim(ds9[ c(10, 7), 10:1, , , ]))
+
##
## More in-depth testing of slicing.
##
More information about the H5r-commits
mailing list