Merge pull request #35 from mojaveazure/develop

SeuratObject v4.0.4

Author: mojaveazure

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: SeuratObject
 Type: Package
 Title: Data Structures for Single Cell Data
-Version: 4.0.3
-Date: 2021-11-10
+Version: 4.0.4
+Date: 2021-11-23
 Authors@R: c(
   person(given = 'Rahul', family = 'Satija', email = '[email protected]', role = 'aut', comment = c(ORCID = '0000-0001-9448-8833')),
   person(given = 'Andrew', family = 'Butler', email = '[email protected]', role = 'aut', comment = c(ORCID = '0000-0003-3608-0463')),
@@ -22,14 +22,14 @@ Description: Defines S4 classes for single-cell genomic data and associated
   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,
+URL: https://mojaveazure.github.io/seurat-object/,
       https://github.com/mojaveazure/seurat-object
 BugReports:
       https://github.com/mojaveazure/seurat-object/issues
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.1.1
+RoxygenNote: 7.1.2
 Depends:
   R (>= 4.0.0)
 Imports:

NAMESPACE

@@ -42,6 +42,9 @@ S3method(Cells,DimReduc)
 S3method(Cells,Neighbor)
 S3method(Cells,SpatialImage)
 S3method(Cells,default)
+S3method(CheckMatrix,dMatrix)
+S3method(CheckMatrix,default)
+S3method(CheckMatrix,lMatrix)
 S3method(Command,Seurat)
 S3method(CreateSeuratObject,Assay)
 S3method(CreateSeuratObject,default)
@@ -159,6 +162,7 @@ export(Cells)
 export(CellsByIdentities)
 export(CheckDots)
 export(CheckGC)
+export(CheckMatrix)
 export(Command)
 export(CreateAssayObject)
 export(CreateDimReducObject)

NEWS.md

@@ -1,3 +1,11 @@
+# SeuratObject 4.0.4
+## Changed
+- `CreateSeuratObject.Assay` sets Assay key when not present (#29)
+- Ignore warnings when creating an `Assay` from a data frame (#32)
+
+## Added
+- New `CheckMatrix` generic for validating expression matrices
+
 # SeuratObject 4.0.3
 
 ## Changed

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 check.matrix Check counts matrix for NA, NaN, Inf, and non-integer values
 #' @param ... Arguments passed to \code{\link{as.sparse}}
 #'
 #' @return A \code{\link{Assay}} object
@@ -93,6 +94,7 @@ CreateAssayObject <- function(
   data,
   min.cells = 0,
   min.features = 0,
+  check.matrix = FALSE,
   ...
 ) {
   if (missing(x = counts) && missing(x = data)) {
@@ -127,7 +129,14 @@ CreateAssayObject <- function(
       stop("No feature names (rownames) names present in the input matrix")
     }
     if (!inherits(x = counts, what = 'dgCMatrix')) {
-      counts <- as.sparse(x = counts, ...)
+      if (inherits(x = counts, what = "data.frame")) {
+        counts <- as.sparse(x = counts, ...)
+      } else {
+        counts <- as.sparse(x = counts)
+      }
+    }
+    if (isTRUE(x = check.matrix)) {
+      CheckMatrix(object = counts)
     }
     # Filter based on min.features
     if (min.features > 0) {

R/seurat.R

@@ -1056,6 +1056,10 @@ CreateSeuratObject.Assay <- function(
       meta.data <- new.meta.data
     }
   }
+  # Check assay key
+  if (!length(x = Key(object = counts)) || !nchar(x = Key(object = counts))) {
+    Key(object = counts) <- UpdateKey(key = tolower(x = assay))
+  }
   assay.list <- list(counts)
   names(x = assay.list) <- assay
   # Set idents

R/utils.R

@@ -25,6 +25,33 @@ as.sparse <- function(x, ...) {
   UseMethod(generic = 'as.sparse', object = x)
 }
 
+#' Check Matrix Validity
+#'
+#' @param object A matrix
+#' @param checks Type of checks to perform, choose one or more from:
+#' \itemize{
+#'  \item \dQuote{\code{infinite}}: Emit a warning if any value is infinite
+#'  \item \dQuote{\code{logical}}: Emit a warning if any value is a logical
+#'  \item \dQuote{\code{integer}}: Emit a warning if any value is \emph{not}
+#'   an integer
+#'  \item \dQuote{\code{na}}: Emit a warning if any value is an \code{NA}
+#'   or \code{NaN}
+#' }
+#' @param ... Arguments passed to other methods
+#'
+#' @return Emits warnings for each test and invisibly returns \code{NULL}
+#'
+#' @name CheckMatrix
+#' @rdname CheckMatrix
+#'
+#' @keywords internal
+#'
+#' @export
+#'
+CheckMatrix <- function(object, checks, ...) {
+  UseMethod(generic = 'CheckMatrix', object = object)
+}
+
 #' S4/List Conversion
 #'
 #' Convert S4 objects to lists and vice versa. Useful for declassing an S4
@@ -436,6 +463,58 @@ as.sparse.Matrix <- function(x, ...) {
 #'
 as.sparse.matrix <- as.sparse.Matrix
 
+#' @rdname CheckMatrix
+#' @method CheckMatrix default
+#' @export
+#'
+CheckMatrix.default <- function(object, checks, ...) {
+  return(invisible(x = NULL))
+}
+
+#' @rdname CheckMatrix
+#' @method CheckMatrix dMatrix
+#' @export
+#'
+CheckMatrix.dMatrix <- function(
+  object,
+  checks = c('infinite', 'logical', 'integer', 'na'),
+  ...
+) {
+  checks <- match.arg(arg = checks, several.ok = TRUE)
+  x <- slot(object = object, name = 'x')
+  for (i in checks) {
+    switch(
+      EXPR = i,
+      'infinite' = if (any(is.infinite(x = x))) {
+        warning("Input matrix contains infinite values")
+      },
+      'logical' = if (any(is.logical(x = x))) {
+        warning("Input matrix contains logical values")
+      },
+      'integer' = if (!all(round(x = x) == x, na.rm = TRUE)) {
+        warning("Input matrix contains non-integer values")
+      },
+      'na' = if (anyNA(x = x)) {
+        warning("Input matrix contains NA/NaN values")
+      },
+    )
+  }
+  return(invisible(x = NULL))
+}
+
+#' @rdname CheckMatrix
+#' @method CheckMatrix lMatrix
+#' @export
+#'
+CheckMatrix.lMatrix <- function(
+  object,
+  checks = c('infinite', 'logical', 'integer', 'na'),
+  ...
+) {
+  warning("Input matrix contains logical values")
+  return(invisible(x = NULL))
+}
+
 #' @importFrom methods slotNames
 #'
 #' @rdname s4list

cran-comments.md

@@ -1,4 +1,4 @@
-# SeuratObject v4.0.3
+# SeuratObject v4.0.4
 
 ## Test environments
 * local ubuntu 20.04 install, R 4.1.1

man/CheckMatrix.Rd

@@ -6,6 +6,11 @@
 
 using namespace Rcpp;
 
+#ifdef RCPP_USE_GLOBAL_ROSTREAM
+Rcpp::Rostream<true>&  Rcpp::Rcout = Rcpp::Rcpp_cout_get();
+Rcpp::Rostream<false>& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get();
+#endif
+
 // GraphToNeighborHelper
 List GraphToNeighborHelper(Eigen::SparseMatrix<double> mat);
 RcppExport SEXP _SeuratObject_GraphToNeighborHelper(SEXP matSEXP) {

man/CreateAssayObject.Rd

@@ -0,0 +1,31 @@
+# Tests for matrix checks
+
+data("pbmc_small")
+
+pbmc_small <- suppressWarnings(suppressMessages(UpdateSeuratObject(pbmc_small)))
+
+counts <- GetAssayData(pbmc_small, assay = "RNA", slot = "counts")
+
+test_that("CheckMatrix works for valid matrix", {
+  expect_null(CheckMatrix(counts))
+})
+
+test_that("CheckMatrix warns for non-integer counts", {
+  counts[1,1] <- 1/2
+  expect_warning(CheckMatrix(counts))
+})
+
+test_that("CheckMatrix warns for NA values", {
+  counts[1,1] <- NA
+  expect_warning(CheckMatrix(counts))
+})
+
+test_that("CheckMatrix warns for NaN values", {
+  counts[1,1] <- NaN
+  expect_warning(CheckMatrix(counts))
+})
+
+test_that("CheckMatrix warns for logical values", {
+  counts <- as(object = counts, Class = "lsparseMatrix")
+  expect_warning(CheckMatrix(counts))
+})