Merge pull request #205 from satijalab/release/5.0.2

Release/5.0.2

DESCRIPTION

@@ -1,10 +1,11 @@
 Package: SeuratObject
 Type: Package
 Title: Data Structures for Single Cell Data
-Version: 5.0.1
+Version: 5.0.2
 Authors@R: c(
-  person(given = 'Rahul', family = 'Satija', email = '[email protected]', role = 'aut', comment = c(ORCID = '0000-0001-9448-8833')),
-  person(given = 'Paul', family = 'Hoffman', email = '[email protected]', role = c('aut', 'cre'), comment = c(ORCID = '0000-0002-7693-8957')),
+  person(given = 'Paul', family = 'Hoffman', email = '[email protected]', role = 'aut', comment = c(ORCID = '0000-0002-7693-8957')),
+  person(given = 'Rahul', family = 'Satija', email = '[email protected]', role = c('aut', 'cre'), comment = c(ORCID = '0000-0001-9448-8833')),
+  person(given = 'David', family = 'Collins', email = '[email protected]', role = 'aut', comment = c(ORCID = '0000-0001-9243-7821')),
   person(given = "Yuhan", family = "Hao", email = '[email protected]', role = 'aut', comment = c(ORCID = '0000-0002-1810-0822')),
   person(given = "Austin", family = "Hartman", email = '[email protected]', role = 'aut', comment = c(ORCID = '0000-0001-7278-1852')),
   person(given = "Gesmira", family = "Molla", email = '[email protected]', role = 'aut', comment = c(ORCID = '0000-0002-8628-5056')),
@@ -29,24 +30,24 @@ Description: Defines S4 classes for single-cell genomic data and associated
   Hao Y, Hao S, et al (2021) <doi:10.1016/j.cell.2021.04.048> and
   Hao Y, et al (2023) <doi:10.1101/2022.02.24.481684> for
   more details.
-URL: https://mojaveazure.github.io/seurat-object/,
-    https://github.com/mojaveazure/seurat-object
-BugReports: https://github.com/mojaveazure/seurat-object/issues
+URL: https://satijalab.github.io/seurat-object/,
+    https://github.com/satijalab/seurat-object
+BugReports: https://github.com/satijalab/seurat-object/issues
 License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Additional_repositories:
     https://bnprks.r-universe.dev
 Depends:
-    R (>= 4.0.0),
+    R (>= 4.1.0),
     sp (>= 1.5.0)
 Imports:
     future,
     future.apply,
     grDevices,
     grid,
-    Matrix (>= 1.6.3),
+    Matrix (>= 1.6.4),
     methods,
     progressr,
     Rcpp (>= 1.0.5),

NAMESPACE

@@ -432,6 +432,7 @@ export(Degrees)
 export(Distances)
 export(Embeddings)
 export(EmptyDF)
+export(EmptyMatrix)
 export(ExtractField)
 export(Features)
 export(FetchData)
@@ -506,6 +507,7 @@ export(as.sparse)
 export(handlers)
 export(intersect)
 export(plan)
+export(t)
 export(with_progress)
 exportClasses(Assay)
 exportClasses(Assay5)
@@ -622,7 +624,6 @@ importFrom(sp,SpatialPolygons)
 importFrom(sp,bbox)
 importFrom(sp,coordinates)
 importFrom(sp,over)
-importFrom(spam,t)
 importFrom(stats,aggregate)
 importFrom(stats,median)
 importFrom(stats,na.omit)

NEWS.md

@@ -1,3 +1,17 @@
+# SeuratObject 5.0.2
+
+## Changes:
+- Properly re-export `%||%` from rlang (#178)
+- Class key-based warnings (#180)
+- Require R 4.1 (#180)
+- Fix errors in `UpdateSeuratObject` (@ddiez, #182)
+- Add `...` to call signature for `Radius` generic (#190)
+- Fix bug in `PolyVtx` (#194)
+- Fix bug in feature-level subsetting (#200)
+- Update `UpdateSeuratObject` to run without `Seurat` installed (#199)
+- Add warning in `Layers.Assay()` when the search returns no results (@maxim-h, #189)
+- Fix bug in `subset` to allow empty images to be dropped (#204)
+
 # SeuratObject 5.0.1
 
 ## Changes:

R/assay.R

@@ -697,6 +697,15 @@ Layers.Assay <- function(object, search = NA, ...) {
   if (!is_na(x = search)) {
     layers <- intersect(x = search, y = layers)
     if (length(x = layers) == 0) {
+      warning(
+        "Layer ",
+        search,
+        " isn't present in the assay ",
+        deparse(expr = substitute(expr = object)),
+        "; returning NULL",
+        call. = FALSE,
+        immediate. = TRUE
+      )
       return(NULL)
     }
   }

R/assay5.R

@@ -2411,6 +2411,12 @@ subset.StdAssay <- function(
   for (lyr in setdiff(x = layers.all, y = layers)) {
     LayerData(object = x, layer = lyr) <- NULL
   }
+  # Subset feature-level metadata
+  mfeatures <- MatchCells(
+    new = Features(x = x, layer = NA),
+    orig = features,
+    ordered = TRUE
+  )
   # Perform the subsets
   for (l in layers) {
     lcells <- MatchCells(
@@ -2442,12 +2448,6 @@ subset.StdAssay <- function(
   for (i in c('cells', 'features')) {
     slot(object = x, name = i) <- droplevels(x = slot(object = x, name = i))
   }
-  # Subset feature-level metadata
-  mfeatures <- MatchCells(
-    new = Features(x = x, layer = NA),
-    orig = features,
-    ordered = TRUE
-  )
   slot(object = x, name = 'meta.data') <- slot(
     object = x,
     name = 'meta.data'

R/centroids.R

@@ -192,7 +192,7 @@ GetTissueCoordinates.Centroids <- function(object, full = TRUE, ...) {
 #' @method Radius Centroids
 #' @export
 #'
-Radius.Centroids <- function(object) {
+Radius.Centroids <- function(object, ...) {
   return(slot(object = object, name = 'radius'))
 }
 

R/fov.R

@@ -904,13 +904,8 @@ setMethod(
 setMethod(
   f = 'initialize',
   signature = 'FOV',
-  definition = function(.Object, molecules, boundaries, assay, key, ...) {
+  definition = function(.Object, ...) {
     .Object <- callNextMethod(.Object, ...)
-    slot(object = .Object, name = 'molecules') <- molecules
-    slot(object = .Object, name = 'boundaries') <- boundaries
-    slot(object = .Object, name = 'assay') <- assay
-    slot(object = .Object, name = 'key') <- key
-    # Reorder cells in boundaries
     .Object <- .OrderCells(object = .Object)
     validObject(object = .Object)
     return(.Object)

R/generics.R

@@ -997,6 +997,8 @@ IsGlobal <- function(object, ...) {
 #'
 #' @concept utils
 #'
+#' @seealso \code{\link{EmptyMatrix}()}
+#'
 #' @examples
 #' IsMatrixEmpty(new("matrix"))
 #' IsMatrixEmpty(matrix())
@@ -1273,6 +1275,7 @@ Project <- function(object, ...) {
 #' Get the spot radius from an image
 #'
 #' @param object An image object
+#' @param ... Arguments passed to other methods
 #'
 #' @return The radius size
 #'
@@ -1281,7 +1284,7 @@ Project <- function(object, ...) {
 #'
 #' @concept spatialimage
 #'
-Radius <- function(object) {
+Radius <- function(object, ...) {
   UseMethod(generic = 'Radius', object = object)
 }
 

R/keymixin.R

@@ -43,9 +43,7 @@ setClass(
 #'
 #' @family key
 #'
-.KeyPattern <- function() {
-  return('^[a-zA-Z][a-zA-Z0-9]*_$')
-}
+.KeyPattern <- \() '^[a-zA-Z][a-zA-Z0-9]*_$'
 
 #' Generate a Random Key
 #'
@@ -63,24 +61,22 @@ setClass(
 #' set.seed(42L)
 #' .RandomKey()
 #'
-.RandomKey <- function(length = 7L, ...) {
-  return(Key(
-    object = RandomName(
-      length = length,
-      chars = c(letters, LETTERS, seq.int(from = 0L, to = 9L)),
-      ...
-    ),
-    quiet = TRUE
-  ))
-}
+.RandomKey <- \(length = 7L, ...) Key(
+  object = RandomName(
+    length = length,
+    chars = c(letters, LETTERS, seq.int(from = 0L, to = 9L)),
+    ...
+  ),
+  quiet = TRUE
+)
 
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 # Methods for Seurat-defined generics
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
 #' @param object An object
-#' @param quiet Suppress warnings when updating characters to keys
 #' @param ... Ignored
+#' @param quiet Suppress warnings when updating characters to keys
 #' @param value A key to set
 #'
 #' @details \code{Key.character}: Update a character to a key
@@ -91,10 +87,14 @@ setClass(
 #' @method Key character
 #' @export
 #'
-Key.character <- function(object, quiet = FALSE, ...) {
-  f <- ifelse(test = isTRUE(x = quiet), yes = suppressWarnings, no = identity)
-  return(f(UpdateKey(key = object)))
-}
+Key.character <- \(object, ..., quiet = FALSE) withCallingHandlers(
+  expr = UpdateKey(key = object),
+  updatedKeyWarning = \(cnd) tryInvokeRestart(r = ifelse(
+    test = isTRUE(x = quiet),
+    yes = 'muffleWarning',
+    no = RandomName()
+  ))
+)
 
 #' @details \code{Key.KeyMixin}: Get the key of a keyed object
 #'
@@ -130,9 +130,7 @@ Key.KeyMixin <- function(object, ...) {
 #' @method Key NULL
 #' @export
 #'
-Key.NULL <- function(object, ...) {
-    return(NULL)
-}
+Key.NULL <- \(object, ...) NULL
 
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 # Methods for R-defined generics
@@ -142,6 +140,57 @@ Key.NULL <- function(object, ...) {
 # Internal
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
+#' Check Usage of Existing Keys
+#'
+#' Check key usage against existing keys to ensure key uniqueness
+#'
+#' @param key Existing key to check usage of; if missing, creates a
+#' key from \code{name}
+#' @param existing A vector of existing keys to match against \code{key}
+#' @param name Name of object that \code{key} is used for; if provided and
+#' \code{existing} is named, the entry of \code{existing} for \code{name} is
+#' removed from the check
+#'
+#' @return A key guaranteed to be unique in the context of \code{existing}
+#'
+#' @keywords internal
+#'
+#' @noRd
+#'
+.CheckKey <- function(key, existing = NULL, name = NULL) {
+  if (rlang::is_missing(x = key) || !length(x = key) || !nzchar(x = key)) {
+    key <- Key(object = tolower(name) %||% RandomName(), quiet = TRUE)
+  }
+  key <- Key(object = key, quiet = TRUE)
+  if (!is.null(x = names(x = existing)) && !is.null(x = name)) {
+    existing <- existing[setdiff(x = names(x = existing), y = name)]
+  }
+  if (key %in% existing) {
+    old <- key
+    key <- Key(object = tolower(x = name %||% RandomName()), quiet = TRUE)
+    i <- 1L
+    n <- 5L
+    while (key %in% existing) {
+      key <- Key(object = RandomName(length = n), quiet = TRUE)
+      i <- i + 1L
+      if (!i %% 7L) {
+        n <- n + 2L
+      }
+    }
+    warn(
+      message = paste(
+        "Key",
+        sQuote(x = old),
+        "taken, using",
+        sQuote(x = key),
+        "instead"
+      ),
+      class = 'existingKeyWarning'
+    )
+  }
+  return(key)
+}
+
 #' Internal Key Methods
 #'
 #' Internal key methods for classes that inherit from \code{\link{KeyMixin}};
@@ -199,18 +248,21 @@ UpdateKey <- function(key) {
   if (new.key == '_') {
     new.key <- paste0(RandomName(length = 3), '_')
   }
-  warning(
-    key.msg,
-    ", setting key from ",
-    key,
-    " to ",
-    new.key,
-    call. = FALSE,
-    immediate. = TRUE
+  warn(
+    message = paste0(
+      key.msg,
+      ", setting key from ",
+      key,
+      " to ",
+      new.key
+    ),
+    class = 'updatedKeyWarning'
   )
   return(new.key)
 }
 
+.MetaKey <- Key(object = 'md', quiet = TRUE)
+
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 # S4 methods
 #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -224,7 +276,7 @@ UpdateKey <- function(key) {
 #' Keys must be a one-length character vector; a key must be composed of one
 #' of the following:
 #' \itemize{
-#'  \item An empty string (eg. \dQuote{\code{''}}) where \code{nzchar() == 0}
+#'  \item An empty string (eg. \dQuote{\code{''}}) where \code{nchar() == 0}
 #'  \item An string composed of one or more alphanumeric values
 #'  (both lower- and upper-case) that ends with an underscore
 #'  (\dQuote{\code{_}}); the first character must be a letter
@@ -262,42 +314,10 @@ setValidity(
         # Ensure proper key composition
         valid <- c(
           valid,
-          paste0("Keys must match the pattern '", .KeyPattern(), "'")
+          paste("Keys must match the pattern", sQuote(x = .KeyPattern()))
         )
       }
     }
     return(valid %||% TRUE)
   }
 )
-
-.CheckKey <- function(key, existing = NULL, name = NULL) {
-  if (rlang::is_missing(x = key) || !length(x = key) || !nzchar(x = key)) {
-    key <- Key(object = tolower(name) %||% RandomName(), quiet = TRUE)
-  }
-  if (!is.null(x = names(x = existing)) && !is.null(x = name)) {
-    existing <- existing[setdiff(x = names(x = existing), y = name)]
-  }
-  if (key %in% existing) {
-    old <- key
-    key <- Key(object = tolower(x = name %||% RandomName()), quiet = TRUE)
-    i <- 1L
-    n <- 5L
-    while (key %in% existing) {
-      key <- Key(object = RandomName(length = n), quiet = TRUE)
-      i <- i + 1L
-      if (!i %% 7L) {
-        n <- n + 2L
-      }
-    }
-    warn(
-      message = paste(
-        "Key",
-        sQuote(x = old),
-        "taken, using",
-        sQuote(x = key),
-        "instead"
-      )
-    )
-  }
-  return(key)
-}