satijalab · mojaveazure · Jun 11, 2021 · Apr 30, 2021 · May 25, 2021 · May 26, 2021
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,6 +1,6 @@
 Package: Seurat
-Version: 4.0.2
-Date: 2021-05-20
+Version: 4.0.2.9002
+Date: 2021-05-28
 Title: Tools for Single Cell Genomics
 Description: A toolkit for quality control, analysis, and exploration of single cell RNA sequencing data. 'Seurat' aims to enable users to identify and interpret sources of heterogeneity from single cell transcriptomic measurements, and to integrate diverse types of single cell data. See Satija R, Farrell J, Gennert D, et al (2015) <doi:10.1038/nbt.3192>, Macosko E, Basu A, Satija R, et al (2015) <doi:10.1016/j.cell.2015.05.002>, Stuart T, Butler A, et al (2019) <doi:10.1016/j.cell.2019.05.031>, and Hao, Hao, et al (2020) <doi:10.1101/2020.10.12.335331> for more details.
 Authors@R: c(

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,11 @@
+## Seurat develop
+
+## Added
+
+## Changes
+- Fix issues with `as.SingleCellExperiment.Seurat` for the latest verion of SingleCellExperiment ([#4532](https://github.com/satijalab/seurat/pull/4532))
+- Ensure proper reference.reduction is used in `MapQuery()`
+
 # Seurat 4.0.2 (2020-03-20)
 ## Added
 - New `AddAzimuthScores()` and `AddAzimuthResults()` functions

diff --git a/R/integration.R b/R/integration.R
@@ -770,6 +770,7 @@ FindTransferAnchors <- function(
   projected <- ifelse(test = reduction == "pcaproject", yes = TRUE, no = FALSE)
   reduction.2 <- character()
   feature.mean <- NULL
+  reference.reduction.init <- reference.reduction
   if (normalization.method == "SCT") {
       # ensure all residuals required are computed
       query <- suppressWarnings(expr = GetResidual(object = query, assay = query.assay, features = features, verbose = FALSE))
@@ -1139,6 +1140,7 @@ FindTransferAnchors <- function(
   }
   slot(object = combined.ob, name = "reductions") <- reductions
   command <- LogSeuratCommand(object = combined.ob, return.command = TRUE)
+  slot(command, name = 'params')$reference.reduction <- reference.reduction.init
   anchor.set <- new(
     Class = "TransferAnchorSet",
     object.list = list(combined.ob),
@@ -1902,9 +1904,16 @@ MapQuery <- function(
   projectumap.args = list(),
   verbose = TRUE
 ) {
+
   # determine anchor type
   if (grepl(pattern = "pca", x = slot(object = anchorset, name = "command")$reduction)) {
     anchor.reduction <- "pcaproject"
+    # check if the anchorset can be used for mapping
+    if (is.null(x = slot(object = anchorset, name = "command")$reference.reduction)) {
+      stop('The reference.reduction parameter was not set when running ',
+      'FindTransferAnchors, so the resulting AnchorSet object cannot be used ',
+      'in the MapQuery function.')
+    }
   } else if (grepl(pattern = "cca", x = slot(object = anchorset, name = "command")$reduction)) {
     anchor.reduction <- "cca"
     ref.cca.embedding <- Embeddings(
@@ -1941,6 +1950,7 @@ MapQuery <- function(
     stop("unkown type of anchors")
   }
 
+
   reference.reduction <- reference.reduction %||%
     slot(object = anchorset, name = "command")$reference.reduction %||%
     anchor.reduction

diff --git a/R/objects.R b/R/objects.R
@@ -1175,7 +1175,7 @@ as.SingleCellExperiment.Seurat <- function(x, assay = NULL, ...) {
     stop("One or more of the assays you are trying to convert is not in the Seurat object")
   }
   experiments <- list()
-  for (assayn in assay){
+  for (assayn in assay) {
   assays = list(
     counts = GetAssayData(object = x, assay = assayn, slot = "counts"),
     logcounts = GetAssayData(object = x, assay = assayn, slot = "data"))
@@ -1187,24 +1187,45 @@ as.SingleCellExperiment.Seurat <- function(x, assay = NULL, ...) {
   sce <- as(object = experiments[[1]], Class = "SingleCellExperiment")
   sce <- SingleCellExperiment::SingleCellExperiment(sce, altExps = experiments)
   orig.exp.name <- names(x = experiments[1])
-  sce <- SingleCellExperiment::swapAltExp(x = sce, name = orig.exp.name, saved = NULL)
+  sce <- SingleCellExperiment::swapAltExp(
+    x = sce,
+    name = orig.exp.name,
+    saved = NULL
+  )
   metadata <- x[[]]
   metadata$ident <- Idents(object = x)
   SummarizedExperiment::colData(x = sce) <- S4Vectors::DataFrame(metadata)
-  for (assayn in assay){
-    sce <- SingleCellExperiment::swapAltExp(x = sce, name = assayn, saved = orig.exp.name)
-    SummarizedExperiment::rowData(x = sce) <- S4Vectors::DataFrame(x[[assayn]][[]])
-    sce <- SingleCellExperiment::swapAltExp(x = sce, name = orig.exp.name, saved = assayn)
+  for (assayn in assay) {
+    if (assayn != orig.exp.name) {
+      sce <- SingleCellExperiment::swapAltExp(
+        x = sce,
+        name = assayn,
+        saved = orig.exp.name
+      )
+      SummarizedExperiment::rowData(x = sce) <- S4Vectors::DataFrame(x[[assayn]][[]])
+      sce <- SingleCellExperiment::swapAltExp(
+        x = sce,
+        name = orig.exp.name,
+        saved = assayn
+      )
+    }
   }
   for (dr in FilterObjects(object = x, classes.keep = "DimReduc")) {
     assay.used <- DefaultAssay(object = x[[dr]])
     if (assay.used %in% SingleCellExperiment::altExpNames(x = sce)) {
-      sce <- SingleCellExperiment::swapAltExp(x = sce, name = assay.used, saved = orig.exp.name)
-      SingleCellExperiment::reducedDim(x = sce, toupper(x = dr)) <- Embeddings(object = x[[dr]])
-      sce <- SingleCellExperiment::swapAltExp(x = sce, name = orig.exp.name, saved = assay.used)
+      sce <- SingleCellExperiment::swapAltExp(
+        x = sce,
+        name = assay.used,
+        saved = orig.exp.name
+      )
+      SingleCellExperiment::reducedDim(x = sce, type = toupper(x = dr)) <- Embeddings(object = x[[dr]])
+      sce <- SingleCellExperiment::swapAltExp(
+        x = sce,
+        name = orig.exp.name,
+        saved = assay.used
+      )
     }
   }
-  sce <- SingleCellExperiment::swapAltExp(x = sce, name = orig.exp.name, saved = NULL)
   return(sce)
 }
 

diff --git a/tests/testthat/test_objects.R b/tests/testthat/test_objects.R
@@ -341,3 +341,30 @@ test_that("Top works", {
   expect_equal(length(tpc1.sub[[1]]), 40)
   expect_equal(length(tpc1.sub[[2]]), 39)
 })
+
+
+# Tests for SCE conversion
+# ------------------------------------------------------------------------------
+test_that("as.SingleCellExperiment works", {
+  skip_on_cran()
+  if (requireNamespace('SingleCellExperiment', quietly = TRUE)) {
+    mat <- matrix(1:100, ncol = 10)
+    colnames(mat) <- LETTERS[1:10]
+    rownames(mat) <- LETTERS[1:10]
+    seuratObj <- Seurat::CreateSeuratObject(mat)
+    sce <- as.SingleCellExperiment(seuratObj)
+
+    expect_equal(ncol(sce), 10)
+    expect_equal(nrow(sce), 10)
+    # expect_equal(length(SingleCellExperiment::altExps(sce)), 0)
+    # expect_equal(SingleCellExperiment::mainExpName(sce), 'RNA')
+
+    seuratObj <- Seurat::CreateSeuratObject(mat)
+    seuratObj[['ADT']] <- CreateAssayObject(mat)
+    sce <- as.SingleCellExperiment(seuratObj)
+    expect_equal(ncol(sce), 10)
+    expect_equal(nrow(sce), 10)
+    # expect_equal(names(SingleCellExperiment::altExps(sce)), 'ADT')
+    # expect_equal(SingleCellExperiment::mainExpName(sce), 'RNA')
+  }
+})