From ed61e199255ee8dd8dcdd94faf23839c2fcbd61b Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Mon, 30 Oct 2023 16:10:21 -0400 Subject: [PATCH 01/18] Update use of `GetAssayData()` Update internal calls to `GetAssayData()` to use `layer` instead of `slot` --- R/assay.R | 34 +++++++++++++++++----------------- R/assay5.R | 2 +- R/seurat.R | 29 +++++++++++++++++++---------- 3 files changed, 37 insertions(+), 28 deletions(-) diff --git a/R/assay.R b/R/assay.R index 4152a052..c96de65f 100644 --- a/R/assay.R +++ b/R/assay.R @@ -319,7 +319,7 @@ Features.Assay <- function( } layer <- layer[1L] %||% 'data' layer <- match.arg(arg = layer) - features <- rownames(x = GetAssayData(object = x, slot = layer)) + features <- rownames(x = GetAssayData(object = x, layer = layer)) if (!length(x = features)) { features <- NULL } @@ -370,7 +370,7 @@ FetchData.Assay <- function( x = vars ) # Pull expression information - mat <- GetAssayData(object = object, slot = layer) + mat <- GetAssayData(object = object, layer = layer) if (IsMatrixEmpty(x = mat)) { abort(message = paste("Layer", sQuote(x = layer), "is empty in this assay")) } @@ -736,7 +736,7 @@ RenameCells.Assay <- function(object, new.names = NULL, ...) { CheckDots(...) names(new.names) <- NULL for (data.slot in c("counts", "data", "scale.data")) { - old.data <- GetAssayData(object = object, slot = data.slot) + old.data <- GetAssayData(object = object, layer = data.slot) if (ncol(x = old.data) <= 1) { next } @@ -1370,7 +1370,7 @@ merge.Assay <- function( } combined.assay <- SetAssayData( object = combined.assay, - slot = "data", + layer = "data", new.data = merged.data ) } @@ -1465,17 +1465,17 @@ subset.Assay <- function(x, cells = NULL, features = NULL, ...) { if (length(x = features) == 0) { abort(message = "Cannot find features provided") } - if (ncol(x = GetAssayData(object = x, slot = 'counts')) == ncol(x = x)) { - slot(object = x, name = "counts") <- GetAssayData(object = x, slot = "counts")[features, cells, drop = FALSE] + if (ncol(x = GetAssayData(object = x, layer = 'counts')) == ncol(x = x)) { + slot(object = x, name = "counts") <- GetAssayData(object = x, layer = "counts")[features, cells, drop = FALSE] } - slot(object = x, name = "data") <- GetAssayData(object = x, slot = "data")[features, cells, drop = FALSE] - cells.scaled <- colnames(x = GetAssayData(object = x, slot = "scale.data")) + slot(object = x, name = "data") <- GetAssayData(object = x, layer = "data")[features, cells, drop = FALSE] + cells.scaled <- colnames(x = GetAssayData(object = x, layer = "scale.data")) cells.scaled <- cells.scaled[cells.scaled %in% cells] cells.scaled <- cells.scaled[na.omit(object = match(x = colnames(x = x), table = cells.scaled))] - features.scaled <- rownames(x = GetAssayData(object = x, slot = 'scale.data')) + features.scaled <- rownames(x = GetAssayData(object = x, layer = 'scale.data')) features.scaled <- intersect(x = features, y = features.scaled) slot(object = x, name = "scale.data") <- if (length(x = cells.scaled) > 0 && length(x = features.scaled) > 0) { - GetAssayData(object = x, slot = "scale.data")[features.scaled, cells.scaled, drop = FALSE] + GetAssayData(object = x, layer = "scale.data")[features.scaled, cells.scaled, drop = FALSE] } else { new(Class = 'matrix') } @@ -1625,7 +1625,7 @@ setMethod( signature = c(x = 'Assay'), definition = function(x, na.rm = FALSE, dims = 1, ..., slot = 'data') { return(Matrix::colMeans( - x = GetAssayData(object = x, slot = slot), + x = GetAssayData(object = x, layer = slot), na.rm = na.rm, dims = dims, ... @@ -1649,7 +1649,7 @@ setMethod( signature = c(x = 'Assay'), definition = function(x, na.rm = FALSE, dims = 1, ..., slot = 'data') { return(Matrix::colSums( - x = GetAssayData(object = x, slot = slot), + x = GetAssayData(object = x, layer = slot), na.rm = na.rm, dims = dims, ... @@ -1673,7 +1673,7 @@ setMethod( signature = c(x = 'Assay'), definition = function(x, na.rm = FALSE, dims = 1, ..., slot = 'data') { return(Matrix::rowMeans( - x = GetAssayData(object = x, slot = slot), + x = GetAssayData(object = x, layer = slot), na.rm = na.rm, dims = dims, ... @@ -1697,7 +1697,7 @@ setMethod( signature = c(x = 'Assay'), definition = function(x, na.rm = FALSE, dims = 1, ..., slot = 'data') { return(Matrix::rowSums( - x = GetAssayData(object = x, slot = slot), + x = GetAssayData(object = x, layer = slot), na.rm = na.rm, dims = dims, ... @@ -1927,11 +1927,11 @@ SubsetVST <- function(sct.info, cells, features) { #' @noRd #' ValidateDataForMerge <- function(assay, slot) { - mat <- GetAssayData(object = assay, slot = slot) + mat <- GetAssayData(object = assay, layer = slot) if (any(dim(x = mat) == c(0, 0))) { slots.to.check <- setdiff(x = c("counts", "data", "scale.data"), y = slot) for (ss in slots.to.check) { - data.dims <- dim(x = GetAssayData(object = assay, slot = ss)) + data.dims <- dim(x = GetAssayData(object = assay, layer = ss)) data.slot <- ss if (!any(data.dims == c(0, 0))) { break @@ -1944,7 +1944,7 @@ ValidateDataForMerge <- function(assay, slot) { data = 0, nrow = data.dims[1], ncol = data.dims[2], - dimnames = dimnames(x = GetAssayData(object = assay, slot = data.slot)) + dimnames = dimnames(x = GetAssayData(object = assay, layer = data.slot)) ) mat <- as.sparse(x = mat) } diff --git a/R/assay5.R b/R/assay5.R index d4270289..79f4de5f 100644 --- a/R/assay5.R +++ b/R/assay5.R @@ -2733,7 +2733,7 @@ setAs( # browser() # Add the expression matrices for (i in c('counts', 'data', 'scale.data')) { - adata <- GetAssayData(object = from, slot = i) + adata <- GetAssayData(object = from, layer = i) if (IsMatrixEmpty(x = adata)) { next } diff --git a/R/seurat.R b/R/seurat.R index b3e51648..2316c4ee 100644 --- a/R/seurat.R +++ b/R/seurat.R @@ -1871,7 +1871,7 @@ FetchData.Seurat <- function( #' #' @examples #' # Get assay data from the default assay in a Seurat object -#' GetAssayData(object = pbmc_small, slot = "data")[1:5,1:5] +#' GetAssayData(object = pbmc_small, layer = "data")[1:5,1:5] #' GetAssayData.Seurat <- function( object, @@ -2153,9 +2153,11 @@ LayerData.Seurat <- function( ... ) { if (is_present(arg = slot)) { - deprecate_stop(when = "5.0.0", - what = "LayerData(slot = )", - with = "LayerData(layer = )") + deprecate_stop( + when = "5.0.0", + what = "LayerData(slot = )", + with = "LayerData(layer = )" + ) } assay <- assay %||% DefaultAssay(object = object) assay <- arg_match(arg = assay, values = Assays(object = object)) @@ -2465,13 +2467,20 @@ SetAssayData.Seurat <- function( ... ) { CheckDots(...) + if (is_present(arg = slot)) { + .Deprecate( + when = '5.0.0', + what = 'GetAssayData(slot = )', + with = 'GetAssayData(layer = )' + ) + layer <- slot + } object <- UpdateSlots(object = object) assay <- assay %||% DefaultAssay(object = object) object[[assay]] <- SetAssayData( object = object[[assay]], layer = layer, new.data = new.data, - slot = slot, ... ) return(object) @@ -2795,7 +2804,7 @@ WhichCells.Seurat <- function( object = object, vars = unique(x = expr.char[vars.use]), cells = cells, - slot = slot + layer = slot ) cells <- rownames(x = data.subset)[eval_tidy(expr = expr, data = data.subset)] } @@ -3644,7 +3653,7 @@ split.Seurat <- function( #' subset(pbmc_small, subset = MS4A1 > 4) #' subset(pbmc_small, subset = `DLGAP1-AS1` > 2) #' subset(pbmc_small, idents = '0', invert = TRUE) -#' subset(pbmc_small, subset = MS4A1 > 3, slot = 'counts') +#' subset(pbmc_small, subset = MS4A1 > 3, layer = 'counts') #' subset(pbmc_small, features = VariableFeatures(object = pbmc_small)) #' subset.Seurat <- function( @@ -3911,7 +3920,7 @@ setMethod( # because R doesn't allow S3-style [[<- for S4 classes # Ensure cell order stays the same if (all(Cells(x = value) %in% Cells(x = x)) && !all(Cells(x = value) == Cells(x = x))) { for (slot in c('counts', 'data', 'scale.data')) { - assay.data <- GetAssayData(object = value, slot = slot) + assay.data <- GetAssayData(object = value, layer = slot) if (!IsMatrixEmpty(x = assay.data)) { assay.data <- assay.data[, Cells(x = x), drop = FALSE] } @@ -4113,8 +4122,8 @@ setMethod( # because R doesn't allow S3-style [[<- for S4 classes if (inherits(x = value, what = 'Assay')) { if ((!i %in% Assays(object = x)) | (i %in% Assays(object = x) && !identical( - x = GetAssayData(object = x, assay = i, slot = "counts"), - y = GetAssayData(object = value, slot = "counts")) + x = GetAssayData(object = x, assay = i, layer = "counts"), + y = GetAssayData(object = value, layer = "counts")) )) { n.calc <- CalcN(object = value) if (!is.null(x = n.calc)) { From 16d3eb84bff3cc0a63cf95933760e10fcd72209d Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Mon, 30 Oct 2023 16:12:36 -0400 Subject: [PATCH 02/18] Bump develop version Update changelog --- DESCRIPTION | 2 +- NEWS.md | 5 +++++ 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index d2d40a65..885b21eb 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: SeuratObject Type: Package Title: Data Structures for Single Cell Data -Version: 5.0.0 +Version: 5.0.0.9001 Authors@R: c( person(given = 'Rahul', family = 'Satija', email = 'rsatija@nygenome.org', role = 'aut', comment = c(ORCID = '0000-0001-9448-8833')), person(given = 'Paul', family = 'Hoffman', email = 'seurat@nygenome.org', role = c('aut', 'cre'), comment = c(ORCID = '0000-0002-7693-8957')), diff --git a/NEWS.md b/NEWS.md index 64e728bf..20761c1e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,3 +1,8 @@ +# Unreleased + +## Changes: +- Update internal calls to `GetAssayData()` to use `layer` instead of `slot` (#160) + # SeuratObject 5.0.0 ## Added - New `Assay5` class with support for layers; layers provide support for: From 9c1936187ecdb295fabb68c9acfe80c02be73774 Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Mon, 30 Oct 2023 16:19:36 -0400 Subject: [PATCH 03/18] Minor fix --- R/seurat.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/seurat.R b/R/seurat.R index 2316c4ee..62d35f4e 100644 --- a/R/seurat.R +++ b/R/seurat.R @@ -3653,7 +3653,7 @@ split.Seurat <- function( #' subset(pbmc_small, subset = MS4A1 > 4) #' subset(pbmc_small, subset = `DLGAP1-AS1` > 2) #' subset(pbmc_small, idents = '0', invert = TRUE) -#' subset(pbmc_small, subset = MS4A1 > 3, layer = 'counts') +#' subset(pbmc_small, subset = MS4A1 > 3, slot = 'counts') #' subset(pbmc_small, features = VariableFeatures(object = pbmc_small)) #' subset.Seurat <- function( From 62f158423868f33c9e01d2bdc9154adb8f8acf93 Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Mon, 30 Oct 2023 16:19:52 -0400 Subject: [PATCH 04/18] Update docs --- man/AssayData.Rd | 2 +- man/SeuratObject-package.Rd | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/man/AssayData.Rd b/man/AssayData.Rd index bee78764..b296dd26 100644 --- a/man/AssayData.Rd +++ b/man/AssayData.Rd @@ -80,7 +80,7 @@ use \code{\link{LayerData<-}} \examples{ # Get assay data from the default assay in a Seurat object -GetAssayData(object = pbmc_small, slot = "data")[1:5,1:5] +GetAssayData(object = pbmc_small, layer = "data")[1:5,1:5] # Set an Assay layer through the Seurat object count.data <- GetAssayData(object = pbmc_small[["RNA"]], layer = "counts") diff --git a/man/SeuratObject-package.Rd b/man/SeuratObject-package.Rd index 7bf8c28c..bf9cffd0 100644 --- a/man/SeuratObject-package.Rd +++ b/man/SeuratObject-package.Rd @@ -33,6 +33,7 @@ Authors: Other contributors: \itemize{ \item Madeline Kowalski \email{mkowalski@nygenome.org} (\href{https://orcid.org/0000-0002-5655-7620}{ORCID}) [contributor] + \item Saket Choudhary \email{schoudhary@nygenome.org} (\href{https://orcid.org/0000-0001-5202-7633}{ORCID}) [contributor] \item Skylar Li \email{sli@nygenome.org} [contributor] \item Longda Jiang \email{ljiang@nygenome.org} (\href{https://orcid.org/0000-0003-4964-6497}{ORCID}) [contributor] \item Jeff Farrell \email{jfarrell@g.harvard.edu} [contributor] From faf86a7ccc06c5c62f9e858c5ef0f10f4d73da4d Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Wed, 8 Nov 2023 19:35:46 -0500 Subject: [PATCH 05/18] Update class imports from Matrix Import the following classes from Matrix on advice from Matrix authors: - dsparseMatrix - dMatrix - sparseMatrix - generalMatrix - compMatrix --- NAMESPACE | 5 +++++ R/seurat.R | 1 - R/zzz.R | 3 ++- 3 files changed, 7 insertions(+), 2 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 74b49243..273adf81 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -531,7 +531,12 @@ exportMethods(show) importClassesFrom(Matrix,CsparseMatrix) importClassesFrom(Matrix,Matrix) importClassesFrom(Matrix,RsparseMatrix) +importClassesFrom(Matrix,compMatrix) +importClassesFrom(Matrix,dMatrix) importClassesFrom(Matrix,dgCMatrix) +importClassesFrom(Matrix,dsparseMatrix) +importClassesFrom(Matrix,generalMatrix) +importClassesFrom(Matrix,sparseMatrix) importClassesFrom(sp,CRS) importClassesFrom(sp,Spatial) importClassesFrom(sp,SpatialPoints) diff --git a/R/seurat.R b/R/seurat.R index 62d35f4e..1e5e2921 100644 --- a/R/seurat.R +++ b/R/seurat.R @@ -6,7 +6,6 @@ #' @include graph.R #' @include spatial.R #' @importFrom methods setClass -#' @importClassesFrom Matrix dgCMatrix #' NULL diff --git a/R/zzz.R b/R/zzz.R index 92ddcc24..3cf0f15c 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -10,7 +10,8 @@ #' enquo eval_tidy have_name inform is_bare_character is_bare_integerish #' is_bare_list is_bare_numeric is_missing is_na is_named is_quosure #' missing_arg warn -#' @importClassesFrom Matrix dgCMatrix +#' @importClassesFrom Matrix dgCMatrix dsparseMatrix dMatrix +#' sparseMatrix generalMatrix compMatrix #' @useDynLib SeuratObject #' NULL From 3589d74136468b780d7be5363a13ce01f725444e Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Wed, 8 Nov 2023 20:25:38 -0500 Subject: [PATCH 06/18] Bump Matrix version A new version of Matrix was released today, set that as the minimum required version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 885b21eb..4b054949 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,7 +46,7 @@ Imports: future.apply, grDevices, grid, - Matrix (>= 1.6.1), + Matrix (>= 1.6.2), methods, progressr, Rcpp (>= 1.0.5), From 3b82039edcb0855817e10574fac011adcdc21ec9 Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Wed, 8 Nov 2023 20:26:54 -0500 Subject: [PATCH 07/18] Bump develop version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 4b054949..359f2c21 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: SeuratObject Type: Package Title: Data Structures for Single Cell Data -Version: 5.0.0.9001 +Version: 5.0.0.9002 Authors@R: c( person(given = 'Rahul', family = 'Satija', email = 'rsatija@nygenome.org', role = 'aut', comment = c(ORCID = '0000-0001-9448-8833')), person(given = 'Paul', family = 'Hoffman', email = 'seurat@nygenome.org', role = c('aut', 'cre'), comment = c(ORCID = '0000-0002-7693-8957')), From 22d60aa69ca7dcaf23b041d5791fcb3145b5b7c7 Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Wed, 8 Nov 2023 20:27:48 -0500 Subject: [PATCH 08/18] Manually switch to dashes (may not last with future use of `usethis::use_package()` --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 359f2c21..73d20b9c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,7 +46,7 @@ Imports: future.apply, grDevices, grid, - Matrix (>= 1.6.2), + Matrix (>= 1.6-2), methods, progressr, Rcpp (>= 1.0.5), From 818b1eb0307df4b72c77a5b1ee7008752504b516 Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Wed, 8 Nov 2023 22:27:30 -0500 Subject: [PATCH 09/18] More imports --- R/zzz.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/zzz.R b/R/zzz.R index 3cf0f15c..6e3ac80e 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -10,8 +10,8 @@ #' enquo eval_tidy have_name inform is_bare_character is_bare_integerish #' is_bare_list is_bare_numeric is_missing is_na is_named is_quosure #' missing_arg warn -#' @importClassesFrom Matrix dgCMatrix dsparseMatrix dMatrix -#' sparseMatrix generalMatrix compMatrix +#' @importClassesFrom Matrix dgCMatrix CsparseMatrix dsparseMatrix generalMatrix +#' dMatrix sparseMatrix compMatrix Matrix #' @useDynLib SeuratObject #' NULL From b22a1e638f0c914455aefad4d18cc4cce22cb7ba Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Sun, 12 Nov 2023 21:12:57 -0500 Subject: [PATCH 10/18] Adjust relocation of on-disk layers Adjust relocation on-disk layers in `SaveSeuratRds()` to always move on-disk layers into `dirname(file)` regardless of whether a layer is in `tempdir()` or not. Deprecate `destdir` in favor of `move` --- R/seurat.R | 66 +++++++++++++++++++++++++------------------- R/utils.R | 17 ++++++++---- man/SaveSeuratRds.Rd | 14 ++++++++-- 3 files changed, 60 insertions(+), 37 deletions(-) diff --git a/R/seurat.R b/R/seurat.R index 1e5e2921..77853363 100644 --- a/R/seurat.R +++ b/R/seurat.R @@ -610,8 +610,8 @@ RenameAssays <- function( #' @param object A \code{\link{Seurat}} object #' @param file Path to save \code{object} to; defaults to #' \code{file.path(getwd(), paste0(Project(object), ".Rds"))} -#' @param destdir Destination directory for on-disk layers saved in -#' \dQuote{\code{\Sexpr[stage=render]{tempdir()}}} +#' @param move Move on-disk layers into \code(dirname(file)) +#' @param destdir \Sexpr[stage=build,results=rd]{lifecycle::badge("deprecated")} #' @param relative Save relative paths instead of absolute ones #' @inheritDotParams base::saveRDS #' @@ -685,12 +685,28 @@ RenameAssays <- function( SaveSeuratRds <- function( object, file = NULL, - destdir = NULL, + move = TRUE, + destdir = deprecated(), relative = FALSE, ... ) { file <- file %||% file.path(getwd(), paste0(Project(object = object), '.Rds')) file <- normalizePath(path = file, winslash = '/', mustWork = FALSE) + if (is_present(arg = destdir)) { + .Deprecate( + when = '5.0.1', + what = 'SaveSeuratRds(destdir = )', + with = 'SaveSeuratRds(move = )', + details = paste( + "Specifying a directory to move on-disk layers stored in", + sQuote(x = normalizePath(path = tempdir(), winslash = '/', mustWork = FALSE)), + "is deprecated; now, specify `move = TRUE` either move all on-disk layers to", + sQuote(x = dirname(path = file)), + "or `move = FALSE` leave them as-is" + ) + ) + move <- is_bare_character(x = destdir, n = 1L) || is.null(x = destdir) + } # Cache v5 assays assays <- .FilterObjects(object = object, classes.keep = 'StdAssay') p <- progressor(along = assays, auto_finish = TRUE) @@ -706,13 +722,9 @@ SaveSeuratRds <- function( ) cache <- vector(mode = 'list', length = length(x = assays)) names(x = cache) <- assays - tdir <- normalizePath(path = tempdir(), winslash = '/') # because macOS is weird - destdir <- destdir %||% dirname(path = file) - if (!is_na(x = destdir) || isTRUE(x = relative)) { - check_installed( - pkg = 'fs', - reason = 'for moving on-disk matrices' - ) + destdir <- dirname(path = file) + if (isTRUE(x = move)) { + check_installed(pkg = 'fs', reason = 'for moving on-disk matrices') } for (assay in assays) { p( @@ -746,27 +758,23 @@ SaveSeuratRds <- function( p(message = "No on-disk layers found", class = 'sticky', amount = 0) next } - if (!is_na(x = destdir)) { + if (isTRUE(x = move)) { for (i in seq_len(length.out = nrow(x = df))) { pth <- df$path[i] - mv <- substr(x = pth, start = 1L, stop = nchar(x = tdir)) == tdir || - isTRUE(x = relative) - if (isTRUE(x = mv)) { - p( - message = paste( - "Moving layer", - sQuote(x = df$layer[i]), - "to", - sQuote(x = destdir) - ), - class = 'sticky', - amount = 0 - ) - df[i, 'path'] <- as.character(x = .FileMove( - path = pth, - new_path = destdir - )) - } + p( + message = paste( + "Moving layer", + sQuote(x = df$layer[i]), + "to", + sQuote(x = destdir) + ), + class = 'sticky', + amount = 0 + ) + df[i, 'path'] <- as.character(x = .FileMove( + path = pth, + new_path = destdir + )) } } if (isTRUE(x = relative)) { diff --git a/R/utils.R b/R/utils.R index d4b7e691..2fb732f2 100644 --- a/R/utils.R +++ b/R/utils.R @@ -2276,7 +2276,11 @@ StitchMatrix.matrix <- function(x, y, rowmap, colmap, ...) { new_path <- fs::path_expand(path = new_path) new_path <- fs::dir_create(path = new_path) dest <- tryCatch( - expr = fs::dir_copy(path = path, new_path = new_path, overwrite = overwrite), + expr = fs::dir_copy( + path = path, + new_path = new_path, + overwrite = overwrite + ), EEXIST = eexist, error = hndlr ) @@ -2292,10 +2296,13 @@ StitchMatrix.matrix <- function(x, y, rowmap, colmap, ...) { ) } else { abort( - message = paste0( - "Can't find path: ", - sQuote(x = path), - "; if path is relative, change working directory." + message = paste( + strwrap(x = paste0( + "Can't find path: ", + sQuote(x = path), + "; if path is relative, change working directory" + )), + sep = '\n' ), call = caller_env(n = 1L + n) ) diff --git a/man/SaveSeuratRds.Rd b/man/SaveSeuratRds.Rd index 8d0fa921..24ad68cc 100644 --- a/man/SaveSeuratRds.Rd +++ b/man/SaveSeuratRds.Rd @@ -5,7 +5,14 @@ \alias{LoadSeuratRds} \title{Save and Load \code{Seurat} Objects from Rds files} \usage{ -SaveSeuratRds(object, file = NULL, destdir = NULL, relative = FALSE, ...) +SaveSeuratRds( + object, + file = NULL, + move = TRUE, + destdir = deprecated(), + relative = FALSE, + ... +) LoadSeuratRds(file, ...) } @@ -15,8 +22,9 @@ LoadSeuratRds(file, ...) \item{file}{Path to save \code{object} to; defaults to \code{file.path(getwd(), paste0(Project(object), ".Rds"))}} -\item{destdir}{Destination directory for on-disk layers saved in -\dQuote{\code{\Sexpr[stage=render]{tempdir()}}}} +\item{move}{Move on-disk layers into \code(dirname(file))} + +\item{destdir}{\Sexpr[stage=build,results=rd]{lifecycle::badge("deprecated")}} \item{relative}{Save relative paths instead of absolute ones} From c662db99c4bd485bca707d359e7176a53948ec82 Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Sun, 12 Nov 2023 21:15:26 -0500 Subject: [PATCH 11/18] Update changelog Bump develop version --- DESCRIPTION | 2 +- NEWS.md | 1 + 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 73d20b9c..7c88df80 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: SeuratObject Type: Package Title: Data Structures for Single Cell Data -Version: 5.0.0.9002 +Version: 5.0.0.9003 Authors@R: c( person(given = 'Rahul', family = 'Satija', email = 'rsatija@nygenome.org', role = 'aut', comment = c(ORCID = '0000-0001-9448-8833')), person(given = 'Paul', family = 'Hoffman', email = 'seurat@nygenome.org', role = c('aut', 'cre'), comment = c(ORCID = '0000-0002-7693-8957')), diff --git a/NEWS.md b/NEWS.md index 20761c1e..f8cef255 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,7 @@ ## Changes: - Update internal calls to `GetAssayData()` to use `layer` instead of `slot` (#160) +- Change layer-saving in `SaveSeuratRds()` to move all layers instead of just those in `tempdir()` (#169) # SeuratObject 5.0.0 ## Added From 1ea1b035f6a8e81ea9ddb11d46748367264c41e0 Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Mon, 13 Nov 2023 16:17:40 -0500 Subject: [PATCH 12/18] Bump version --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7c88df80..111719e6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: SeuratObject Type: Package Title: Data Structures for Single Cell Data -Version: 5.0.0.9003 +Version: 5.0.1 Authors@R: c( person(given = 'Rahul', family = 'Satija', email = 'rsatija@nygenome.org', role = 'aut', comment = c(ORCID = '0000-0001-9448-8833')), person(given = 'Paul', family = 'Hoffman', email = 'seurat@nygenome.org', role = c('aut', 'cre'), comment = c(ORCID = '0000-0002-7693-8957')), From 438ff86cd734fccadbffb843af1290d46b1f2929 Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Mon, 13 Nov 2023 16:19:22 -0500 Subject: [PATCH 13/18] Update changelog --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index f8cef255..6a5e528c 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,7 +1,8 @@ -# Unreleased +# SeuratObject 5.0.1 ## Changes: - Update internal calls to `GetAssayData()` to use `layer` instead of `slot` (#160) +- Update Matrix version to 1.6-2 (#164) - Change layer-saving in `SaveSeuratRds()` to move all layers instead of just those in `tempdir()` (#169) # SeuratObject 5.0.0 From a61ccd54477c60534c6a69cb0b3a6f28da0eb2f8 Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Mon, 13 Nov 2023 16:27:25 -0500 Subject: [PATCH 14/18] Fixes for documentation --- R/seurat.R | 2 +- man/SaveSeuratRds.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/seurat.R b/R/seurat.R index 77853363..994b40b3 100644 --- a/R/seurat.R +++ b/R/seurat.R @@ -610,7 +610,7 @@ RenameAssays <- function( #' @param object A \code{\link{Seurat}} object #' @param file Path to save \code{object} to; defaults to #' \code{file.path(getwd(), paste0(Project(object), ".Rds"))} -#' @param move Move on-disk layers into \code(dirname(file)) +#' @param move Move on-disk layers into \code{dirname(file)} #' @param destdir \Sexpr[stage=build,results=rd]{lifecycle::badge("deprecated")} #' @param relative Save relative paths instead of absolute ones #' @inheritDotParams base::saveRDS diff --git a/man/SaveSeuratRds.Rd b/man/SaveSeuratRds.Rd index 24ad68cc..4a20c0f1 100644 --- a/man/SaveSeuratRds.Rd +++ b/man/SaveSeuratRds.Rd @@ -22,7 +22,7 @@ LoadSeuratRds(file, ...) \item{file}{Path to save \code{object} to; defaults to \code{file.path(getwd(), paste0(Project(object), ".Rds"))}} -\item{move}{Move on-disk layers into \code(dirname(file))} +\item{move}{Move on-disk layers into \code{dirname(file)}} \item{destdir}{\Sexpr[stage=build,results=rd]{lifecycle::badge("deprecated")}} From b35044e426435aa2c764fad909f871555f5e3624 Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Wed, 15 Nov 2023 13:49:20 -0500 Subject: [PATCH 15/18] Two fixes to no longer use deprecated routines Replace use of `slot` with `layer` in `SetAssayData.StdAssay()` Replace use of `FilterObjects()` with `.FilterObjects() --- R/assay5.R | 2 +- R/seurat.R | 37 ++++++++++++++++++------------------- R/utils.R | 4 ++-- 3 files changed, 21 insertions(+), 22 deletions(-) diff --git a/R/assay5.R b/R/assay5.R index 79f4de5f..3f54cf6b 100644 --- a/R/assay5.R +++ b/R/assay5.R @@ -1518,7 +1518,7 @@ SetAssayData.StdAssay <- function( ) layer <- slot } - LayerData(object = object, layer = slot) <- new.data + LayerData(object = object, layer = layer) <- new.data return(object) } diff --git a/R/seurat.R b/R/seurat.R index 77853363..50a6bb5e 100644 --- a/R/seurat.R +++ b/R/seurat.R @@ -474,7 +474,6 @@ Neighbors <- function(object, slot = NULL) { #' Reductions(object = pbmc_small) #' Reductions <- function(object, slot = NULL) { - # reductions <- FilterObjects(object = object, classes.keep = 'DimReduc') reductions <- .FilterObjects(object = object, classes.keep = 'DimReduc') if (is.null(x = slot)) { return(reductions) @@ -900,7 +899,7 @@ UpdateSeuratObject <- function(object) { object <- UpdateSlots(object = object) # Validate object keys message("Ensuring keys are in the proper structure") - for (ko in FilterObjects(object = object)) { + for (ko in .FilterObjects(object = object)) { key <- Key(object = object[[ko]]) if (!length(x = key) || !nzchar(x = key)) { key <- Key(object = ko, quiet = TRUE) @@ -931,7 +930,7 @@ UpdateSeuratObject <- function(object) { assays <- make.names(names = Assays(object = object)) names(x = assays) <- Assays(object = object) object <- do.call(what = RenameAssays, args = c('object' = object, assays)) - for (obj in FilterObjects(object = object, classes.keep = c('Assay', 'DimReduc', 'Graph'))) { + for (obj in .FilterObjects(object = object, classes.keep = c('Assay', 'DimReduc', 'Graph'))) { suppressWarnings( expr = object[[obj]] <- UpdateSlots(object = object[[obj]]), classes = 'validationWarning' @@ -944,7 +943,7 @@ UpdateSeuratObject <- function(object) { } # Validate object keys message("Ensuring keys are in the proper structure") - for (ko in FilterObjects(object = object)) { + for (ko in .FilterObjects(object = object)) { suppressWarnings( expr = Key(object = object[[ko]]) <- UpdateKey(key = Key(object = object[[ko]])), classes = 'validationWarning' @@ -952,7 +951,7 @@ UpdateSeuratObject <- function(object) { } # Check feature names message("Ensuring feature names don't have underscores or pipes") - for (assay.name in FilterObjects(object = object, classes.keep = 'Assay')) { + for (assay.name in .FilterObjects(object = object, classes.keep = 'Assay')) { assay <- object[[assay.name]] for (slot in c('counts', 'data', 'scale.data')) { if (!IsMatrixEmpty(x = slot(object = assay, name = slot))) { @@ -1005,7 +1004,7 @@ UpdateSeuratObject <- function(object) { classes = 'validationWarning' ) } - for (reduc.name in FilterObjects(object = object, classes.keep = 'DimReduc')) { + for (reduc.name in .FilterObjects(object = object, classes.keep = 'DimReduc')) { reduc <- object[[reduc.name]] for (slot in c('feature.loadings', 'feature.loadings.projected')) { if (!IsMatrixEmpty(x = slot(object = reduc, name = slot))) { @@ -1433,7 +1432,7 @@ DefaultAssay.Seurat <- function(object, ...) { #' DefaultFOV.Seurat <- function(object, assay = NULL, ...) { assay <- assay[1L] %||% DefaultAssay(object = object) - fovs <- FilterObjects(object = object, classes.keep = 'FOV') + fovs <- .FilterObjects(object = object, classes.keep = 'FOV') if (is.na(x = assay)) { return(fovs[1L]) } @@ -1463,7 +1462,7 @@ DefaultFOV.Seurat <- function(object, assay = NULL, ...) { #' "DefaultFOV<-.Seurat" <- function(object, assay = NA, ..., value) { assay <- assay[1L] %||% DefaultAssay(object = object) - fovs <- FilterObjects(object = object, classes.keep = 'FOV') + fovs <- .FilterObjects(object = object, classes.keep = 'FOV') value <- match.arg(arg = value, choices = fovs) if (!is.na(x = assay)) { assay <- match.arg(arg = assay, choices = Assays(object = object)) @@ -1975,7 +1974,7 @@ HVFInfo.Seurat <- function( cmds <- apply( X = expand.grid( c('FindVariableFeatures', 'SCTransform'), - FilterObjects(object = object, classes.keep = c('Assay', 'Assay5')) + .FilterObjects(object = object, classes.keep = c('Assay', 'Assay5')) ), MARGIN = 1, FUN = paste, @@ -2366,7 +2365,7 @@ RenameCells.Seurat <- function( Idents(object = object) <- old.ids names(x = new.cell.names) <- old.names # rename in the assay objects - assays <- FilterObjects(object = object, classes.keep = 'Assay') + assays <- .FilterObjects(object = object, classes.keep = 'Assay') for (i in assays) { slot(object = object, name = "assays")[[i]] <- RenameCells( object = object[[i]], @@ -2374,7 +2373,7 @@ RenameCells.Seurat <- function( ) } # rename in the assay5 objects - assays5 <- FilterObjects(object = object, classes.keep = 'Assay5') + assays5 <- .FilterObjects(object = object, classes.keep = 'Assay5') for (i in assays5) { slot(object = object, name = "assays")[[i]] <- RenameCells( object = object[[i]], @@ -2382,7 +2381,7 @@ RenameCells.Seurat <- function( ) } # rename in the DimReduc objects - dimreducs <- FilterObjects(object = object, classes.keep = 'DimReduc') + dimreducs <- .FilterObjects(object = object, classes.keep = 'DimReduc') for (i in dimreducs) { slot(object = object, name = "reductions")[[i]] <- RenameCells( object = object[[i]], @@ -2390,7 +2389,7 @@ RenameCells.Seurat <- function( ) } # rename the graphs - graphs <- FilterObjects(object = object, classes.keep = "Graph") + graphs <- .FilterObjects(object = object, classes.keep = "Graph") for (g in graphs) { graph.g <- object[[g]] rownames(graph.g) <- colnames(graph.g) <- new.cell.names[colnames(x = graph.g)] @@ -2477,8 +2476,8 @@ SetAssayData.Seurat <- function( if (is_present(arg = slot)) { .Deprecate( when = '5.0.0', - what = 'GetAssayData(slot = )', - with = 'GetAssayData(layer = )' + what = 'SetAssayData(slot = )', + with = 'SetAssayData(layer = )' ) layer <- slot } @@ -2771,7 +2770,7 @@ WhichCells.Seurat <- function( cells <- intersect(x = cells, y = cells.idents) } if (!missing(x = expression)) { - objects.use <- FilterObjects( + objects.use <- .FilterObjects( object = object, classes.keep = c('Assay', 'StdAssay', 'DimReduc', 'SpatialImage') ) @@ -3750,11 +3749,11 @@ subset.Seurat <- function( f = Negate(f = is.null), x = slot(object = x, name = 'assays') ) - if (length(x = FilterObjects(object = x, classes.keep = c('Assay', 'StdAssay'))) == 0 || is.null(x = x[[DefaultAssay(object = x)]])) { + if (length(x = .FilterObjects(object = x, classes.keep = c('Assay', 'StdAssay'))) == 0 || is.null(x = x[[DefaultAssay(object = x)]])) { abort(message = "Under current subsetting parameters, the default assay will be removed. Please adjust subsetting parameters or change default assay") } # Filter DimReduc objects - for (dimreduc in FilterObjects(object = x, classes.keep = 'DimReduc')) { + for (dimreduc in .FilterObjects(object = x, classes.keep = 'DimReduc')) { suppressWarnings( x[[dimreduc]] <- tryCatch( expr = subset.DimReduc(x = x[[dimreduc]], cells = cells, features = features), @@ -3770,7 +3769,7 @@ subset.Seurat <- function( } # Recalculate nCount and nFeature if (!is.null(features)) { - for (assay in FilterObjects(object = x, classes.keep = 'Assay')) { + for (assay in .FilterObjects(object = x, classes.keep = 'Assay')) { n.calc <- CalcN(object = x[[assay]]) if (!is.null(x = n.calc)) { names(x = n.calc) <- paste(names(x = n.calc), assay, sep = '_') diff --git a/R/utils.R b/R/utils.R index 2fb732f2..b9f61f70 100644 --- a/R/utils.R +++ b/R/utils.R @@ -267,7 +267,7 @@ NULL #' @concept utils #' .DefaultFOV <- function(object, assay = NULL) { - images <- FilterObjects(object = object, classes.keep = 'FOV') + images <- .FilterObjects(object = object, classes.keep = 'FOV') if (!is.null(x = assay)) { assays <- c(assay, DefaultAssay(object = object[[assay]])) images <- Filter( @@ -1011,7 +1011,7 @@ DefaultDimReduc <- function(object, assay = NULL) { object <- UpdateSlots(object = object) assay <- assay %||% DefaultAssay(object = object) drs.use <- c('umap', 'tsne', 'pca') - dim.reducs <- FilterObjects(object = object, classes.keep = 'DimReduc') + dim.reducs <- .FilterObjects(object = object, classes.keep = 'DimReduc') drs.assay <- Filter( f = function(x) { return(DefaultAssay(object = object[[x]]) == assay) From 92da71f471b93aea5196e5dd95f57a1c30c971ea Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Wed, 15 Nov 2023 13:52:54 -0500 Subject: [PATCH 16/18] Bump develop version Update changelog --- DESCRIPTION | 2 +- NEWS.md | 2 ++ 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 7c88df80..60c24f0b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: SeuratObject Type: Package Title: Data Structures for Single Cell Data -Version: 5.0.0.9003 +Version: 5.0.0.9004 Authors@R: c( person(given = 'Rahul', family = 'Satija', email = 'rsatija@nygenome.org', role = 'aut', comment = c(ORCID = '0000-0001-9448-8833')), person(given = 'Paul', family = 'Hoffman', email = 'seurat@nygenome.org', role = c('aut', 'cre'), comment = c(ORCID = '0000-0002-7693-8957')), diff --git a/NEWS.md b/NEWS.md index f8cef255..347fbb76 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,8 @@ ## Changes: - Update internal calls to `GetAssayData()` to use `layer` instead of `slot` (#160) - Change layer-saving in `SaveSeuratRds()` to move all layers instead of just those in `tempdir()` (#169) +- Update internal calls to `SetAssayData()` to use `layer` instead of `slot` (#171) +- Replace internal calls of `FilterObjects()` to `.FilterObjects()` (#171) # SeuratObject 5.0.0 ## Added From 260ebc22c8e55a83ef73c7cd888761d3c9479519 Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Thu, 16 Nov 2023 16:26:06 -0500 Subject: [PATCH 17/18] Update CRAN comments --- cran-comments.md | 17 ++++++----------- 1 file changed, 6 insertions(+), 11 deletions(-) diff --git a/cran-comments.md b/cran-comments.md index 0b4c84d8..9011be8c 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1,8 +1,10 @@ -# SeuratObject v5.0.0 +# SeuratObject v5.0.1 ## Test environments * local ubuntu 22.04 install, R 4.2.3 -* win-builder (oldrelease, release, devel) +* win-builder (oldrelease, release) + +We were unable to test on r-devel on win-builder due to insufficient Matrix version ## R CMD check results @@ -23,14 +25,7 @@ BPCells is hosted on R-universe and used conditionally in SeuratObject ## Downstream dependencies -The following reverse dependencies are impacted by this release of SeuratObject: - -- Seurat: - - new test failures and warnings: Seurat's tests expect errors that are now handled by SeuratObject. Warnings occur due to use of deprecated, but still accepted arguments. The authors of Seurat are aware of these changes, but the functionality of Seurat is not impacted - - S3 generic/method consistency: Seurat defines a method for a generic defined in SeuratObject. In the latest update, SeuratObject changes one of the parameters in the method signature, but still accepts the old arguments. The functionality of Seurat is not impacted by this update - -- Signac - - new test failures: SeuratObject changes the order of the results, but not the actual values. The authors of Signac are aware of this, but the functionality of Signac is not impacted +The following reverse dependency is impacted by this release of SeuratObject: - tidyseurat - - new test failures: SeuratObject changes the order of the results, but not the actual values. The authors of tidyseurat are aware of this, but the functionality of tidyseurat is not impacted + - test failures: SeuratObject changes the order of the results, but not the actual values. The authors of tidyseurat are aware of this, but the functionality of tidyseurat is not impacted From dd1072f2a9a1e913e18c6b549c09c7df0ca0ae98 Mon Sep 17 00:00:00 2001 From: Paul Hoffman Date: Thu, 16 Nov 2023 16:33:28 -0500 Subject: [PATCH 18/18] Pre-release dependency checks --- DESCRIPTION | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/DESCRIPTION b/DESCRIPTION index 111719e6..0fecef43 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -46,7 +46,7 @@ Imports: future.apply, grDevices, grid, - Matrix (>= 1.6-2), + Matrix (>= 1.6.3), methods, progressr, Rcpp (>= 1.0.5),