From 2cfc13bbbb2e0e6a89b645f8e9c436c172a01f21 Mon Sep 17 00:00:00 2001 From: Mike Smith Date: Fri, 16 Feb 2024 16:59:44 +0100 Subject: [PATCH] Better memory dtype for enum --- R/H5A.R | 3 +-- R/h5create.R | 9 +++++++-- R/h5writeAttr.R | 19 +++++++++++++++++-- man/H5Acreate.Rd | 2 +- man/h5_writeAttribute.Rd | 3 ++- src/H5A.c | 20 +++++++++++++++++--- 6 files changed, 45 insertions(+), 11 deletions(-) diff --git a/R/H5A.R b/R/H5A.R index 58e2a9e7..827a31bc 100644 --- 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 index c6756d26..349dc283 100644 --- 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 index ea34b12b..0b3af372 100644 --- 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 index 7e95771d..4091dca5 100644 --- a/man/H5Acreate.Rd +++ b/man/H5Acreate.Rd @@ -15,7 +15,7 @@ identifier (file, group, or dataset). See \code{\link[=H5Fcreate]{H5Fcreate()}}, \item{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.} \item{h5space}{An object of class \linkS4class{H5IdComponent} representing a H5 dataspace. See \code{\link[=H5Dget_space]{H5Dget_space()}}, \code{\link[=H5Screate_simple]{H5Screate_simple()}}, \code{\link[=H5Screate]{H5Screate()}} to create an object diff --git a/man/h5_writeAttribute.Rd b/man/h5_writeAttribute.Rd index 46d2aaa1..adb3d099 100644 --- a/man/h5_writeAttribute.Rd +++ b/man/h5_writeAttribute.Rd @@ -23,7 +23,8 @@ h5writeAttribute( encoding = NULL, cset = NULL, variableLengthString = FALSE, - asScalar = FALSE + asScalar = FALSE, + checkForNA = FALSE ) } \arguments{ diff --git a/src/H5A.c b/src/H5A.c index 57385b7e..a1419d77 100644 --- 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; }