[H5r-commits] r13 - R inst src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Apr 23 02:14:41 CEST 2010
Author: extemporaneousb
Date: 2010-04-23 02:14:40 +0200 (Fri, 23 Apr 2010)
New Revision: 13
Modified:
R/h5R.R
inst/.Rhistory
inst/tests.R
src/h5_wrap.c
Log:
Still working on hyperslabs, indexing is a pain.
Modified: R/h5R.R
===================================================================
--- R/h5R.R 2010-04-22 01:28:39 UTC (rev 12)
+++ R/h5R.R 2010-04-23 00:14:40 UTC (rev 13)
@@ -99,30 +99,16 @@
})
.initH5DataContainer <- function(o, name, inMemory = TRUE) {
- o at name <- name
+ o at name <- name
o at h5Type <- getH5Type(o)
-
- d <- getH5Dim(o)
-
- ## I can preserve the dimensions on 2-d objects, but on
- ## >= 3 I reverse them. This is necessary because of the
- ## different ways of storing.
- if (length(d) == 2)
- o at dims <- d
- else if (length(d) > 2)
- o at dims <- rev(d)
- else
- o at dims <- d ## I store the length of the vector here, note that in
- ## dim I take this into account.
-
- ## This caches the data. At some point, we'll want to
- ## move away from this and just grab things from disk
- ## and provide a mechanism to cache.
+ o at dims <- getH5Dim(o)
+
if (! inMemory) {
o at .data <- NULL
} else {
o at .data <- new.env(parent = emptyenv(), hash = TRUE)
}
+
return(o)
}
@@ -138,7 +124,6 @@
return(.initH5DataContainer(o, attrName))
})
-
.internalSlice <- function(x, i, j, ..., drop = TRUE) {
if (!.hasData(x)) {
.putData(x, .loadDataset(x))
@@ -156,16 +141,27 @@
}
setMethod("[", "H5DataContainer", .internalSlice)
-setMethod("[", "H5Dataset", function(x, i, j, ..., drop = TRUE) {
+setMethod("[", "H5Dataset", function(x, i, j, ..., drop = FALSE) {
if (.inMemory(x)) {
- callNextMethod()
+ if (!.hasData(x)) {
+ .putData(x, .loadDataset(x))
+ }
+ d <- .getData(x)
+
+ if (is.null(dim(x))) {
+ if (! missing(j))
+ stop("incorrect number of dimensions")
+ d[i]
+ }
+ else {
+ d[i, j, ..., drop = drop]
+ }
}
-
- ##
- ## Currently, This supports only a limited range of slicing.
- ## contiguous chunks
- ##
else {
+ ##
+ ## Currently, This supports only a limited range of slicing.
+ ## contiguous chunks
+ ##
if (is.null(dim(x))) {
if (! missing(j))
stop("incorrect number of dimensions")
@@ -204,26 +200,27 @@
}
ext <- sel[,2] - sel[,1] + 1
-
- if (nrow(sel) == 2) {
- dta <- readSlab(x, sel[,1], ext)
- dta <- matrix(dta, nrow = ext[1], ncol = ext[2], byrow = TRUE)
- dta <- if (drop) drop(dta) else dta
- } else {
- dta <- readSlab(x, rev(sel[,1]), rev(ext))
- dim(dta) <- rev(ext)
- }
+ dta <- readSlab(x, sel[,1], ext)
}
return(dta)
}
})
+##
+## Note: the two reverses.
+##
+.myperm <- function(d) if (!is.null(dim(d))) aperm(d) else d
+.loadDataset <- function(h5Dataset) {
+ d <- readDataAsVector(h5Dataset)
+ dim(d) <- rev(dim(h5Dataset))
+ .myperm(d)
+}
+
readSlab <- function(h5Dataset, offsets, dims) {
-### stopifnot(length(offsets) == length(dims))
-### stopifnot(all((offsets + dims - 1) <=
-### (if (is.null(dim(h5Dataset))) length(h5Dataset) else dim(h5Dataset))))
- .Call("h5R_read_slab", .ePtr(h5Dataset), as.integer(offsets - 1), as.integer(dims))
+ d <- .Call("h5R_read_slab", .ePtr(h5Dataset), as.integer(offsets - 1), as.integer(dims))
+ dim(d) <- rev(dims)
+ .myperm(d)
}
setGeneric("readDataAsVector", function(h5Obj, ...) {
@@ -238,23 +235,6 @@
.Call('h5R_read_attr', .ePtr(h5Obj), PACKAGE = 'h5r')
})
-.loadDataset <- function(h5Dataset) {
- d <- readDataAsVector(h5Dataset)
-
- if (is.null(dim(h5Dataset)))
- return(d)
- else if (length(dim(h5Dataset)) == 2) {
- dim(d) <- rev(dim(h5Dataset))
- ## Again, for the common case of 2-d I preserve the dimensions
- ## as defined in the h5 file, but in higher dimensions they must
- ## be reversed.
- return(t(d))
- } else {
- dim(d) <- dim(h5Dataset)
- return(d)
- }
-}
-
setMethod("show", "H5Obj", function(object) {
cat("class of:", class(object), "\n")
})
Modified: inst/.Rhistory
===================================================================
--- inst/.Rhistory 2010-04-22 01:28:39 UTC (rev 12)
+++ inst/.Rhistory 2010-04-23 00:14:40 UTC (rev 13)
@@ -1,150 +1,150 @@
-diLong
-readSlab(diLong, 1, 100)
-diLong[1:100]
-seq.int(10000, 10)
-gc()
-gc()
-time()
-date()
-?date
-Sys.time()
-?system.time
-proc.time()
d3
-d2
-q()
-n
-d2
-nrow(d)
-debug("readSlab")
-n
-offsets + dims
-offsets + dims - 1
-Q
-d2
-gc()
-emptyenv()
-length(emptyenv())
-?callNextMethod
-?emptyenv
-setUnion
-setClassUnion
-?setClassUnion
-?setClassUnion
-readSlab
-ls()
-d
-d2
-readSlab(d2, c(1,1), c(1000, 10))
-length(readSlab(d2, c(1,1), c(1000, 10)))
-length(readSlab(d2, c(5,5), c(1000, 10)))
-length(readSlab(d2, c(1,5), c(1000, 5)))
-d
-d[1:10]
+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)
+d3 at .data
+d3 at .data$.data
+d3 at .data$datta
d[]
-d
-d[1:10]
-d2[1:10]
-d2[,] = d[,]
-c(1,2,3,4)[]
-d
-d at .data
-d2 at .data
-d2 at .data$.data
-b
-dM
-dMM
-dM
-dM[] == dMM
-dM[] == dMM[]
-dM[] == t(dMM[])
-dim(dM[])
-dim(dMM[])
-dM
-dM[1:5, 2]
-dMM[1:5, 2]
-dM[1,2]
-dM[1:4,2]
-dMM[1:10, 2]
-dM[1:10, 2]
-dM[1:10, 2] == dMM[1:10, 2]
-dM[1:5, 2] == dMM[1:999, 2]
-dMM[1:999, 2]
-dM[1:999, 2]
-dim(d3)
-dim(d3M)
-d3
+d3[]
+d3[,,]
+d3[,1,]
d3[1,,]
+d3 at .data$.data
+dim(d3 at .data$.data)
+d3[,,]
+d3[1,,]
+n
debug(.internalSlice)
-debug(h5r:::.internalSlice)
-debug(h5r:::.internalSlice)
-h5R:::.inMemory(d3)
-d3
-d3 at .data
-d3M at .data
-d3M at .data$.data
-d3
-d3M
-traceback()
-d3M at .data$data[,,]
-d3M at .data$data
-debug(h5r:::.internalSlice)
-traceback()
-c
-n
-dim(x)
-n
+x
i
-d
-c
+missing(i)
+missing(j)
+missing(...)
+missing(drop)
n
-x at .data$.data
n
-class(d)
- drop
-d[i, j, ..., drop = FALSE]
-dim(d)
-Q
-?callNextMethod
-traceback()
-a = function(a, ...) { list(...) }
-a(1)
-c
-x
-c
n
n
n
n
-...
+dim(x)
+missing(i)
+missing(j)
missing(...)
-list(...)
-class(...)
-mode(...)
-length(...)
+missing(drop)
+drop
+dim(d)
+d[]
+d[i,j,...]
+d[i,j,]
+d[i,j,...,drop = TRUE]
+missing(...)
+d[i, j, drop = drop]
+d[i, j, ]
+d[i, j, , drop = drop]
+d[i, j, ..., drop = drop]
+missing(...)
+d
+d[i, j, ..., drop = drop]
+d[i, j, , drop = drop]
+?"..."
+help.search("...")
?missing
substitute(...)
-length(substitute(...))
-class(substitute(...))
-Q
-?promise
-?substitue
-?substitute
-n
-n
-ext
-n
-n
-sel[,1]
-sel
-dim(x)
-l
-sel
-Q
-n
-readSlab(x, rev(sel[, 1]), rev(ext))
-Q
-n
-n
-n
-readSlab(x, rev(sel[, 1]), rev(ext))
+d[i,j,NULL]
+d[i,j,]
+d3
+d3[,,]
+dim(d3[,,])
+d3 at .data$.data
+dim(d3 at .data$.data)
+d3
+d3
+d3[,,]
+dim(d3[,,])
+dim(d3[1,,])
+d3[1,,]
+dim(d3[1,,])
+d3[1,,]
+d3[,,1]
+dim(d3)
+d3[1,,1]
+d3
+d3[]
+d3 at .data$.data
+d3 at .data$.data[]
+d3[]
+traceback()
+d3M[,,]
+?array
+?aperm
+ d3
+ d3[]
+ d3[,,]
+aperm( d3[,,], rev(dim(d3)))
+aperm( d3[,,], perm = rev(dim(d3)))
+?aperm
+aperm( d3[,,] )
+d3[1,,]
+d3[,,1]
+aperm(d3[,,1])
+dim(d3[,,1])
+aperm(drop(d3[,,1]))
+drop(d3[,,1])
+dim(d[1:10,]
+)
+dim(d)
+dim(d)
+dim(d[1:10,])
+dim(d[1:10,1])
+dim(d[1:10,1:2])
+d at .data
+d at .data$.data
+dim(d at .data$.data)
+d[1:10, ]
+d[1:10, ] = d[1:10, 1:10]
+d[1:10, ] == d[1:10, 1:10]
+d3
+d2
+d2
+d2[]
+d3[,,]
+d3M[]
+d3 at .data$.data
+d3 at .data$.data[,,1]
+Internal
+internal
+?Internal
+?internal
+?copy
+.Internal
+?.Internal
+.Internal(rnorm(100))
+.Internal(rnorm)
+.Machine
+d3
+d3[]
+d3[,,]
+?missing
Modified: inst/tests.R
===================================================================
--- inst/tests.R 2010-04-22 01:28:39 UTC (rev 12)
+++ inst/tests.R 2010-04-23 00:14:40 UTC (rev 13)
@@ -9,13 +9,14 @@
f <- H5File(files[1])
g <- getH5Group(f, "group_1")
-d <- getH5Dataset(g, "ds_1")
+d <- getH5Dataset(g, "ds_1", inMemory = T)
+
d[1:10, 1:10]
d[1:10,]
d[,1]
## string dataset
-d2 <- getH5Dataset(g, "ds_2")
+d2 <- getH5Dataset(g, "ds_2", inMemory = T)
d2[1:10]
## attributes
@@ -24,10 +25,22 @@
dim(c <- getH5Attribute(d2, "z"))
## > 2 dimensional data.
-d3 <- getH5Dataset(g, "ds_3")
+d3 <- getH5Dataset(g, "ds_3", inMemory = T)
+all(dim(d3[,,]) == dim(d3))
+id3 <- d3 at .data$.data
+all(id3[,,] == d3[,,])
+all(id3[,1,] == d3[,1,])
+
+
+d3M <- getH5Dataset(g, "ds_3", inMemory = F)
+all(d3M[,,] == d3[,,])
+
+d3M[,,]
+
+
## 2 dimensional string dataset.
-d4 <- getH5Dataset(g, "ds_4")
+d4 <- getH5Dataset(g, "ds_4", inMemory = T)
d4[,]
## instanteate a lot of objects, see if memory remains
Modified: src/h5_wrap.c
===================================================================
--- src/h5_wrap.c 2010-04-22 01:28:39 UTC (rev 12)
+++ src/h5_wrap.c 2010-04-23 00:14:40 UTC (rev 13)
@@ -193,7 +193,8 @@
default:
error("Unsupported class in h5R_read_dataset.");
}
- H5Dread(HID(h5_dataset), memtype, H5S_ALL, H5S_ALL, H5P_DEFAULT, buf);
+
+ H5Dread(HID(h5_dataset), memtype, H5S_ALL, H5S_ALL, H5P_DEFAULT, buf);
UNPROTECT(1);
return(dta);
@@ -286,3 +287,24 @@
return dta;
}
+
+
+ /* int rank = _h5R_get_ndims(h5_dataset); */
+ /* hsize_t* dims = Calloc(rank, hsize_t); */
+ /* hsize_t* odims = Calloc(rank, hsize_t); */
+
+ /* hid_t space = _h5R_get_space(h5_dataset); */
+
+ /* H5Sget_simple_extent_dims(space, odims, NULL); */
+
+ /* int i; */
+ /* for (i = 0; i < rank; i++) { */
+ /* dims[rank - i - 1] = odims[i]; */
+ /* } */
+
+ /* hsize_t mmm[2] = {H5S_UNLIMITED, H5S_UNLIMITED}; */
+
+ /* hid_t memspace = H5Screate_simple(rank, dims, mmm); */
+
+ /* for (i = 0; i < rank; i++) */
+ /* Rprintf("original: %d, reversed: %d \n", odims[i], dims[i]); */
More information about the H5r-commits
mailing list