[r] add get_presence_matrix

api/r/CellCensus/DESCRIPTION

@@ -18,6 +18,8 @@ Imports:
   aws.s3,
   httr,
   jsonlite,
+  methods,
+  stats,
   tiledbsoma,
   tiledb
 Suggests: 

api/r/CellCensus/NAMESPACE

@@ -3,11 +3,14 @@
 export(download_source_h5ad)
 export(get_census_version_description)
 export(get_census_version_directory)
+export(get_presence_matrix)
 export(get_source_h5ad_uri)
 export(open_soma)
 importFrom(aws.s3,save_object)
 importFrom(httr,build_url)
 importFrom(httr,parse_url)
 importFrom(jsonlite,fromJSON)
+importFrom(methods,is)
+importFrom(stats,setNames)
 importFrom(tiledbsoma,SOMACollection)
 importFrom(tiledbsoma,SOMATileDBContext)

api/r/CellCensus/R/get_helpers.R

@@ -0,0 +1,47 @@
+#' Read the feature dataset presence matrix.
+#'
+#' @param census The census SOMACollection from which to read the presence matrix.
+#' @param organism The organism to query, usually one of `Homo sapiens` or `Mus musculus`
+#' @param measurement_name The measurement object to query. Defaults to `RNA`.
+#'
+#' @return a [Matrix::sparseMatrix] with dataset join id & feature join id dimensions,
+#'         filled with 1s indicating presence
+#' @export
+#'
+#' @examples
+get_presence_matrix <- function(census, organism, measurement_name = "RNA") {
+  exp <- get_experiment(census, organism)
+  presence <- exp$ms$get(measurement_name)$get("feature_dataset_presence_matrix")
+  return(presence$read_sparse_matrix())
+}
+
+#' Get the SOMAExperiment for a named organism
+#'
+#' @param census The census SOMACollection.
+#' @param organism The organism name, e.g. `Homo sapiens`
+#'
+#' @return a [tiledbsoma::SOMAExperiment] with the requested experiment.
+#'
+#' @importFrom methods is
+#' @importFrom stats setNames
+#'
+#' @noRd
+get_experiment <- function(census, organism) {
+  # lower/snake case the organism name to find the experiment name
+  exp_name <- tolower(gsub("\\s+", "_", organism))
+  census_data <- census$get("census_data")
+
+  stopifnot(setNames(
+    exp_name %in% census_data$names(),
+    paste("Unknown organism", organism, "- does not exist")
+  ))
+
+  exp <- census_data$get(exp_name)
+
+  stopifnot(setNames(
+    is(exp, "SOMAExperiment"),
+    paste("Unknown organism", organism, "- not a SOMA Experiment")
+  ))
+
+  return(exp)
+}

api/r/CellCensus/R/open.R

@@ -43,5 +43,5 @@ open_soma <- function(census_version = "latest", uri = NULL, tiledbsoma_ctx = NU
   }
   tiledbsoma_ctx <- tiledbsoma::SOMATileDBContext$new(config = cfg)
 
-  return(tiledbsoma::SOMACollection$new(uri, tiledbsoma_ctx = tiledbsoma_ctx))
+  return(tiledbsoma::SOMACollectionOpen(uri, tiledbsoma_ctx = tiledbsoma_ctx))
 }

api/r/CellCensus/tests/testthat/test-get_helpers.R

@@ -0,0 +1,33 @@
+test_that("get_experiment", {
+  census <- open_soma()
+
+  cases <- list(
+    "mus_musculus" = c("Mus musculus", "mus_musculus"),
+    "homo_sapiens" = c("Homo sapiens", "homo_sapiens")
+  )
+
+  for (org in names(cases)) {
+    uri <- census$get("census_data")$get(org)$uri
+    for (alias in c(org, cases[[org]])) {
+      expect_equal(get_experiment(census, alias)$uri, uri)
+    }
+  }
+
+  expect_error(get_experiment(census, "bogus"), "Unknown organism")
+})
+
+test_that("get_presence_matrix", {
+  census <- open_soma()
+  datasets <- as.data.frame(census$get("census_info")$get("datasets")$read())
+  for (org in c("homo_sapiens", "mus_musculus")) {
+    pm <- get_presence_matrix(census, org)
+    expect_s4_class(pm, "sparseMatrix")
+    expect_equal(nrow(pm), nrow(datasets))
+    expect_equal(
+      ncol(pm),
+      nrow(census$get("census_data")$get(org)$ms$get("RNA")$var$read(column_names = "soma_joinid"))
+    )
+    expect_equal(min(pm), 0)
+    expect_equal(max(pm), 1)
+  }
+})