Add option to writeAttributes where a file path is provided rather th…

…an an object handle

R/H5T.R

@@ -206,12 +206,14 @@ H5Tget_precision <- function( dtype_id ) {
 #' @param value The value of the new member.  Must be compatible with the base
 #'   datatype defined by `dtype_id`.
 #'
-#' @returns * `H5Tinsert_enum()` returns an character representing the H5 identifier
-#' of the new datatype. * `H5Tset_precision()` is called
-#'   for its side-effect of modifying the existing datatype.  It will
-#'   invisibly return `TRUE` if this is successful `FALSE` if not.
-#'   
-#' @examples 
+#' @returns
+#' * `H5Tinsert_enum()` returns an character representing the H5 identifier
+#' of the new datatype.
+#' * `H5Tset_precision()` is called for its side-effect of modifying the 
+#' existing datatype.  It will invisibly
+#' return `TRUE` if this is successful `FALSE` if not.
+#'
+#' @examples
 #' tid <- H5Tenum_create(dtype_id = "H5T_NATIVE_UCHAR")
 #' H5Tenum_insert(tid, name = "TRUE", value = 1L)
 #' H5Tenum_insert(tid, name = "FALSE", value = 0L)
@@ -239,6 +241,31 @@ H5Tenum_insert <- function(dtype_id, name, value) {
   return(invisible(res >= 0))
 }
 
+#' Get details of HDF5 data types
+#'
+#' @param dtype_id ID of HDF5 datatype to work with.  Normally created with
+#' a function like `H5Tcopy` or `H5Tenum_create`.
+#'
+#' @returns
+#' * `H5Tget_class()` returns an character vector of length 1 giving the
+#' class of the data type.
+#' * `H5Tget_nmembers()` returns the number of members in the given
+#' datatype.  Will fail with an error if the supplied datatype is not of type 
+#' `H5T_COMPUND` or `H5T_ENUM`.
+#'
+#' @examples
+#' ## create an enum datatype with two entries
+#' tid <- H5Tenum_create(dtype_id = "H5T_NATIVE_UCHAR")
+#' H5Tenum_insert(tid, name = "TRUE", value = 1L)
+#' H5Tenum_insert(tid, name = "FALSE", value = 0L)
+#' 
+#' H5Tget_class(tid)
+#' H5Tget_nmembers(tid)
+#'
+#' @name H5T_ops
+NULL
+
+#' @rdname H5T_ops
 #' @export
 H5Tget_class <- function(dtype_id) {
 
@@ -247,6 +274,7 @@ H5Tget_class <- function(dtype_id) {
 
 }
 
+#' @rdname H5T_ops
 #' @export
 H5Tget_nmembers <- function(dtype_id) {
 

R/h5create.R

@@ -550,16 +550,20 @@ h5createAttribute <- function(obj, attr, dims, maxdims = dims, file,
                               tid
                           },
                           logical = {
-                            stop("Can not create dataset. 'storage.mode' has to be a character.")
+                              tid <- H5Tenum_create(dtype_id = "H5T_NATIVE_UCHAR")
+                              H5Tenum_insert(tid, name = "TRUE", value = 1L)
+                              H5Tenum_insert(tid, name = "FALSE", value = 0L)
+                              H5Tenum_insert(tid, name = "NA", value = 255L)
+                              tid
                           },
                           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 {
-        if(!grepl(pattern = "^[[:digit:]]+$", tid)) {
-          tid <- h5checkConstants("H5T", H5type)
+        if(grepl(pattern = "^[[:digit:]]+$", H5type)) {
+          tid <- H5type
         }
     }
     if(!grepl(pattern = "^[[:digit:]]+$", tid)) {

R/h5writeAttr.R

@@ -1,34 +1,33 @@
 #' Write an R object as an HDF5 attribute
 #'
 #' @param attr The R object to be written as an HDF5 attribute.
-#' @param h5obj An object of class [H5IdComponent-class] representing a H5
-#'   object identifier (file, group, or dataset). See \code{\link{H5Fcreate}},
-#'   \code{\link{H5Fopen}}, \code{\link{H5Gcreate}}, \code{\link{H5Gopen}},
-#'   \code{\link{H5Dcreate}}, or \code{\link{H5Dopen}} to create an object of
-#'   this kind.
+#' @param h5obj Normally an object of class [H5IdComponent-class] representing a
+#'   H5 object identifier (file, group, or dataset). See
+#'   \code{\link{H5Fcreate}}, \code{\link{H5Fopen}}, \code{\link{H5Gcreate}},
+#'   \code{\link{H5Gopen}}, \code{\link{H5Dcreate}}, or \code{\link{H5Dopen}} to
+#'   create an object of this kind.  This argument can also be given the path to
+#'   an HDF5 file.
 #' @param name The name of the attribute to be written.
+#' @param h5loc The location of the group or dataset within a file to which the
+#'   attribute should be attached. This argument is only used if the
+#'   \code{h5obj} argument is the path to an HDF5 file, otherwise it is ignored.
 #' @param encoding The encoding of the string data type. Valid options are
 #'   "ASCII" and "UTF-8".
-#' @param cset *Deprecated in favour of the `encoding` argument.*
 #' @param variableLengthString Whether character vectors should be written as
 #'   variable-length strings into the attributes.
 #' @param asScalar Whether length-1 \code{attr} should be written into a scalar
 #'   dataspace.
-#'
+#' @param checkForNA Whether a \code{attr} should be checked for \code{NA}
+#'   values before being written.  This only applies of \code{attr} is of type
+#'   logical.  Testing for \code{NA} values can be slow if the object to be
+#'   written is large, so if you are sure no such values will be present this
+#'   argument can be used to disable the testing.
 #' @name h5_writeAttribute
 #' @export
-h5writeAttribute <- function(attr, h5obj, name, encoding = NULL, cset = NULL,
-                             variableLengthString=FALSE, asScalar=FALSE) {
-
-  ## remove the cset argument in BioC 3.16
-  if(!is.null(cset)) {
-    if(is.null(encoding)) 
-      encoding <- cset
-    message("The 'cset' argument has been deprecated.\n",
-            "Please use the argument 'encoding' instead.")
-  }
+h5writeAttribute <- function(attr, h5obj, name, h5loc, encoding = NULL, 
+                             variableLengthString=FALSE, asScalar=FALSE,
+                             checkForNA = TRUE) {
 
-  h5checktype(h5obj, "object")
   if (is(attr, "H5IdComponent"))
     res <- h5writeAttribute.array(attr, h5obj, name, asScalar=TRUE)
   else
@@ -50,9 +49,19 @@ h5writeAttribute.character <- function(...) { h5writeAttribute.array(...) }
 h5writeAttribute.default <- function(attr, h5obj, name, ...) { warning("No function found to write attribute of class '",class(attr),"'. Attribute '",name,"' is not written to hdf5-file.") }
 
 #' @rdname h5_writeAttribute
-h5writeAttribute.array <- function(attr, h5obj, name, encoding = NULL, cset=NULL, 
+h5writeAttribute.array <- function(attr, h5obj, name, h5loc, encoding = NULL, 
                                    variableLengthString=FALSE, asScalar=FALSE,
-                                   checkForNA = FALSE) {
+                                   checkForNA = TRUE) {
+
+  if(is.character(h5obj) && file.exists(h5obj)) {
+    fid <- H5Fopen(h5obj, flags = "H5F_ACC_RDWR")
+    on.exit(H5Fclose(fid))
+    h5obj <- H5Oopen(h5loc = fid, name = h5loc)
+    on.exit(H5Oclose(h5obj), add = TRUE)
+  } else {
+    h5checktype(h5obj, "object")
+  }
+
   if (asScalar) {
     if (length(attr) != 1L) {
       stop("cannot use 'asScalar=TRUE' when 'length(attr) > 1'")
@@ -74,34 +83,32 @@ h5writeAttribute.array <- function(attr, h5obj, name, encoding = NULL, cset=NULL
     H5Adelete(h5obj, name)
   }
   storagemode <- storage.mode(attr)
+  tid <- NULL
   if (storagemode == "S4" && is(attr, "H5IdComponent")) {
     storagemode <- "H5IdComponent"
   } else if (storagemode == "logical") {
+    ## should check for NA values if required
     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, 
+                    size = size, H5type = tid,
                     encoding = match.arg(encoding, choices = c("ASCII", "UTF-8", "UTF8")))
   h5attr <- H5Aopen(h5obj, name)
 
   DimMem <- dim(attr)
   h5spaceMem <- H5Screate_simple(DimMem,NULL)
 
-  try( { res <- H5Awrite(h5attr, attr) } )
+  res <- H5Awrite(h5attr, attr) 
 
-  try( { H5Sclose(h5spaceMem) } )
-  try( { H5Aclose(h5attr) } )
+  H5Sclose(h5spaceMem) 
+  H5Aclose(h5attr) 
   invisible(res)
 }