[r] [RFC] Add SOMASparseNDArray$read_spam_matrix()

apis/r/DESCRIPTION

@@ -63,7 +63,9 @@ Suggests:
     testthat (>= 3.0.0),
     pbmc3k.tiledb,
     SeuratObject (>= 4.1.0),
-    datasets
+    datasets,
+    spam,
+    spam64
 VignetteBuilder: knitr
 Config/testthat/edition: 2
 OS_type: unix

apis/r/R/SOMASparseNDArray.R

@@ -214,6 +214,81 @@ SOMASparseNDArray <- R6::R6Class(
       }
     },
 
+    #' @description Read as a spam-based sparse matrix (lifecycle: experimental)
+    #' @param coords ...
+    #' @template param-result-order
+    #' @param log_level ...
+    #'
+    read_spam_matrix = function(
+      coords = NULL,
+      result_order = "auto",
+      log_level = "warn",
+      transpose = FALSE
+    ) {
+      dims <- self$dimensions()
+      attr <- self$attributes()
+      stopifnot(
+        "'spam' is required for reading in spam matrices" =
+          requireNamespace("spam", quietly = TRUE),
+        "Array must have two dimensions" = length(dims) == 2L,
+        "Array must contain columns 'soma_dim_0' and 'soma_dim_1'" =
+          identical(names(dims), c("soma_dim_0", "soma_dim_1")),
+        "Array must contain column 'soma_data'" = identical(names(attr), "soma_data"),
+        "'transpose' must be a single logical value" = is_scalar_logical(transpose)
+      )
+      if (!'package:spam' %in% search()) {
+        attachNamespace('spam')
+      }
+      shape <- if (is.null(coords)) {
+        sapply(
+          X = dims,
+          FUN = function(x) {
+            return(max(as.numeric(tiledb::domain(x))) + 1)
+          }
+        )
+      } else {
+        stopifnot(
+          "'coords' must be a list" = is.list(coords),
+          "'coords' must be a list of vectors or integer64" =
+            all(vapply_lgl(coords, is_vector_or_int64)),
+          "'coords' if unnamed must have length of dim names, else if named names must match dim names" =
+            (is.null(names(coords)) && length(coords) == length(self$dimnames())) ||
+            (!is.null(names(coords)) && all(names(coords) %in% self$dimnames()))
+        )
+        sapply(
+          X = seq_along(coords),
+          FUN = function(i) {
+            mx <- max(as.numeric(coords[[i]])) + 1
+            dim <- as.numeric(self$shape()[i])
+            return(dim - (dim - mx))
+          }
+        )
+      }
+      if (any(c(shape, self$nnz()) > .Machine$integer.max)) {
+        stopifnot(
+          "'spam64' is required for reading large spam matrices" =
+            requireNamespace('spam64', quietly = TRUE)
+        )
+      }
+      tbl <- as.list(self$read_arrow_table(
+        coords = coords,
+        result_order = result_order,
+        log_level = log_level
+      ))
+      tbl$soma_dim_0 <- tbl$soma_dim_0 + 1
+      tbl$soma_dim_1 <- tbl$soma_dim_1 + 1
+      if (isTRUE(x = transpose)) {
+        names(tbl) <- c('j', 'i', 'x')
+        nrow <- shape[2L]
+        ncol <- shape[1L]
+      } else {
+        names(tbl) <- c('i', 'j', 'x')
+        nrow <- shape[1L]
+        ncol <- shape[2L]
+      }
+      return(spam::spam(tbl, nrow = nrow, ncol = ncol))
+    },
+
     #' @description Write matrix-like data to the array. (lifecycle: experimental)
     #'
     #' @param values Any `matrix`-like object coercible to a

apis/r/tests/testthat/test-SOMASparseNDArray.R

@@ -65,7 +65,7 @@ test_that("SOMASparseNDArray creation", {
   expect_equal(shape(uri), c(10,10))
   ## shape with config, expected breakge as 'bad key' used
   expect_error(shape(uri, c(sm.encryption_key="Nope", sm.encryption_type="AES_256_GCM")))
-  
+
 })
 
 test_that("SOMASparseNDArray read_sparse_matrix_zero_based", {
@@ -268,3 +268,60 @@ test_that("platform_config defaults", {
   expect_equal(tiledb::tiledb_filter_get_option(d1, "COMPRESSION_LEVEL"), 3)
 
 })
+
+test_that("SOMASparseNDArray read_spam_matrix", {
+  skip_if_not_installed('spam')
+  withr::local_package("spam")
+  uri <- withr::local_tempdir("sparse-ndarray-spam")
+  ndarray <- SOMASparseNDArray$new(uri, internal_use_only = "allowed_use")
+  ndarray$create(arrow::int32(), shape = c(10, 20))
+
+  mat <- create_sparse_matrix_with_int_dims(10, 20)
+  ndarray$write(mat)
+
+  expect_no_condition(sp <- ndarray$read_spam_matrix())
+  expect_s4_class(sp, 'spam')
+  expect_type(sp@colindices, 'integer')
+  expect_identical(dim(sp), dim(mat))
+  expect_identical(as.matrix(sp), as.matrix(mat))
+
+  # Test transposed
+  expect_no_condition(spt <- ndarray$read_spam_matrix(transpose = TRUE))
+  expect_s4_class(spt, 'spam')
+  mat_t <- Matrix::t(mat)
+  expect_identical(dim(spt), dim(mat_t))
+  expect_identical(as.matrix(spt), as.matrix(mat_t))
+
+  # Test with coords
+  coords <- list(soma_dim_0 = 0, soma_dim_1 = 0:2)
+  expect_no_condition(spc <- ndarray$read_spam_matrix(coords))
+  expect_identical(
+    dim(spc),
+    vapply(X = coords, FUN = length, FUN.VALUE = integer(1L), USE.NAMES = FALSE)
+  )
+  expect_identical(
+    as.matrix(spc),
+    as.matrix(mat[coords[[1L]] + 1, coords[[2L]] + 1, drop = FALSE])
+  )
+
+  # Test with coords -- unnamed
+  ucoords <- list(0, 0:2)
+  expect_no_condition(spu <- ndarray$read_spam_matrix(coords))
+  expect_identical(
+    dim(spu),
+    vapply(X = ucoords, FUN = length, FUN.VALUE = integer(1L), USE.NAMES = FALSE)
+  )
+  expect_identical(
+    as.matrix(spu),
+    as.matrix(mat[ucoords[[1L]] + 1, ucoords[[2L]] + 1, drop = FALSE])
+  )
+
+  # Test forced spam64
+  skip_if_not_installed('spam64')
+  withr::local_options(list(spam.force64 = TRUE))
+  expect_no_condition(sp64 <- ndarray$read_spam_matrix())
+  expect_s4_class(sp64, 'spam')
+  expect_type(sp64@colindices, 'double')
+  expect_equivalent(dim(sp64), dim(mat))
+  expect_identical(as.matrix(sp64), as.matrix(mat))
+})