Better memory dtype for enum

grimbough · Feb 16, 2024 · 2cfc13b · 2cfc13b
1 parent b6220b1
commit 2cfc13b
Show file tree

Hide file tree

Showing 6 changed files with 45 additions and 11 deletions.
diff --git a/R/H5A.R b/R/H5A.R
@@ -9,7 +9,7 @@
 #' @param name The name of the attribute (character).
 #' @param dtype_id A character name of a datatype. See \code{h5const("H5T")} for 
 #' possible datatypes. Can also be an integer representing an HDF5 datatype. 
-#' Only simple datatypes are allowed for atttributes.
+#' Only simple datatypes are allowed for attributes.
 #' @param h5space An object of class [H5IdComponent-class] representing a H5 
 #' dataspace. See [H5Dget_space()], [H5Screate_simple()], [H5Screate()] to create an object 
 #' of this kind.
@@ -20,7 +20,6 @@
 H5Acreate <- function( h5obj, name, dtype_id, h5space ) {
   h5checktype(h5obj, "object")
   if (length(name)!=1 || !is.character(name)) stop("'name' must be a character string of length 1")
-  ##if (!is.integer(dtype_id)) {
   ## dont check if we have an H5T identifier already    
   if (!grepl(pattern = "^[[:digit:]]+$", dtype_id)) {
     dtype_id<- h5checkConstants( "H5T", dtype_id)

diff --git a/R/h5create.R b/R/h5create.R
@@ -532,8 +532,8 @@ h5createAttribute <- function(obj, attr, dims, maxdims = dims, file,
     } else {
       stop("Can not create attribute. 'dims' and 'maxdims' have to be numeric.")
     }
-
     on.exit(H5Sclose(sid), add = TRUE)
+
     if (is.null(H5type)) {
         if (is.character(storage.mode)) {
             tid <- switch(storage.mode[1],
@@ -549,13 +549,18 @@ h5createAttribute <- function(obj, attr, dims, maxdims = dims, file,
                               H5Tset_size(tid, size) # NULL = variable.
                               tid
                           },
+                          logical = {
+                            stop("Can not create dataset. 'storage.mode' has to be a character.")
+                          },
                           H5IdComponent=h5constants$H5T["H5T_STD_REF_OBJ"],
                           { stop("datatype ",storage.mode," not yet implemented. Try 'double', 'integer', or 'character'.") } )
         } else {
             stop("Can not create dataset. 'storage.mode' has to be a character.")
         }
     } else {
-        tid <- h5checkConstants("H5T", H5type)
+        if(!grepl(pattern = "^[[:digit:]]+$", tid)) {
+          tid <- h5checkConstants("H5T", H5type)
+        }
     }
     if(!grepl(pattern = "^[[:digit:]]+$", tid)) {
         message("Can not create attribute. H5type unknown. Check h5const('H5T') for valid types.")

diff --git a/R/h5writeAttr.R b/R/h5writeAttr.R
@@ -51,7 +51,8 @@ h5writeAttribute.default <- function(attr, h5obj, name, ...) { warning("No funct
 
 #' @rdname h5_writeAttribute
 h5writeAttribute.array <- function(attr, h5obj, name, encoding = NULL, cset=NULL, 
-                                   variableLengthString=FALSE, asScalar=FALSE) {
+                                   variableLengthString=FALSE, asScalar=FALSE,
+                                   checkForNA = FALSE) {
   if (asScalar) {
     if (length(attr) != 1L) {
       stop("cannot use 'asScalar=TRUE' when 'length(attr) > 1'")
@@ -73,8 +74,22 @@ h5writeAttribute.array <- function(attr, h5obj, name, encoding = NULL, cset=NULL
     H5Adelete(h5obj, name)
   }
   storagemode <- storage.mode(attr)
-  if (storagemode == "S4" && is(attr, "H5IdComponent"))
+  if (storagemode == "S4" && is(attr, "H5IdComponent")) {
     storagemode <- "H5IdComponent"
+  } else if (storagemode == "logical") {
+    any_na <- ifelse(checkForNA, yes = any(is.na(attr)), no = FALSE)
+
+    tid <- H5Tenum_create(dtype_id = "H5T_NATIVE_UCHAR")
+    H5Tenum_insert(tid, name = "TRUE", value = 1L)
+    H5Tenum_insert(tid, name = "FALSE", value = 0L)
+    if(any_na) 
+      H5Tenum_insert(tid, name = "NA", value = 255L)
+
+
+
+  }
+
+
   h5createAttribute(h5obj, name, dims = dims, storage.mode = storagemode, 
                     size = size, 
                     encoding = match.arg(encoding, choices = c("ASCII", "UTF-8", "UTF8")))

diff --git a/man/H5Acreate.Rd b/man/H5Acreate.Rd
diff --git a/man/h5_writeAttribute.Rd b/man/h5_writeAttribute.Rd
diff --git a/src/H5A.c b/src/H5A.c
@@ -426,9 +426,12 @@ SEXP _H5Aread( SEXP _attr_id, SEXP _buf, SEXP _bit64conversion ) {
 SEXP _H5Awrite( SEXP _attr_id, SEXP _buf) {
     hid_t attr_id = STRSXP_2_HID( _attr_id );
     hid_t mem_type_id = -1;
-
+    
     const void * buf;
     static const char* H5Ref[] = {"H5Ref", ""};
+    int values[3] = {1, 0, NA_LOGICAL};
+
+    int n_unprotect = 0;
 
     switch(TYPEOF(_buf)) {
     case INTSXP :
@@ -444,7 +447,17 @@ SEXP _H5Awrite( SEXP _attr_id, SEXP _buf) {
         buf = read_string_datatype(mem_type_id, _buf);
         break;
     case LGLSXP :
-        mem_type_id = H5Aget_type(attr_id);
+        // create memory enum type
+        mem_type_id = H5Tenum_create(H5T_NATIVE_INT32);
+        H5Tenum_insert(mem_type_id, "TRUE",  &values[0]);
+        H5Tenum_insert(mem_type_id, "FALSE", &values[1]);
+
+        hid_t attr_type_id = H5Aget_type(attr_id);
+        int n = H5Tget_nmembers(attr_type_id);
+        // only do this if we have 3 values in the datatype: TRUE, FALSE & NA
+        if(n == 3) {
+          H5Tenum_insert(mem_type_id, "NA", &values[2]);
+        }
         buf = LOGICAL(_buf);
         break;
     case S4SXP : 
@@ -471,8 +484,9 @@ SEXP _H5Awrite( SEXP _attr_id, SEXP _buf) {
     if(herr < 0) { error("Error writing attribute"); }
     SEXP Rval;
     PROTECT(Rval = allocVector(INTSXP, 1));
+    n_unprotect++;
     INTEGER(Rval)[0] = herr;
-    UNPROTECT(1);
+    UNPROTECT(n_unprotect);
     return Rval;
 }