Add lazy named list

NAMESPACE

@@ -1,13 +1,20 @@
 # Generated by roxygen2: do not edit by hand
 
+S3method("$",AnnDataSlotList)
 S3method("[",AbstractAnnData)
+S3method("[",AnnDataSlotList)
+S3method("[[",AnnDataSlotList)
+S3method("[[<-",AnnDataSlotList)
 S3method("dimnames<-",AbstractAnnData)
+S3method("names<-",AnnDataSlotList)
 S3method(as_AnnData,Seurat)
 S3method(as_AnnData,SingleCellExperiment)
 S3method(dim,AbstractAnnData)
 S3method(dimnames,AbstractAnnData)
+S3method(names,AnnDataSlotList)
 S3method(ncol,AbstractAnnData)
 S3method(nrow,AbstractAnnData)
+S3method(print,AnnDataSlotList)
 S3method(py_to_r,anndata._core.anndata.AnnData)
 S3method(py_to_r,collections.abc.Mapping)
 S3method(r_to_py,AbstractAnnData)

R/AbstractAnnData.R

@@ -65,23 +65,187 @@ AbstractAnnData <- R6::R6Class(
     },
     #' @field obsm See [AnnData-usage]
     obsm = function(value) {
-      .abstract_function("ad$obsm")
+      proxy <- AnnDataSlotList(
+        get_keys_fn = function() private$.get_keys("obsm"),
+        set_keys_fn = function(keys) private$.set_keys("obsm", keys),
+        get_value_fn = function(name) private$.get_value("obsm", name),
+        set_value_fn = function(name, value) {
+          res <- private$.validate_aligned_array(
+            value,
+            paste0(".obsm[['", key, "']]"),
+            c(self$n_obs()),
+            expected_rownames = self$obs_names,
+            strip_rownames = TRUE,
+            strip_colnames = FALSE
+          )
+          private$.set_value("obsm", name, res)
+        },
+        set_values_fn = function(value) {
+          res <- private$.validate_aligned_mapping(
+            value,
+            ".obsm",
+            c(self$n_obs()),
+            expected_rownames = self$obs_names,
+            strip_rownames = TRUE,
+            strip_colnames = FALSE
+          )
+          private$.set_values("obsm", res)
+        },
+        get_rownames_fn = function() self$obs_names
+      )
+      if (missing(value)) {
+        # if there is no value, the user is accessing adata$obsm and thus 
+        # the proxy object should be returned. It might be that they are
+        # then subsetting the obsm afterwards, e.g. `adata$obsm[["X_pca"]]`
+        # or `adata$obsm[["X_pca"]] <- ...some matrix...`.
+        proxy
+      } else if (inherits(value, "AnnDataSlotList")) {
+        # no-op: already handled in-place by [[<-.AnnDataSlotList
+        invisible(NULL)
+      } else {
+        # user is setting the obsm with a new named list.
+        proxy$set_values_fn(value)
+      }
     },
     #' @field varm See [AnnData-usage]
     varm = function(value) {
-      .abstract_function("ad$varm")
+      proxy <- AnnDataSlotList(
+        get_keys_fn = function() private$.get_keys("varm"),
+        set_keys_fn = function(keys) private$.set_keys("varm", keys),
+        get_value_fn = function(name) private$.get_value("varm", name),
+        set_value_fn = function(name, value) {
+          res <- private$.validate_aligned_array(
+            value,
+            paste0("varm[['", name, "']]"),
+            c(self$n_vars()),
+            expected_rownames = self$var_names,
+            strip_rownames = TRUE,
+            strip_colnames = FALSE
+          )
+          private$.set_value("varm", name, res)
+        },
+        set_values_fn = function(value) {
+          res <- private$.validate_aligned_mapping(
+            value,
+            "varm",
+            c(self$n_vars()),
+            expected_rownames = self$var_names,
+            strip_rownames = TRUE,
+            strip_colnames = FALSE
+          )
+          private$.set_values("varm", res)
+        },
+        get_rownames_fn = function() self$var_names
+      )
+      if (missing(value)) {
+        proxy
+      } else if (inherits(value, "AnnDataSlotList")) {
+        invisible(NULL)
+      } else {
+        proxy$set_values_fn(value)
+      }
     },
     #' @field obsp See [AnnData-usage]
     obsp = function(value) {
-      .abstract_function("ad$obsp")
+      proxy <- AnnDataSlotList(
+        get_keys_fn = function() private$.get_keys("obsp"),
+        set_keys_fn = function(keys) private$.set_keys("obsp", keys),
+        get_value_fn = function(name) private$.get_value("obsp", name),
+        set_value_fn = function(name, value) {
+          res <- private$.validate_aligned_array(
+            value,
+            paste0("obsp[['", name, "']]"),
+            c(self$n_obs(), self$n_obs()),
+            expected_rownames = self$obs_names,
+            expected_colnames = self$obs_names
+          )
+          private$.set_value("obsp", name, res)
+        },
+        set_values_fn = function(value) {
+          res <- private$.validate_aligned_mapping(
+            value,
+            "obsp",
+            c(self$n_obs(), self$n_obs()),
+            expected_rownames = self$obs_names,
+            expected_colnames = self$obs_names
+          )
+          private$.set_values("obsp", res)
+        },
+        get_rownames_fn = function() self$obs_names,
+        get_colnames_fn = function() self$obs_names
+      )
+      if (missing(value)) {
+        proxy
+      } else if (inherits(value, "AnnDataSlotList")) {
+        invisible(NULL)
+      } else {
+        proxy$set_values_fn(value)
+      }
     },
     #' @field varp See [AnnData-usage]
     varp = function(value) {
-      .abstract_function("ad$varp")
+      proxy <- AnnDataSlotList(
+        get_keys_fn = function() private$.get_keys("varp"),
+        set_keys_fn = function(keys) private$.set_keys("varp", keys),
+        get_value_fn = function(name) private$.get_value("varp", name),
+        set_value_fn = function(name, value) {
+          res <- private$.validate_aligned_array(
+            value,
+            paste0("varp[['", value, "']]"),
+            c(self$n_vars(), self$n_vars()),
+            expected_rownames = self$var_names,
+            expected_colnames = self$var_names
+          )
+          private$.set_value("varp", name, res)
+        },
+        set_values_fn = function(value) {
+          res <- private$.validate_aligned_mapping(
+            value,
+            "varp",
+            c(self$n_vars(), self$n_vars()),
+            expected_rownames = self$var_names,
+            expected_colnames = self$var_names
+          )
+          private$.set_values("varp", res)
+        },
+        get_rownames_fn = function() self$var_names,
+        get_colnames_fn = function() self$var_names
+      )
+      if (missing(value)) {
+        proxy
+      } else if (inherits(value, "AnnDataSlotList")) {
+        invisible(NULL)
+      } else {
+        proxy$set_values_fn(value)
+      }
     },
     #' @field uns See [AnnData-usage]
     uns = function(value) {
-      .abstract_function("ad$uns")
+      proxy <- AnnDataSlotList(
+        get_keys_fn = function() private$.get_keys("uns"),
+        set_keys_fn = function(keys) private$.set_keys("uns", keys),
+        get_value_fn = function(name) private$.get_value("uns", name),
+        set_value_fn = function(name, value) private$.set_value("uns", name, res),
+        set_values_fn = function(value) {
+          res <- private$.validate_named_list(
+            value,
+            "uns",
+            c(self$n_vars(), self$n_vars()),
+            expected_rownames = self$var_names,
+            expected_colnames = self$var_names
+          )
+          private$.set_values("uns", res)
+        },
+        get_rownames_fn = function() self$var_names,
+        get_colnames_fn = function() self$var_names
+      )
+      if (missing(value)) {
+        proxy
+      } else if (inherits(value, "AnnDataSlotList")) {
+        invisible(NULL)
+      } else {
+        proxy$set_values_fn(value)
+      }
     }
   ),
   public = list(
@@ -433,7 +597,7 @@ AbstractAnnData <- R6::R6Class(
 
       collection_names <- names(collection)
       if (
-        !is.list(collection) ||
+        (!is.list(collection) && class(collection) != "AnnDataSlotList") ||
           ((length(collection) != 0) && is.null(collection_names))
       ) {
         cli_abort(

R/AnnDataSlotList-s3methods.R

@@ -0,0 +1,60 @@
+#' S3 Methods for AbstractAnnData Objects
+
+#' @rdname AnnDataSlotList-s3methods
+#' @method names AnnDataSlotList
+#' @export
+names.AnnDataSlotList <- function(x) {
+  x$get_keys_fn()
+}
+
+#' @rdname AnnDataSlotList-s3methods
+#' @method names<- AnnDataSlotList
+#' @export
+`names<-.AnnDataSlotList` <- function(x, value) {
+  x$set_keys_fn(value)
+  x
+}
+
+#' @rdname AnnDataSlotList-s3methods
+#' @method [ AnnDataSlotList
+#' @export
+`[.AnnDataSlotList` <- function(x, i, ...) {
+  if (missing(i)) {
+    # return all values when no index is provided
+    keys <- x$get_keys_fn()
+    result <- lapply(keys, x$get_value_fn)
+    names(result) <- keys
+    result
+  } else {
+    res <- list(x$get_value_fn(i))
+    names(res) <- i
+    res
+  }
+}
+
+#' @rdname AnnDataSlotList-s3methods
+#' @method [[ AnnDataSlotList
+#' @export
+`[[.AnnDataSlotList` <- function(x, i, ...) {
+  x$get_value_fn(i)
+}
+
+#' @rdname AnnDataSlotList-s3methods
+#' @method [[<- AnnDataSlotList
+#' @export
+`[[<-.AnnDataSlotList` <- function(x, i, value) {
+  x$set_value_fn(i, value)
+  x
+}
+
+#' @rdname AnnDataSlotList-s3methods
+#' @method $ AnnDataSlotList
+#' @export
+# `$.AnnDataSlotList` <- function(x, name) {
+#   keys <- x$get_keys_fn()
+#   if (!(name %in% keys)) {
+#     stop(sprintf("Key '%s' not found in AnnDataSlotList (available keys: %s)",
+#                  name, paste(keys, collapse = ", ")), call. = FALSE)
+#   }
+#   x$get_value_fn(name)
+# }