Merge pull request #68 from mojaveazure/release/4.1.3

SeuratObject v4.1.3

Author: mojaveazure

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: SeuratObject
 Type: Package
 Title: Data Structures for Single Cell Data
-Version: 4.1.2
-Date: 2022-09-20
+Version: 4.1.3
+Date: 2022-11-07
 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')),
@@ -29,9 +29,10 @@ BugReports:
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.0
+RoxygenNote: 7.2.1
 Depends:
-  R (>= 4.0.0)
+    R (>= 4.0.0),
+    sp (>= 1.5.0)
 Imports:
     future,
     future.apply,
@@ -41,14 +42,13 @@ Imports:
     methods,
     progressr,
     Rcpp (>= 1.0.5),
-    sp (>= 1.5.0),
-    rgeos,
     rlang (>= 0.4.7),
     stats,
     tools,
     utils
 Suggests:
     ggplot2,
+    rgeos,
     testthat
 Collate:
     'RcppExports.R'

NAMESPACE

@@ -384,7 +384,6 @@ importFrom(methods,validObject)
 importFrom(progressr,handlers)
 importFrom(progressr,progressor)
 importFrom(progressr,with_progress)
-importFrom(rgeos,gSimplify)
 importFrom(rlang,"%||%")
 importFrom(rlang,enquo)
 importFrom(rlang,eval_tidy)

NEWS.md

@@ -1,3 +1,11 @@
+# SeuratObject 4.1.3
+## Changes
+- Move {rgeos} to Suggests; segmentation simplification now requires {regos} to be installed manually
+- Move {sp} to Depends
+
+## Added
+- Add keys to `Assays` and `DimReducs` in `UpdateSeuratObject` when missing
+
 # SeuratObject 4.1.2
 ## Changed
 - Bump required Matrix version to >= 1.5.0

R/centroids.R

@@ -211,7 +211,7 @@ RenameCells.Centroids <- function(object, new.names = NULL, ...) {
   }
   new.names <- make.unique(names = new.names)
   if (length(x = new.names) != length(x = Cells(x = object))) {
-    stop("Cannot partially rename cells", call. = FALSE)
+    stop("Cannot partially rename centroid cells", call. = FALSE)
   }
   slot(object = object, name = 'cells') <- new.names
   return(object)
@@ -373,6 +373,10 @@ setMethod(
   definition = function(x, y, invert = FALSE, ...) {
     idx <- over(x = x, y = y)
     idx <- idx[!is.na(x = idx)]
+    if (!length(idx)) {
+      warning("The selected region does not contain any cell centroids")
+      return(NULL)
+    }
     idx <- sort(x = as.integer(x = names(x = idx)))
     if (isTRUE(x = invert)) {
       idx <- -idx

R/fov.R

@@ -862,7 +862,7 @@ setMethod(
     if (inherits(x = x[[i]], what = 'Molecules')) {
       slot(object = x, name = 'molecules')[[i]] <- NULL
     } else if (i == DefaultBoundary(object = x)) {
-      stop("Cannot remove default segmentation", call. = FALSE)
+      stop("Cannot remove default boundary", call. = FALSE)
     } else {
       slot(object = x, name = 'boundaries')[[i]] <- NULL
     }
@@ -1016,21 +1016,30 @@ setValidity(
           )
           break
         } else {
-          matched.cells <- MatchCells(
-            new = all.cells,
-            orig = Cells(x = object[[s]]),
-            ordered = TRUE
-          )
-          if (length(x = matched.cells) != length(x = Cells(x = object[[s]]))) {
-            valid <- c(
-              valid,
-              "All segmentation boundaries must have cells"
+          cells <- Cells(x = object[[s]])
+          if (!is.null(cells)) {
+            matched.cells <- MatchCells(
+              new = all.cells,
+              orig = cells,
+              ordered = TRUE
             )
-            break
-          } else if (is.unsorted(x = matched.cells)) {
+            if (length(x = matched.cells) != length(x = Cells(x = object[[s]]))) {
+              valid <- c(
+                valid,
+                "All segmentation boundaries must have cells"
+              )
+              break
+            } else if (is.unsorted(x = matched.cells)) {
+              valid <- c(
+                valid,
+                "All segmentation boundaries must be ordered"
+              )
+              break
+            }
+          } else {
             valid <- c(
               valid,
-              "All segmentation boundaries must be ordered"
+              paste(s, "contains 0 cells")
             )
             break
           }

R/segmentation.R

@@ -174,7 +174,7 @@ RenameCells.Segmentation <- function(object, new.names = NULL, ...) {
   }
   new.names <- make.unique(names = new.names)
   if (length(x = new.names) != length(x = Cells(x = object))) {
-    stop("Cannot partially rename cells", call. = FALSE)
+    stop("Cannot partially rename segmentation cells", call. = FALSE)
   }
   names(x = slot(object = object, name = 'polygons')) <- new.names
   p <- progressor(along = slot(object = object, name = 'polygons'))
@@ -223,6 +223,8 @@ subset.Segmentation <- function(x, cells = NULL, ...) {
   if (is.numeric(x = cells)) {
     cells <- Cells(x = x)[cells]
     cells <- MatchCells(new = Cells(x = x), orig = cells, ordered = TRUE)
+  } else {
+    cells <- intersect(Cells(x), cells)
   }
   if (!length(x = cells)) {
     stop("None of the requested cells found")
@@ -304,6 +306,10 @@ setMethod(
   definition = function(x, y, invert = FALSE, ...) {
     idx <- over(x = x, y = y)
     idx <- idx[!is.na(x = idx)]
+    if (!length(idx)) {
+      warning("The selected region does not contain any cell segmentations")
+      return(NULL)
+    }
     names(x = idx) <- vapply(
       X = strsplit(x = names(x = idx), split = '\\.'),
       FUN = '[[',

R/seurat.R

@@ -562,6 +562,18 @@ UpdateSeuratObject <- function(object) {
       # Update object slots
       message("Updating object slots")
       object <- UpdateSlots(object = object)
+      # Validate object keys
+      message("Ensuring keys are in the proper structure")
+      for (ko in FilterObjects(object = object)) {
+        key <- Key(object = object[[ko]])
+        if (!length(x = key) || !nzchar(x = key)) {
+          key <- Key(object = ko, quiet = TRUE)
+        }
+        slot(
+          object = slot(object = object, name = FindObject(object, ko))[[ko]],
+          name = 'key'
+        ) <- UpdateKey(key)
+      }
       # Rename assays
       assays <- make.names(names = Assays(object = object))
       names(x = assays) <- Assays(object = object)
@@ -574,11 +586,6 @@ UpdateSeuratObject <- function(object) {
           object = Command(object = object, command = cmd)
         )
       }
-      # Validate object keys
-      message("Ensuring keys are in the proper strucutre")
-      for (ko in FilterObjects(object = object)) {
-        Key(object = object[[ko]]) <- UpdateKey(key = Key(object = object[[ko]]))
-      }
       # Check feature names
       message("Ensuring feature names don't have underscores or pipes")
       for (assay.name in FilterObjects(object = object, classes.keep = 'Assay')) {
@@ -1668,7 +1675,9 @@ RenameCells.Seurat <- function(
   for (i in Images(object = object)) {
     object[[i]] <- RenameCells(
       object = object[[i]],
-      new.names = unname(obj = new.cell.names[Cells(x = object[[i]])])
+      new.names = unname(
+        obj = new.cell.names[Cells(x = object[[i]], boundary = NA)]
+      )
     )
   }
   # Rename the Neighbor

R/utils.R

@@ -598,6 +598,12 @@ as.sparse.Matrix <- function(x, ...) {
 #' @method as.sparse matrix
 #'
 as.sparse.matrix <- function(x, ...) {
+  if (is.character(x = x)) {
+    dnames <- dimnames(x = x)
+    nc <- ncol(x = x)
+    x <- matrix(data = as.numeric(x = x), ncol = nc)
+    dimnames(x = x) <- dnames
+  }
   x <- as(object = x, Class = "Matrix")
   return(as.sparse.Matrix(x, ...))
 }
@@ -702,13 +708,14 @@ S4ToList.list <- function(object) {
   return(object)
 }
 
-#' @importFrom rgeos gSimplify
-#'
 #' @rdname Simplify
 #' @method Simplify Spatial
 #' @export
 #'
 Simplify.Spatial <- function(coords, tol, topologyPreserve = TRUE) {
+  if (!PackageCheck('rgeos', error = FALSE)) {
+    stop("'Simplify' requires rgeos to be installed", call. = FALSE)
+  }
   class.orig <- class(x = coords)
   dest <- ifelse(
     test = grepl(pattern = '^Spatial', x = class.orig),
@@ -719,7 +726,7 @@ Simplify.Spatial <- function(coords, tol, topologyPreserve = TRUE) {
       value = TRUE
     )[1L]
   )
-  coords <- gSimplify(
+  coords <- rgeos::gSimplify(
     spgeom = as(object = coords, Class = dest),
     tol = as.numeric(x = tol),
     topologyPreserve = isTRUE(x = topologyPreserve)

R/zzz.R

@@ -460,11 +460,6 @@ NameIndex <- function(x, names, MARGIN) {
 # Hooks
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
-.onAttach <- function(libname, pkgname) {
-  AttachDeps(deps = 'sp')
-  return(invisible(x = NULL))
-}
-
 .onLoad <- function(libname, pkgname) {
   toset <- setdiff(x = names(x = Seurat.options), y = names(x = options()))
   if (length(x = toset)) {

cran-comments.md

@@ -1,8 +1,8 @@
-# SeuratObject v4.1.2
+# SeuratObject v4.1.3
 
 ## Test environments
-* local ubuntu 20.04 install, R 4.1.3
-* win-builder (release, devel)
+* local ubuntu 20.04 install, R 4.2.0
+* win-builder (oldrelease, release, devel)
 
 ## R CMD check results
 
@@ -12,6 +12,6 @@ There were no ERRORs, WARNINGs, or NOTEs
 
 There is one package that depends on SeuratObject: tidyseurat; this update does not impact its functionality
 
-There are four packages that import SeuratObject: CAMML, Platypus, Seurat, and Signac; this update does not impact their functionality
+There are six packages that import SeuratObject: bbknnR, CAMML, Platypus, scpoisson, Seurat, and Signac; this update does not impact their functionality
 
-There are two packages that suggest SeuratObject: singleCellHaystack and VAM; this update does not impact their functionality
+There are five packages that suggest SeuratObject: cellpypes, scOntoMatch, singleCellHaystack, SPECK, and VAM; this update does not impact their functionality