Merge pull request #346 from biomage-org/40-fix-reduction-names

Fix reduction names in uploaded Seurat object

pipeline-runner/R/seurat-2-load_seurat.R

@@ -132,6 +132,19 @@ reconstruct_seurat <- function(dataset_fpath) {
     names(user_scdata@reductions) <- tolower(names(user_scdata@reductions))
     red_name <- SeuratObject::DefaultDimReduc(user_scdata)
     check_type_is_safe(red_name)
+    red_match <- grep("umap|tsne", red_name, value = TRUE)
+
+    if (length(red_match) > 0 && !(red_match %in% c("umap", "tsne"))) {
+      is_umap <- grepl("umap", red_match)
+      is_tsne <- grepl("tsne", red_match)
+      new_red_name <- ifelse(is_umap, "umap", ifelse(is_tsne, "tsne", NA))
+
+      message("Found reduction name ", red_match," containing ", new_red_name)
+      user_scdata <- update_reduction_name(user_scdata, red_name, new_red_name)
+      red_name <- SeuratObject::DefaultDimReduc(user_scdata)
+      message("Updated default reduction: ", red_name)
+    }
+
     stopifnot(red_name %in% c('umap', 'tsne'))
 
     embedding <- user_scdata@reductions[[red_name]]@cell.embeddings
@@ -192,3 +205,16 @@ check_type_is_safe <- function(x) {
     stop('Unexpected data type in uploaded .rds file.')
   }
 }
+
+
+update_reduction_name <- function(scdata, red_name, new_name) {
+  current_names <- names(scdata@reductions)
+  if (new_name %in% current_names) {
+    message("Renaming existing reduction name ", names(scdata@reductions)[current_names == new_name], " to ", paste0(new_name, ".ori"))
+    names(scdata@reductions)[current_names == new_name] <- paste0(new_name, ".ori")
+  }
+  names(scdata@reductions)[current_names == red_name] <- new_name
+
+  return(scdata)
+}
+

pipeline-runner/tests/testthat/test-seurat-2-load_seurat.R

@@ -239,3 +239,46 @@ test_that("load_seurat identifies and log-transforms counts stored in data assay
   unlink(data_dir, recursive = TRUE)
 })
 
+test_that("load_seurat works when default reducion is different than umap or tsne", {
+  # setup
+  input_dir <- tempdir()
+  data_dir <- file.path(input_dir, 'pbmc_small')
+  dir.create(data_dir)
+  orig_scdata <- mock_scdata(data_dir)
+  withr::defer(unlink(data_dir, recursive = TRUE))
+
+  # simulate the condition where renaming is needed
+  names(orig_scdata@reductions)[names(orig_scdata@reductions) == "tsne"] <- "tsne.ref"
+  orig_scdata@reductions$tsne <- orig_scdata@reductions$tsne.ref
+  saveRDS(orig_scdata, file.path(data_dir, 'r.rds'))
+
+  prev_out <- list(config = list(samples = 'pbmc_small'))
+  res <- load_seurat(input = NULL, pipeline_config = NULL, prev_out = prev_out, input_dir = input_dir)
+  scdata <- res$output$scdata
+
+  expect_true('tsne' %in% names(scdata@reductions))
+  expect_equal('tsne', SeuratObject::DefaultDimReduc(scdata))
+})
+
+test_that("update_reduction_name correctly renames dimensionality reductions", {
+  # setup
+  input_dir <- tempdir()
+  data_dir <- file.path(input_dir, 'pbmc_small')
+  dir.create(data_dir)
+  scdata <- mock_scdata(data_dir)
+  withr::defer(unlink(data_dir, recursive = TRUE))
+
+  # simulate the condition where renaming is needed
+  names(scdata@reductions)[names(scdata@reductions) == 'tsne'] <- 'tsne.ref'
+  scdata@reductions$tsne <- scdata@reductions$tsne.ref
+
+  red_name <- SeuratObject::DefaultDimReduc(scdata)
+  red_match <- grep('umap|tsne', red_name, value = TRUE)
+  is_umap <- grepl('umap', red_match)
+  is_tsne <- grepl('tsne', red_match)
+  new_red_name <- ifelse(is_umap, 'umap', ifelse(is_tsne, 'tsne', NA))
+
+  updated_scdata <- update_reduction_name(scdata, red_name, new_red_name)
+  expect_equal(SeuratObject::DefaultDimReduc(updated_scdata), new_red_name)
+  expect_true('tsne.ori' %in% names(updated_scdata@reductions))
+})