[H5r-commits] r82 - / R inst/h5_files src tests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Aug 2 01:19:03 CEST 2012


Author: extemporaneousb
Date: 2012-08-02 01:19:03 +0200 (Thu, 02 Aug 2012)
New Revision: 82

Removed:
   BinaryFiles
Modified:
   DESCRIPTION
   NEWS
   R/h5R.R
   inst/h5_files/ex_1.h5
   inst/h5_files/makeH5.py
   src/h5_wrap.c
   tests/testRead.R
Log:
Major refactor of the package. Mostly behind the scene HDF5 wrapping code. Support for fixed-length string data.



Deleted: BinaryFiles
===================================================================
--- BinaryFiles	2012-07-11 01:20:46 UTC (rev 81)
+++ BinaryFiles	2012-08-01 23:19:03 UTC (rev 82)
@@ -1,8 +0,0 @@
-windows/i386/lib/libhdf5.a
-windows/i386/lib/libhdf5_hl.a
-windows/i386/lib/libsz.a
-windows/i386/lib/libz.a
-windows/x64/lib/libhdf5.a
-windows/x64/lib/libhdf5_hl.a
-windows/x64/lib/libsz.a
-windows/x64/lib/libz.a

Modified: DESCRIPTION
===================================================================
--- DESCRIPTION	2012-07-11 01:20:46 UTC (rev 81)
+++ DESCRIPTION	2012-08-01 23:19:03 UTC (rev 82)
@@ -1,12 +1,12 @@
 Package: h5r
 Type: Package
 Title: Interface to HDF5 Files
-Version: 1.3
+Version: 1.4
 Date: 2011-09-19
 Author: James Bullard
 Maintainer: <jbullard at pacificbiosciences.com>
 Depends: R (>= 2.10.0), methods
 Imports: utils, methods
-Description: A package for interfacing with HDF5 files.
+Description: A package for reading and writing HDF5 files.
 License: LGPL
 

Modified: NEWS
===================================================================
--- NEWS	2012-07-11 01:20:46 UTC (rev 81)
+++ NEWS	2012-08-01 23:19:03 UTC (rev 82)
@@ -1,5 +1,20 @@
         **************************************************
         *                                                *
+        *              1.4 SERIES NEWS                   *
+        *                                                *
+        **************************************************
+
+
+                CHANGES IN h5r VERSION 1.4
+
+NEW FEATURES
+    o Added real Windows support thanks to Mengjuei Hsieh
+    o Added support to read fixed length character strings
+    o Large cleanup of the C interface file
+
+
+        **************************************************
+        *                                                *
         *              1.3 SERIES NEWS                   *
         *                                                *
         **************************************************

Modified: R/h5R.R
===================================================================
--- R/h5R.R	2012-07-11 01:20:46 UTC (rev 81)
+++ R/h5R.R	2012-08-01 23:19:03 UTC (rev 82)
@@ -505,8 +505,7 @@
 readSlab <- function(h5Dataset, offsets, dims) {
   if (! all((offsets + dims - 1) <= dim(h5Dataset)))
     stop("error invalid slice specification in readSlab.")
-  
-  d <- .myCall("h5R_read_slab", .ePtr(h5Dataset), as.integer(offsets - 1), as.integer(dims))
+  d <- .myCall("h5R_read_dataset", .ePtr(h5Dataset), as.integer(offsets - 1), as.integer(dims))
   dim(d) <- rev(dims)
 
   if (! is.null(dim(h5Dataset))) aperm(d) else d
@@ -523,7 +522,14 @@
 }
 
 setMethod("readH5Data", "H5Dataset", function(h5Obj) {
-  .myCall('h5R_read_dataset', .ePtr(h5Obj))
+  ## nndims <- if (is.null(dim(h5Obj))) {
+  ##   length(h5Obj)
+  ## } else {
+  ##   dim(h5Obj)
+  ## }
+  ## .myCall('h5R_read_dataset', .ePtr(h5Obj), as.integer(rep(0, length(nndims))), as.integer(nndims));
+
+  .myCall('h5R_read_dataset_all', .ePtr(h5Obj))
 })
 
 setMethod("readH5Data", "H5Attribute", function(h5Obj) {

Modified: inst/h5_files/ex_1.h5
===================================================================
(Binary files differ)

Modified: inst/h5_files/makeH5.py
===================================================================
--- inst/h5_files/makeH5.py	2012-07-11 01:20:46 UTC (rev 81)
+++ inst/h5_files/makeH5.py	2012-08-01 23:19:03 UTC (rev 82)
@@ -48,4 +48,11 @@
 a = random.randint(1, 10000, prod([10]*5)).reshape(tuple([10]*5))
 g.create_dataset("ds_9", data = a, maxshape = tuple([None]*5))
 
+## create a fixed-length string dataset.
+g.create_dataset("ds_10", data = array(['rosalind', 'james', 'joseph', 'michael', 'rebecca']))
+
+letterArray = array(['a', 'bb', 'ccc', 'dddd', 'eeeee', 'ffffff'])
+g.create_dataset("ds_11", data = letterArray.reshape((2, 3)))
+
+
 f.close()

Modified: src/h5_wrap.c
===================================================================
--- src/h5_wrap.c	2012-07-11 01:20:46 UTC (rev 81)
+++ src/h5_wrap.c	2012-08-01 23:19:03 UTC (rev 82)
@@ -5,816 +5,735 @@
 #include <Rinternals.h>    
 #include <R.h>
 
-#define DEBUG 0
+#define DEBUG 1
 #define HID(argname) (((h5_holder*) R_ExternalPtrAddr(argname))->id)
 #define NM(argname) (CHAR(STRING_ELT(argname, 0)))
 #define SUCCESS ScalarLogical(1)
 #define FAILURE ScalarLogical(0)
 
 typedef struct h5_holder {
-    int is_file;
-    hid_t id;
+  int is_file;
+  hid_t id;
 } h5_holder;
 
 void h5R_finalizer(SEXP h5_obj) {
-    h5_holder* h = (h5_holder*) R_ExternalPtrAddr(h5_obj);
-    if (! h) {
-	return;
+  h5_holder* h = (h5_holder*) R_ExternalPtrAddr(h5_obj);
+  if (! h) {
+    return;
+  }
+  if (h->is_file == 1) {
+    H5Fflush(HID(h5_obj), H5F_SCOPE_GLOBAL);
+    H5Fclose(HID(h5_obj));
+  } else {
+    switch (H5Iget_type(HID(h5_obj))) {
+    case H5I_DATASET:
+      H5Dclose(HID(h5_obj));
+      break;
+    case H5I_ATTR:
+      H5Aclose(HID(h5_obj));
+      break;
+    case H5I_GROUP:
+      H5Gclose(HID(h5_obj));
+      break;
+    default:
+      break;
     }
-    if (h->is_file == 1) {
-	H5Fflush(HID(h5_obj), H5F_SCOPE_GLOBAL);
-	H5Fclose(HID(h5_obj));
-    } else {
-	switch (H5Iget_type(HID(h5_obj))) {
-	case H5I_DATASET:
-	    H5Dclose(HID(h5_obj));
-	    break;
-	case H5I_ATTR:
-	    H5Aclose(HID(h5_obj));
-	    break;
-	case H5I_GROUP:
-	    H5Gclose(HID(h5_obj));
-	    break;
-	default:
-	    break;
-	}
-    }
-    Free(h);
-    R_ClearExternalPtr(h5_obj);
+  }
+  Free(h);
+  R_ClearExternalPtr(h5_obj);
 }
 
 SEXP _h5R_make_holder (hid_t id, int is_file) {
-    if (id < 0) {
-	return R_NilValue;
-    } 
-    h5_holder* holder = (h5_holder*) Calloc(1, h5_holder);
-    holder->id = id;
-    holder->is_file = is_file;
-    SEXP e_ptr = R_MakeExternalPtr(holder, R_NilValue, R_NilValue); 
-    PROTECT(e_ptr);
-    R_RegisterCFinalizerEx(e_ptr, h5R_finalizer, TRUE);
-    UNPROTECT(1); 
-    return e_ptr;
+  if (id < 0) {
+    return R_NilValue;
+  } 
+  h5_holder* holder = (h5_holder*) Calloc(1, h5_holder);
+  holder->id = id;
+  holder->is_file = is_file;
+  SEXP e_ptr = R_MakeExternalPtr(holder, R_NilValue, R_NilValue); 
+  PROTECT(e_ptr);
+  R_RegisterCFinalizerEx(e_ptr, h5R_finalizer, TRUE);
+  UNPROTECT(1); 
+  return e_ptr;
 }
 
 SEXP h5R_flush(SEXP h5_file) {
-    H5Fflush(HID(h5_file), H5F_SCOPE_GLOBAL);
-    return SUCCESS;
+  H5Fflush(HID(h5_file), H5F_SCOPE_GLOBAL);
+  return SUCCESS;
 }
 
 SEXP h5R_open(SEXP filename, SEXP mode) {
-    int _mode_ = (INTEGER(mode)[0] == 1) ? H5F_ACC_RDWR : H5F_ACC_RDONLY;
-    return _h5R_make_holder(H5Fopen(NM(filename), _mode_, H5P_DEFAULT), 1);
+  int _mode_ = (INTEGER(mode)[0] == 1) ? H5F_ACC_RDWR : H5F_ACC_RDONLY;
+  return _h5R_make_holder(H5Fopen(NM(filename), _mode_, H5P_DEFAULT), 1);
 }
 
 SEXP h5R_create(SEXP filename) {
-    return _h5R_make_holder(H5Fcreate(NM(filename), H5F_ACC_EXCL, H5P_DEFAULT, H5P_DEFAULT), 1);
+  return _h5R_make_holder(H5Fcreate(NM(filename), H5F_ACC_EXCL, H5P_DEFAULT, H5P_DEFAULT), 1);
 }
 
 SEXP h5R_get_group(SEXP h5_obj, SEXP group_name) {
-    return _h5R_make_holder(H5Gopen2(HID(h5_obj), NM(group_name), H5P_DEFAULT), 0);
+  return _h5R_make_holder(H5Gopen2(HID(h5_obj), NM(group_name), H5P_DEFAULT), 0);
 }
 
 SEXP h5R_create_group(SEXP h5_obj, SEXP group_name) {
-    return _h5R_make_holder(H5Gcreate2(HID(h5_obj), NM(group_name), H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT), 0);
+  return _h5R_make_holder(H5Gcreate2(HID(h5_obj), NM(group_name), H5P_DEFAULT, H5P_DEFAULT, H5P_DEFAULT), 0);
 }
 
 SEXP h5R_get_dataset(SEXP h5_obj, SEXP dataset_name) {
-    return _h5R_make_holder(H5Dopen2(HID(h5_obj), NM(dataset_name), H5P_DEFAULT), 0);
+  return _h5R_make_holder(H5Dopen2(HID(h5_obj), NM(dataset_name), H5P_DEFAULT), 0);
 }
 
 SEXP h5R_get_attr(SEXP h5_obj, SEXP attr_name) {
-    return _h5R_make_holder(H5Aopen(HID(h5_obj), NM(attr_name), H5P_DEFAULT), 0);
+  return _h5R_make_holder(H5Aopen(HID(h5_obj), NM(attr_name), H5P_DEFAULT), 0);
 }
 
-SEXP h5R_get_type(SEXP h5_obj) {
-    SEXP dtype   = R_NilValue;
-    hid_t cls_id = -1;
+hid_t _h5R_get_space(SEXP h5_obj) {
+  hid_t space = -1;
 
-    switch (H5Iget_type(HID(h5_obj))) {
-    case H5I_DATASET:
-	cls_id = H5Dget_type(HID(h5_obj));
-	break;
-    case H5I_ATTR:
-	cls_id = H5Aget_type(HID(h5_obj));
-	break;
-    default:
-	error("Unkown object in %s.\n", __func__);
-    }
-    PROTECT(dtype = ScalarInteger(H5Tget_class(cls_id)));
-    H5Tclose(cls_id);
-    UNPROTECT(1);
+  switch (H5Iget_type(HID(h5_obj))) {
+  case H5I_DATASET:
+    space = H5Dget_space(HID(h5_obj));
+    break;
+  case H5I_ATTR:
+    space = H5Aget_space(HID(h5_obj));
+    break;
+  default:
+    error("Unknown object in %s.\n", __func__);
+  }
+  return space;
+}
 
-    return(dtype);
+hid_t _h5R_get_type(SEXP h5_obj) {
+  hid_t dtype = -1;
+
+  switch (H5Iget_type(HID(h5_obj))) {
+  case H5I_DATASET:
+    dtype = H5Dget_type(HID(h5_obj));
+    break;
+  case H5I_ATTR:
+    dtype = H5Aget_type(HID(h5_obj));
+    break;
+  default:
+    error("Unknown object in %s.\n", __func__);
+  }
+  return dtype;
 }
 
-hid_t _h5R_get_space(SEXP h5_obj) {
-    hid_t space = -1;
+int _h5R_get_size (SEXP h5_obj) {
+  int s = -1;
 
-    switch (H5Iget_type(HID(h5_obj))) {
-    case H5I_DATASET:
-	space = H5Dget_space(HID(h5_obj));
-	break;
-    case H5I_ATTR:
-	space = H5Aget_space(HID(h5_obj));
-	break;
-    default:
-	error("Unknown object in %s.\n", __func__);
-    }
-    return space;
+  switch (H5Iget_type(HID(h5_obj))) {
+  case H5I_DATASET:
+    s = H5Tget_size(H5Dget_type(HID(h5_obj)));
+    break;
+  case H5I_ATTR:
+    s = H5Tget_size(H5Aget_type(HID(h5_obj)));
+    break;
+  default:
+    error("Unknown object in %s.\n", __func__);
+  }
+  return s;
 }
 
+int _h5R_is_vlen (SEXP h5_obj) {
+  hid_t hdty = _h5R_get_type(h5_obj);
+  int rval = H5Tis_variable_str(hdty);
+  H5Tclose(hdty);
+  return rval;
+}
+
 int _h5R_get_ndims(SEXP h5_obj) {
-    hid_t space = _h5R_get_space(h5_obj);
-    int ndims = H5Sget_simple_extent_ndims(space);
-    H5Sclose(space);
-    return ((ndims < 0) ? 1 : ndims);
+  hid_t space = _h5R_get_space(h5_obj);
+  int ndims = H5Sget_simple_extent_ndims(space);
+  H5Sclose(space);
+  return ((ndims < 0) ? 1 : ndims);
 }
 
 int _h5R_get_nelts(SEXP h5_obj) {
-    int v = 1; int i;
-    int ndims = _h5R_get_ndims(h5_obj);
-    hid_t space = _h5R_get_space(h5_obj);
-    
-    hsize_t* dims = (hsize_t* ) Calloc(ndims, hsize_t);
-    H5Sget_simple_extent_dims(space, dims, NULL);
-    for (i = 0; i < ndims; i++)
-	v *= dims[i];
-    
-    Free(dims);
-    H5Sclose(space);
+  int v = 1; int i;
+  int ndims = _h5R_get_ndims(h5_obj);
+  hid_t space = _h5R_get_space(h5_obj);
+  hsize_t* dims = (hsize_t* ) Calloc(ndims, hsize_t);
+  H5Sget_simple_extent_dims(space, dims, NULL);
+  for (i = 0; i < ndims; i++)
+    v *= dims[i];
+  Free(dims);
+  H5Sclose(space);
+  return(v);
+}
 
-    return(v);
+SEXP h5R_get_type(SEXP h5_obj) {
+  SEXP dtype = R_NilValue;
+  hid_t hdty = _h5R_get_type(h5_obj);
+  PROTECT(dtype = ScalarInteger(H5Tget_class(hdty)));
+  H5Tclose(hdty);
+  UNPROTECT(1);
+  return(dtype);
 }
 
 SEXP h5R_get_dims(SEXP h5_obj) {
-    int i; SEXP res; 
-    int ndims = _h5R_get_ndims(h5_obj);
-    hid_t space = _h5R_get_space(h5_obj);
+  int i; SEXP res; 
+  int ndims = _h5R_get_ndims(h5_obj);
+  hid_t space = _h5R_get_space(h5_obj);
 
-    hsize_t* dims = (hsize_t* ) Calloc(ndims, hsize_t);
-    H5Sget_simple_extent_dims(space, dims, NULL);
+  hsize_t* dims = (hsize_t* ) Calloc(ndims, hsize_t);
+  H5Sget_simple_extent_dims(space, dims, NULL);
     
-    PROTECT(res = allocVector(INTSXP, ndims)); 
-    for (i = 0; i < ndims; i++)
-	INTEGER(res)[i] = dims[i];
-    UNPROTECT(1);
+  PROTECT(res = allocVector(INTSXP, ndims)); 
+  for (i = 0; i < ndims; i++)
+    INTEGER(res)[i] = dims[i];
+  UNPROTECT(1);
     
-    Free(dims);
-    H5Sclose(space);
+  Free(dims);
+  H5Sclose(space);
     
-    return res;
+  return res;
 }
 
-int _h5R_is_vlen (SEXP h5_obj) {
-    hid_t dtype = -1;
-
-    switch (H5Iget_type(HID(h5_obj))) {
-    case H5I_DATASET:
-	dtype = H5Dget_type(HID(h5_obj));
-	break;
-    case H5I_ATTR:
-	dtype = H5Aget_type(HID(h5_obj));
-	break;
-    default:
-	error("Unknown object in %s.\n", __func__);
-    }
-    return H5Tis_variable_str(dtype);
+/** ******************************************************************************
+ *
+ * Read API
+ *
+ ******************************************************************************* **/
+SEXP _h5R_read_integer(SEXP h5_obj, int nelts, hid_t memspace, hid_t filespace) {
+  SEXP dta;
+  PROTECT(dta = allocVector(INTSXP, nelts));
+  if (H5Iget_type(HID(h5_obj)) == H5I_DATASET) {
+    H5Dread(HID(h5_obj), H5T_NATIVE_INT, memspace, filespace, H5P_DEFAULT, INTEGER(dta));
+  } else {
+    H5Aread(HID(h5_obj), H5T_NATIVE_INT, INTEGER(dta)); 
+  }
+  UNPROTECT(1);
+  return dta;
 }
 
-int _h5R_get_size (SEXP h5_obj) {
-    int s = -1;
-
-    switch (H5Iget_type(HID(h5_obj))) {
-    case H5I_DATASET:
-	s = H5Tget_size(H5Dget_type(HID(h5_obj)));
-	break;
-    case H5I_ATTR:
-	s = H5Tget_size(H5Aget_type(HID(h5_obj)));
-	break;
-    default:
-	error("Unknown object in %s.\n", __func__);
-    }
-    return s;
+SEXP _h5R_read_float(SEXP h5_obj, int nelts, hid_t memspace, hid_t filespace) {
+  SEXP dta;
+  PROTECT(dta = allocVector(REALSXP, nelts));
+  if (H5Iget_type(HID(h5_obj)) == H5I_DATASET) {
+    H5Dread(HID(h5_obj), H5T_NATIVE_DOUBLE, memspace, filespace, H5P_DEFAULT, REAL(dta));
+  } else {
+    H5Aread(HID(h5_obj), H5T_NATIVE_DOUBLE, REAL(dta));
+  }
+  UNPROTECT(1);
+  return dta;
 }
 
-SEXP _h5R_read_compound_dataset(SEXP h5_obj) {
-    error("This functionality doesn't yet exist.\n");
+SEXP _h5R_read_string(SEXP h5_obj, int nelts, hid_t memspace, hid_t filespace) {
+  SEXP dta = R_NilValue;
+  void* buf; 
+  char** rdata = (char **) Calloc(nelts, char*);
+  hid_t memtype = H5Tcopy (H5T_C_S1);
 
-    int nelts = _h5R_get_nelts(h5_obj);
-    int size  = _h5R_get_size(h5_obj);
-    int nmembers = H5Tget_nmembers(H5Dget_type(HID(h5_obj)));
+  if (! _h5R_is_vlen(h5_obj)) { 
+    int sdim = _h5R_get_size(h5_obj) + 1; 
+    rdata[0] = (char *) Calloc(nelts * sdim, char);
+    for (int i = 1; i < nelts; i++)
+      rdata[i] = rdata[0] + i * sdim;
+    H5Tset_size (memtype, sdim);
+    buf = rdata[0];
+  } 
+  else {
+    H5Tset_size(memtype, H5T_VARIABLE);
+    buf = rdata;
+  }
 
-    Rprintf("nelts:%d\n", nelts);
-    Rprintf("size:%d\n", size);
-    Rprintf("nmembers:%d\n", nmembers);
-    
-    /*hid_t space = H5Dget_space(HID(h5_obj));*/
-    hid_t memtype = H5Tcreate(H5T_COMPOUND, nmembers*sizeof(int));
-    for (int i = 0; i < nmembers; i++) {
-	H5Tinsert(memtype, 
-		  H5Tget_member_name(H5Dget_type(HID(h5_obj)), i),
-		  H5Tget_member_offset(H5Dget_type(HID(h5_obj)), i),
-		  H5Tget_class(H5Tget_member_type(H5Dget_type(HID(h5_obj)), i)));
-    }
-    /* void* p = (int**) malloc(sizeof(int) * nmembers * nelts); */
-    /* H5Dread(HID(h5_obj), memtype, H5S_ALL, H5S_ALL, H5P_DEFAULT, p); */
-    /* for (int i; i < nelts; i++) { */
-    /* 	Rprintf("%d, %d\n", ((int*) p)[0][i], ((int*) p)[1][i]); */
-    /* } */
-    
-    return h5R_get_dims(h5_obj);
-}
+  if (H5Iget_type(HID(h5_obj)) == H5I_DATASET) {
+    H5Dread(HID(h5_obj), memtype, memspace, filespace, H5P_DEFAULT, buf);
+  } else {
+    H5Aread(HID(h5_obj), memtype, buf);
+  }
 
-SEXP _h5R_read_vlen_str(SEXP h5_obj) {
-    int __ERROR__ = 0;
-    int i = -1;
-    SEXP res = R_NilValue;
-    void* buf;
-    
-    int nelts     = _h5R_get_nelts(h5_obj);
-    char** rdata  = (char **) Calloc(nelts, char*);
-    hid_t memtype = H5Tcopy (H5T_C_S1);
+  PROTECT(dta = allocVector(STRSXP, nelts));
+  for (int i = 0; i < nelts; i++) {
+    if (rdata[i]) 
+      SET_STRING_ELT(dta, i, mkChar(rdata[i])); 
+  }
+  UNPROTECT(1); 
 
-    if (! _h5R_is_vlen(h5_obj)) {
-	H5Tset_size(memtype, _h5R_get_size(h5_obj) + 1);
-	for (i = 0; i < nelts; i++) {
-	    rdata[i] = (char *) Calloc(_h5R_get_size(h5_obj) + 1, char*);
-	}
-	buf = rdata[0];
+  if (_h5R_is_vlen(h5_obj)) {
+    // It doesn't like the H5S_ALL space in the vlen_reclaim.
+    if (memspace == H5S_ALL) {
+      hid_t space = _h5R_get_space(h5_obj);
+      H5Dvlen_reclaim (memtype, space, H5P_DEFAULT, buf);
+      H5Sclose(space);
+    } else {
+      H5Dvlen_reclaim (memtype, memspace, H5P_DEFAULT, buf);
     }
-    else {
-	H5Tset_size(memtype, H5T_VARIABLE);
-	buf = rdata;
-    }
-    
-    switch (H5Iget_type(HID(h5_obj))) {
-    case H5I_DATASET:
-	H5Dread(HID(h5_obj), memtype, H5S_ALL, H5S_ALL, H5P_DEFAULT, buf);
-	break;
-    case H5I_ATTR:
-	H5Aread(HID(h5_obj), memtype, buf);
-	break;
-    default:
-	__ERROR__ = 1;	
-    }
-    
-    if (__ERROR__ == 0) {
-	PROTECT(res = allocVector(STRSXP, nelts));
-	for (i = 0; i < nelts; i++) {
-	    if (rdata[i]) {
-		SET_STRING_ELT(res, i, mkChar(rdata[i])); 
-	    }
-	}
-	UNPROTECT(1); 
-    }
-    
-    /** Cleanup. **/
-    if (_h5R_is_vlen(h5_obj)) {
-	hid_t space = _h5R_get_space(h5_obj);
-	H5Dvlen_reclaim (memtype, space, H5P_DEFAULT, rdata);
-	H5Sclose(space);
-    } 
-    else {
-	for (i = 0; i < nelts; i++)
-	    Free(rdata[i]);
-    }
-    Free(rdata);
-    H5Tclose(memtype);
+  } else {
+    Free(buf);
+  }
+  Free(rdata);
 
-    if (__ERROR__ == 1) {
-	error("Unsupported class in %s.\n", __func__);
-    }
+  return dta;
+}
 
-    return res;
+SEXP _h5R_read_compound(SEXP h5_obj, int nelts, hid_t memspace, hid_t filespace) {
+  return R_NilValue;
 }
 
-SEXP h5R_read_dataset(SEXP h5_dataset) {
-    SEXP dta = R_NilValue;
-    hid_t memtype = -1;
-    void* buf = NULL; 
-    
+SEXP h5R_read_dataset_all(SEXP h5_dataset) {
+  SEXP dta = R_NilValue;
 
-    switch (INTEGER(h5R_get_type(h5_dataset))[0]) {
-    case H5T_INTEGER: 
-	PROTECT(dta = allocVector(INTSXP, _h5R_get_nelts(h5_dataset)));
-	memtype = H5T_NATIVE_INT;
-	buf = INTEGER(dta);
-	break;
-    case H5T_FLOAT:
-	PROTECT(dta = allocVector(REALSXP, _h5R_get_nelts(h5_dataset)));
-	memtype = H5T_NATIVE_DOUBLE;
-	buf = REAL(dta);
-	break;
-    case H5T_STRING:
-	return _h5R_read_vlen_str(h5_dataset);
-    case H5T_COMPOUND:
-	return _h5R_read_compound_dataset(h5_dataset);
-    default:
-	error("Unsupported class in %s.\n", __func__);
-    }
-
-    H5Dread(HID(h5_dataset), memtype, H5S_ALL, H5S_ALL, H5P_DEFAULT, buf); 
-    UNPROTECT(1);
-
-    return(dta);
+  switch (INTEGER(h5R_get_type(h5_dataset))[0]) {
+  case H5T_INTEGER: 
+    dta = _h5R_read_integer(h5_dataset, _h5R_get_nelts(h5_dataset), H5S_ALL, H5S_ALL);
+    break;
+  case H5T_FLOAT:
+    dta = _h5R_read_float(h5_dataset, _h5R_get_nelts(h5_dataset), H5S_ALL, H5S_ALL);
+    break;
+  case H5T_STRING:
+    dta = _h5R_read_string(h5_dataset, _h5R_get_nelts(h5_dataset), H5S_ALL, H5S_ALL);
+    break;
+  case H5T_COMPOUND:
+    dta = _h5R_read_compound(h5_dataset, _h5R_get_nelts(h5_dataset), H5S_ALL, H5S_ALL);
+    break;
+  default:
+    dta = R_NilValue;
+  }
+  return dta;
 }
 
-SEXP h5R_create_dataset(SEXP h5_obj, SEXP name, SEXP h5_type, SEXP dims, SEXP chunks) {
-    int i; 
-    
-    hsize_t* current_dims = (hsize_t*) Calloc(length(dims), hsize_t);
-    hsize_t* max_dims = (hsize_t*) Calloc(length(dims), hsize_t);
-    hsize_t* chunk_lens = (hsize_t*) Calloc(length(chunks), hsize_t);
+SEXP h5R_read_dataset(SEXP h5_dataset, SEXP _offsets, SEXP _counts) {
+  SEXP dta = R_NilValue;
+  hid_t filespace = -1, memspace = -1;
+  int nelts = 1;
 
-    for (i = 0; i < length(dims); i++) {
-	current_dims[i] = INTEGER(dims)[i];
-	max_dims[i]     = H5S_UNLIMITED;
-	chunk_lens[i]   = INTEGER(chunks)[i];
-    }
-    
-    hid_t memtype = -1;
-
-    switch (INTEGER(h5_type)[0]) {
-    case H5T_INTEGER: 
-	memtype = H5T_NATIVE_INT;
-	break;
-    case H5T_FLOAT:
-	memtype = H5T_NATIVE_DOUBLE;
-	break;
-    case H5T_STRING:
-	memtype = H5Tcopy (H5T_C_S1);
-	H5Tset_size (memtype, H5T_VARIABLE);   
-	break;
-    default:
-	error("Unsupported class in %s.\n", __func__);
-    }
-   
-    hid_t cparms = H5Pcreate(H5P_DATASET_CREATE);
-    H5Pset_chunk(cparms, length(chunks), chunk_lens);
-    
-    hid_t dataspace = H5Screate_simple(length(dims), current_dims, max_dims);
-    hid_t dataset   = H5Dcreate2(HID(h5_obj), NM(name), memtype, 
-				 dataspace, H5P_DEFAULT, cparms, H5P_DEFAULT);
-    
-    H5Pclose(cparms);
-    H5Sclose(dataspace);
-
-    Free(max_dims);
-    Free(current_dims);
-    Free(chunk_lens);
+  hsize_t* _h_offsets = (hsize_t*) Calloc(length(_counts), hsize_t);
+  hsize_t* _h_counts  = (hsize_t*) Calloc(length(_counts), hsize_t);
   
-    return _h5R_make_holder(dataset, 0);
+  for (int i = 0; i < length(_counts); i++) {
+    nelts *= INTEGER(_counts)[i];
+    _h_offsets[i] = INTEGER(_offsets)[i];
+    _h_counts[i] = INTEGER(_counts)[i];
+  }
+  filespace = _h5R_get_space(h5_dataset);
+  H5Sselect_hyperslab(filespace, H5S_SELECT_SET, _h_offsets, NULL, _h_counts, NULL);
+  memspace = H5Screate_simple(length(_counts), _h_counts, NULL);
+  
+  switch (INTEGER(h5R_get_type(h5_dataset))[0]) {
+  case H5T_INTEGER: 
+    dta = _h5R_read_integer(h5_dataset, nelts, memspace, filespace);
+    break;
+  case H5T_FLOAT:
+    dta = _h5R_read_float(h5_dataset, nelts, memspace, filespace);
+    break;
+  case H5T_STRING:
+    dta = _h5R_read_string(h5_dataset, nelts, memspace, filespace);
+    break;
+  case H5T_COMPOUND:
+    dta = _h5R_read_compound(h5_dataset, nelts, memspace, filespace);
+    break;
+  default:
+    dta = R_NilValue;
+  }
+  Free(_h_offsets);
+  Free(_h_counts);
+  H5Sclose(memspace);
+  H5Sclose(filespace);
+  
+  if (dta == R_NilValue) {
+    error("Unsupported class in %s\n", __func__);
+  }
+  return dta;
 }
 
-SEXP h5R_write_slab(SEXP h5_dataset, SEXP _offsets, SEXP _counts, SEXP data) {
-    int __ERROR__ = 0;
-    hid_t space = -1, memspace = -1, memtype = -1;
-    int i; 
-    void* _data; 
-    char** tmp;
+SEXP h5R_read_points(SEXP h5_dataset, SEXP _points, SEXP _nr, SEXP _nc) {
+  SEXP dta = R_NilValue;
+  hid_t filespace = -1, memspace = -1;
 
-    int* offsets  = INTEGER(_offsets);
-    int* counts   = INTEGER(_counts);
+  int nr = INTEGER(_nr)[0];
+  int nc = INTEGER(_nc)[0];
 
-    /** I'm surprised I have to do this, but it seems to be necessary. **/
-    hsize_t* _h_offsets = (hsize_t*) Calloc(length(_counts), hsize_t);
-    hsize_t* _h_counts  = (hsize_t*) Calloc(length(_counts), hsize_t);
+  hsize_t* points = (hsize_t*) Calloc(nr*nc, hsize_t);
+  for (int i = 0; i < nr*nc; i++)	
+    points[i] = INTEGER(_points)[i];
+  hsize_t hnr = nr;
 
-    for (i = 0; i < length(_counts); i++) {
-	_h_offsets[i] = offsets[i];
-	_h_counts[i]  = counts[i];
-    }
+  filespace = _h5R_get_space(h5_dataset);
+  H5Sselect_elements(filespace, H5S_SELECT_SET, nr, points);
+  memspace = H5Screate_simple(nc, &hnr, NULL);
 
-    space = _h5R_get_space(h5_dataset);
-    H5Sselect_hyperslab(space, H5S_SELECT_SET, _h_offsets, NULL, _h_counts, NULL);
-    memspace = H5Screate_simple(length(_counts), _h_counts, NULL);
+  switch (INTEGER(h5R_get_type(h5_dataset))[0]) {
+  case H5T_INTEGER: 
+    dta = _h5R_read_integer(h5_dataset, length(_points), memspace, filespace);
+    break;
+  case H5T_FLOAT:
+    dta = _h5R_read_float(h5_dataset, length(_points), memspace, filespace);
+    break;
+  case H5T_STRING:
+    dta = _h5R_read_string(h5_dataset, length(_points), memspace, filespace);
+    break;
+  case H5T_COMPOUND:
+    dta = _h5R_read_compound(h5_dataset, length(_points), memspace, filespace);
+    break;
+  default:
+    dta = R_NilValue;
+  }
 
-    int memtype_int = INTEGER(h5R_get_type(h5_dataset))[0];
+  /** clean up. **/
+  Free(points);
+  H5Sclose(memspace);
+  H5Sclose(filespace);
     
-    switch (memtype_int) {
-    case H5T_INTEGER: 
-	memtype = H5T_NATIVE_INT;
-	_data = (void*) INTEGER(data);
-	break;
-    case H5T_FLOAT:
-	memtype = H5T_NATIVE_DOUBLE;
-	_data = (void*) REAL(data);
-	break;
-    case H5T_STRING:
-	memtype = H5Tcopy (H5T_C_S1);
-	H5Tset_size (memtype, H5T_VARIABLE);   
-	tmp = (char**) Calloc(length(data), char*);
-	for (i = 0; i < length(data); i++)
-	    tmp[i] = (char*) CHAR(STRING_ELT(data, i));
-	_data = (void*) tmp;
-	break;
-    default:
-	__ERROR__ = 1;
-    }
+  if (dta == R_NilValue) {
+    error("Unsupported class in %s\n", __func__);
+  }
+  return dta;
+}
 
-    if (__ERROR__ == 0) {
-	H5Dwrite(HID(h5_dataset), memtype, memspace, space, H5P_DEFAULT, _data);
-	if (memtype_int == H5T_STRING) Free(tmp);
-    }
+SEXP h5R_read_attr(SEXP h5_attr) {
+  SEXP dta = R_NilValue;
 
-    /** clean up. **/
-    Free(_h_offsets);
-    Free(_h_counts);
-    H5Sclose(memspace);
-    H5Sclose(space);
+  switch (INTEGER(h5R_get_type(h5_attr))[0]) {
+  case H5T_INTEGER:
+    dta = _h5R_read_integer(h5_attr, _h5R_get_nelts(h5_attr), H5S_ALL, H5S_ALL);
+    break;
+  case H5T_FLOAT:
+    dta = _h5R_read_float(h5_attr, _h5R_get_nelts(h5_attr), H5S_ALL, H5S_ALL);
+    break;
+  case H5T_STRING:
+    dta =  _h5R_read_string(h5_attr, _h5R_get_nelts(h5_attr), H5S_ALL, H5S_ALL);
+    break;
+  default:
+    error("Unsupported class in %s.\n", __func__);
+  }
+  return dta;
+}
+
+/** This is an optimization to a very common use case of 1-d slabs. **/
+SEXP h5R_read_1d_slabs(SEXP h5_dataset, SEXP _offsets, SEXP _counts) {
+  int rlen = length(_counts);
+  SEXP r_lst, _SEXP_offsets, _SEXP_counts;
+  int i;
+  int* counts = INTEGER(_counts);
+  int* offsets = INTEGER(_offsets);
     
-    if (__ERROR__ == 1) {
-	error("Unsupported class in %s\n", __func__);
-	return FAILURE;
-    }
-    return SUCCESS;
+  PROTECT(r_lst = allocVector(VECSXP, rlen));
+  PROTECT(_SEXP_offsets = allocVector(INTSXP, 1));
+  PROTECT(_SEXP_counts  = allocVector(INTSXP, 1));
+    
+  for (i = 0; i < rlen; i++) {
+    INTEGER(_SEXP_offsets)[0] = offsets[i];
+    INTEGER(_SEXP_counts)[0] = counts[i];
+    SET_VECTOR_ELT(r_lst, i, h5R_read_dataset(h5_dataset, _SEXP_offsets, _SEXP_counts));
+  }
+  UNPROTECT(3);
+  return(r_lst);
 }
 
 
-SEXP h5R_read_slab(SEXP h5_dataset, SEXP _offsets, SEXP _counts) {
-    int __ERROR__ = 0;
-    SEXP dta = R_NilValue;
-    hid_t space = -1, memspace = -1, memtype = -1;
-    void* buf = NULL; 
-    int i; 
+/** ******************************************************************************
+ *
+ * Write API
+ *
+ ******************************************************************************* **/
+SEXP h5R_create_dataset(SEXP h5_obj, SEXP name, SEXP h5_type, SEXP dims, SEXP chunks) {
+  int i; 
+    
+  hsize_t* current_dims = (hsize_t*) Calloc(length(dims), hsize_t);
+  hsize_t* max_dims = (hsize_t*) Calloc(length(dims), hsize_t);
+  hsize_t* chunk_lens = (hsize_t*) Calloc(length(chunks), hsize_t);
 
-    int* offsets  = INTEGER(_offsets);
-    int* counts   = INTEGER(_counts);
-
-    /** I'm surprised I have to do this, but it seems to be necessary. **/
-    hsize_t* _h_offsets = (hsize_t*) Calloc(length(_counts), hsize_t);
-    hsize_t* _h_counts  = (hsize_t*) Calloc(length(_counts), hsize_t);
-
-    int v = 1;
-    for (i = 0; i < length(_counts); i++) {
-    	v *= counts[i];
-	_h_offsets[i] = offsets[i];
-	_h_counts[i]  = counts[i];
-    }
-
-    space = _h5R_get_space(h5_dataset);
-    H5Sselect_hyperslab(space, H5S_SELECT_SET, _h_offsets, NULL, _h_counts, NULL);
-    memspace = H5Screate_simple(length(_counts), _h_counts, NULL);
-
-    switch (INTEGER(h5R_get_type(h5_dataset))[0]) {
-    case H5T_INTEGER: 
-	PROTECT(dta = allocVector(INTSXP, v));
-	memtype = H5T_NATIVE_INT;
-	buf = INTEGER(dta);
-	break;
-    case H5T_FLOAT:
-	PROTECT(dta = allocVector(REALSXP, v));
-	memtype = H5T_NATIVE_DOUBLE;
-	buf = REAL(dta);
-	break;
-    case H5T_STRING:
-	buf = (char **) Calloc(v, char*);
-	memtype = H5Tcopy (H5T_C_S1);
-	H5Tset_size (memtype, H5T_VARIABLE);   
-	break;
-    default:
-	__ERROR__ = 1;
-    }
+  for (i = 0; i < length(dims); i++) {
+    current_dims[i] = INTEGER(dims)[i];
+    max_dims[i]     = H5S_UNLIMITED;
+    chunk_lens[i]   = INTEGER(chunks)[i];
+  }
     
-    if (__ERROR__ == 0) {
-	H5Dread(HID(h5_dataset), memtype, memspace, space, H5P_DEFAULT, buf);
-	/** There requires a little more with strings. **/
-	if (H5T_STRING == INTEGER(h5R_get_type(h5_dataset))[0]) {
-	    PROTECT(dta = allocVector(STRSXP, v));
-	    for (i = 0; i < v; i++) {
-		if (((char **) buf)[i]) {
-		    SET_STRING_ELT(dta, i, mkChar(  ((char **) buf)[i] )); 
-		}
-	    }
-	    H5Dvlen_reclaim (memtype, memspace, H5P_DEFAULT, buf);
-	    H5Tclose(memtype);
-	    Free(buf);
-	}
-    }
-    /** clean up. **/
-    Free(_h_offsets);
-    Free(_h_counts);
-    H5Sclose(memspace);
-    H5Sclose(space);
-    UNPROTECT(1);
-    
-    if (__ERROR__ == 1) {
-	error("Unsupported class in %s\n", __func__);
-    }
-    return dta;
-}
+  hid_t memtype = -1;
 
-/** This is an optimization to a very common use case of 1-d slabs. **/
-SEXP h5R_read_1d_slabs(SEXP h5_dataset, SEXP _offsets, SEXP _counts) {
-    int rlen = length(_counts);
-    SEXP r_lst, _SEXP_offsets, _SEXP_counts;
-    int i;
-    int* counts = INTEGER(_counts);
-    int* offsets = INTEGER(_offsets);
+  switch (INTEGER(h5_type)[0]) {
+  case H5T_INTEGER: 
+    memtype = H5T_NATIVE_INT;
+    break;
+  case H5T_FLOAT:
+    memtype = H5T_NATIVE_DOUBLE;
+    break;
+  case H5T_STRING:
+    memtype = H5Tcopy (H5T_C_S1);
+    H5Tset_size (memtype, H5T_VARIABLE);   
+    break;
+  default:
+    error("Unsupported class in %s.\n", __func__);
+  }
+   
+  hid_t cparms = H5Pcreate(H5P_DATASET_CREATE);
+  H5Pset_chunk(cparms, length(chunks), chunk_lens);
     
-    PROTECT(r_lst = allocVector(VECSXP, rlen));
-    PROTECT(_SEXP_offsets = allocVector(INTSXP, 1));
-    PROTECT(_SEXP_counts  = allocVector(INTSXP, 1));
+  hid_t dataspace = H5Screate_simple(length(dims), current_dims, max_dims);
+  hid_t dataset   = H5Dcreate2(HID(h5_obj), NM(name), memtype, 
+			       dataspace, H5P_DEFAULT, cparms, H5P_DEFAULT);
     
-    for (i = 0; i < rlen; i++) {
-	INTEGER(_SEXP_offsets)[0] = offsets[i];
-	INTEGER(_SEXP_counts)[0] = counts[i];
-	SET_VECTOR_ELT(r_lst, i, h5R_read_slab(h5_dataset, _SEXP_offsets, 
-					       _SEXP_counts));
-    }
-    UNPROTECT(3);
-    return(r_lst);
+  H5Pclose(cparms);
+  H5Sclose(dataspace);
+
+  Free(max_dims);
+  Free(current_dims);
+  Free(chunk_lens);
+  
+  return _h5R_make_holder(dataset, 0);
 }
 
-SEXP h5R_read_points(SEXP h5_dataset, SEXP _points, SEXP _nr, SEXP _nc) {
-    int __ERROR__ = 0;
-    SEXP dta      = R_NilValue;
-    hid_t space   = -1, memspace = -1, memtype = -1;
-    void* buf     = NULL; 
-    int i; 
+SEXP h5R_write_slab(SEXP h5_dataset, SEXP _offsets, SEXP _counts, SEXP data) {
+  int __ERROR__ = 0;
+  hid_t space = -1, memspace = -1, memtype = -1;
+  int i; 
+  void* _data; 
+  char** tmp;
 
-    int nr = INTEGER(_nr)[0];
-    int nc = INTEGER(_nc)[0];
+  int* offsets  = INTEGER(_offsets);
+  int* counts   = INTEGER(_counts);
 
-    /** I'm surprised I have to do this, but it seems to be necessary. **/
-    hsize_t* points = (hsize_t*) Calloc(nr*nc, hsize_t);
-    for (i = 0; i < nr*nc; i++)	points[i] = INTEGER(_points)[i];
+  /** I'm surprised I have to do this, but it seems to be necessary. **/
+  hsize_t* _h_offsets = (hsize_t*) Calloc(length(_counts), hsize_t);
+  hsize_t* _h_counts  = (hsize_t*) Calloc(length(_counts), hsize_t);
 
-    hsize_t hnr = nr;
+  for (i = 0; i < length(_counts); i++) {
+    _h_offsets[i] = offsets[i];
+    _h_counts[i]  = counts[i];
+  }
 
-    space = _h5R_get_space(h5_dataset);
-    H5Sselect_elements(space, H5S_SELECT_SET, nr, points);
-    memspace = H5Screate_simple(nc, &hnr, NULL);
+  space = _h5R_get_space(h5_dataset);
+  H5Sselect_hyperslab(space, H5S_SELECT_SET, _h_offsets, NULL, _h_counts, NULL);
+  memspace = H5Screate_simple(length(_counts), _h_counts, NULL);
 
-    switch (INTEGER(h5R_get_type(h5_dataset))[0]) {
-    case H5T_INTEGER: 
-	PROTECT(dta = allocVector(INTSXP, length(_points)));
-	memtype = H5T_NATIVE_INT;
-	buf = INTEGER(dta);
-	break;
-    case H5T_FLOAT:
-	PROTECT(dta = allocVector(REALSXP, length(_points)));
-	memtype = H5T_NATIVE_DOUBLE;
-	buf = REAL(dta);
-	break;
-    case H5T_STRING:
-	buf = (char **) Calloc(length(_points), char*);
-	memtype = H5Tcopy (H5T_C_S1);
-	H5Tset_size (memtype, H5T_VARIABLE);   
-	break;
-    default:
-	__ERROR__ = 1;
-    }
+  int memtype_int = INTEGER(h5R_get_type(h5_dataset))[0];
+    
+  switch (memtype_int) {
+  case H5T_INTEGER: 
+    memtype = H5T_NATIVE_INT;
+    _data = (void*) INTEGER(data);
+    break;
+  case H5T_FLOAT:
+    memtype = H5T_NATIVE_DOUBLE;
+    _data = (void*) REAL(data);
+    break;
+  case H5T_STRING:
+    memtype = H5Tcopy (H5T_C_S1);
+    H5Tset_size (memtype, H5T_VARIABLE);   
+    tmp = (char**) Calloc(length(data), char*);
+    for (i = 0; i < length(data); i++)
+      tmp[i] = (char*) CHAR(STRING_ELT(data, i));
+    _data = (void*) tmp;
+    break;
+  default:
+    __ERROR__ = 1;
+  }
 
-    if (__ERROR__ == 0) {
-	H5Dread(HID(h5_dataset), memtype, memspace, space, H5P_DEFAULT, buf);
+  if (__ERROR__ == 0) {
+    H5Dwrite(HID(h5_dataset), memtype, memspace, space, H5P_DEFAULT, _data);
+    if (memtype_int == H5T_STRING) Free(tmp);
+  }
 
-	/** There requires a little more with strings. **/
-	if (H5T_STRING == INTEGER(h5R_get_type(h5_dataset))[0]) {
-	    PROTECT(dta = allocVector(STRSXP, nr));
-	    for (i = 0; i < nr; i++)
-		if (((char **) buf)[i]) {
-		    SET_STRING_ELT(dta, i, mkChar(  ((char **) buf)[i] ));
-		}
-	    H5Dvlen_reclaim (memtype, memspace, H5P_DEFAULT, buf);
-	    H5Tclose(memtype);
-	    Free(buf);
-	}
-    }
-
-    /** clean up. **/
-    Free(points);
-    H5Sclose(memspace);
-    H5Sclose(space);
-    UNPROTECT(1);
+  /** clean up. **/
+  Free(_h_offsets);
+  Free(_h_counts);
+  H5Sclose(memspace);
+  H5Sclose(space);
     
-    if (__ERROR__ == 1) {
-	error("Unsupported class in %s\n", __func__);
-    }
-    return dta;
+  if (__ERROR__ == 1) {
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/h5r -r 82


More information about the H5r-commits mailing list