Merge pull request #4608 from satijalab/develop

Seurat v4.0.3

Author: mojaveazure

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Seurat
-Version: 4.0.2
-Date: 2021-05-20
+Version: 4.0.3
+Date: 2021-06-10
 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(
@@ -66,7 +66,7 @@ Imports:
     scales,
     scattermore (>= 0.7),
     sctransform (>= 0.3.2),
-    SeuratObject,
+    SeuratObject (>= 4.0.2),
     shiny,
     spatstat.core,
     spatstat.geom,

NEWS.md

@@ -1,4 +1,16 @@
-# Seurat 4.0.2 (2020-03-20)
+## Seurat 4.0.3 (2020-06-10)
+## Added
+- Add `jitter` parameter to `FeatureScatter()` 
+
+## 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()`
+- Fix to `UpdateSymbolList()`, no longer searches aliases and exposes the `search.types` parameter in `GeneSymbolThesarus()` ([#4545](https://github.com/satijalab/seurat/issues/4545))
+- Transfer `scale.data` slot as well when converting with `as.SingleCellExperiment.Seurat()`
+- Enable `alpha` parameter for `SpatialDimPlot()`
+- Fix `as.SingleCellExperiment.Seurat()` conversion for atypical `reducedDim` components
+
+# Seurat 4.0.2 (2020-05-20)
 ## Added
 - New `AddAzimuthScores()` and `AddAzimuthResults()` functions
 - Add `shuffle` parameter to `FeatureScatter()` ([#4280](https://github.com/satijalab/seurat/pull/4280))

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

R/objects.R

@@ -1039,17 +1039,22 @@ as.Seurat.SingleCellExperiment <- function(
     )
   }
   meta.data <- as.data.frame(x = SummarizedExperiment::colData(x = x))
+  if (packageVersion(pkg = "SingleCellExperiment") >= "1.14.0") {
+    orig.exp <- SingleCellExperiment::mainExpName(x = x) %||% "originalexp"
+  } else {
+    orig.exp <- "originalexp"
+  }
   if (!is.null(SingleCellExperiment::altExpNames(x = x))) {
     assayn <- assay %||% SingleCellExperiment::altExpNames(x = x)
     if (!all(assay %in% SingleCellExperiment::altExpNames(x = x))) {
       stop("One or more of the assays you are trying to convert is not in the SingleCellExperiment object")
     }
-    assayn <- c("originalexp", assayn)
+    assayn <- c(orig.exp, assayn)
   } else {
-    assayn <- "originalexp"
+    assayn <- orig.exp
   }
   for (assay in assayn) {
-    if (assay != "originalexp") {
+    if (assay != orig.exp) {
       x <- SingleCellExperiment::swapAltExp(x = x, name = assay, saved = NULL)
     }
     # Pull matrices
@@ -1068,7 +1073,7 @@ as.Seurat.SingleCellExperiment <- function(
       # if cell names are NULL, fill with cell_X
       if (is.null(x = colnames(x = mats[[m]]))) {
         warning(
-          "The column names of the",
+          "The column names of the ",
           names(x = mats)[m],
           " matrix is NULL. Setting cell names to cell_columnidx (e.g 'cell_1').",
           call. = FALSE,
@@ -1106,28 +1111,30 @@ as.Seurat.SingleCellExperiment <- function(
     DefaultAssay(object = object) <- assay
     # add feature level meta data
     md <- SingleCellExperiment::rowData(x = x)
-    # replace underscores
-    rownames(x = md) <- gsub(pattern = "_", replacement = "-", x = rownames(x = md))
-    md <- as.data.frame(x = md)
-    # ensure order same as data
-    md <- md[rownames(x = object[[assay]]), ]
-    object[[assay]] <- AddMetaData(
-      object = object[[assay]],
-      metadata = md
-    )
+    if (ncol(x = md) > 0) {
+      # replace underscores
+      rownames(x = md) <- gsub(pattern = "_", replacement = "-", x = rownames(x = md))
+      md <- as.data.frame(x = md)
+      # ensure order same as data
+      md <- md[rownames(x = object[[assay]]), , drop = FALSE]
+      object[[assay]] <- AddMetaData(
+        object = object[[assay]],
+        metadata = md
+      )
+    }
     Idents(object = object) <- project
     # Get DimReduc information, add underscores if needed and pull from different alt EXP
     if (length(x = SingleCellExperiment::reducedDimNames(x = x)) > 0) {
       for (dr in SingleCellExperiment::reducedDimNames(x = x)) {
-        embeddings <- SingleCellExperiment::reducedDim(x = x, type = dr)
+        embeddings <- as.matrix(x = SingleCellExperiment::reducedDim(x = x, type = dr))
         if (is.null(x = rownames(x = embeddings))) {
           rownames(x = embeddings)  <- cell.names
         }
-        if(!grepl('_$',
+        if (isTRUE(x = !grepl('_$',
         gsub(pattern = "[[:digit:]]",
           replacement = "_",
           x = colnames(x = SingleCellExperiment::reducedDim(x = x, type = dr))[1]
-        ))){
+        )))) {
         key <- gsub(
           pattern = "[[:digit:]]",
           replacement = "_",
@@ -1173,36 +1180,65 @@ 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"))
+    logcounts = GetAssayData(object = x, assay = assayn, slot = "data"),
+    scaledata = GetAssayData(object = x, assay = assayn, slot = "scale.data"))
     assays <- assays[sapply(X = assays, FUN = nrow) != 0]
     sume <- SummarizedExperiment::SummarizedExperiment(assays = assays)
     experiments[[assayn]] <- sume
   }
   # create one single cell experiment
   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)
+  if (packageVersion(pkg = "SingleCellExperiment") >= "1.14.0") {
+    SingleCellExperiment::mainExpName(sce) <- names(x = experiments[1])
+  }
+  if (length(x = experiments) > 1) {
+    sce <- SingleCellExperiment::SingleCellExperiment(sce, altExps = experiments)
+    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)
+    if (assay.used %in% SingleCellExperiment::altExpNames(x = sce) & assay.used != orig.exp.name) {
+      sce <- SingleCellExperiment::swapAltExp(
+        x = sce,
+        name = assay.used,
+        saved = orig.exp.name
+      )
+    }
+    SingleCellExperiment::reducedDim(x = sce, type = toupper(x = dr)) <- Embeddings(object = x[[dr]])
+    if (assay.used %in% SingleCellExperiment::altExpNames(x = sce) & assay.used != orig.exp.name) {
+      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)
 }
 

R/utilities.R

@@ -796,14 +796,25 @@ FastRowScale <- function(
 #' @note This function requires internet access
 #'
 #' @param symbols A vector of gene symbols
-#' @param timeout Time to wait before cancelling query in seconds
-#' @param several.ok Allow several current gene sybmols for each provided symbol
+#' @param timeout Time to wait before canceling query in seconds
+#' @param several.ok Allow several current gene symbols for each
+#' provided symbol
+#' @param search.types Type of query to perform:
+#' \describe{
+#'  \item{\dQuote{\code{alias_symbol}}}{Find alternate symbols for the genes
+#'  described by \code{symbols}}
+#'  \item{\dQuote{\code{prev_symbol}}}{Find new new symbols for the genes
+#'  described by \code{symbols}}
+#' }
+#' This parameter accepts multiple options and short-hand options
+#' (eg. \dQuote{\code{prev}} for \dQuote{\code{prev_symbol}})
 #' @param verbose Show a progress bar depicting search progress
 #' @param ... Extra parameters passed to \code{\link[httr]{GET}}
 #'
-#' @return For \code{GeneSymbolThesarus}, if \code{several.ok}, a named list
-#' where each entry is the current symbol found for each symbol provided and the
-#' names are the provided symbols. Otherwise, a named vector with the same information.
+#' @return \code{GeneSymbolThesarus}:, if \code{several.ok}, a named list
+#' where each entry is the current symbol found for each symbol provided and
+#' the names are the provided symbols. Otherwise, a named vector with the
+#' same information.
 #'
 #' @source \url{https://www.genenames.org/} \url{https://www.genenames.org/help/rest/}
 #'
@@ -827,11 +838,13 @@ GeneSymbolThesarus <- function(
   symbols,
   timeout = 10,
   several.ok = FALSE,
+  search.types = c('alias_symbol', 'prev_symbol'),
   verbose = TRUE,
   ...
 ) {
   db.url <- 'http://rest.genenames.org/fetch'
-  search.types <- c('alias_symbol', 'prev_symbol')
+  # search.types <- c('alias_symbol', 'prev_symbol')
+  search.types <- match.arg(arg = search.types, several.ok = TRUE)
   synonyms <- vector(mode = 'list', length = length(x = symbols))
   not.found <- vector(mode = 'logical', length = length(x = symbols))
   multiple.found <- vector(mode = 'logical', length = length(x = symbols))
@@ -1472,7 +1485,7 @@ RegroupIdents <- function(object, metadata) {
 
 #' @rdname UpdateSymbolList
 #'
-#' @return For \code{UpdateSymbolList}, \code{symbols} with updated symbols from
+#' @return \code{UpdateSymbolList}: \code{symbols} with updated symbols from
 #' HGNC's gene names database
 #'
 #' @export
@@ -1494,6 +1507,7 @@ UpdateSymbolList <- function(
     symbols = symbols,
     timeout = timeout,
     several.ok = several.ok,
+    search.types = 'prev_symbol',
     verbose = verbose,
     ...
   ))