@@ -183,7 +183,12 @@ read_matrix <- function(dataset, backed=FALSE) {

             cls <- "Dense_H5ADMatrixSeed"

             seed <- HDF5Array::HDF5ArraySeed

         } else {

-            return(H5Dread(dataset))

+            dset <- H5Dread(dataset)

+            if (length(dim(dset)) == 1)

+                dset <- as.vector(dset)

+            else if (length(dim(dset)) == 2)

+                dset <- as.matrix(dset)

+            return(dset)

         }

     }

     if (backed) {

@@ -214,6 +219,10 @@ read_array <- function(attr, encoding, strict=TRUE) {

         check_encodingversion(attr, encoding, "0.2.0")

     ret <- H5Dread(attr)

+    if (length(dim(ret)) == 1)

+        ret <- as.vector(ret)

+    else if (length(dim(ret)) == 2)

+        ret <- as.matrix(ret)

     # h5py saves boolean arrays as HDF5 enums

     if (is.factor(ret) && all(levels(ret) == c("FALSE", "TRUE"))) {

         ret <- as.logical(ret)

@@ -222,6 +222,8 @@ read_array <- function(attr, encoding, strict=TRUE) {

     if (!is.null(encoding) && (endsWith(encoding, "-scalar") || encoding == "string")) {

         attr(ret, "encoding-scalar") <- TRUE

     }

+    if (length(dim(ret)) > 1)

+        ret <- t(ret)

     ret

 }

@@ -329,8 +331,6 @@ read_modality <- function(view, backed=FALSE) {

         obsmnames <- h5ls(h5autoclose(view & "obsm"), recursive=FALSE)$name

         obsm <- lapply(obsmnames, function(space) {

             elem <- read_attribute(h5autoclose(view & paste("obsm", space, sep="/")))

-            if (!is.data.frame(elem) && length(dim(elem)) > 1)

-                elem <- t(elem)

             rownames(elem) <- rownames(obs)

             elem

         })

@@ -76,9 +76,9 @@ read_dataframe <- function(group, encoding) {

 #' Helper function to convert values + labels into factors

 #'

 #' @description  A helper function to convert categories into factors.

-#'  Assumptions: 

+#'  Assumptions:

 #'      - values correspond to the zero indexed categories

-#'          (i.e. value 0 is the first category) 

+#'          (i.e. value 0 is the first category)

 #'      - NA are encoded with a value -1

 #'  Categories not uses will be dropped.

 #'

@@ -88,7 +88,7 @@ read_dataframe <- function(group, encoding) {

 #' @returns factor with categorical values

 #'

 #' @keywords internal

-#' @noRd 

+#' @noRd

 convert_categoricals <- function(values, categories) {

     # The levels are 0 indexed integers

     levels <- seq_len(length(categories))-1

@@ -236,13 +236,7 @@ read_categorical <- function(group, encoding) {

     values <- as.integer(H5Dread(h5autoclose(group & "codes")))

     labels <- H5Dread(h5autoclose(group & "categories"))

-    n_labels <- max(values) + 1

-    if (length(labels) > n_labels) {

-        labels_items <- labels_items[seq_len(n_labels)]

-    }

-

-    values[values == -1] <- NA

-    factor(values, labels=labels, ordered=ordered)

+    convert_categoricals(values, labels)

 }

 #' @importFrom rhdf5 H5Dread

@@ -1,7 +1,34 @@

 #' @importFrom rhdf5 H5Aexists H5Aopen H5Aread H5Aclose H5Dread H5Dclose H5Rdereference

+#' @importFrom S4Vectors DataFrame

 #' @importMethodsFrom rhdf5 &

 #' @importFrom methods is

-read_dataframe <- function(group) {

+read_dataframe_020 <- function(group, encoding, strict=TRUE) {

+    if (strict)

+        check_encodingversion(group, encoding, "0.2.0")

+    indexattr <- H5Aopen(group, "_index")

+    indexcol <- H5Aread(indexattr)

+    H5Aclose(indexattr)

+

+    orderedattr <- H5Aopen(group, "column-order")

+    columnorder <- H5Aread(orderedattr)

+    H5Aclose(orderedattr)

+

+    col_list <- lapply(columnorder, function(name) {

+        read_attribute(h5autoclose(group & name))

+    })

+    names(col_list) <- columnorder

+    index <- h5autoclose(group & indexcol)

+    col_list[["row.names"]] <- H5Dread(index)

+    do.call(DataFrame, args=col_list)

+}

+

+#' @importFrom rhdf5 H5Aexists H5Aopen H5Aread H5Aclose H5Dread H5Dclose H5Rdereference

+#' @importFrom S4Vectors DataFrame

+#' @importMethodsFrom rhdf5 &

+#' @importFrom methods is

+read_dataframe_010 <- function(group, encoding, strict=TRUE) {

+    if (strict)

+        check_encodingversion(group, encoding, "0.1.0")

     indexcol <- "_index"

     if (H5Aexists(group, "_index")) {

         indexattr <- H5Aopen(group, "_index")

@@ -34,10 +61,16 @@ read_dataframe <- function(group) {

         values

     })

     names(col_list) <- columnorder

-    index <- group & indexcol

-    col_list[["row.names"]] <- H5Dread(index)

-    H5Dclose(index)

-    do.call(data.frame, args=col_list)

+    col_list[["row.names"]] <- H5Dread(h5autoclose(group & indexcol))

+    do.call(DataFrame, args=col_list)

+}

+

+read_dataframe <- function(group, encoding) {

+    version <- check_encodingversion(group, encoding, c("0.1.0", "0.2.0"))

+    if (version == "0.1.0")

+        read_dataframe_010(group, encoding, strict=FALSE)

+    else

+        read_dataframe_020(group, encoding, strict=FALSE)

 }

 #' Helper function to convert values + labels into factors

@@ -100,18 +133,16 @@ read_with_index <- function(dataset) {

     }

 }

-#' @importFrom rhdf5 H5Dread H5Dclose H5Aopen H5Aread H5Aclose

+#' @importFrom rhdf5 H5Dread H5Aopen H5Aread H5Aclose

 #' @importMethodsFrom rhdf5 &

 read_sparse_matrix <- function(group, encoding, backed=FALSE) {

-    indices <- group & "indices"

-    indptr <- group & "indptr"

-    data <- group & "data"

+    check_encodingversion(group, encoding, "0.1.0")

+    indices <- h5autoclose(group & "indices")

+    indptr <- h5autoclose(group & "indptr")

+    data <- h5autoclose(group & "data")

     i <- as.vector(H5Dread(indices))

     p <- as.vector(H5Dread(indptr))

     x <- as.vector(H5Dread(data))

-    H5Dclose(indices)

-    H5Dclose(indptr)

-    H5Dclose(data)

     shapeattr <- H5Aopen(group, "shape")

     shape <- H5Aread(shapeattr)

     H5Aclose(shapeattr)

@@ -166,41 +197,113 @@ read_matrix <- function(dataset, backed=FALSE) {

     }

 }

-#' @importFrom rhdf5 H5Aopen H5Aread H5Aclose H5Aexists h5ls

+#' @importFrom rhdf5 h5ls

+#' @importMethodsFrom rhdf5 &

 #' @importFrom stats setNames

-read_group <- function(group, read_uns=FALSE) {

-    if (H5Aexists(group, "encoding-type")) {

-        encattr <- H5Aopen(group, "encoding-type")

-        encoding <- H5Aread(encattr)

-        H5Aclose(encattr)

-

-        if (encoding == "dataframe") {

-            return(read_dataframe(group))

-        } else if (endsWith(encoding, "matrix")) {

-            return(read_sparse_matrix(group))

-        } else {

-            warning("Unknown encoding ", encoding)

-            if (!read_uns)

-                return(invisible(NULL))

-        }

-    }

+read_dict <- function(group, encoding, strict=TRUE) {

+    if (strict)

+        check_encodingversion(group, encoding, "0.1.0")

     objects <- h5ls(group, recursive=FALSE, datasetinfo=FALSE)$name

     lapply(setNames(nm=objects), function(x)read_attribute(h5autoclose(group & x)))

 }

-#' @importFrom rhdf5 H5Iget_type H5Dread

+#' @importFrom rhdf5 H5Dread

+read_array <- function(attr, encoding, strict=TRUE) {

+    if (strict)

+        check_encodingversion(attr, encoding, "0.2.0")

+

+    ret <- H5Dread(attr)

+    # h5py saves boolean arrays as HDF5 enums

+    if (is.factor(ret) && all(levels(ret) == c("FALSE", "TRUE"))) {

+        ret <- as.logical(ret)

+    }

+

+    if (!is.null(encoding) && (endsWith(encoding, "-scalar") || encoding == "string")) {

+        attr(ret, "encoding-scalar") <- TRUE

+    }

+    ret

+}

+

+#' @importFrom rhdf5 H5Aopen H5Aread H5Aclose H5Dread

+#' @importMethodsFrom rhdf5 &

+read_categorical <- function(group, encoding) {

+    check_encodingversion(group, encoding, "0.2.0")

+

+    orderedattr <- H5Aopen(group, "ordered")

+    ordered <- as.logical(H5Aread(orderedattr))

+    H5Aclose(orderedattr)

+

+    values <- as.integer(H5Dread(h5autoclose(group & "codes")))

+    labels <- H5Dread(h5autoclose(group & "categories"))

+    n_labels <- max(values) + 1

+    if (length(labels) > n_labels) {

+        labels_items <- labels_items[seq_len(n_labels)]

+    }

+

+    values[values == -1] <- NA

+    factor(values, labels=labels, ordered=ordered)

+}

+

+#' @importFrom rhdf5 H5Dread

+#' @importMethodsFrom rhdf5 &

+read_nullable <- function(group, encoding) {

+    check_encodingversion(group, encoding, "0.1.0")

+    values <- H5Dread(h5autoclose(group & "values"))

+    mask <- as.logical(H5Dread(h5autoclose(group & "mask")))

+    values[mask] <- NA

+    if (endsWith(encoding, "-boolean")) {

+        values <- as.logical(values)

+    }

+    values

+}

+

+.read_funcs <- list("array"=read_array,

+                    "csr_matrix"=read_sparse_matrix,

+                    "csc_matrix"=read_sparse_matrix,

+                    "dataframe"=read_dataframe,

+                    "dict"=read_dict,

+                    "numeric-scalar"=read_array,

+                    "string"=read_array,

+                    "categorical"=read_categorical,

+                    "string-array"=read_array,

+                    "nullable-integer"=read_nullable,

+                    "nullable-boolean"=read_nullable)

+

+#' @importFrom rhdf5 H5Aexists H5Aopen H5Aread H5Aclose H5Iget_type H5Iget_name

 read_attribute <- function(attr) {

-    if (H5Iget_type(attr) == "H5I_GROUP")

-        read_group(attr)

-    else {

-        values <- H5Dread(attr)

-        # h5py saves boolean arrays as HDF5 enums

-        if (is.factor(values) && all(levels(values) == c("FALSE", "TRUE"))) {

-            values <- as.logical(values)

+    ret <- NULL

+    if (H5Aexists(attr, "encoding-type")) {

+        encattr <- H5Aopen(attr, "encoding-type")

+        encoding <- H5Aread(encattr)

+        H5Aclose(encattr)

+

+        func <- switch(encoding,

+                      "array"=read_array,

+                      "csr_matrix"=read_sparse_matrix,

+                      "csc_matrix"=read_sparse_matrix,

+                      "dataframe"=read_dataframe,

+                      "dict"=read_dict,

+                      "numeric-scalar"=read_array,

+                      "string"=read_array,

+                      "categorical"=read_categorical,

+                      "string-array"=read_array,

+                      "nullable-integer"=read_nullable,

+                      "nullable-boolean"=read_nullable)

+        if (is.null(func)) {

+            warning("Unknown encoding ", encoding, " for element ", H5Iget_name(attr))

+        } else {

+            ret <- func(attr, encoding)

         }

-        values

     }

+

+    if (is.null(ret)) {

+        if (H5Iget_type(attr) == "H5I_GROUP")

+            ret <- read_dict(attr, NULL, strict=FALSE)

+        else

+            ret <- read_array(attr, NULL, strict=FALSE)

+    }

+    ret

 }

 #' @importFrom stats setNames

@@ -273,7 +376,7 @@ read_modality <- function(view, backed=FALSE) {

     }

     if ("uns" %in% viewnames)

-        metadata(se) <- read_group(h5autoclose(view & "uns"))

+        metadata(se) <- read_dict(h5autoclose(view & "uns"), NULL, strict=FALSE)

     se

 }

@@ -350,9 +453,8 @@ readH5MU <- function(file, backed=FALSE) {

     # if colData(MAE) has different row names than the experiments

     if (H5Lexists(h5, "obsmap")) {

         samplemaps <- lapply(assays, function(mod) {

-            cmapdset <- h5 & paste("obsmap", mod, sep="/")

+            cmapdset <- h5autoclose(h5 & paste("obsmap", mod, sep="/"))

             cmap <- H5Dread(cmapdset)

-            H5Dclose(cmapdset)

             idx <- which(cmap > 0)

             data.frame(assay=mod, primary=rownames(metadata)[idx], colname=colnames(modalities[[mod]])[cmap[idx]])

@@ -363,7 +465,7 @@ readH5MU <- function(file, backed=FALSE) {

     }

     if (H5Lexists(h5, "uns"))

-        args$metadata <- read_group(h5autoclose(h5 & "uns"))

+        args$metadata <- read_dict(h5autoclose(h5 & "uns"), NULL, strict=FALSE)

     # Close the connection

     H5Fclose(h5)

@@ -25,11 +25,7 @@ read_dataframe <- function(group) {

             } else {

                 labels <- H5Rdereference(labels, h5loc=col)

                 labels_items <- H5Dread(labels)

-                n_labels <- length(unique(values))

-                if (length(labels_items) > n_labels) {

-                    labels_items <- labels_items[seq_len(n_labels)]

-                }

-                values <- factor(as.integer(values), labels=labels_items)

+                values <- convert_categoricals(values, labels_items)

                 H5Dclose(labels)

             }

             H5Aclose(attr)

@@ -44,6 +40,30 @@ read_dataframe <- function(group) {

     do.call(data.frame, args=col_list)

 }

+#' Helper function to convert values + labels into factors

+#'

+#' @description  A helper function to convert categories into factors.

+#'  Assumptions: 

+#'      - values correspond to the zero indexed categories

+#'          (i.e. value 0 is the first category) 

+#'      - NA are encoded with a value -1

+#'  Categories not uses will be dropped.

+#'

+#' @param values Vector of integer level numbers (zero indexed). -1 indicate NA

+#' @param categories Labels for level numbers (zero indexed).

+#'

+#' @returns factor with categorical values

+#'

+#' @keywords internal

+#' @noRd 

+convert_categoricals <- function(values, categories) {

+    # The levels are 0 indexed integers

+    levels <- seq_len(length(categories))-1

+    value_factor <- factor(as.integer(values), levels, labels=categories)

+    # Drop unused levels

+    droplevels(value_factor)

+}

+

 #' @importFrom rhdf5 H5Dread H5Aexists H5Aopen H5Aread H5Aclose

 read_dataframe_legacy <- function(dataset) {

     table <- H5Dread(dataset)

@@ -176,7 +176,7 @@ read_attribute <- function(attr) {

     else {

         values <- H5Dread(attr)

         # h5py saves boolean arrays as HDF5 enums

-        if (is.factor(values) && levels(values) == c("FALSE", "TRUE")) {

+        if (is.factor(values) && all(levels(values) == c("FALSE", "TRUE"))) {

             values <- as.logical(values)

         }

         values

@@ -15,16 +15,12 @@ read_dataframe <- function(group) {

     col_list <- lapply(columnorder, function(name) {

         col <- group & name

-        values <- H5Dread(col)

-        # h5py saves boolean arrays as HDF5 enums

-        if (is.factor(values) && levels(values) == c("FALSE", "TRUE")) {

-            values <- as.logical(values)

-        }

+        values <- read_attribute(col)

         if (H5Aexists(col, "categories")) {

             attr <- H5Aopen(col, "categories")

             labels <- H5Aread(attr)

             if (!is(labels, "H5Ref")) {

-                warning("found categories attribute for column ", 

+                warning("found categories attribute for column ",

                         name, ", but it is not a reference")

             } else {

                 labels <- H5Rdereference(labels, h5loc=col)

@@ -74,7 +70,7 @@ read_with_index <- function(dataset) {

         encoding <- H5Aread(encattr, "encoding-type")

         H5Aclose(encattr)

         if (encoding != "dataframe") {

-            warning("Unknown encoding ", encoding, 

+            warning("Unknown encoding ", encoding,

                     " when attempting to read data frame")

             return(data.frame())

         }

@@ -177,8 +173,14 @@ read_group <- function(group, read_uns=FALSE) {

 read_attribute <- function(attr) {

     if (H5Iget_type(attr) == "H5I_GROUP")

         read_group(attr)

-    else

-        H5Dread(attr)

+    else {

+        values <- H5Dread(attr)

+        # h5py saves boolean arrays as HDF5 enums

+        if (is.factor(values) && levels(values) == c("FALSE", "TRUE")) {

+            values <- as.logical(values)

+        }

+        values

+    }

 }

 #' @importFrom stats setNames

@@ -219,7 +219,6 @@ read_modality <- function(view, backed=FALSE) {

         args$reducedDims <- obsm

     }

-    objectclass <- NULL

     if (H5Aexists(view, "origin-class")) {

         originattr <- H5Aopen(view, "origin-class")

         objectclass <- H5Aread(originattr)

@@ -233,9 +232,9 @@ read_modality <- function(view, backed=FALSE) {

 		}

 		se <- do.call(SingleCellExperiment, args)

 	}

-    }

-    if (is.null(objectclass))

+    } else {

 	se <- do.call(SingleCellExperiment, args)

+    }

     for (cp in list(list(name="obsp", setter=`colPair<-`), list(name="varp", setter=`rowPair<-`))) {

         if (cp$name %in% viewnames) {

@@ -219,7 +219,23 @@ read_modality <- function(view, backed=FALSE) {

         args$reducedDims <- obsm

     }

-    se <- do.call(SingleCellExperiment, args)

+    objectclass <- NULL

+    if (H5Aexists(view, "origin-class")) {

+        originattr <- H5Aopen(view, "origin-class")

+        objectclass <- H5Aread(originattr)

+        H5Aclose(originattr)

+

+	if (objectclass == "SummarizedExperiment") {

+		se <- do.call(SummarizedExperiment, args)

+	} else {

+		if (objectclass != "SingleCellExperiment") {

+            		message("Reading as SingleCellExperiment where the original object class is ", objectclass)

+		}

+		se <- do.call(SingleCellExperiment, args)

+	}

+    }

+    if (is.null(objectclass))

+	se <- do.call(SingleCellExperiment, args)

     for (cp in list(list(name="obsp", setter=`colPair<-`), list(name="varp", setter=`rowPair<-`))) {

         if (cp$name %in% viewnames) {

@@ -24,14 +24,15 @@ read_dataframe <- function(group) {

             attr <- H5Aopen(col, "categories")

             labels <- H5Aread(attr)

             if (!is(labels, "H5Ref")) {

-                warning("found categories attribute for column ", name, ", but it is not a reference")

+                warning("found categories attribute for column ", 

+                        name, ", but it is not a reference")

             } else {

                 labels <- H5Rdereference(labels, h5loc=col)

-	        labels_items <- H5Dread(labels)

-		n_labels <- length(unique(values))

-		if (length(labels_items) > n_labels) {

-			labels_items <- labels_items[seq_len(n_labels)]

-		}

+                labels_items <- H5Dread(labels)

+                n_labels <- length(unique(values))

+                if (length(labels_items) > n_labels) {

+                    labels_items <- labels_items[seq_len(n_labels)]

+                }

                 values <- factor(as.integer(values), labels=labels_items)

                 H5Dclose(labels)

             }

@@ -73,7 +74,8 @@ read_with_index <- function(dataset) {

         encoding <- H5Aread(encattr, "encoding-type")

         H5Aclose(encattr)

         if (encoding != "dataframe") {

-            warning("Unknown encoding ", encoding, " when attempting to read data frame")

+            warning("Unknown encoding ", encoding, 

+                    " when attempting to read data frame")

             return(data.frame())

         }

         read_dataframe(dataset)

@@ -110,8 +110,7 @@ read_matrix <- function(dataset, backed=FALSE) {

     if (backed) {

         have_delayedarray <- requireNamespace("HDF5Array", quietly=TRUE)

         if (!have_delayedarray) {

-            warning("Could not load the HDF5Array package. HDF5Array is required for backed matrices. Loading matrix into memory...")

-            backed <- FALSE

+            stop("Could not load the HDF5Array package. HDF5Array is required for backed matrices.")

         }

     }

@@ -149,19 +149,27 @@ read_matrix <- function(dataset, backed=FALSE) {

     }

 }

-#' @importFrom rhdf5 H5Aopen H5Aread H5Aclose

-read_group <- function(group) {

-    encattr <- H5Aopen(group, "encoding-type")

-    encoding <- H5Aread(encattr)

-    H5Aclose(encattr)

-    if (encoding == "dataframe") {

-        read_dataframe(group)

-    } else if (endsWith(encoding, "matrix")) {

-        read_sparse_matrix(group)

-    } else {

-        warning("Unknown encoding ", encoding)

-        invisible(NULL)

+#' @importFrom rhdf5 H5Aopen H5Aread H5Aclose H5Aexists h5ls

+#' @importFrom stats setNames

+read_group <- function(group, read_uns=FALSE) {

+    if (H5Aexists(group, "encoding-type")) {

+        encattr <- H5Aopen(group, "encoding-type")

+        encoding <- H5Aread(encattr)

+        H5Aclose(encattr)

+

+        if (encoding == "dataframe") {

+            return(read_dataframe(group))

+        } else if (endsWith(encoding, "matrix")) {

+            return(read_sparse_matrix(group))

+        } else {

+            warning("Unknown encoding ", encoding)

+            if (!read_uns)

+                return(invisible(NULL))

+        }

     }

+

+    objects <- h5ls(group, recursive=FALSE, datasetinfo=FALSE)$name

+    lapply(setNames(nm=objects), function(x)read_attribute(h5autoclose(group & x)))

 }

 #' @importFrom rhdf5 H5Iget_type H5Dread

@@ -178,7 +186,7 @@ read_attribute <- function(attr) {

 #' @importFrom S4Vectors SimpleList

 #' @importFrom SingleCellExperiment SingleCellExperiment

 #' @importMethodsFrom SingleCellExperiment colPair<- rowPair<-

-#' @importFrom SummarizedExperiment SummarizedExperiment

+#' @importFrom SummarizedExperiment SummarizedExperiment metadata<-

 #' @importFrom methods is

 read_modality <- function(view, backed=FALSE) {

     X <- read_matrix(h5autoclose(view & "X"), backed=backed)

@@ -225,6 +233,9 @@ read_modality <- function(view, backed=FALSE) {

             }

         }

     }

+

+    if ("uns" %in% viewnames)

+        metadata(se) <- read_group(h5autoclose(view & "uns"))

     se

 }

@@ -313,6 +324,9 @@ readH5MU <- function(file, backed=FALSE) {

         args$sampleMap <- sampleMap

     }

+    if (H5Lexists(h5, "uns"))

+        args$metadata <- read_group(h5autoclose(h5 & "uns"))

+

     # Close the connection

     H5Fclose(h5)

@@ -242,12 +242,12 @@ read_modality <- function(view, backed=FALSE) {

 #'

 #' @examples

 #' data(miniACC, package="MultiAssayExperiment")

-#' WriteH5AD(miniACC[[1]], "miniacc.h5ad")

-#' sce <- ReadH5AD("miniacc.h5ad")

+#' writeH5AD(miniACC[[1]], "miniacc.h5ad")

+#' sce <- readH5AD("miniacc.h5ad")

 #'

 #' @importFrom rhdf5 H5Fclose

 #' @export

-ReadH5AD <- function(file, backed=FALSE) {

+readH5AD <- function(file, backed=FALSE) {

     h5 <- H5Fopen(file, flags="H5F_ACC_RDONLY", native=FALSE)

     res <- read_modality(h5, backed)

     H5Fclose(h5)

@@ -267,8 +267,8 @@ ReadH5AD <- function(file, backed=FALSE) {

 #'

 #' @examples

 #' data(miniACC, package="MultiAssayExperiment")

-#' WriteH5MU(miniACC, "miniacc.h5mu")

-#' mae <- ReadH5MU("miniacc.h5mu")

+#' writeH5MU(miniACC, "miniacc.h5mu")

+#' mae <- readH5MU("miniacc.h5mu")

 #'

 #' @importFrom stats setNames

 #' @importFrom rhdf5 h5ls H5Fclose H5Lexists H5Dread H5Dclose

@@ -276,7 +276,7 @@ ReadH5AD <- function(file, backed=FALSE) {

 #' @importFrom MultiAssayExperiment MultiAssayExperiment

 #'

 #' @export

-ReadH5MU <- function(file, backed=FALSE) {

+readH5MU <- function(file, backed=FALSE) {

     # Connect to the the file

     h5 <- open_and_check_mudata(file)

@@ -283,6 +283,9 @@ ReadH5MU <- function(file, backed=FALSE) {

     # Check all the assays are written

     assays <- setNames(nm=h5ls(h5autoclose(h5 & "mod"), recursive=FALSE)$name)

+    # Read modality order if available and matches available assays

+    mod_order <- check_mod_order(h5)

+

     # Create global colData

     metadata <- read_with_index(h5autoclose(h5 & "obs"))

@@ -290,6 +293,7 @@ ReadH5MU <- function(file, backed=FALSE) {

     modalities <- lapply(assays, function(mod) {

         read_modality(h5autoclose(h5 & paste("mod", mod, sep="/")), backed)

     })

+    modalities <- modalities[mod_order]

     args <- list(experiments=modalities, colData=metadata)

@@ -30,7 +30,7 @@ read_dataframe <- function(group) {

 	        labels_items <- H5Dread(labels)

 		n_labels <- length(unique(values))

 		if (length(labels_items) > n_labels) {

-			labels_items <- labels_items[1:n_labels]

+			labels_items <- labels_items[seq_len(n_labels)]

 		}

                 values <- factor(as.integer(values), labels=labels_items)

                 H5Dclose(labels)

@@ -27,7 +27,12 @@ read_dataframe <- function(group) {

                 warning("found categories attribute for column ", name, ", but it is not a reference")

             } else {

                 labels <- H5Rdereference(labels, h5loc=col)

-                values <- factor(as.integer(values), labels=H5Dread(labels))

+	        labels_items <- H5Dread(labels)

+		n_labels <- length(unique(values))

+		if (length(labels_items) > n_labels) {

+			labels_items <- labels_items[1:n_labels]

+		}

+                values <- factor(as.integer(values), labels=labels_items)

                 H5Dclose(labels)

             }

             H5Aclose(attr)

@@ -236,7 +236,8 @@ read_modality <- function(view, backed=FALSE) {

 #' @return A \code{\linkS4class{SingleCellExperiment}}.

 #'

 #' @examples

-#' WriteH5AD(MultiAssayExperiment::miniACC[[1]], "miniacc.h5ad")

+#' data(miniACC, package="MultiAssayExperiment")

+#' WriteH5AD(miniACC[[1]], "miniacc.h5ad")

 #' sce <- ReadH5AD("miniacc.h5ad")

 #'

 #' @importFrom rhdf5 H5Fclose

@@ -260,7 +261,8 @@ ReadH5AD <- function(file, backed=FALSE) {

 #' @return A \code{\linkS4class{MultiAssayExperiment}}

 #'

 #' @examples

-#' WriteH5MU(MultiAssayExperiment::miniACC, "miniacc.h5mu")

+#' data(miniACC, package="MultiAssayExperiment")

+#' WriteH5MU(miniACC, "miniacc.h5mu")

 #' mae <- ReadH5MU("miniacc.h5mu")

 #'

 #' @importFrom stats setNames

@@ -1,4 +1,4 @@

-#' @importFrom rhdf5 H5Aexists H5Aopen H5Aread H5Aclose H5Dread H5Dclose

+#' @importFrom rhdf5 H5Aexists H5Aopen H5Aread H5Aclose H5Dread H5Dclose H5Rdereference

 #' @importMethodsFrom rhdf5 &

 #' @importFrom methods is

 read_dataframe <- function(group) {

@@ -16,12 +16,17 @@ read_dataframe <- function(group) {

     col_list <- lapply(columnorder, function(name) {

         col <- group & name

         values <- H5Dread(col)

+        # h5py saves boolean arrays as HDF5 enums

+        if (is.factor(values) && levels(values) == c("FALSE", "TRUE")) {

+            values <- as.logical(values)

+        }

         if (H5Aexists(col, "categories")) {

             attr <- H5Aopen(col, "categories")

             labels <- H5Aread(attr)

-            if (!is(labels, "H5IdComponent")) {

+            if (!is(labels, "H5Ref")) {

                 warning("found categories attribute for column ", name, ", but it is not a reference")

             } else {

+                labels <- H5Rdereference(labels, h5loc=col)

                 values <- factor(as.integer(values), labels=H5Dread(labels))

                 H5Dclose(labels)

             }

@@ -20,7 +20,7 @@ read_dataframe <- function(group) {

             attr <- H5Aopen(col, "categories")

             labels <- H5Aread(attr)

             if (!is(labels, "H5IdComponent")) {

-                warning(paste0("found categories attribute for column ", name, ", but it is not a reference"))

+                warning("found categories attribute for column ", name, ", but it is not a reference")

             } else {

                 values <- factor(as.integer(values), labels=H5Dread(labels))

                 H5Dclose(labels)

@@ -63,7 +63,7 @@ read_with_index <- function(dataset) {

         encoding <- H5Aread(encattr, "encoding-type")

         H5Aclose(encattr)

         if (encoding != "dataframe") {

-            warning(paste0("Unknown encoding ", encoding, " when attempting to read data frame"))

+            warning("Unknown encoding ", encoding, " when attempting to read data frame")

             return(data.frame())

         }

         read_dataframe(dataset)

@@ -117,7 +117,7 @@ read_matrix <- function(dataset, backed=FALSE) {

                 return(read_sparse_matrix(dataset, encoding))

             }

         } else {

-            warning(paste0("Unknown encoding ", encoding, "when attempting to read matrix"))

+            warning("Unknown encoding ", encoding, "when attempting to read matrix")

             return(matrix())

         }

     } else {

@@ -149,7 +149,7 @@ read_group <- function(group) {

     } else if (endsWith(encoding, "matrix")) {

         read_sparse_matrix(group)

     } else {

-        warning(paste0("Unknown encoding ", encoding))

+        warning("Unknown encoding ", encoding)

         invisible(NULL)

     }

 }

@@ -208,7 +208,7 @@ read_modality <- function(view, backed=FALSE) {

             for (name in names) {

                 cpair <- read_matrix(h5autoclose(view & paste(cp$name, name, sep="/")))

                 if (!is(cpair, "dsparseMatrix")) {

-                    warning(paste("Pairwise", cp$name, "matrix", name, "is not a sparse matrix. Only sparse matrices are currently supported, skipping..."))

+                    warning("Pairwise ", cp$name, " matrix ", name, " is not a sparse matrix. Only sparse matrices are currently supported, skipping...")

                 } else {

                     se <- cp$setter(se, name, value=cpair)

                 }

@@ -230,6 +230,10 @@ read_modality <- function(view, backed=FALSE) {

 #'

 #' @return A \code{\linkS4class{SingleCellExperiment}}.

 #'

+#' @examples

+#' WriteH5AD(MultiAssayExperiment::miniACC[[1]], "miniacc.h5ad")

+#' sce <- ReadH5AD("miniacc.h5ad")

+#'

 #' @importFrom rhdf5 H5Fclose

 #' @export

 ReadH5AD <- function(file, backed=FALSE) {

@@ -250,6 +254,10 @@ ReadH5AD <- function(file, backed=FALSE) {

 #'

 #' @return A \code{\linkS4class{MultiAssayExperiment}}

 #'

+#' @examples

+#' WriteH5MU(MultiAssayExperiment::miniACC, "miniacc.h5mu")

+#' mae <- ReadH5MU("miniacc.h5mu")

+#'

 #' @importFrom stats setNames

 #' @importFrom rhdf5 h5ls H5Fclose H5Lexists H5Dread H5Dclose

 #' @importMethodsFrom rhdf5 &

@@ -1,5 +1,6 @@

 #' @importFrom rhdf5 H5Aexists H5Aopen H5Aread H5Aclose H5Dread H5Dclose

 #' @importMethodsFrom rhdf5 &

+#' @importFrom methods is

 read_dataframe <- function(group) {

     indexcol <- "_index"

     if (H5Aexists(group, "_index")) {

@@ -94,6 +95,7 @@ read_sparse_matrix <- function(group, encoding, backed=FALSE) {

 }

 #' @importFrom rhdf5 H5Iget_type H5Iget_name H5Aexists H5Aopen H5Aread H5Aclose H5Dread H5Dclose H5Gclose H5Fget_name

+#' @importFrom methods new

 read_matrix <- function(dataset, backed=FALSE) {

     if (backed) {

         have_delayedarray <- requireNamespace("HDF5Array", quietly=TRUE)

@@ -167,6 +169,7 @@ read_attribute <- function(attr) {

 #' @importFrom SingleCellExperiment SingleCellExperiment

 #' @importMethodsFrom SingleCellExperiment colPair<- rowPair<-

 #' @importFrom SummarizedExperiment SummarizedExperiment

+#' @importFrom methods is

 read_modality <- function(view, backed=FALSE) {

     X <- read_matrix(h5autoclose(view & "X"), backed=backed)

     var <- read_with_index(h5autoclose(view & "var"))

@@ -205,7 +208,7 @@ read_modality <- function(view, backed=FALSE) {

             for (name in names) {

                 cpair <- read_matrix(h5autoclose(view & paste(cp$name, name, sep="/")))

                 if (!is(cpair, "dsparseMatrix")) {

-                    warn(paste("Pairwise", cp$name, "matrix", name, "is not a sparse matrix. Only sparse matrices are currently supported, skipping..."))

+                    warning(paste("Pairwise", cp$name, "matrix", name, "is not a sparse matrix. Only sparse matrices are currently supported, skipping..."))

                 } else {

                     se <- cp$setter(se, name, value=cpair)

                 }

@@ -109,7 +109,7 @@ read_matrix <- function(dataset, backed=FALSE) {

         H5Aclose(encattr)

         if (encoding %in% c("csr_matrix", "csc_matrix")) {

             if (backed) {

-                cls <- ifelse(encoding == "csr_matrix", "CSR_H5ADMatrixSeed", "CSC_H5ADMatrixSeed")

+                cls <- ifelse(encoding == "csr_matrix", "CSC_H5ADMatrixSeed", "CSR_H5ADMatrixSeed")

                 seed <- HDF5Array::H5SparseMatrixSeed

             } else {

                 return(read_sparse_matrix(dataset, encoding))

@@ -160,6 +160,7 @@ read_attribute <- function(attr) {

         H5Dread(attr)

 }

+#' @importFrom stats setNames

 #' @importFrom rhdf5 h5ls

 #' @importMethodsFrom rhdf5 &

 #' @importFrom S4Vectors SimpleList

@@ -170,12 +171,19 @@ read_modality <- function(view, backed=FALSE) {

     X <- read_matrix(h5autoclose(view & "X"), backed=backed)

     var <- read_with_index(h5autoclose(view & "var"))

     obs <- read_with_index(h5autoclose(view  & "obs"))

-

-    viewnames <- h5ls(view, recursive=FALSE)$name

     rownames(X) <- rownames(var)

     colnames(X) <- rownames(obs)

-    args <- list(assays=list(counts=X), rowData=var, colData=obs)

+    viewnames <- h5ls(view, recursive=FALSE)$name

+    layers <- list()

+    if ("layers" %in% viewnames) {

+        layers <- lapply(setNames(nm=h5ls(h5autoclose(view & "layers"), recursive=FALSE)$name), function(layer) {

+            read_matrix(h5autoclose(view & paste("layers", layer, sep="/")), backed=backed)

+        })

+    }

+

+    args <- list(assays=c(list(X), layers), rowData=var, colData=obs)

+

     if ("obsm" %in% viewnames) {

         obsmnames <- h5ls(h5autoclose(view & "obsm"), recursive=FALSE)$name

         obsm <- lapply(obsmnames, function(space) {