[H5r-commits] r14 - R inst

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

Author: extemporaneousb
Date: 2010-04-23 20:31:58 +0200 (Fri, 23 Apr 2010)
New Revision: 14

Modified:
   R/h5R.R
   inst/.Rhistory
   inst/tests.R
Log:
A preliminary successfull version of hyperslab selection; now datasets can be specified as inMemory or not. 



Modified: R/h5R.R
===================================================================
--- R/h5R.R	2010-04-23 00:14:40 UTC (rev 13)
+++ R/h5R.R	2010-04-23 18:31:58 UTC (rev 14)
@@ -141,8 +141,11 @@
 }
 
 setMethod("[", "H5DataContainer", .internalSlice)
-setMethod("[", "H5Dataset", function(x, i, j, ..., drop = FALSE) {
+setMethod("[", "H5Dataset", function(x, i, j, ..., drop = TRUE) {
   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.
     if (!.hasData(x)) {
       .putData(x, .loadDataset(x))
     }
@@ -183,17 +186,17 @@
       else
         sel[2, ] <- c(1, dim(x)[2])
 
-      ##
-      ## Not quite sure why this results in a strange state
-      ## of both missing and !missing(.)
-      ##
-      l <- tryCatch(list(...), simpleError = function(e) {
-        return(list())
-      })
       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) 
-            sel[k, ] <- range(l[[k]])
+          if (length(l) >= k - 2)
+            sel[k, ] <- range(l[[k - 2]]) # the offset into the list.
           else
             sel[k, ] <- c(1, dim(x)[k])
         }
@@ -201,8 +204,8 @@
 
       ext <- sel[,2] - sel[,1] + 1
       dta <- readSlab(x, sel[,1], ext)
-    }
-    return(dta)
+     }
+    if (drop) drop(dta) else dta
   }
 })
 
@@ -218,6 +221,9 @@
 }
 
 readSlab <- function(h5Dataset, offsets, dims) {
+  if (! all((offsets + dims - 1) <= dim(h5Dataset)))
+    stop("error invalid slice specification in readSlab.")
+  
   d <- .Call("h5R_read_slab", .ePtr(h5Dataset), as.integer(offsets - 1), as.integer(dims))
   dim(d) <- rev(dims)
   .myperm(d)

Modified: inst/.Rhistory
===================================================================
--- inst/.Rhistory	2010-04-23 00:14:40 UTC (rev 13)
+++ inst/.Rhistory	2010-04-23 18:31:58 UTC (rev 14)
@@ -1,25 +1,4 @@
-d3
-d3[]
-dim(d3[])
-d3[,,1]
-d3[1,,]]
-d3[1,,]
-dim(d3)
-readDataAsVector
-readDataAsVector(d3)
-x  = readDataAsVector(d3)
-dim(x) <- c(9, 7, 3)
-x
-x[,,1]
-x[]
-dim(x[])
-debug(rev)
 c
-c
-c
-c
-c
-c
 dim(d3)
 d3 at .data
 dim(d3)
@@ -148,3 +127,24 @@
 d3[]
 d3[,,]
 ?missing
+d3
+d3[1,,,drop=TRUE]
+d3M
+id3[,1,1,drop=TRUE]
+d3M[,1,1,drop=TRUE]
+dim(id3)
+dim(d3M)
+c
+c
+c
+c
+n
+l
+Q
+c
+c
+c
+c
+n
+c
+c

Modified: inst/tests.R
===================================================================
--- inst/tests.R	2010-04-23 00:14:40 UTC (rev 13)
+++ inst/tests.R	2010-04-23 18:31:58 UTC (rev 14)
@@ -30,14 +30,20 @@
 id3 <- d3 at .data$.data
 
 all(id3[,,] == d3[,,])
-all(id3[,1,] == d3[,1,])
+all(id3[,1,,drop=TRUE] == d3[,1,,drop=TRUE])
+all(id3[1,1,,drop=TRUE] == d3[1,1,,drop=TRUE])
+all(id3[1,,3,drop=TRUE] == d3[1,,3,drop=TRUE])
 
 
 d3M <- getH5Dataset(g, "ds_3", inMemory = F)
 all(d3M[,,] == d3[,,])
 
-d3M[,,]
+all(id3[,1,,drop=TRUE] == d3M[,1,,drop=TRUE])
+all(id3[3,1,,drop=TRUE] == d3M[3,1,,drop=TRUE])
+all(id3[,1,,drop=FALSE] == d3M[,1,,drop=FALSE])
 
+all(id3[,1,1,drop=TRUE] == d3M[,1,1,drop=TRUE])
+all(id3[,1,1:2] == d3M[,1,1:2])
 
 ## 2 dimensional string dataset.
 d4 <- getH5Dataset(g, "ds_4", inMemory = T)