Implement coercion using as()

NEWS.md

@@ -5,6 +5,7 @@
 * Implemented an `AnnDataView` class, which provides a lazy view of an `AnnData` object without copying data (PR #1096)
 * Implemented S3 methods for `AbstractAnnData` objects: `dim`, `nrow`, `ncol`, `dimnames`, `rownames`, `colnames`, and `[` (PR #1096)
 * Add `ReticulateAnnData` class for seamless Python integration via **{reticulate}** (PR #322)
+* Added S4 `as()` coercions linking AnnData implementations with `SingleCellExperiment` and `Seurat` objects (PR #358)
 
 ## Major changes
 
@@ -29,6 +30,7 @@
 - Add checks for type arguments to `generate_dataset()` (PR #354)
 - Generalise the layers created by `generate_dataset()` when `format = "Seurat"`
   (PR #354)
+- Fix inconsistency in `output_class` argument values across conversion functions (PR #358)
 
 ## Bug fixes
 

R/as-coercions.R

@@ -0,0 +1,223 @@
+#' Coercion helpers for `as()`
+#'
+#' These helper registrations wire up S4-style `as()` conversions so that
+#' AnnData implementations (including [`InMemoryAnnData`], [`HDF5AnnData`], and
+#' [`ReticulateAnnData`]) as well as [`SingleCellExperiment`] and
+#' [`SeuratObject::Seurat`] objects can be coerced
+#' between one another without the caller needing to know the underlying helper
+#' functions. Because `as()` cannot accept additional arguments, conversions
+#' that require them (such as writing HDF5-backed AnnData objects) raise an
+#' informative error pointing to the richer interface.
+#'
+#' @keywords internal
+#' @noRd
+NULL
+
+# Class compatibility registrations -----------------------------------------
+
+.register_oldclass <- function(class, super = character()) {
+  if (!methods::isClass(class)) {
+    methods::setOldClass(c(class, super))
+  }
+}
+
+.register_oldclass("AbstractAnnData", "R6")
+.register_oldclass("InMemoryAnnData", c("AbstractAnnData", "R6"))
+.register_oldclass("HDF5AnnData", c("AbstractAnnData", "R6"))
+.register_oldclass("ReticulateAnnData", c("AbstractAnnData", "R6"))
+.register_oldclass("AnnDataView", c("AbstractAnnData", "R6"))
+
+.as_abort_extra_args <- function(from, to, helper) {
+  cli::cli_abort(
+    c(
+      "Can't coerce {.cls {from}} to {.cls {to}} with {.fun as}.",
+      "i" = helper
+    ),
+    call = rlang::caller_env()
+  )
+}
+
+.warn_as_limited <- function(recommendation) {
+  cli::cli_warn(
+    c(
+      "Using {.fun as} limits control over data mapping.",
+      "i" = recommendation
+    ),
+    call = rlang::caller_env()
+  )
+}
+
+# Handler constructors -------------------------------------------------------
+
+.make_convert_handler <- function(converter, warn = NULL, pre = NULL) {
+  force(warn)
+  force(pre)
+
+  function(from) {
+    if (!is.null(pre)) {
+      pre(from)
+    }
+    if (!is.null(warn)) {
+      .warn_as_limited(warn)
+    }
+    converter(from)
+  }
+}
+
+.make_abort_handler <- function(from_class, to_class, helper) {
+  force(from_class)
+  force(to_class)
+  force(helper)
+
+  function(from) {
+    .as_abort_extra_args(from_class, to_class, helper)
+  }
+}
+
+.register_set_as_rules <- function(rules) {
+  for (rule in rules) {
+    methods::setAs(rule$from, rule$to, rule$handler)
+  }
+}
+
+.format_control_recommendation <- function(call_expr) {
+  sprintf("Prefer `%s` for fine-grained control over data mapping.", call_expr)
+}
+
+# AnnData <-> AnnData coercion rules ----------------------------------------
+warn_ann_inmemory <- .format_control_recommendation(
+  "adata$as_InMemoryAnnData(...)"
+)
+warn_ann_reticulate <- .format_control_recommendation(
+  "adata$as_ReticulateAnnData(...)"
+)
+
+ann_data_rules <- list(
+  list(
+    from = "AbstractAnnData",
+    to = "InMemoryAnnData",
+    handler = .make_convert_handler(
+      converter = as_InMemoryAnnData,
+      warn = warn_ann_inmemory
+    )
+  ),
+  list(
+    from = "AbstractAnnData",
+    to = "ReticulateAnnData",
+    handler = .make_convert_handler(
+      converter = as_ReticulateAnnData,
+      warn = warn_ann_reticulate
+    )
+  ),
+  list(
+    from = "AbstractAnnData",
+    to = "HDF5AnnData",
+    handler = .make_abort_handler(
+      from_class = "AbstractAnnData",
+      to_class = "HDF5AnnData",
+      helper = "Use `adata$as_HDF5AnnData(file = <path>)` to provide the output file."
+    )
+  )
+)
+
+.register_set_as_rules(ann_data_rules)
+
+# SingleCellExperiment coercion rules ---------------------------------------
+
+if (rlang::is_installed("SingleCellExperiment")) {
+  warn_customise <- .format_control_recommendation("as_AnnData(...)")
+  warn_sce <- .format_control_recommendation(
+    "adata$as_SingleCellExperiment(...)"
+  )
+
+  single_cell_rules <- list(
+    list(
+      from = "SingleCellExperiment",
+      to = "InMemoryAnnData",
+      handler = .make_convert_handler(
+        converter = function(from) {
+          as_AnnData(from, output_class = "InMemoryAnnData")
+        },
+        warn = warn_customise
+      )
+    ),
+    list(
+      from = "SingleCellExperiment",
+      to = "ReticulateAnnData",
+      handler = .make_convert_handler(
+        converter = function(from) {
+          as_AnnData(from, output_class = "ReticulateAnnData")
+        },
+        warn = warn_customise
+      )
+    ),
+    list(
+      from = "SingleCellExperiment",
+      to = "HDF5AnnData",
+      handler = .make_abort_handler(
+        from_class = "SingleCellExperiment",
+        to_class = "HDF5AnnData",
+        helper = "Use `as_AnnData(from, output_class = \"HDF5AnnData\", filename = <path>)` to provide the output file."
+      )
+    ),
+    list(
+      from = "AbstractAnnData",
+      to = "SingleCellExperiment",
+      handler = .make_convert_handler(
+        converter = as_SingleCellExperiment,
+        warn = warn_sce
+      )
+    )
+  )
+
+  .register_set_as_rules(single_cell_rules)
+}
+
+# Seurat coercion rules ------------------------------------------------------
+
+if (rlang::is_installed("SeuratObject")) {
+  warn_customise <- .format_control_recommendation("as_AnnData(...)")
+  warn_seurat <- .format_control_recommendation("adata$as_Seurat(...)")
+
+  seurat_rules <- list(
+    list(
+      from = "Seurat",
+      to = "InMemoryAnnData",
+      handler = .make_convert_handler(
+        converter = function(from) {
+          as_AnnData(from, output_class = "InMemoryAnnData")
+        },
+        warn = warn_customise
+      )
+    ),
+    list(
+      from = "Seurat",
+      to = "ReticulateAnnData",
+      handler = .make_convert_handler(
+        converter = function(from) {
+          as_AnnData(from, output_class = "ReticulateAnnData")
+        },
+        warn = warn_customise
+      )
+    ),
+    list(
+      from = "Seurat",
+      to = "HDF5AnnData",
+      handler = .make_abort_handler(
+        from_class = "Seurat",
+        to_class = "HDF5AnnData",
+        helper = "Use `as_AnnData(from, output_class = \"HDF5AnnData\", filename = <path>)` to provide the output file."
+      )
+    ),
+    list(
+      from = "AbstractAnnData",
+      to = "Seurat",
+      handler = .make_convert_handler(
+        converter = as_Seurat,
+        warn = warn_seurat
+      )
+    )
+  )
+
+  .register_set_as_rules(seurat_rules)
+}

R/as_AnnData.R

@@ -162,7 +162,7 @@ as_AnnData <- function(
   varp_mapping = TRUE,
   uns_mapping = TRUE,
   assay_name = NULL,
-  output_class = c("InMemory", "HDF5AnnData", "ReticulateAnnData"),
+  output_class = c("InMemoryAnnData", "HDF5AnnData", "ReticulateAnnData"),
   ...
 ) {
   UseMethod("as_AnnData", x)
@@ -182,7 +182,7 @@ as_AnnData.SingleCellExperiment <- function(
   varp_mapping = TRUE,
   uns_mapping = TRUE,
   assay_name = TRUE,
-  output_class = c("InMemory", "HDF5AnnData", "ReticulateAnnData"),
+  output_class = c("InMemoryAnnData", "HDF5AnnData", "ReticulateAnnData"),
   ...
 ) {
   from_SingleCellExperiment(
@@ -215,7 +215,7 @@ as_AnnData.Seurat <- function(
   varp_mapping = TRUE,
   uns_mapping = TRUE,
   assay_name = NULL,
-  output_class = c("InMemory", "HDF5AnnData", "ReticulateAnnData"),
+  output_class = c("InMemoryAnnData", "HDF5AnnData", "ReticulateAnnData"),
   ...
 ) {
   from_Seurat(

R/from_Seurat.R

@@ -30,7 +30,7 @@ from_Seurat <- function(
   obsp_mapping = TRUE,
   varp_mapping = TRUE,
   uns_mapping = TRUE,
-  output_class = c("InMemory", "HDF5AnnData", "ReticulateAnnData"),
+  output_class = c("InMemoryAnnData", "HDF5AnnData", "ReticulateAnnData"),
   ...
 ) {
   check_requires("Converting Seurat to AnnData", c("SeuratObject", "Seurat"))

R/from_SingleCellExperiment.R

@@ -28,7 +28,7 @@ from_SingleCellExperiment <- function(
   obsp_mapping = TRUE,
   varp_mapping = TRUE,
   uns_mapping = TRUE,
-  output_class = c("InMemory", "HDF5AnnData", "ReticulateAnnData"),
+  output_class = c("InMemoryAnnData", "HDF5AnnData", "ReticulateAnnData"),
   ...
 ) {
   check_requires(