Merge pull request #28 from mojaveazure/develop

SeuratObject v4.0.3

.Rbuildignore

@@ -16,7 +16,7 @@
 ^.*\.h5Seurat$
 ^.*\.rds$
 ^.*\.Rds$
-^LICENSE$
 ^data-raw$
 ^inst$
 ^tests$
+^LICENSE\.md$

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: SeuratObject
 Type: Package
 Title: Data Structures for Single Cell Data
-Version: 4.0.2
-Date: 2021-06-08
+Version: 4.0.3
+Date: 2021-11-10
 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')),
@@ -26,7 +26,7 @@ URL: https://satijalab.org/seurat,
       https://github.com/mojaveazure/seurat-object
 BugReports:
       https://github.com/mojaveazure/seurat-object/issues
-License: GPL-3
+License: MIT + file LICENSE
 Encoding: UTF-8
 LazyData: true
 RoxygenNote: 7.1.1

LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2021 SeuratObject authors
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

NAMESPACE

@@ -157,15 +157,18 @@ export(Assays)
 export(AttachDeps)
 export(Cells)
 export(CellsByIdentities)
+export(CheckDots)
 export(CheckGC)
 export(Command)
 export(CreateAssayObject)
 export(CreateDimReducObject)
 export(CreateSeuratObject)
 export(DefaultAssay)
+export(DefaultDimReduc)
 export(Distances)
 export(Embeddings)
 export(FetchData)
+export(FilterObjects)
 export(GetAssayData)
 export(GetImage)
 export(GetTissueCoordinates)
@@ -185,8 +188,10 @@ export(Loadings)
 export(LogSeuratCommand)
 export(Misc)
 export(Neighbors)
+export(PackageCheck)
 export(Project)
 export(Radius)
+export(RandomName)
 export(Reductions)
 export(RenameAssays)
 export(RenameCells)

NEWS.md

@@ -1,3 +1,10 @@
+# SeuratObject 4.0.3
+
+## Changed
+- Export utility functions (#22)
+- Bug fix in names with `Key.Seurat` (#26)
+- Improved duplicate key checking and resolution
+
 # SeuratObject 4.0.2
 
 ## Changed
@@ -15,7 +22,7 @@
 - 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` 
+- 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)

R/seurat.R

@@ -499,6 +499,52 @@ FetchData <- function(object, vars, cells = NULL, slot = 'data') {
   return(data.fetched)
 }
 
+#' Find Sub-objects of a Certain Class
+#'
+#' Get the names of objects within a \code{Seurat} object that are of a
+#' certain class
+#'
+#' @param object A \code{\link{Seurat}} object
+#' @param classes.keep A vector of names of classes to get
+#'
+#' @return A vector with the names of objects within the \code{Seurat} object
+#' that are of class \code{classes.keep}
+#'
+#' @export
+#'
+#' @examples
+#' FilterObjects(pbmc_small)
+#'
+FilterObjects <- function(object, classes.keep = c('Assay', 'DimReduc')) {
+  object <- UpdateSlots(object = object)
+  slots <- na.omit(object = Filter(
+    f = function(x) {
+      sobj <- slot(object = object, name = x)
+      return(is.list(x = sobj) && !is.data.frame(x = sobj) && !is.package_version(x = sobj))
+    },
+    x = slotNames(x = object)
+  ))
+  slots <- grep(pattern = 'tools', x = slots, value = TRUE, invert = TRUE)
+  slots <- grep(pattern = 'misc', x = slots, value = TRUE, invert = TRUE)
+  slots.objects <- unlist(
+    x = lapply(
+      X = slots,
+      FUN = function(x) {
+        return(names(x = slot(object = object, name = x)))
+      }
+    ),
+    use.names = FALSE
+  )
+  object.classes <- sapply(
+    X = slots.objects,
+    FUN = function(i) {
+      return(inherits(x = object[[i]], what = classes.keep))
+    }
+  )
+  object.classes <- which(x = object.classes, useNames = TRUE)
+  return(names(x = object.classes))
+}
+
 #' @rdname ObjectAccess
 #' @export
 #'
@@ -1313,12 +1359,16 @@ Key.Seurat <- function(object, ...) {
     object = object,
     classes.keep = c('Assay', 'DimReduc', 'SpatialImage')
   )
-  return(sapply(
+  keys <- vapply(
     X = keyed.objects,
     FUN = function(x) {
       return(Key(object = object[[x]]))
-    }
-  ))
+    },
+    FUN.VALUE = character(length = 1L),
+    USE.NAMES = FALSE
+  )
+  names(x = keys) <- keyed.objects
+  return(keys)
 }
 
 #' @param reduction Name of reduction to pull feature loadings for
@@ -2766,38 +2816,51 @@ setMethod( # because R doesn't allow S3-style [[<- for S4 classes
         }
         Key(object = value) <- UpdateKey(key = Key(object = value))
         # Check for duplicate keys
-        object.keys <- sapply(
-          X = FilterObjects(object = x),
-          FUN = function(i) {
-            return(Key(object = x[[i]]))
-          }
-        )
-        if (Key(object = value) %in% object.keys && is.null(x = FindObject(object = x, name = i))) {
-          # Attempt to create a duplicate key based off the name of the object being added
-          new.keys <- c(paste0(tolower(x = i), c('_', paste0(RandomName(length = 2L), '_'))))
-          # Select new key to use
-          key.use <- min(which(x = !new.keys %in% object.keys))
-          new.key <- if (is.infinite(x = key.use)) {
-            RandomName(length = 17L)
+        object.keys <- Key(object = x)
+        vkey <- Key(object = value)
+        if (vkey %in% object.keys && !isTRUE(x = object.keys[i] == vkey)) {
+          new.key <- if (is.na(x = object.keys[i])) {
+            # Attempt to create a duplicate key based off the name of the object being added
+            new.keys <- paste0(
+              paste0(tolower(x = i), c('', RandomName(length = 2L))),
+              '_'
+            )
+            # Select new key to use
+            key.use <- min(which(x = !new.keys %in% object.keys))
+            new.key <- if (is.infinite(x = key.use)) {
+              RandomName(length = 17L)
+            } else {
+              new.keys[key.use]
+            }
+            warning(
+              "Cannot add objects with duplicate keys (offending key: ",
+              Key(object = value),
+              "), setting key to '",
+              new.key,
+              "'",
+              call. = FALSE
+            )
+            new.key
           } else {
-            new.keys[key.use]
+            # Use existing key
+            warning(
+              "Cannot add objects with duplicate keys (offending key: ",
+              Key(object = value),
+              ") setting key to original value '",
+              object.keys[i],
+              "'",
+              call. = FALSE
+            )
+            object.keys[i]
           }
-          warning(
-            "Cannot add objects with duplicate keys (offending key: ",
-            Key(object = value),
-            "), setting key to '",
-            new.key,
-            "'",
-            call. = FALSE
-          )
           # Set new key
           Key(object = value) <- new.key
         }
       }
       # For Assays, run CalcN
       if (inherits(x = value, what = 'Assay')) {
         if ((!i %in% Assays(object = x)) |
-            (i %in% Assays(object = x) && ! identical(
+            (i %in% Assays(object = x) && !identical(
               x = GetAssayData(object = x, assay = i, slot = "counts"),
               y = GetAssayData(object = value, slot = "counts"))
             )) {
@@ -3082,48 +3145,6 @@ DefaultImage <- function(object) {
   return(images[[1]])
 }
 
-#' Get the names of objects within a Seurat object that are of a certain class
-#'
-#' @param object A \code{\link{Seurat}} object
-#' @param classes.keep A vector of names of classes to get
-#'
-#' @return A vector with the names of objects within the Seurat object that are
-#' of class \code{classes.keep}
-#'
-#' @keywords internal
-#'
-#' @noRd
-#'
-FilterObjects <- function(object, classes.keep = c('Assay', 'DimReduc')) {
-  object <- UpdateSlots(object = object)
-  slots <- na.omit(object = Filter(
-    f = function(x) {
-      sobj <- slot(object = object, name = x)
-      return(is.list(x = sobj) && !is.data.frame(x = sobj) && !is.package_version(x = sobj))
-    },
-    x = slotNames(x = object)
-  ))
-  slots <- grep(pattern = 'tools', x = slots, value = TRUE, invert = TRUE)
-  slots <- grep(pattern = 'misc', x = slots, value = TRUE, invert = TRUE)
-  slots.objects <- unlist(
-    x = lapply(
-      X = slots,
-      FUN = function(x) {
-        return(names(x = slot(object = object, name = x)))
-      }
-    ),
-    use.names = FALSE
-  )
-  object.classes <- sapply(
-    X = slots.objects,
-    FUN = function(i) {
-      return(inherits(x = object[[i]], what = classes.keep))
-    }
-  )
-  object.classes <- which(x = object.classes, useNames = TRUE)
-  return(names(x = object.classes))
-}
-
 #' Find the collection of an object within a Seurat object
 #'
 #' @param object A \code{\link{Seurat}} object