Merge pull request hms-dbmi-cellenics#347 from biomage-org/fix-bug-em…

…pty-cell-level-sets

[Cell-level metadata] Fix cell level cellsets not getting created in some cases

pipeline-runner/R/qc-7-embed_and_cluster.R

@@ -393,14 +393,23 @@ make_cl_metadata_cellclass <- function(variable, type, cl_metadata, color_pool)
       cell_ids <- cl_metadata[get(variable) == values[i], cells_id]
     }
 
-    cl_metadata_cellset$children[[i]] <- list(
-      key = uuid::UUIDgenerate(),
-      name = as.character(values[i]),
-      rootNode = FALSE,
-      type = type,
-      color = color_pool[1],
-      cellIds = ensure_is_list_in_json(cell_ids)
+    # Empty cell sets shouldn't be created based on cell level metadata
+    if (length(cell_ids) == 0) next
+
+    cl_metadata_cellset$children <- append(
+      cl_metadata_cellset$children,
+      list(
+        list(
+          key = uuid::UUIDgenerate(),
+          name = as.character(values[i]),
+          rootNode = FALSE,
+          type = type,
+          color = color_pool[1],
+          cellIds = ensure_is_list_in_json(cell_ids)
+        )
+      )
     )
+
     color_pool <- color_pool[-1]
   }
 

pipeline-runner/tests/testthat/test-qc-7-embed_and_cluster.R

@@ -30,8 +30,9 @@ mock_color_pool <- function(n) {
 }
 
 
-mock_cl_metadata <- function(scdata) {
-  barcode <-  rownames(scdata@meta.data)
+mock_cl_metadata <- function(scdata, optional_custom_barcodes) {
+  barcode <- if (missing(optional_custom_barcodes)) rownames(scdata@meta.data) else optional_custom_barcodes
+
   samples <- rep_len(paste0("sample_", 1:4), length(barcode))
   cell_type <- rep_len(paste0("cell_type_", 1:10), length(barcode))
   group_var <- rep_len(paste0("group_", 1:2), length(barcode))
@@ -607,6 +608,23 @@ test_that("make_cl_metadata_cellsets makes cell-level metadata cellsets.", {
   }
 })
 
+test_that("make_cl_metadata_cellsets skips making cellsets that are empty (no cellIds).", {
+  config <- mock_config()
+  scdata <- mock_scdata()
+  cl_metadata <- mock_cl_metadata(
+    scdata,
+    c(paste0("missing-barcode", 1:50))
+  )
+
+  local_mock_cl_metadata_table(cl_metadata, "mock_experiment_id")
+
+  res <- stubbed_make_cl_metadata_cellsets(scdata, config)
+  withr::defer(unlink(file.path(".", basename(config$metadata_s3_path))))
+
+  expect_equal(length(res[[1]]$children), 0)
+  expect_equal(length(res[[2]]$children), 0)
+})
+
 
 with_fake_http(
   test_that("replace_cl_metadata_through_api sends patch request", {