Merge remote-tracking branch 'origin/main' into issue-75-compression

scverse · Nov 30, 2023 · baa7448 · baa7448
2 parents 1298df1 + 50418e1
commit baa7448
Show file tree

Hide file tree

Showing 16 changed files with 183 additions and 242 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -3,39 +3,50 @@ Title: AnnData interoperability in R
 Version: 0.0.0.9000
 Authors@R: c(
     person(
-        "Robrecht",
-        "Cannoodt", 
+        "Robrecht", "Cannoodt", 
         email = "[email protected]",
         role = c("aut", "cre"),
         comment = c(ORCID = "0000-0003-3641-729X", github = "rcannood")
     ),
     person(
-        "Luke",
-        "Zappia",
+        "Luke", "Zappia",
         email = "[email protected]",
         role = "aut",
         comment = c(ORCID = "0000-0001-7744-8565", github = "lazappi")
     ),
     person(
-        "Martin",
-        "Morgan",
+        "Martin", "Morgan",
         email = "[email protected]",
         role = "aut",
         comment = c(ORCID = "0000-0002-5874-8148", github = "mtmorgan")
     ),
     person(
-        "Louise",
-        "Deconinck",
+        "Louise", "Deconinck",
         email = "[email protected]",
         role = "aut",
         comment = c(ORCID = "0000-0001-8100-6823", github = "LouiseDck")
     ),
     person(
-        "Danila",
-        "Bredikhin",
+        "Danila", "Bredikhin",
         email = "[email protected]",
         role = "ctb",
         comment = c(ORCID = "0000-0001-8089-6983", github = "gtca")
+    ),
+    person(
+        "Isaac", "Virshup",
+        role = "ctb",
+        comment = c(ORCID = "0000-0002-1710-8945", github = "ivirshup")
+    ),
+    person(
+        "Brian", "Schilder", 
+        role = "aut",
+        email = "[email protected]", 
+        comment = c(ORCID = "0000-0001-5949-2191", github = "bschilder")
+    ),
+    person(
+        "Chananchida", "Sang-aram",
+        role = "ctb",
+        comment = c(ORCID = "0000-0002-0922-0822", github = "csangara")
     )
   )
 Description: Bring the power and flexibility of AnnData to the R

diff --git a/R/AbstractAnnData.R b/R/AbstractAnnData.R
@@ -82,19 +82,27 @@ AbstractAnnData <- R6::R6Class("AbstractAnnData", # nolint
       for (attribute in c(
         "obs",
         "var",
-        "uns",
+        # "uns", # TODO: remove this when uns is implemented
         "obsm",
         "varm",
         "layers",
         "obsp",
         "varp"
       )) {
-        attr_key <- paste0(attribute, "_keys")
-        if (!is.null(self[[attr_key]])) {
-          slot_keys <- self[[attr_key]]()
-          if (length(slot_keys) > 0) {
-            cat("    ", pretty_print(attribute, slot_keys), "\n", sep = "")
+        key_fun <- self[[paste0(attribute, "_keys")]]
+        keys <-
+          if (!is.null(key_fun)) {
+            key_fun()
+          } else {
+            NULL
           }
+        if (length(keys) > 0) {
+          cat(
+            "    ", attribute, ":",
+            paste("'", keys, "'", collapse = ", "),
+            "\n",
+            sep = ""
+          )
         }
       }
     },
@@ -126,6 +134,22 @@ AbstractAnnData <- R6::R6Class("AbstractAnnData", # nolint
     layers_keys = function() {
       names(self$layers)
     },
+    #' @description Keys (element names) of `obsm`.
+    obsm_keys = function() {
+      names(self$obsm)
+    },
+    #' @description Keys (element names) of `varm`.
+    varm_keys = function() {
+      names(self$varm)
+    },
+    #' @description Keys (element names) of `obsp`.
+    obsp_keys = function() {
+      names(self$obsp)
+    },
+    #' @description Keys (element names) of `varp`.
+    varp_keys = function() {
+      names(self$varp)
+    },
     #' @description Convert to SingleCellExperiment
     to_SingleCellExperiment = function() {
       to_SingleCellExperiment(self)
@@ -145,40 +169,6 @@ AbstractAnnData <- R6::R6Class("AbstractAnnData", # nolint
     }
   ),
   private = list(
-    # @description `.validate_matrix()` checks that dimensions are
-    #   consistent with `obs` and `var`, and removes dimnames if
-    #   present.
-    # @param mat A matrix to validate
-    # @param label Must be `"X"` or `"layer[[...]]"` where `...` is
-    #   the name of a layer.
-    .validate_matrix = function(mat, label) {
-      if (!is.null(mat)) {
-        if (nrow(mat) != self$n_obs()) {
-          stop("nrow(", label, ") should be the same as nrow(obs)")
-        }
-        if (ncol(mat) != self$n_vars()) {
-          stop("ncol(", label, ") should be the same as nrow(var)")
-        }
-
-        if (!is.null(rownames(mat))) {
-          warning(wrap_message(
-            "rownames(", label, ") should be NULL, removing them from the matrix"
-          ))
-          rownames(mat) <- NULL
-        }
-
-        if (!is.null(colnames(mat))) {
-          warning(wrap_message(
-            "colnames(", label, ") should be NULL, removing them from the matrix"
-          ))
-          colnames(mat) <- NULL
-        }
-      }
-
-      mat
-    },
-
-
     # @description `.validate_aligned_array()` checks that dimensions are
     #   consistent with the anndata object.
     # @param mat A matrix to validate
@@ -188,6 +178,9 @@ AbstractAnnData <- R6::R6Class("AbstractAnnData", # nolint
     # @param expected_rownames
     # @param excepted_colnames
     .validate_aligned_array = function(mat, label, shape, expected_rownames = NULL, expected_colnames = NULL) {
+      if (is.null(mat)) {
+        return(mat)
+      }
       mat_dims <- dim(mat)
       for (i in seq_along(shape)) {
         expected_dim <- shape[i]
@@ -196,26 +189,16 @@ AbstractAnnData <- R6::R6Class("AbstractAnnData", # nolint
           stop("dim(", label, ")[", i, "] should have shape: ", expected_dim, ", found: ", found_dim, ".")
         }
       }
-      if (!is.null(expected_rownames) & !is.null(rownames(mat))) {
+      if (!is.null(expected_rownames) & !has_row_names(mat)) {
         if (!identical(rownames(mat), expected_rownames)) {
           stop("rownames(", label, ") should be the same as expected_rownames")
         }
-      }
-      if (!is.null(rownames(mat))) {
-        warning(wrap_message(
-          "rownames(", label, ") should be NULL, removing them from the matrix"
-        ))
         rownames(mat) <- NULL
       }
       if (!is.null(expected_colnames) & !is.null(colnames(mat))) {
         if (!identical(colnames(mat), expected_colnames)) {
           stop("colnames(", label, ") should be the same as expected_colnames")
         }
-      }
-      if (!is.null(colnames(mat))) {
-        warning(wrap_message(
-          "colnames(", label, ") should be NULL, removing them from the matrix"
-        ))
         colnames(mat) <- NULL
       }
 
@@ -227,8 +210,8 @@ AbstractAnnData <- R6::R6Class("AbstractAnnData", # nolint
     #   whose entries will be validated
     # @param label The label of the collection, used for error messages
     # @param shape Expected dimensions of arrays. Arrays may have more dimensions than specified here
-    # @param expected_rownames
-    # @param expected_colnames
+    # @param expected_rownames Expected row names
+    # @param expected_colnames Expected column names
     .validate_aligned_mapping = function(collection, label, shape, expected_rownames = NULL, expected_colnames = NULL) {
       if (is.null(collection)) {
         return(collection)
@@ -282,7 +265,7 @@ AbstractAnnData <- R6::R6Class("AbstractAnnData", # nolint
         ))
       }
 
-      if (.row_names_info(df) > 0) {
+      if (has_row_names(df)) {
         warning(wrap_message(
           "'", label, "' should not have any rownames, removing them from the data frame."
         ))

diff --git a/R/HDF5AnnData.R b/R/HDF5AnnData.R
@@ -24,7 +24,13 @@ HDF5AnnData <- R6::R6Class("HDF5AnnData", # nolint
         read_h5ad_element(private$.h5obj, "/X")
       } else {
         # trackstatus: class=HDF5AnnData, feature=set_X, status=done
-        value <- private$.validate_matrix(value, "X")
+        value <- private$.validate_aligned_array(
+          value,
+          "X",
+          shape = c(self$n_obs(), self$n_vars()),
+          expected_rownames = rownames(self),
+          expected_colnames = colnames(self)
+        )
         write_h5ad_element(value, private$.h5obj, "/X", private$.compression)
       }
     },

diff --git a/R/InMemoryAnnData.R b/R/InMemoryAnnData.R
@@ -51,7 +51,13 @@ InMemoryAnnData <- R6::R6Class("InMemoryAnnData", # nolint
         private$.X
       } else {
         # trackstatus: class=InMemoryAnnData, feature=set_X, status=done
-        private$.X <- private$.validate_matrix(value, "X")
+        private$.X <- private$.validate_aligned_array(
+          value,
+          "X",
+          shape = c(self$n_obs(), self$n_vars()),
+          expected_rownames = rownames(self),
+          expected_colnames = colnames(self)
+        )
         self
       }
     },

diff --git a/R/utilities.R b/R/utilities.R
diff --git a/R/utils.R b/R/utils.R
@@ -0,0 +1,12 @@
+wrap_message <- function(...) {
+  txt <- paste0(..., collapse = "")
+  paste(strwrap(txt, exdent = 2L), collapse = "\n")
+}
+
+has_row_names <- function(x) {
+  if (is.data.frame(x)) {
+    .row_names_info(x) > 0
+  } else {
+    !is.null(dimnames(x)[[1]])
+  }
+}
diff --git a/R/write_h5ad.R b/R/write_h5ad.R
@@ -42,24 +42,25 @@
 #'
 #' # Write a Seurat as a H5AD
 #' if (requireNamespace("SeuratObject", quietly = TRUE)) {
-#'   h5ad_file <- tempfile(fileext = ".h5ad")
-#'   counts <- matrix(1:15, 3L, 5L)
-#'   dimnames(counts) <- list(
-#'     letters[1:3],
-#'     LETTERS[1:5]
-#'   )
-#'   gene.metadata <- data.frame(
-#'     row.names = LETTERS[1:5],
-#'     gene = 1:5
-#'   )
-#'   obj <- SeuratObject::CreateSeuratObject(counts, meta.data = gene.metadata)
-#'   cell.metadata <- data.frame(
-#'     row.names = letters[1:3],
-#'     cell = 1:3
-#'   )
-#'   obj <- SeuratObject::AddMetaData(obj, cell.metadata)
-#'
-#'   write_h5ad(obj, h5ad_file)
+#'   # TODO: uncomment this code when the seurat converter is fixed
+#'   # h5ad_file <- tempfile(fileext = ".h5ad")
+#'   # counts <- matrix(1:15, 3L, 5L)
+#'   # dimnames(counts) <- list(
+#'   #   letters[1:3],
+#'   #   LETTERS[1:5]
+#'   # )
+#'   # gene.metadata <- data.frame(
+#'   #   row.names = LETTERS[1:5],
+#'   #   gene = 1:5
+#'   # )
+#'   # obj <- SeuratObject::CreateSeuratObject(counts, meta.data = gene.metadata)
+#'   # cell.metadata <- data.frame(
+#'   #   row.names = letters[1:3],
+#'   #   cell = 1:3
+#'   # )
+#'   # obj <- SeuratObject::AddMetaData(obj, cell.metadata)
+#'   #
+#'   # write_h5ad(obj, h5ad_file)
 #' }
 write_h5ad <- function(object, path, ...) {
   if (inherits(object, "SingleCellExperiment")) {

diff --git a/man/AbstractAnnData.Rd b/man/AbstractAnnData.Rd
diff --git a/man/HDF5AnnData.Rd b/man/HDF5AnnData.Rd