Report a missing key as NA rather than failing

NEWS.md

@@ -2,6 +2,7 @@
 
 ## Changes:
 - Replace `future_mapply` with `mapply` in `RenameCells.Segmentation` for improved performance ([#294](https://github.com/satijalab/seurat-object/pull/294))
+- Fixed `Key` failing with "values must be length 1" on an object that holds an assay, reduction or image with no key, which took down `FetchData` and everything that plots ([#41](https://github.com/satijalab/seurat-object/issues/41))
 
 # SeuratObject 5.4.0
 

R/seurat.R

@@ -2187,7 +2187,13 @@ Key.Seurat <- function(object, ...) {
         object = object,
         classes.keep = c('SpatialImage', 'KeyMixin')
       ),
-      FUN = \(x) Key(object = object[[x]]),
+      FUN = \(x) {
+        key <- Key(object = object[[x]])
+        # an object stored with no key at all, which objects made before keys
+        # were enforced still carry; NA is what the rest of the code expects
+        # for one, see the duplicate-key handling in `[[<-`
+        if (!length(x = key)) NA_character_ else key
+      },
       FUN.VALUE = character(length = 1L),
       USE.NAMES = TRUE
     )

tests/testthat/test_key_missing.R

@@ -0,0 +1,44 @@
+set.seed(42)
+
+# Key() vapplies over the keyed members with FUN.VALUE = character(1), so a
+# member carrying no key at all returned length 0 and the whole call failed
+# with "values must be length 1, but FUN(X[[2]]) result is length 0", which
+# took down FetchData and everything that plots
+build_object <- function() {
+  counts <- matrix(
+    rpois(200, lambda = 3),
+    nrow = 20,
+    dimnames = list(paste0("g", seq_len(20)), paste0("c", seq_len(10)))
+  )
+  object <- suppressWarnings(CreateSeuratObject(counts = as.sparse(counts)))
+  object[["other"]] <- CreateAssayObject(counts = counts)
+  object
+}
+
+drop_key <- function(object, assay) {
+  slot(slot(object, name = "assays")[[assay]], name = "key") <- character(0)
+  object
+}
+
+test_that("an assay with no key does not break Key()", {
+  object <- drop_key(build_object(), "other")
+  keys <- Key(object)
+  expect_length(keys, 3L)
+  expect_identical(unname(keys[["other"]]), NA_character_)
+  expect_identical(unname(keys[["RNA"]]), "rna_")
+  expect_identical(Keys(object), keys)
+})
+
+test_that("an assay with no key does not break fetching data", {
+  object <- drop_key(build_object(), "other")
+  fetched <- FetchData(object, vars = "g1")
+  expect_identical(rownames(fetched), colnames(object))
+  expect_identical(ncol(fetched), 1L)
+})
+
+test_that("keys are unchanged when every object has one", {
+  object <- build_object()
+  keys <- Key(object)
+  expect_false(anyNA(keys))
+  expect_identical(unname(keys[["other"]]), "other_")
+})