Merge pull request #12 from mojaveazure/develop

SeuratObject v4.0.1

.Rbuildignore

@@ -8,6 +8,7 @@
 ^doc$
 ^Meta$
 ^README\.Rmd$
+^README\.md$
 ^cran-comments\.md$
 ^.*\.loom$
 ^.*\.h5ad$

DESCRIPTION

@@ -1,12 +1,12 @@
 Package: SeuratObject
 Type: Package
 Title: Data Structures for Single Cell Data
-Version: 4.0.0
-Date: 2021-01-07
+Version: 4.0.1
+Date: 2021-05-07
 Authors@R: c(
   person(given = 'Rahul', family = 'Satija', email = 'rsatija@nygenome.org', role = 'aut', comment = c(ORCID = '0000-0001-9448-8833')),
   person(given = 'Andrew', family = 'Butler', email = 'abutler@nygenome.org', role = 'aut', comment = c(ORCID = '0000-0003-3608-0463')),
-  person(given = 'Paul', family = 'Hoffman', email = 'nygcSatijalab@nygenome.org', role = c('aut', 'cre'), comment = c(ORCID = '0000-0002-7693-8957')),
+  person(given = 'Paul', family = 'Hoffman', email = 'seurat@nygenome.org', role = c('aut', 'cre'), comment = c(ORCID = '0000-0002-7693-8957')),
   person(given = 'Tim', family = 'Stuart', email = 'tstuart@nygenome.org', role = 'aut', comment = c(ORCID = '0000-0002-3044-0897')),
   person(given = 'Jeff', family = 'Farrell', email = 'jfarrell@g.harvard.edu', role = 'ctb'),
   person(given = 'Shiwei', family = 'Zheng', email = 'szheng@nygenome.org', role = 'ctb', comment = c(ORCID = '0000-0001-6682-6743')),
@@ -17,10 +17,10 @@ Authors@R: c(
 Description: Defines S4 classes for single-cell genomic data and associated
   information, such as dimensionality reduction embeddings, nearest-neighbor
   graphs, and spatially-resolved coordinates. Provides data access methods and
-  R-native hooks to ensure the Seurat object is familiar to other R users. 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>, 
-  and Stuart T, Butler A, et al (2019) <doi:10.1016/j.cell.2019.05.031> for 
+  R-native hooks to ensure the Seurat object is familiar to other R users. 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>,
+  and Stuart T, Butler A, et al (2019) <doi:10.1016/j.cell.2019.05.031> for
   more details.
 URL: https://satijalab.org/seurat,
       https://github.com/mojaveazure/seurat-object
@@ -30,21 +30,20 @@ License: GPL-3
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 7.1.1
-Depends: 
-  R (>= 3.5.0)
-Imports: 
+Depends:
+  R (>= 4.0.0)
+Imports:
     grDevices,
     grid,
-    Matrix (>= 1.2.18),
+    Matrix (>= 1.3.3),
     methods,
     Rcpp (>= 1.0.5),
     rlang (>= 0.4.7),
-    sctransform,
     stats,
     tools,
     utils
-Suggests: 
-    tinytest
+Suggests:
+    testthat
 Collate: 'RcppExports.R' 'utils.R' 'zzz.R' 'generics.R'
       'assay.R' 'command.R' 'data.R' 'default.R'
       'jackstraw.R' 'dimreduc.R' 'graph.R' 'neighbor.R'

NAMESPACE

@@ -103,6 +103,7 @@ S3method(Stdev,Seurat)
 S3method(Tool,Seurat)
 S3method(VariableFeatures,Assay)
 S3method(VariableFeatures,Seurat)
+S3method(Version,Seurat)
 S3method(WhichCells,Assay)
 S3method(WhichCells,Seurat)
 S3method(as.Graph,Matrix)
@@ -123,6 +124,8 @@ S3method(dimnames,Assay)
 S3method(dimnames,DimReduc)
 S3method(dimnames,Seurat)
 S3method(droplevels,Seurat)
+S3method(head,Assay)
+S3method(head,Seurat)
 S3method(length,DimReduc)
 S3method(levels,Seurat)
 S3method(merge,Assay)
@@ -135,6 +138,8 @@ S3method(subset,Assay)
 S3method(subset,DimReduc)
 S3method(subset,Seurat)
 S3method(subset,SpatialImage)
+S3method(tail,Assay)
+S3method(tail,Seurat)
 export("%iff%")
 export("%||%")
 export("DefaultAssay<-")
@@ -149,6 +154,7 @@ export("Tool<-")
 export("VariableFeatures<-")
 export(AddMetaData)
 export(Assays)
+export(AttachDeps)
 export(Cells)
 export(CellsByIdentities)
 export(CheckGC)
@@ -170,6 +176,7 @@ export(Images)
 export(Index)
 export(Indices)
 export(IsGlobal)
+export(IsMatrixEmpty)
 export(IsS4List)
 export(JS)
 export(Key)
@@ -196,6 +203,7 @@ export(Stdev)
 export(Tool)
 export(UpdateSeuratObject)
 export(VariableFeatures)
+export(Version)
 export(WhichCells)
 export(as.Graph)
 export(as.Neighbor)
@@ -245,7 +253,6 @@ importFrom(rlang,enquo)
 importFrom(rlang,eval_tidy)
 importFrom(rlang,is_null)
 importFrom(rlang,is_quosure)
-importFrom(sctransform,get_residuals)
 importFrom(stats,na.omit)
 importFrom(tools,file_path_sans_ext)
 importFrom(utils,.DollarNames)

NEWS.md

@@ -0,0 +1,23 @@
+# SeuratObject 4.0.1
+
+## Added
+- `head` and `tail` methods for `Seurat` and `Assay` objects (#5)
+- New utility functions (#6):
+  - `AttachDeps` to attach required imported dependencies on package attachment
+  - `IsMatrixEmpty` to test if a matrix is empty or not
+
+## Changed
+- Allow super classes to replace child classes (#1). For example, allows `Assay`
+  objects to replace `Seurat::SCTAssay` or `Signac::ChromatinAssay` objects of
+  the same name
+- Better support for creating sparse matrices from `data.table`/`tibble` 
+  objects (#4)
+- Improved error messages for clashing object names (#7)
+- Allow returning a `NULL` if a subset results in zero cells (#9)
+
+## Removed
+- SCT-specific code (#2)
+
+# SeuratObject 4.0.0
+
+- Initial release of SeuratObject

R/assay.R

@@ -67,6 +67,7 @@ Assay <- setClass(
 #' new object with a lower cutoff.
 #' @param min.features Include cells where at least this many features are
 #' detected.
+#' @param ... Arguments passed to \code{\link{as.sparse}}
 #'
 #' @return A \code{\link{Assay}} object
 #'
@@ -91,7 +92,8 @@ CreateAssayObject <- function(
   counts,
   data,
   min.cells = 0,
-  min.features = 0
+  min.features = 0,
+  ...
 ) {
   if (missing(x = counts) && missing(x = data)) {
     stop("Must provide either 'counts' or 'data'")
@@ -125,7 +127,7 @@ CreateAssayObject <- function(
       stop("No feature names (rownames) names present in the input matrix")
     }
     if (!inherits(x = counts, what = 'dgCMatrix')) {
-      counts <- as(object = as.matrix(x = counts), Class = 'dgCMatrix')
+      counts <- as.sparse(x = counts, ...)
     }
     # Filter based on min.features
     if (min.features > 0) {
@@ -387,24 +389,6 @@ Misc.Assay <- .Misc
 #'
 RenameCells.Assay <- function(object, new.names = NULL, ...) {
   CheckDots(...)
-  if (IsSCT(assay = object)) {
-    if (is.null(x = Misc(object = object, slot = 'vst.set'))) {
-      suppressWarnings(Misc(object = object, slot = "vst.out")$cells_step1 <- new.names)
-      suppressWarnings(rownames(x = Misc(object = object, slot = "vst.out")$cell_attr) <- new.names)
-    } else{
-      suppressWarnings(
-        Misc(object, slot = "vst.set") <- lapply(
-          X = Misc(object = object, slot = "vst.set"),
-          FUN = function(x) {
-            new.names.vst <- new.names[which(x = x$cells_step1 %in% Cells(x = object))]
-            x$cells_step1 <- new.names.vst
-            rownames(x = x$cell_attr) <- new.names.vst
-            return(x)
-          }
-        )
-      )
-    }
-  }
   for (data.slot in c("counts", "data", "scale.data")) {
     old.data <- GetAssayData(object = object, slot = data.slot)
     if (ncol(x = old.data) <= 1) {
@@ -777,6 +761,17 @@ dimnames.Assay <- function(x) {
   return(dimnames(x = GetAssayData(object = x)))
 }
 
+#' @describeIn Assay-methods Get the first rows of feature-level metadata
+#'
+#' @inheritParams utils::head
+#'
+#' @return \code{head}: The first \code{n} rows of feature-level metadata
+#'
+#' @export
+#' @method head Assay
+#'
+head.Assay <- .head
+
 #' @describeIn Assay-methods Merge \code{Assay} objects
 #'
 #' @param y A vector or list of one or more objects to merge
@@ -839,43 +834,6 @@ merge.Assay <- function(
       new.data = merged.data
     )
   }
-  # merge SCT assay misc vst info and scale.data
-  if (all(IsSCT(assay = assays))) {
-    vst.set.new <- list()
-    idx <- 1
-    umi.assay.new <- list()
-    for (i in 1:length(x = assays)) {
-      vst.set.old <- Misc(object = assays[[i]], slot = "vst.set")
-      umi.assay.old <- Misc(object = assays[[i]], slot = "umi.assay")
-      if (!is.null(x = vst.set.old) && length(x = vst.set.old) > 1) {
-        for (j in 1:length(x = vst.set.old)) {
-          vst.set.new[[idx]] <- vst.set.old[[j]]
-          umi.assay.new[[idx]] <- umi.assay.old[[j]]
-          idx <- idx + 1
-        }
-      } else if (!is.null(x = Misc(object = assays[[i]], slot = "vst.out"))) {
-        vst.set.new[[idx]] <- Misc(object = assays[[i]], slot = "vst.out")
-        umi.assay.new[[idx]] <- Misc(object = assays[[i]], slot = "umi.assay")
-        idx <- idx + 1
-      }
-    }
-    Misc(object = combined.assay, slot = "vst.set") <- vst.set.new
-    Misc(object = combined.assay, slot = "umi.assay") <- umi.assay.new
-    scale.data <- do.call(
-      what = cbind,
-      args = lapply(
-        X = assays,
-        FUN = GetAssayData,
-        slot = 'scale.data'
-        # FUN = function(x) GetAssayData(object = x, slot = "scale.data")
-      )
-    )
-    combined.assay <- SetAssayData(
-      object = combined.assay,
-      slot = "scale.data",
-      new.data = scale.data
-    )
-  }
   return(combined.assay)
 }
 
@@ -935,33 +893,20 @@ subset.Assay <- function(x, cells = NULL, features = NULL, ...) {
   }
   VariableFeatures(object = x) <- VariableFeatures(object = x)[VariableFeatures(object = x) %in% features]
   slot(object = x, name = 'meta.features') <- x[[]][features, , drop = FALSE]
-  if (IsSCT(assay = x)) {
-    # subset cells and genes in the SCT assay
-    obj.misc <- Misc(object = x)
-    if ("vst.set" %in% names(x = obj.misc)) {
-      # set of vst.out objects
-      vst.info <- obj.misc[["vst.set"]]
-      for (i in seq_along(along.with = vst.info)) {
-        vst.info[[i]] <- SubsetVST(
-          sct.info = vst.info[[i]],
-          cells = cells,
-          features = features
-        )
-      }
-      obj.misc[["vst.set"]] <- vst.info
-    } else {
-      # just one vst.out
-      obj.misc[["vst.out"]] <- SubsetVST(
-        sct.info = obj.misc[["vst.out"]],
-        cells = cells,
-        features = features
-      )
-    }
-    slot(object = x, name = "misc") <- obj.misc
-  }
   return(x)
 }
 
+#' @describeIn Assay-methods Get the last rows of feature-level metadata
+#'
+#' @return \code{tail}: The last \code{n} rows of feature-level metadata
+#'
+#' @importFrom utils tail
+#'
+#' @export
+#' @method tail Assay
+#'
+tail.Assay <- .tail
+
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 # S4 methods
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -1188,31 +1133,11 @@ CalcN <- function(object) {
     return(NULL)
   }
   return(list(
-    nCount = colSums(x = object, slot = 'counts'),
-    nFeature = colSums(x = GetAssayData(object = object, slot = 'counts') > 0)
+    nCount = Matrix::colSums(x = object, slot = 'counts'),
+    nFeature = Matrix::colSums(x = GetAssayData(object = object, slot = 'counts') > 0)
   ))
 }
 
-#' Check whether an assay has been processed by sctransform
-#'
-#' @param assay assay to check
-#'
-#' @return Boolean
-#'
-#' @keywords internal
-#'
-#' @noRd
-#'
-IsSCT <- function(assay) {
-  if (is.list(x = assay)) {
-    sct.check <- lapply(X = assay, FUN = function(x) {
-      return(!is.null(x = Misc(object = x, slot = 'vst.out')) | !is.null(x = Misc(object = x, slot = 'vst.set')))
-    })
-    return(unlist(x = sct.check))
-  }
-  return(!is.null(x = Misc(object = assay, slot = 'vst.out')) | !is.null(x = Misc(object = assay, slot = 'vst.set')))
-}
-
 #' Subset cells in vst data
 #'
 #' @param sct.info A vst.out list

R/generics.R

@@ -827,6 +827,23 @@ VariableFeatures <- function(object, selection.method = NULL, ...) {
   UseMethod(generic = 'VariableFeatures<-', object = object)
 }
 
+#' Get Version Information
+#'
+#' @param object An object
+#' @param ... Arguments passed to other methods
+#'
+#' @rdname Version
+#' @export Version
+#'
+#' @concept data-access
+#'
+#' @examples
+#' Version(pbmc_small)
+#'
+Version <- function(object, ...) {
+  UseMethod(generic = "Version", object = object)
+}
+
 #' Identify cells matching certain criteria
 #'
 #' Returns a list of cells that match a particular set of criteria such as