SeuratObject/0000755000175000017500000000000014147244102012775 5ustar nileshnileshSeuratObject/MD50000644000175000017500000001144514147244102013312 0ustar nileshnilesh02be6c9955dea2b37bf215934424f76b *DESCRIPTION 51a445d321e29ebb29fee2b069584f4b *LICENSE 507b0c7bf530864131e94390f9cdd03a *NAMESPACE e733b0136c84478fd10598d9fb56018f *NEWS.md 34df10962de6a9e289b4adad0cf5eaef *R/RcppExports.R 71961c66c9a8dbe63ceee1f7480ae527 *R/assay.R 207449e710f467a0f0f9a45938c370e1 *R/command.R 55fbb8a1de4de27bc7a49e56141cb30a *R/data.R fecce2418002e48348f9578fa7bded2c *R/default.R c64aef458bb5e6e6b8c5534562b34341 *R/dimreduc.R 54d64df9535872448f79bb57a092f4b2 *R/generics.R f3b2ea70c11935ca1ced2f4c04aec303 *R/graph.R 58b8af27bef1b9d90d5709917ee214c4 *R/jackstraw.R ebb286d75a41e5a53dbbceb92317d0be *R/neighbor.R 5df4d5eabb20adc872236ba39aa87bd2 *R/seurat.R dd6304c4ada4f3cb6dd6b946e0de4c17 *R/spatial.R ca93bdc8aa088622d76734d5a1aad46c *R/utils.R 019f91eae14530082ce623583747cc4d *R/zzz.R 674c3364ad5d96d39b25c4cd5b40af1d *data/pbmc_small.rda 0b29a4923fffe787efc5328f9e2a7c5e *man/AddMetaData.Rd d6e2b16f3d13eae7211519917b7c4c0e *man/Assay-class.Rd 19829f2beb81a599cd028166b2786416 *man/Assay-methods.Rd 3c44925b0d94927da4bbad8bc18b703a *man/AssayData.Rd 41c4bc7c8aa7c0944a1051ba572ccf4f *man/AttachDeps.Rd 1593cf973beb6c0790a13939cbada567 *man/Cells.Rd 5e76043eb02b766763d9f19c0955dbac *man/CellsByIdentities.Rd 62f8158d220be99ebf294149a990869d *man/CellsByImage.Rd 6cc1f889cd0dcf3f0a7736002ba24ef7 *man/CheckDots.Rd da8078655056e8130c36c9cb7ba29bd1 *man/CheckGC.Rd eb4894c30e5dc763a5081c163cdc485e *man/CheckMatrix.Rd 07575870555b49149ac81395bb3bb397 *man/Command.Rd a73658fcc5f4c7b4682a712f9ca12e8f *man/CreateAssayObject.Rd 2df165472c7fba58f02091b6f729a45c *man/CreateDimReducObject.Rd 385c849132b720254d9a1f187ca78aef *man/CreateSeuratObject.Rd 0b65c80e29d6b4788947d882e096f499 *man/DefaultAssay.Rd bde8e3a1676444d8ba9fde60c6a32b8c *man/DefaultDimReduc.Rd 8bd6b29a794bcbcc20ee81d1ebbed3f5 *man/DimReduc-class.Rd 87dd5948d6871cbf4a67577f6c6e0e01 *man/DimReduc-methods.Rd 3fbbf118376bc55e71b62459f214a0cb *man/Distances.Rd 2eec1b225da7d23d2ab12169c6da56b5 *man/Embeddings.Rd fc30561e8f482a35bfaf9aa40fe68073 *man/FetchData.Rd 7767b1a57c1cf049a66b7b3bccedc419 *man/FilterObjects.Rd f5813c66d90e0e41471779f502142a99 *man/GetImage.Rd a8d7f4dcf70294bf8fc450f5ec86b613 *man/GetTissueCoordinates.Rd 0e3440587ede66d179de30a98a49d73e *man/Graph-class.Rd a32499cf13f00e5763c2ab141445915c *man/Idents.Rd 8ce644523c9b724668641ec87c8b3ac9 *man/Images.Rd 071c889ca2132b13fcbb75aac17236d4 *man/Index.Rd ed9d5e272727c83315875be3426bcb95 *man/Indices.Rd f65a308c6130160a7b0cc71a3e03d6f1 *man/IsGlobal.Rd dee8cb8daf601e5ffc6e757e9fb278b4 *man/IsMatrixEmpty.Rd 539bbb8c43d038c789aba294961c08e7 *man/JS.Rd bd0aa85cedf8142d552e748e12beb97f *man/JackStrawData-class.Rd edcd00a0dfe8768bea546c0d6518ebd7 *man/JackStrawData-methods.Rd 1cf726f8d441ea2415ef4d483931fb4f *man/Key.Rd 00fb4ca6f4bc7cfaaf16a70687cac27e *man/Loadings.Rd d1594ed0aab049d164d48763ab8e3934 *man/LogSeuratCommand.Rd 850671d0628a4d822c25fad7bb05cc01 *man/Misc.Rd b69ec370a967359b606c97a746a06136 *man/Neighbor-class.Rd a37968e75bc74d215023e1cc9f152e95 *man/Neighbor-methods.Rd 24f0a86d7f94b7429e80239167830258 *man/ObjectAccess.Rd 1dbfab523fb6cef6ff1e08ad9b62cae0 *man/PackageCheck.Rd 2e2aa4b4d568fed8fd2dc69b08877408 *man/Project.Rd 74efaac6adcddf6f1f7c73245978d8b5 *man/Radius.Rd 68857854becb38ee10dbe30e904c73ad *man/RandomName.Rd 9c3665ad420ef989031650b03c94aee9 *man/RenameAssays.Rd c1222a20600188a7ab68db49ccffc00a *man/RenameCells.Rd 3cccbc7351846becfa577101424b2551 *man/RowMergeSparseMatrices.Rd 9d0bc357e417fd33715d80dc95a7f6f2 *man/Seurat-class.Rd 6df8c75ebb44e8ce45d97051aed15605 *man/Seurat-methods.Rd 8ff597c8d08a440809fced7b6e39dc46 *man/SeuratCommand-class.Rd d63b22f70a8725201ae502abbb241a3c *man/SeuratCommand-methods.Rd 3e44a35942d97f9963c04aa429a0ae78 *man/SeuratObject-package.Rd ee6f7075623e54c6cb43ad3818c10b93 *man/SpatialImage-class.Rd 183df15160c1361d10470c50e24875b6 *man/SpatialImage-methods.Rd 36d940b4f7071a8c84f5c9c5868a7eb7 *man/Stdev.Rd e65f4f832d6872af4cd9eb4b564ecfde *man/Tool.Rd 2fca52f2ce5f3d6f20522c0ffe259462 *man/UpdateSeuratObject.Rd e82a5cac428e1ab00b0b13a6eb9218ef *man/VariableFeatures.Rd 3ba1e2ae496857d51b279a466818b94e *man/Version.Rd c196f9fcb44e3ea0d63b374355813d83 *man/WhichCells.Rd 4af947bc4114b7a0832e672fd4317396 *man/as.Graph.Rd 764355bf04b972b2cc848e22836ddb49 *man/as.Neighbor.Rd a9b6c9eacfbf9b0f9daef9ee280a0716 *man/as.Seurat.Rd 223d01ca6bfe2d415fdb624fed7b0da8 *man/as.sparse.Rd 641d9a4ba5316271aa20e45d169d7737 *man/oldseurat-class.Rd 72ff61f578b283267cf20e05f63293bd *man/pbmc_small.Rd 789f8cf70682dfdd6d5b7290515d5176 *man/reexports.Rd 8c6d87f7958eadadd465799a48532c08 *man/s4list.Rd 45641d15712d235b5fb0c9fcf6472871 *man/set-if-null.Rd 48564b53bdf7cadfa2a1cf088e08fa1a *src/RcppExports.cpp 288fcd4e7664587a425de78708c7f251 *src/data_manipulation.cpp f99ccc0ef8d6bb241950e293d697668f *src/data_manipulation.h f33c09d14c160d9f29a89251fd91a036 *src/valid_pointer.c SeuratObject/NEWS.md0000644000175000017500000000236714147216461014112 0ustar nileshnilesh# 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 - Export utility functions (#22) - Bug fix in names with `Key.Seurat` (#26) - Improved duplicate key checking and resolution # SeuratObject 4.0.2 ## Changed - Provide default option for `Seurat.checkdots` option if option is not set (#16) # SeuratObject 4.0.1 ## Added - `head` and `tail` methods for `Seurat` and `Assay` objects (#5) - New utility functions (#6): - `AttachDeps` to attach required imported dependencies on package attachment - `IsMatrixEmpty` to test if a matrix is empty or not ## Changed - 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` objects (#4) - Improved error messages for clashing object names (#7) - Allow returning a `NULL` if a subset results in zero cells (#9) ## Removed - SCT-specific code (#2) # SeuratObject 4.0.0 - Initial release of SeuratObject SeuratObject/DESCRIPTION0000644000175000017500000000607414147244102014512 0ustar nileshnileshPackage: SeuratObject Type: Package Title: Data Structures for Single Cell Data Version: 4.0.4 Date: 2021-11-23 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')), person(given = 'Paul', family = 'Hoffman', email = 'seurat@nygenome.org', role = c('aut', 'cre'), comment = c(ORCID = '0000-0002-7693-8957')), person(given = 'Tim', family = 'Stuart', email = 'tstuart@nygenome.org', role = 'aut', comment = c(ORCID = '0000-0002-3044-0897')), person(given = 'Jeff', family = 'Farrell', email = 'jfarrell@g.harvard.edu', role = 'ctb'), person(given = 'Shiwei', family = 'Zheng', email = 'szheng@nygenome.org', role = 'ctb', comment = c(ORCID = '0000-0001-6682-6743')), person(given = 'Christoph', family = 'Hafemeister', email = 'chafemeister@nygenome.org', role = 'ctb', comment = c(ORCID = '0000-0001-6365-8254')), person(given = 'Patrick', family = 'Roelli', email = 'proelli@nygenome.org', role = 'ctb'), person(given = "Yuhan", family = "Hao", email = 'yhao@nygenome.org', role = 'ctb', comment = c(ORCID = '0000-0002-1810-0822')) ) Description: Defines S4 classes for single-cell genomic data and associated information, such as dimensionality reduction embeddings, nearest-neighbor graphs, and spatially-resolved coordinates. Provides data access methods and R-native hooks to ensure the Seurat object is familiar to other R users. See Satija R, Farrell J, Gennert D, et al (2015) , Macosko E, Basu A, Satija R, et al (2015) , and Stuart T, Butler A, et al (2019) for more details. 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.2 Depends: R (>= 4.0.0) Imports: grDevices, grid, Matrix (>= 1.3.3), methods, Rcpp (>= 1.0.5), rlang (>= 0.4.7), stats, tools, utils Suggests: testthat Collate: 'RcppExports.R' 'utils.R' 'zzz.R' 'generics.R' 'assay.R' 'command.R' 'data.R' 'default.R' 'jackstraw.R' 'dimreduc.R' 'graph.R' 'neighbor.R' 'spatial.R' 'seurat.R' LinkingTo: Rcpp, RcppEigen NeedsCompilation: yes Packaged: 2021-11-23 17:09:25 UTC; paul Author: Rahul Satija [aut] (), Andrew Butler [aut] (), Paul Hoffman [aut, cre] (), Tim Stuart [aut] (), Jeff Farrell [ctb], Shiwei Zheng [ctb] (), Christoph Hafemeister [ctb] (), Patrick Roelli [ctb], Yuhan Hao [ctb] () Maintainer: Paul Hoffman Repository: CRAN Date/Publication: 2021-11-23 20:00:02 UTC SeuratObject/man/0000755000175000017500000000000014147216431013554 5ustar nileshnileshSeuratObject/man/IsMatrixEmpty.Rd0000644000175000017500000000072614145250210016616 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{IsMatrixEmpty} \alias{IsMatrixEmpty} \title{Check if a matrix is empty} \usage{ IsMatrixEmpty(x) } \arguments{ \item{x}{A matrix} } \value{ Whether or not \code{x} is empty } \description{ Takes a matrix and asks if it's empty (either 0x0 or 1x1 with a value of NA) } \examples{ IsMatrixEmpty(new("matrix")) IsMatrixEmpty(matrix()) IsMatrixEmpty(matrix(1:3)) } \concept{utils} SeuratObject/man/Cells.Rd0000644000175000017500000000104114146000252015070 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/default.R, R/dimreduc.R, % R/neighbor.R \name{Cells} \alias{Cells} \alias{Cells.default} \alias{Cells.DimReduc} \alias{Cells.Neighbor} \title{Get cells present in an object} \usage{ Cells(x) \method{Cells}{default}(x) \method{Cells}{DimReduc}(x) \method{Cells}{Neighbor}(x) } \arguments{ \item{x}{An object} } \value{ A vector of cell names } \description{ Get cells present in an object } \examples{ Cells(x = pbmc_small) } \concept{data-access} SeuratObject/man/Command.Rd0000644000175000017500000000130014133577537015427 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/seurat.R \name{Command} \alias{Command} \alias{Command.Seurat} \title{Get SeuratCommands} \usage{ Command(object, ...) \method{Command}{Seurat}(object, command = NULL, value = NULL, ...) } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} \item{command}{Name of the command to pull, pass \code{NULL} to get the names of all commands run} \item{value}{Name of the parameter to pull the value for} } \value{ Either a SeuratCommand object or the requested parameter value } \description{ Pull information on previously run commands in the Seurat object. } \concept{data-access} SeuratObject/man/RenameAssays.Rd0000644000175000017500000000076714133577537016464 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/seurat.R \name{RenameAssays} \alias{RenameAssays} \title{Rename assays in a \code{Seurat} object} \usage{ RenameAssays(object, ...) } \arguments{ \item{object}{A \code{Seurat} object} \item{...}{Named arguments as \code{old.assay = new.assay}} } \value{ \code{object} with assays renamed } \description{ Rename assays in a \code{Seurat} object } \examples{ RenameAssays(object = pbmc_small, RNA = 'rna') } \concept{seurat} SeuratObject/man/SeuratCommand-class.Rd0000644000175000017500000000127014133577537017724 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/command.R \docType{class} \name{SeuratCommand-class} \alias{SeuratCommand-class} \alias{SeuratCommand} \title{The SeuratCommand Class} \description{ The SeuratCommand is used for logging commands that are run on a \code{Seurat} object; it stores parameters and timestamps } \section{Slots}{ \describe{ \item{\code{name}}{Command name} \item{\code{time.stamp}}{Timestamp of when command was tun} \item{\code{assay.used}}{Optional name of assay used to generate \code{SeuratCommand} object} \item{\code{call.string}}{String of the command call} \item{\code{params}}{List of parameters used in the command call} }} SeuratObject/man/CellsByIdentities.Rd0000644000175000017500000000146614133577537017445 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/seurat.R \name{CellsByIdentities} \alias{CellsByIdentities} \title{Get cell names grouped by identity class} \usage{ CellsByIdentities(object, idents = NULL, cells = NULL, return.null = FALSE) } \arguments{ \item{object}{A Seurat object} \item{idents}{A vector of identity class levels to limit resulting list to; defaults to all identity class levels} \item{cells}{A vector of cells to grouping to} \item{return.null}{If no cells are request, return a \code{NULL}; by default, throws an error} } \value{ A named list where names are identity classes and values are vectors of cells belonging to that class } \description{ Get cell names grouped by identity class } \examples{ CellsByIdentities(object = pbmc_small) } \concept{data-access} SeuratObject/man/Index.Rd0000644000175000017500000000126514133577537015132 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/neighbor.R \name{Index} \alias{Index} \alias{Index<-} \alias{Index.Neighbor} \alias{Index<-.Neighbor} \title{Get Neighbor algorithm index} \usage{ Index(object, ...) Index(object, ...) <- value \method{Index}{Neighbor}(object, ...) \method{Index}{Neighbor}(object, ...) <- value } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods;} \item{value}{The index to store} } \value{ Returns the value in the alg.idx slot of the Neighbor object \code{Idents<-}: A Neighbor object with the index stored } \description{ Get Neighbor algorithm index } \concept{data-access} SeuratObject/man/Distances.Rd0000644000175000017500000000077114133577537016001 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/neighbor.R \name{Distances} \alias{Distances} \alias{Distances.Neighbor} \title{Get the Neighbor nearest neighbors distance matrix} \usage{ Distances(object, ...) \method{Distances}{Neighbor}(object, ...) } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} } \value{ The distance matrix } \description{ Get the Neighbor nearest neighbors distance matrix } \concept{data-access} SeuratObject/man/as.Neighbor.Rd0000644000175000017500000000101314133577537016211 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/neighbor.R \name{as.Neighbor} \alias{as.Neighbor} \alias{as.Neighbor.Graph} \title{Coerce to a \code{Neighbor} Object} \usage{ as.Neighbor(x, ...) \method{as.Neighbor}{Graph}(x, ...) } \arguments{ \item{x}{An object to convert to \code{\link{Neighbor}}} \item{...}{Arguments passed to other methods} } \value{ A \code{\link{Neighbor}} object } \description{ Convert objects to \code{\link{Neighbor}} objects } \concept{neighbor} SeuratObject/man/Embeddings.Rd0000644000175000017500000000153314133577537016122 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/dimreduc.R, R/seurat.R \name{Embeddings} \alias{Embeddings} \alias{Embeddings.DimReduc} \alias{Embeddings.Seurat} \title{Get Cell Embeddings} \usage{ Embeddings(object, ...) \method{Embeddings}{DimReduc}(object, ...) \method{Embeddings}{Seurat}(object, reduction = "pca", ...) } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} \item{reduction}{Name of reduction to pull cell embeddings for} } \value{ The embeddings matrix } \description{ Get Cell Embeddings } \examples{ # Get the embeddings directly from a DimReduc object Embeddings(object = pbmc_small[["pca"]])[1:5, 1:5] # Get the embeddings from a specific DimReduc in a Seurat object Embeddings(object = pbmc_small, reduction = "pca")[1:5, 1:5] } \concept{data-access} SeuratObject/man/CheckGC.Rd0000644000175000017500000000053114133577537015305 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{CheckGC} \alias{CheckGC} \title{Conditional Garbage Collection} \usage{ CheckGC(option = "SeuratObject.memsafe") } \arguments{ \item{option}{...} } \value{ Invisibly returns \code{NULL} } \description{ Call \code{gc} only when desired } \concept{utils} SeuratObject/man/Loadings.Rd0000644000175000017500000000262514133577537015624 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/dimreduc.R, R/seurat.R \name{Loadings} \alias{Loadings} \alias{Loadings<-} \alias{Loadings.DimReduc} \alias{Loadings<-.DimReduc} \alias{Loadings.Seurat} \title{Get and set feature loadings} \usage{ Loadings(object, ...) Loadings(object, ...) <- value \method{Loadings}{DimReduc}(object, projected = FALSE, ...) \method{Loadings}{DimReduc}(object, projected = TRUE, ...) <- value \method{Loadings}{Seurat}(object, reduction = "pca", projected = FALSE, ...) } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} \item{value}{Feature loadings to add} \item{projected}{Pull the projected feature loadings?} \item{reduction}{Name of reduction to pull feature loadings for} } \value{ \code{Loadings}: the feature loadings for \code{object} \code{Loadings<-}: \code{object} with the updated loadings } \description{ Get and set feature loadings } \examples{ # Get the feature loadings for a given DimReduc Loadings(object = pbmc_small[["pca"]])[1:5,1:5] # Set the feature loadings for a given DimReduc new.loadings <- Loadings(object = pbmc_small[["pca"]]) new.loadings <- new.loadings + 0.01 Loadings(object = pbmc_small[["pca"]]) <- new.loadings # Get the feature loadings for a specified DimReduc in a Seurat object Loadings(object = pbmc_small, reduction = "pca")[1:5,1:5] } \concept{data-access} SeuratObject/man/DefaultDimReduc.Rd0000644000175000017500000000145014143043627017045 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{DefaultDimReduc} \alias{DefaultDimReduc} \title{Find the default \code{\link{DimReduc}}} \usage{ DefaultDimReduc(object, assay = NULL) } \arguments{ \item{object}{A \code{\link{Seurat}} object} \item{assay}{Name of assay to use; defaults to the default assay of the object} } \value{ The default \code{\link{DimReduc}}, if possible } \description{ Searches for \code{\link{DimReduc}s} matching \dQuote{umap}, \dQuote{tsne}, or \dQuote{pca}, case-insensitive, and in that order. Priority given to \code{\link{DimReduc}s} matching the \code{DefaultAssay} or assay specified (eg. \dQuote{pca} for the default assay weights higher than \dQuote{umap} for a non-default assay) } \examples{ DefaultDimReduc(pbmc_small) } SeuratObject/man/CheckMatrix.Rd0000644000175000017500000000216514147216431016251 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{CheckMatrix} \alias{CheckMatrix} \alias{CheckMatrix.default} \alias{CheckMatrix.dMatrix} \alias{CheckMatrix.lMatrix} \title{Check Matrix Validity} \usage{ CheckMatrix(object, checks, ...) \method{CheckMatrix}{default}(object, checks, ...) \method{CheckMatrix}{dMatrix}(object, checks = c("infinite", "logical", "integer", "na"), ...) \method{CheckMatrix}{lMatrix}(object, checks = c("infinite", "logical", "integer", "na"), ...) } \arguments{ \item{object}{A matrix} \item{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} }} \item{...}{Arguments passed to other methods} } \value{ Emits warnings for each test and invisibly returns \code{NULL} } \description{ Check Matrix Validity } \keyword{internal} SeuratObject/man/Graph-class.Rd0000644000175000017500000000075514133577537016232 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/graph.R \docType{class} \name{Graph-class} \alias{Graph-class} \alias{Graph} \title{The Graph Class} \description{ The Graph class inherits from \code{\link[Matrix:sparseMatrix]{dgCMatrix}}. We do this to enable future expandability of graphs. } \section{Slots}{ \describe{ \item{\code{assay.used}}{Optional name of assay used to generate \code{Graph} object} }} \seealso{ \code{\link[Matrix]{dgCMatrix-class}} } SeuratObject/man/CellsByImage.Rd0000644000175000017500000000123214133577537016355 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/seurat.R \name{CellsByImage} \alias{CellsByImage} \title{Get a vector of cell names associated with an image (or set of images)} \usage{ CellsByImage(object, images = NULL, unlist = FALSE) } \arguments{ \item{object}{Seurat object} \item{images}{Vector of image names} \item{unlist}{Return as a single vector of cell names as opposed to a list, named by image name.} } \value{ A vector of cell names } \description{ Get a vector of cell names associated with an image (or set of images) } \examples{ \dontrun{ CellsByImage(object = object, images = "slice1") } } \concept{data-access} SeuratObject/man/JS.Rd0000644000175000017500000000177314133577537014403 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/jackstraw.R, R/dimreduc.R \name{JS} \alias{JS} \alias{JS<-} \alias{JS.JackStrawData} \alias{JS<-.JackStrawData} \alias{JS.DimReduc} \alias{JS<-.DimReduc} \title{Get and set JackStraw information} \usage{ JS(object, ...) JS(object, ...) <- value \method{JS}{JackStrawData}(object, slot, ...) \method{JS}{JackStrawData}(object, slot, ...) <- value \method{JS}{DimReduc}(object, slot = NULL, ...) \method{JS}{DimReduc}(object, slot = NULL, ...) <- value } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} \item{value}{JackStraw information} \item{slot}{Name of slot to store JackStraw scores to Can shorten to 'empirical', 'fake', 'full', or 'overall'} } \value{ \code{JS}: either a \code{\link{JackStrawData}} object or the specified jackstraw data \code{JS<-}: \code{object} with the update jackstraw information } \description{ Get and set JackStraw information } \concept{jackstraw} SeuratObject/man/Indices.Rd0000644000175000017500000000077314133577537015444 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/neighbor.R \name{Indices} \alias{Indices} \alias{Indices.Neighbor} \title{Get Neighbor nearest neighbor index matrices} \usage{ Indices(object, ...) \method{Indices}{Neighbor}(object, ...) } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods;} } \value{ A matrix with the nearest neighbor indices } \description{ Get Neighbor nearest neighbor index matrices } \concept{data-access} SeuratObject/man/FetchData.Rd0000644000175000017500000000147014146000252015657 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/seurat.R \name{FetchData} \alias{FetchData} \title{Access cellular data} \usage{ FetchData(object, vars, cells = NULL, slot = "data") } \arguments{ \item{object}{Seurat object} \item{vars}{List of all variables to fetch, use keyword \dQuote{ident} to pull identity classes} \item{cells}{Cells to collect data for (default is all cells)} \item{slot}{Slot to pull feature data for} } \value{ A data frame with cells as rows and cellular data as columns } \description{ Retrieves data (feature expression, PCA scores, metrics, etc.) for a set of cells in a Seurat object } \examples{ pc1 <- FetchData(object = pbmc_small, vars = 'PC_1') head(x = pc1) head(x = FetchData(object = pbmc_small, vars = c('groups', 'ident'))) } \concept{data-access} SeuratObject/man/Neighbor-methods.Rd0000644000175000017500000000142514133577537017257 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/neighbor.R \name{Neighbor-methods} \alias{Neighbor-methods} \alias{dim.Neighbor} \alias{show,Neighbor-method} \title{\code{Neighbor} Methods} \usage{ \method{dim}{Neighbor}(x) \S4method{show}{Neighbor}(object) } \arguments{ \item{x, object}{A \code{\link{Neighbor}} object} } \value{ \code{dim} Dimensions of the indices matrix \code{show}: Prints summary to \code{\link[base]{stdout}} and invisibly returns \code{NULL} } \description{ Methods for \code{\link{Neighbor}} objects for generics defined in other packages } \section{Functions}{ \itemize{ \item \code{dim.Neighbor}: Dimensions of the neighbor indices \item \code{show,Neighbor-method}: Overview of a \code{Neighbor} object }} \concept{neighbor} SeuratObject/man/Key.Rd0000644000175000017500000000225114145250210014562 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/assay.R, R/dimreduc.R, R/seurat.R \name{Key} \alias{Key} \alias{Key<-} \alias{Key.Assay} \alias{Key<-.Assay} \alias{Key.DimReduc} \alias{Key<-.DimReduc} \alias{Key.Seurat} \title{Get and set object keys} \usage{ Key(object, ...) Key(object, ...) <- value \method{Key}{Assay}(object, ...) \method{Key}{Assay}(object, ...) <- value \method{Key}{DimReduc}(object, ...) \method{Key}{DimReduc}(object, ...) <- value \method{Key}{Seurat}(object, ...) } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} \item{value}{Key value} } \value{ \code{Key}: the object key \code{Key<-}: \code{object} with an updated key } \description{ Get and set object keys } \examples{ # Get an Assay key Key(pbmc_small[["RNA"]]) # Set the key for an Assay Key(pbmc_small[["RNA"]]) <- "newkey_" Key(pbmc_small[["RNA"]]) # Get a DimReduc key Key(object = pbmc_small[["pca"]]) # Set the key for DimReduc Key(object = pbmc_small[["pca"]]) <- "newkey2_" Key(object = pbmc_small[["pca"]]) # Show all keys associated with a Seurat object Key(object = pbmc_small) } \concept{data-access} SeuratObject/man/set-if-null.Rd0000644000175000017500000000143614133577537016222 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \docType{import} \name{set-if-null} \alias{set-if-null} \alias{\%||\%} \alias{\%iff\%} \title{Set a default value depending on if an object is \code{NULL}} \usage{ x \%iff\% y } \arguments{ \item{x}{An object to test} \item{y}{A default value} } \value{ For \code{\%||\%}: \code{y} if \code{x} is \code{NULL} otherwise \code{x} For \code{\%iff\%}: \code{y} if \code{x} is \strong{not} \code{NULL}; otherwise \code{x} } \examples{ 1 \%||\% 2 NULL \%||\% 2 1 \%iff\% 2 NULL \%iff\% 2 } \concept{utils} \keyword{internal} \description{ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ \item{rlang}{\code{\link[rlang:op-null-default]{\%||\%}}} }} SeuratObject/man/pbmc_small.Rd0000644000175000017500000000226714133577537016177 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/data.R \docType{data} \name{pbmc_small} \alias{pbmc_small} \title{A small example version of the PBMC dataset} \format{ A Seurat object with the following slots filled \describe{ \item{assays}{ \itemize{Currently only contains one assay ("RNA" - scRNA-seq expression data) \item{counts - Raw expression data} \item{data - Normalized expression data} \item{scale.data - Scaled expression data} \item{var.features - names of the current features selected as variable} \item{meta.features - Assay level metadata such as mean and variance} }} \item{meta.data}{Cell level metadata} \item{active.assay}{Current default assay} \item{active.ident}{Current default idents} \item{graphs}{Neighbor graphs computed, currently stores the SNN} \item{reductions}{Dimensional reductions: currently PCA and tSNE} \item{version}{Seurat version used to create the object} \item{commands}{Command history} } } \source{ \url{https://support.10xgenomics.com/single-cell-gene-expression/datasets/1.1.0/pbmc3k} } \usage{ pbmc_small } \description{ A subsetted version of 10X Genomics' 3k PBMC dataset } \keyword{datasets} SeuratObject/man/RowMergeSparseMatrices.Rd0000644000175000017500000000113614133577537020455 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{RowMergeSparseMatrices} \alias{RowMergeSparseMatrices} \title{Merge Sparse Matrices by Row} \usage{ RowMergeSparseMatrices(mat1, mat2) } \arguments{ \item{mat1}{First matrix} \item{mat2}{Second matrix or list of matrices} } \value{ Returns a sparse matrix } \description{ Merge two or more sparse matrices by rowname. } \details{ Shared matrix rows (with the same row name) will be merged, and unshared rows (with different names) will be filled with zeros in the matrix not containing the row. } \concept{utils} SeuratObject/man/ObjectAccess.Rd0000644000175000017500000000150714145250210016365 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/seurat.R \name{Assays} \alias{Assays} \alias{Graphs} \alias{Neighbors} \alias{Reductions} \title{Query Specific Object Types} \usage{ Assays(object, slot = NULL) Graphs(object, slot = NULL) Neighbors(object, slot = NULL) Reductions(object, slot = NULL) } \arguments{ \item{object}{A \code{\link{Seurat}} object} \item{slot}{Name of component object to return} } \value{ If \code{slot} is \code{NULL}, the names of all component objects in this \code{Seurat} object. Otherwise, the specific object specified } \description{ List the names of \code{\link{Assay}}, \code{\link{DimReduc}}, \code{\link{Graph}}, \code{\link{Neighbor}} objects } \examples{ Assays(object = pbmc_small) Graphs(pbmc_small) Reductions(object = pbmc_small) } \concept{data-access} SeuratObject/man/reexports.Rd0000644000175000017500000000106114145250210016063 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/zzz.R \docType{import} \name{reexports} \alias{reexports} \alias{colMeans} \alias{colSums} \alias{rowMeans} \alias{rowSums} \title{Objects exported from other packages} \keyword{internal} \description{ These objects are imported from other packages. Follow the links below to see their documentation. \describe{ \item{Matrix}{\code{\link[Matrix:colSums]{colMeans}}, \code{\link[Matrix]{colSums}}, \code{\link[Matrix:colSums]{rowMeans}}, \code{\link[Matrix:colSums]{rowSums}}} }} SeuratObject/man/CreateSeuratObject.Rd0000644000175000017500000000600414133577537017575 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/seurat.R \name{CreateSeuratObject} \alias{CreateSeuratObject} \alias{CreateSeuratObject.default} \alias{CreateSeuratObject.Assay} \title{Create a \code{Seurat} object} \usage{ CreateSeuratObject( counts, project = "CreateSeuratObject", assay = "RNA", names.field = 1, names.delim = "_", meta.data = NULL, ... ) \method{CreateSeuratObject}{default}( counts, project = "SeuratProject", assay = "RNA", names.field = 1, names.delim = "_", meta.data = NULL, min.cells = 0, min.features = 0, row.names = NULL, ... ) \method{CreateSeuratObject}{Assay}( counts, project = "SeuratProject", assay = "RNA", names.field = 1, names.delim = "_", meta.data = NULL, ... ) } \arguments{ \item{counts}{Either a \code{\link[base]{matrix}}-like object with unnormalized data with cells as columns and features as rows or an \code{\link{Assay}}-derived object} \item{project}{\link{Project} name for the \code{Seurat} object} \item{assay}{Name of the initial assay} \item{names.field}{For the initial identity class for each cell, choose this field from the cell's name. E.g. If your cells are named as BARCODE_CLUSTER_CELLTYPE in the input matrix, set \code{names.field} to 3 to set the initial identities to CELLTYPE.} \item{names.delim}{For the initial identity class for each cell, choose this delimiter from the cell's column name. E.g. If your cells are named as BARCODE-CLUSTER-CELLTYPE, set this to \dQuote{-} to separate the cell name into its component parts for picking the relevant field.} \item{meta.data}{Additional cell-level metadata to add to the Seurat object. Should be a \code{\link[base]{data.frame}} where the rows are cell names and the columns are additional metadata fields. Row names in the metadata need to match the column names of the counts matrix.} \item{...}{Arguments passed to other methods} \item{min.cells}{Include features detected in at least this many cells. Will subset the counts matrix as well. To reintroduce excluded features, create a new object with a lower cutoff.} \item{min.features}{Include cells where at least this many features are detected.} \item{row.names}{When \code{counts} is a \code{data.frame} or \code{data.frame}-derived object: an optional vector of feature names to be used} } \value{ A \code{\link{Seurat}} object } \description{ Create a \code{Seurat} object from raw data } \note{ In previous versions (<3.0), this function also accepted a parameter to set the expression threshold for a \sQuote{detected} feature (gene). This functionality has been removed to simplify the initialization process/assumptions. If you would still like to impose this threshold for your particular dataset, simply filter the input expression matrix before calling this function. } \examples{ \dontrun{ pbmc_raw <- read.table( file = system.file('extdata', 'pbmc_raw.txt', package = 'Seurat'), as.is = TRUE ) pbmc_small <- CreateSeuratObject(counts = pbmc_raw) pbmc_small } } \concept{seurat} SeuratObject/man/Seurat-methods.Rd0000644000175000017500000002237214146000252016744 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/seurat.R \name{Seurat-methods} \alias{Seurat-methods} \alias{.DollarNames.Seurat} \alias{$.Seurat} \alias{$<-.Seurat} \alias{[.Seurat} \alias{[[.Seurat} \alias{dim.Seurat} \alias{dimnames.Seurat} \alias{head.Seurat} \alias{merge.Seurat} \alias{merge} \alias{MergeSeurat} \alias{AddSamples} \alias{names.Seurat} \alias{subset.Seurat} \alias{subset} \alias{tail.Seurat} \alias{[[<-,Seurat-method} \alias{colMeans,Seurat-method} \alias{colSums,Seurat-method} \alias{rowMeans,Seurat-method} \alias{rowSums,Seurat-method} \alias{show,Seurat-method} \title{Seurat Methods} \usage{ \method{.DollarNames}{Seurat}(x, pattern = "") \method{$}{Seurat}(x, i, ...) \method{$}{Seurat}(x, i, ...) <- value \method{[}{Seurat}(x, i, j, ...) \method{[[}{Seurat}(x, i, ..., drop = FALSE) \method{dim}{Seurat}(x) \method{dimnames}{Seurat}(x) \method{head}{Seurat}(x, n = 10L, ...) \method{merge}{Seurat}( x = NULL, y = NULL, add.cell.ids = NULL, merge.data = TRUE, merge.dr = NULL, project = "SeuratProject", ... ) \method{names}{Seurat}(x) \method{subset}{Seurat}( x, subset, cells = NULL, features = NULL, idents = NULL, return.null = FALSE, ... ) \method{tail}{Seurat}(x, n = 10L, ...) \S4method{[[}{Seurat}(x, i, j, ...) <- value \S4method{colMeans}{Seurat}(x, na.rm = FALSE, dims = 1, ..., slot = "data") \S4method{colSums}{Seurat}(x, na.rm = FALSE, dims = 1, ..., slot = "data") \S4method{rowMeans}{Seurat}(x, na.rm = FALSE, dims = 1, ..., slot = "data") \S4method{rowSums}{Seurat}(x, na.rm = FALSE, dims = 1, ..., slot = "data") \S4method{show}{Seurat}(object) } \arguments{ \item{x, object}{A \code{\link{Seurat}} object} \item{pattern}{ A regular expression. Only matching names are returned. } \item{i, features}{Depends on the method \describe{ \item{\code{[}, \code{subset}}{Feature names or indices} \item{\code{$}, \code{$<-}}{Name of a single metadata column} \item{\code{[[}, \code{[[<-}}{ Name of one or more metadata columns or an associated object; associated objects include \code{\link{Assay}}, \code{\link{DimReduc}}, \code{\link{Graph}}, \code{\link{SeuratCommand}}, or \code{\link{SpatialImage}} objects } }} \item{...}{Arguments passed to other methods} \item{value}{Additional metadata or associated objects to add; \strong{note}: can pass \code{NULL} to remove metadata or an associated object} \item{j, cells}{Cell names or indices} \item{drop}{See \code{\link[base]{drop}}} \item{n}{The number of rows of metadata to return} \item{y}{A single \code{Seurat} object or a list of \code{Seurat} objects} \item{add.cell.ids}{A character vector of \code{length(x = c(x, y))}; appends the corresponding values to the start of each objects' cell names} \item{merge.data}{Merge the data slots instead of just merging the counts (which requires renormalization); this is recommended if the same normalization approach was applied to all objects} \item{merge.dr}{Merge specified DimReducs that are present in all objects; will only merge the embeddings slots for the first \code{N} dimensions that are shared across all objects.} \item{project}{\link{Project} name for the \code{Seurat} object} \item{subset}{Logical expression indicating features/variables to keep} \item{idents}{A vector of identity classes to keep} \item{return.null}{If no cells are request, return a \code{NULL}; by default, throws an error} \item{na.rm}{logical. Should missing values (including \code{NaN}) be omitted from the calculations?} \item{dims}{completely ignored by the \code{Matrix} methods.} \item{slot}{Name of assay expression matrix to calculate column/row means/sums on} } \value{ \code{$}: metadata column \code{i} for object \code{x}; \strong{note}: unlike \code{[[}, \code{$} drops the shape of the metadata to return a vector instead of a data frame \code{$<-}: object \code{x} with metadata \code{value} saved as \code{i} \code{[}: object \code{x} with features \code{i} and cells \code{j} \code{[[}: If \code{i} is missing, the metadata data frame; if \code{i} is a vector of metadata names, a data frame with the requested metadata, otherwise, the requested associated object \code{dim}: The number of features (\code{nrow}) and cells (\code{ncol}) for the default assay; \strong{note}: while the number of features changes depending on the active assay, the number of cells remains the same across all assays \code{dimnames}: The feature (row) and cell (column) names; \strong{note}: while the features change depending on the active assay, the cell names remain the same across all assays \code{head}: The first \code{n} rows of cell-level metadata \code{merge}: Merged object \code{names}: The names of all \code{\link{Assay}}, \code{\link{DimReduc}}, \code{\link{Graph}}, and \code{\link{SpatialImage}} objects in the \code{Seurat} object \code{subset}: A subsetted \code{Seurat} object \code{tail}: The last \code{n} rows of cell-level metadata \code{[[<-}: \code{x} with the metadata or associated objects added as \code{i}; if \code{value} is \code{NULL}, removes metadata or associated object \code{i} from object \code{x} \code{show}: Prints summary to \code{\link[base]{stdout}} and invisibly returns \code{NULL} } \description{ Methods for \code{\link{Seurat}} objects for generics defined in other packages } \section{Functions}{ \itemize{ \item \code{.DollarNames.Seurat}: Autocompletion for \code{$} access on a \code{Seurat} object \item \code{$.Seurat}: Metadata access for \code{Seurat} objects \item \code{$<-.Seurat}: Metadata setter for \code{Seurat} objects \item \code{[.Seurat}: Simple subsetter for \code{Seurat} objects \item \code{[[.Seurat}: Metadata and associated object accessor \item \code{dim.Seurat}: Number of cells and features for the active assay \item \code{dimnames.Seurat}: The cell and feature names for the active assay \item \code{head.Seurat}: Get the first rows of cell-level metadata \item \code{merge.Seurat}: Merge two or more \code{Seurat} objects together \item \code{names.Seurat}: Common associated objects \item \code{subset.Seurat}: Subset a \code{\link{Seurat}} object \item \code{tail.Seurat}: Get the last rows of cell-level metadata \item \code{[[<-,Seurat-method}: Add cell-level metadata or associated objects \item \code{colMeans,Seurat-method}: Calculate \code{\link[base]{colMeans}} on a \code{Seurat} object \item \code{colSums,Seurat-method}: Calculate \code{\link[base]{colSums}} on a \code{Seurat} object \item \code{rowMeans,Seurat-method}: Calculate \code{\link[base]{rowMeans}} on a \code{rowMeans} object \item \code{rowSums,Seurat-method}: Calculate \code{\link[base]{rowSums}} on a \code{Seurat} object \item \code{show,Seurat-method}: Overview of a \code{Seurat} object }} \section{Merge Details}{ When merging Seurat objects, the merge procedure will merge the Assay level counts and potentially the data slots (depending on the merge.data parameter). It will also merge the cell-level meta data that was stored with each object and preserve the cell identities that were active in the objects pre-merge. The merge will optionally merge reductions depending on the values passed to \code{merge.dr} if they have the same name across objects. Here the embeddings slots will be merged and if there are differing numbers of dimensions across objects, only the first N shared dimensions will be merged. The feature loadings slots will be filled by the values present in the first object.The merge will not preserve graphs, logged commands, or feature-level metadata that were present in the original objects. If add.cell.ids isn't specified and any cell names are duplicated, cell names will be appended with _X, where X is the numeric index of the object in c(x, y). } \examples{ # Get metadata using `$' head(pbmc_small$groups) # Add metadata using the `$' operator set.seed(42) pbmc_small$value <- sample(1:3, size = ncol(pbmc_small), replace = TRUE) head(pbmc_small[["value"]]) # `[' examples pbmc_small[VariableFeatures(object = pbmc_small), ] pbmc_small[, 1:10] # Get the cell-level metadata data frame head(pbmc_small[[]]) # Pull specific metadata information head(pbmc_small[[c("letter.idents", "groups")]]) head(pbmc_small[["groups", drop = TRUE]]) # Get a sub-object (eg. an `Assay' or `DimReduc') pbmc_small[["RNA"]] pbmc_small[["pca"]] # Get the number of features in an object nrow(pbmc_small) # Get the number of cells in an object ncol(pbmc_small) # Get the feature names of an object rownames(pbmc_small) # Get the cell names of an object colnames(pbmc_small) # Get the first 10 rows of cell-level metadata head(pbmc_small) # `merge' examples # merge two objects merge(pbmc_small, y = pbmc_small) # to merge more than two objects, pass one to x and a list of objects to y merge(pbmc_small, y = c(pbmc_small, pbmc_small)) names(pbmc_small) # `subset' examples 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, features = VariableFeatures(object = pbmc_small)) # Get the last 10 rows of cell-level metadata tail(pbmc_small) head(colMeans(pbmc_small)) head(colSums(pbmc_small)) head(rowMeans(pbmc_small)) head(rowSums(pbmc_small)) } \seealso{ \code{\link[base]{subset}} \code{\link{WhichCells}} } \concept{seurat} SeuratObject/man/WhichCells.Rd0000644000175000017500000000354014133577537016106 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/assay.R, R/seurat.R \name{WhichCells} \alias{WhichCells} \alias{WhichCells.Assay} \alias{WhichCells.Seurat} \title{Identify cells matching certain criteria} \usage{ WhichCells(object, ...) \method{WhichCells}{Assay}(object, cells = NULL, expression, invert = FALSE, ...) \method{WhichCells}{Seurat}( object, cells = NULL, idents = NULL, expression, slot = "data", invert = FALSE, downsample = Inf, seed = 1, ... ) } \arguments{ \item{object}{An object} \item{...}{ Arguments passed on to \code{\link[=CellsByIdentities]{CellsByIdentities}} \describe{ \item{\code{return.null}}{If no cells are request, return a \code{NULL}; by default, throws an error} }} \item{cells}{Subset of cell names} \item{expression}{A predicate expression for feature/variable expression, can evaluate anything that can be pulled by \code{FetchData}; please note, you may need to wrap feature names in backticks (\code{``}) if dashes between numbers are present in the feature name} \item{invert}{Invert the selection of cells} \item{idents}{A vector of identity classes to keep} \item{slot}{Slot to pull feature data for} \item{downsample}{Maximum number of cells per identity class, default is \code{Inf}; downsampling will happen after all other operations, including inverting the cell selection} \item{seed}{Random seed for downsampling. If NULL, does not set a seed} } \value{ A vector of cell names } \description{ Returns a list of cells that match a particular set of criteria such as identity class, high/low values for particular PCs, etc. } \examples{ WhichCells(pbmc_small, idents = 2) WhichCells(pbmc_small, expression = MS4A1 > 3) levels(pbmc_small) WhichCells(pbmc_small, idents = c(1, 2), invert = TRUE) } \seealso{ \code{\link{FetchData}} } \concept{data-access} SeuratObject/man/Seurat-class.Rd0000644000175000017500000000370414133577537016431 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/seurat.R \docType{class} \name{Seurat-class} \alias{Seurat-class} \alias{Seurat} \title{The Seurat Class} \description{ The Seurat object is a representation of single-cell expression data for R; each Seurat object revolves around a set of cells and consists of one or more \code{\link{Assay}} objects, or individual representations of expression data (eg. RNA-seq, ATAC-seq, etc). These assays can be reduced from their high-dimensional state to a lower-dimension state and stored as \code{\link{DimReduc}} objects. Seurat objects also store additional metadata, both at the cell and feature level (contained within individual assays). The object was designed to be as self-contained as possible, and easily extendable to new methods. } \section{Slots}{ \describe{ \item{\code{assays}}{A list of assays for this project} \item{\code{meta.data}}{Contains meta-information about each cell, starting with number of features detected (nFeature) and the original identity class (orig.ident); more information is added using \code{\link{AddMetaData}}} \item{\code{active.assay}}{Name of the active, or default, assay; settable using \code{\link{DefaultAssay}}} \item{\code{active.ident}}{The active cluster identity for this Seurat object; settable using \code{\link{Idents}}} \item{\code{graphs}}{A list of \code{\link{Graph}} objects} \item{\code{neighbors}}{...} \item{\code{reductions}}{A list of dimensional reduction objects for this object} \item{\code{images}}{A list of spatial image objects} \item{\code{project.name}}{Name of the project} \item{\code{misc}}{A list of miscellaneous information} \item{\code{version}}{Version of Seurat this object was built under} \item{\code{commands}}{A list of logged commands run on this \code{Seurat} object} \item{\code{tools}}{A list of miscellaneous data generated by other tools, should be filled by developers only using \code{\link{Tool}<-}} }} SeuratObject/man/LogSeuratCommand.Rd0000644000175000017500000000116114133577537017262 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/command.R \name{LogSeuratCommand} \alias{LogSeuratCommand} \title{Log a command} \usage{ LogSeuratCommand(object, return.command = FALSE) } \arguments{ \item{object}{Name of Seurat object} \item{return.command}{Return a \link{SeuratCommand} object instead} } \value{ If \code{return.command}, returns a SeuratCommand object. Otherwise, returns the Seurat object with command stored } \description{ Logs command run, storing the name, timestamp, and argument list. Stores in the Seurat object } \seealso{ \code{\link{Command}} } \concept{command} SeuratObject/man/CheckDots.Rd0000644000175000017500000000246414143043627015721 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{CheckDots} \alias{CheckDots} \title{Check the Use of Dots} \usage{ CheckDots(..., fxns = NULL) } \arguments{ \item{...}{Arguments passed to a function that fall under \code{...}} \item{fxns}{A list/vector of functions or function names} } \value{ Emits either an error or warning if an argument passed is unused; invisibly returns \code{NULL} } \description{ Function to check the use of unused arguments passed to \code{...}; this function is designed to be called from another function to see if an argument passed to \code{...} remains unused and alert the user if so. Also accepts a vector of function or function names to see if \code{...} can be used in a downstream function } \details{ Behavior of \code{CheckDots} can be controlled by the following option(s): \describe{ \item{\dQuote{\code{Seurat.checkdots}}}{Control how to alert the presence of unused arguments in \code{...}; choose from \itemize{ \item \dQuote{\code{warn}}: emit a warning (default) \item \dQuote{\code{error}}: throw an error \item \dQuote{\code{silent}}: no not alert the presence of unused arguments in \code{...} } } } } \examples{ \dontrun{ f <- function(x, ...) { CheckDots(...) return(x ^ 2) } f(x = 3, y = 9) } } \keyword{internal} SeuratObject/man/CreateAssayObject.Rd0000644000175000017500000000250514147216431017400 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assay.R \name{CreateAssayObject} \alias{CreateAssayObject} \title{Create an Assay object} \usage{ CreateAssayObject( counts, data, min.cells = 0, min.features = 0, check.matrix = FALSE, ... ) } \arguments{ \item{counts}{Unnormalized data such as raw counts or TPMs} \item{data}{Prenormalized data; if provided, do not pass \code{counts}} \item{min.cells}{Include features detected in at least this many cells. Will subset the counts matrix as well. To reintroduce excluded features, create a new object with a lower cutoff.} \item{min.features}{Include cells where at least this many features are detected.} \item{check.matrix}{Check counts matrix for NA, NaN, Inf, and non-integer values} \item{...}{Arguments passed to \code{\link{as.sparse}}} } \value{ A \code{\link{Assay}} object } \description{ Create an Assay object from a feature (e.g. gene) expression matrix. The expected format of the input matrix is features x cells. } \details{ Non-unique cell or feature names are not allowed. Please make unique before calling this function. } \examples{ \dontrun{ pbmc_raw <- read.table( file = system.file('extdata', 'pbmc_raw.txt', package = 'Seurat'), as.is = TRUE ) pbmc_rna <- CreateAssayObject(counts = pbmc_raw) pbmc_rna } } \concept{assay} SeuratObject/man/CreateDimReducObject.Rd0000644000175000017500000000265614133577537020037 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dimreduc.R \name{CreateDimReducObject} \alias{CreateDimReducObject} \alias{SetDimReduction} \title{Create a DimReduc object} \usage{ CreateDimReducObject( embeddings = new(Class = "matrix"), loadings = new(Class = "matrix"), projected = new(Class = "matrix"), assay = NULL, stdev = numeric(), key = NULL, global = FALSE, jackstraw = NULL, misc = list() ) } \arguments{ \item{embeddings}{A matrix with the cell embeddings} \item{loadings}{A matrix with the feature loadings} \item{projected}{A matrix with the projected feature loadings} \item{assay}{Assay used to calculate this dimensional reduction} \item{stdev}{Standard deviation (if applicable) for the dimensional reduction} \item{key}{A character string to facilitate looking up features from a specific DimReduc} \item{global}{Specify this as a global reduction (useful for visualizations)} \item{jackstraw}{Results from the JackStraw function} \item{misc}{list for the user to store any additional information associated with the dimensional reduction} } \value{ A \code{\link{DimReduc}} object } \description{ Create a DimReduc object } \examples{ data <- GetAssayData(pbmc_small[["RNA"]], slot = "scale.data") pcs <- prcomp(x = data) pca.dr <- CreateDimReducObject( embeddings = pcs$rotation, loadings = pcs$x, stdev = pcs$sdev, key = "PC", assay = "RNA" ) } \concept{dimreduc} SeuratObject/man/Radius.Rd0000644000175000017500000000051114133577537015303 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R \name{Radius} \alias{Radius} \title{Get the spot radius from an image} \usage{ Radius(object) } \arguments{ \item{object}{An image object} } \value{ The radius size } \description{ Get the spot radius from an image } \concept{spatialimage} SeuratObject/man/VariableFeatures.Rd0000644000175000017500000000657014145250210017266 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/seurat.R, R/assay.R \name{HVFInfo} \alias{HVFInfo} \alias{VariableFeatures} \alias{VariableFeatures<-} \alias{SVFInfo} \alias{SpatiallyVariableFeatures} \alias{HVFInfo.Seurat} \alias{VariableFeatures.Seurat} \alias{VariableFeatures<-.Seurat} \alias{SVFInfo.Seurat} \alias{SpatiallyVariableFeatures.Seurat} \alias{HVFInfo.Assay} \alias{SpatiallyVariableFeatures.Assay} \alias{SVFInfo.Assay} \alias{VariableFeatures.Assay} \alias{VariableFeatures<-.Assay} \title{Highly Variable Features} \usage{ HVFInfo(object, selection.method, status = FALSE, ...) VariableFeatures(object, selection.method = NULL, ...) VariableFeatures(object, ...) <- value SVFInfo(object, selection.method, status, ...) SpatiallyVariableFeatures(object, selection.method, ...) \method{HVFInfo}{Seurat}(object, selection.method = NULL, status = FALSE, assay = NULL, ...) \method{VariableFeatures}{Seurat}(object, selection.method = NULL, assay = NULL, ...) \method{VariableFeatures}{Seurat}(object, assay = NULL, ...) <- value \method{SVFInfo}{Seurat}( object, selection.method = c("markvariogram", "moransi"), status = FALSE, assay = NULL, ... ) \method{SpatiallyVariableFeatures}{Seurat}( object, selection.method = "markvariogram", assay = NULL, decreasing = TRUE, ... ) \method{HVFInfo}{Assay}(object, selection.method, status = FALSE, ...) \method{SpatiallyVariableFeatures}{Assay}( object, selection.method = "markvariogram", decreasing = TRUE, ... ) \method{SVFInfo}{Assay}( object, selection.method = c("markvariogram", "moransi"), status = FALSE, ... ) \method{VariableFeatures}{Assay}(object, selection.method = NULL, ...) \method{VariableFeatures}{Assay}(object, ...) <- value } \arguments{ \item{object}{An object} \item{selection.method}{Which method to pull. For \code{HVFInfo} and \code{VariableFeatures}, choose one from one of the following: \itemize{ \item \dQuote{vst} \item \dQuote{sctransform} or \dQuote{sct} \item \dQuote{mean.var.plot}, \dQuote{dispersion}, \dQuote{mvp}, or \dQuote{disp} } For \code{SVFInfo} and \code{SpatiallyVariableFeatures}, choose from: \itemize{ \item \dQuote{markvariogram} \item \dQuote{moransi} }} \item{status}{Add variable status to the resulting data frame} \item{...}{Arguments passed to other methods} \item{value}{A character vector of variable features} \item{assay}{Name of assay to pull highly variable feature information for} \item{decreasing}{Return features in decreasing order (most spatially variable first).} } \value{ \code{HVFInfo}: A data frame with feature means, dispersion, and scaled dispersion \code{VariableFeatures}: a vector of the variable features \code{SVFInfo}: a data frame with the spatially variable features \code{SpatiallyVariableFeatures}: a character vector of the spatially variable features } \description{ Get and set variable feature information for an \code{\link{Assay}} object. \code{HVFInfo} and \code{VariableFeatures} utilize generally variable features, while \code{SVFInfo} and \code{SpatiallyVariableFeatures} are restricted to spatially variable features } \examples{ # Get the HVF info from a specific Assay in a Seurat object HVFInfo(object = pbmc_small, assay = "RNA")[1:5, ] # Get the HVF info directly from an Assay object HVFInfo(pbmc_small[["RNA"]], selection.method = 'vst')[1:5, ] } \concept{data-access} SeuratObject/man/SpatialImage-class.Rd0000644000175000017500000000137414133577537017527 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/spatial.R \docType{class} \name{SpatialImage-class} \alias{SpatialImage-class} \alias{SpatialImage} \title{The SpatialImage class} \description{ The \code{SpatialImage} class is a virtual class representing spatial information for Seurat. All spatial image information must inherit from this class for use with \code{Seurat} objects } \section{Slots}{ \describe{ \item{\code{assay}}{Name of assay to associate image data with; will give this image priority for visualization when the assay is set as the active/default assay in a \code{Seurat} object} \item{\code{key}}{Key for the image} }} \seealso{ \code{\link{SpatialImage-methods}} for a list of required and provided methods } SeuratObject/man/RandomName.Rd0000644000175000017500000000116214143043627016065 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{RandomName} \alias{RandomName} \title{Generate a random name} \usage{ RandomName(length = 5L, ...) } \arguments{ \item{length}{How long should the name be} \item{...}{Extra parameters passed to \code{\link[base]{sample}}} } \value{ A character with \code{nchar == length} of randomly sampled letters } \description{ Make a name from randomly sampled lowercase letters, pasted together with no spaces or other characters } \examples{ set.seed(42L) RandomName() RandomName(7L, replace = TRUE) } \seealso{ \code{\link[base]{sample}} } SeuratObject/man/as.Graph.Rd0000644000175000017500000000224414133577537015524 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/graph.R \name{as.Graph} \alias{as.Graph} \alias{as.Graph.Matrix} \alias{as.Graph.matrix} \alias{as.Graph.Neighbor} \title{Coerce to a \code{Graph} Object} \usage{ as.Graph(x, ...) \method{as.Graph}{Matrix}(x, ...) \method{as.Graph}{matrix}(x, ...) \method{as.Graph}{Neighbor}(x, weighted = TRUE, ...) } \arguments{ \item{x}{The matrix to convert} \item{...}{Arguments passed to other methods (ignored for now)} \item{weighted}{If TRUE, fill entries in Graph matrix with value from the nn.dist slot of the Neighbor object} } \value{ A \code{\link{Graph}} object } \description{ Convert a \code{\link[base]{matrix}} (or \code{\link[Matrix]{Matrix}}) to a \code{\link{Graph}} object } \examples{ # converting sparse matrix mat <- Matrix::rsparsematrix(nrow = 10, ncol = 10, density = 0.1) rownames(x = mat) <- paste0("feature_", 1:10) colnames(x = mat) <- paste0("cell_", 1:10) g <- as.Graph(x = mat) # converting dense matrix mat <- matrix(data = 1:16, nrow = 4) rownames(x = mat) <- paste0("feature_", 1:4) colnames(x = mat) <- paste0("cell_", 1:4) g <- as.Graph(x = mat) } \concept{graph} SeuratObject/man/GetTissueCoordinates.Rd0000644000175000017500000000123114133577537020163 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/seurat.R \name{GetTissueCoordinates} \alias{GetTissueCoordinates} \alias{GetTissueCoordinates.Seurat} \title{Get tissue coordinates} \usage{ GetTissueCoordinates(object, ...) \method{GetTissueCoordinates}{Seurat}(object, image = NULL, ...) } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} \item{image}{Name of \code{SpatialImage} object to get coordinates for; if \code{NULL}, will attempt to select an image automatically} } \value{ A data frame with tissue coordinates } \description{ Get tissue coordinates } \concept{data-access} SeuratObject/man/RenameCells.Rd0000644000175000017500000000373214133577537016256 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/assay.R, R/dimreduc.R, % R/neighbor.R, R/seurat.R \name{RenameCells} \alias{RenameCells} \alias{RenameCells.Assay} \alias{RenameCells.DimReduc} \alias{RenameCells.Neighbor} \alias{RenameCells.Seurat} \title{Rename cells} \usage{ RenameCells(object, ...) \method{RenameCells}{Assay}(object, new.names = NULL, ...) \method{RenameCells}{DimReduc}(object, new.names = NULL, ...) \method{RenameCells}{Neighbor}(object, old.names = NULL, new.names = NULL, ...) \method{RenameCells}{Seurat}( object, add.cell.id = NULL, new.names = NULL, for.merge = FALSE, ... ) } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} \item{new.names}{vector of new cell names} \item{old.names}{vector of old cell names} \item{add.cell.id}{prefix to add cell names} \item{for.merge}{Only rename slots needed for merging Seurat objects. Currently only renames the raw.data and meta.data slots.} } \value{ An object with new cell names } \description{ Change the cell names in all the different parts of an object. Can be useful before combining multiple objects. } \details{ If \code{add.cell.id} is set a prefix is added to existing cell names. If \code{new.names} is set these will be used to replace existing names. } \examples{ # Rename cells in an Assay head(x = colnames(x = pbmc_small[["RNA"]])) renamed.assay <- RenameCells( pbmc_small[["RNA"]], new.names = paste0("A_", colnames(x = pbmc_small[["RNA"]])) ) head(x = colnames(x = renamed.assay)) # Rename cells in a DimReduc head(x = Cells(x = pbmc_small[["pca"]])) renamed.dimreduc <- RenameCells( object = pbmc_small[["pca"]], new.names = paste0("A_", Cells(x = pbmc_small[["pca"]])) ) head(x = Cells(x = renamed.dimreduc)) # Rename cells in a Seurat object head(x = colnames(x = pbmc_small)) pbmc_small <- RenameCells(object = pbmc_small, add.cell.id = "A") head(x = colnames(x = pbmc_small)) } \concept{seurat} SeuratObject/man/Version.Rd0000644000175000017500000000066714133577537015515 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/seurat.R \name{Version} \alias{Version} \alias{Version.Seurat} \title{Get Version Information} \usage{ Version(object, ...) \method{Version}{Seurat}(object, ...) } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} } \description{ Get Version Information } \examples{ Version(pbmc_small) } \concept{data-access} SeuratObject/man/DimReduc-class.Rd0000644000175000017500000000240614133577537016660 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dimreduc.R \docType{class} \name{DimReduc-class} \alias{DimReduc-class} \alias{DimReduc} \title{The Dimensional Reduction Class} \description{ The DimReduc object stores a dimensionality reduction taken out in Seurat; each DimReduc consists of a cell embeddings matrix, a feature loadings matrix, and a projected feature loadings matrix. } \section{Slots}{ \describe{ \item{\code{cell.embeddings}}{Cell embeddings matrix (required)} \item{\code{feature.loadings}}{Feature loadings matrix (optional)} \item{\code{feature.loadings.projected}}{Projected feature loadings matrix (optional)} \item{\code{assay.used}}{Name of assay used to generate \code{DimReduc} object} \item{\code{global}}{Is this \code{DimReduc} global/persistent? If so, it will not be removed when removing its associated assay} \item{\code{stdev}}{A vector of standard deviations} \item{\code{key}}{Key for the \code{DimReduc}, must be alphanumeric characters followed by an underscore} \item{\code{jackstraw}}{A \code{\link{JackStrawData-class}} object associated with this \code{DimReduc}} \item{\code{misc}}{Utility slot for storing additional data associated with the \code{DimReduc} (e.g. the total variance of the PCA)} }} SeuratObject/man/AssayData.Rd0000644000175000017500000000433214145250210015706 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/seurat.R, R/assay.R \name{AssayData} \alias{AssayData} \alias{GetAssayData} \alias{SetAssayData} \alias{GetAssayData.Seurat} \alias{SetAssayData.Seurat} \alias{GetAssayData.Assay} \alias{SetAssayData.Assay} \title{Get and Set Assay Data} \usage{ GetAssayData(object, slot, ...) SetAssayData(object, slot, new.data, ...) \method{GetAssayData}{Seurat}(object, slot = "data", assay = NULL, ...) \method{SetAssayData}{Seurat}(object, slot = "data", new.data, assay = NULL, ...) \method{GetAssayData}{Assay}(object, slot = c("data", "scale.data", "counts"), ...) \method{SetAssayData}{Assay}(object, slot = c("data", "scale.data", "counts"), new.data, ...) } \arguments{ \item{object}{An object} \item{slot}{Specific assay data to get or set} \item{...}{Arguments passed to other methods} \item{new.data}{New assay data to add} \item{assay}{Specific assay to get data from or set data for; defaults to the \link[SeuratObject:DefaultAssay]{default assay}} } \value{ \code{GetAssayData}: returns the specified assay data \code{SetAssayData}: \code{object} with the assay data set } \description{ General accessor and setter functions for \code{\link{Assay}} objects. \code{GetAssayData} can be used to pull information from any of the expression matrices (eg. \dQuote{counts}, \dQuote{data}, or \dQuote{scale.data}). \code{SetAssayData} can be used to replace one of these expression matrices } \examples{ # Get assay data from the default assay in a Seurat object GetAssayData(object = pbmc_small, slot = "data")[1:5,1:5] # Set an Assay slot through the Seurat object count.data <- GetAssayData(object = pbmc_small[["RNA"]], slot = "counts") count.data <- as.matrix(x = count.data + 1) new.seurat.object <- SetAssayData( object = pbmc_small, slot = "counts", new.data = count.data, assay = "RNA" ) # Get the data directly from an Assay object GetAssayData(pbmc_small[["RNA"]], slot = "data")[1:5,1:5] # Set an Assay slot directly count.data <- GetAssayData(pbmc_small[["RNA"]], slot = "counts") count.data <- as.matrix(x = count.data + 1) new.assay <- SetAssayData(pbmc_small[["RNA"]], slot = "counts", new.data = count.data) } \concept{data-access} SeuratObject/man/DimReduc-methods.Rd0000644000175000017500000000630214133577537017215 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/dimreduc.R \name{DimReduc-methods} \alias{DimReduc-methods} \alias{[.DimReduc} \alias{[[.DimReduc} \alias{dim.DimReduc} \alias{dimnames.DimReduc} \alias{length.DimReduc} \alias{merge.DimReduc} \alias{names.DimReduc} \alias{print.DimReduc} \alias{print} \alias{subset.DimReduc} \alias{show,DimReduc-method} \title{\code{DimReduc} Methods} \usage{ \method{[}{DimReduc}(x, i, j, drop = FALSE, ...) \method{[[}{DimReduc}(x, i, j, drop = FALSE, ...) \method{dim}{DimReduc}(x) \method{dimnames}{DimReduc}(x) \method{length}{DimReduc}(x) \method{merge}{DimReduc}(x = NULL, y = NULL, add.cell.ids = NULL, ...) \method{names}{DimReduc}(x) \method{print}{DimReduc}(x, dims = 1:5, nfeatures = 20, projected = FALSE, ...) \method{subset}{DimReduc}(x, cells = NULL, features = NULL, ...) \S4method{show}{DimReduc}(object) } \arguments{ \item{x, object}{A \code{\link{DimReduc}} object} \item{i}{For \code{[}: feature names or indices; for \code{[[}: cell names or indices} \item{j}{Dimensions to pull for} \item{drop}{See \code{\link[base]{drop}}} \item{...}{Arguments passed to other methods} \item{y}{A vector or list of one or more objects to merge} \item{add.cell.ids}{A character vector of \code{length(x = c(x, y))}; appends the corresponding values to the start of each objects' cell names} \item{dims}{Number of dimensions to display} \item{nfeatures}{Number of genes to display} \item{projected}{Use projected slot} \item{cells, features}{Cells and features to keep during the subset} } \value{ \code{[}: Feature loadings for features \code{i} and dimensions \code{j} \code{[[}: Cell embeddings for cells \code{i} and dimensions \code{j} \code{dim}: The number of cells (\code{nrow}) and dimensions (\code{ncol}) \code{dimnames}: The cell (row) and dimension (column) names \code{length}: The number of dimensions \code{names}: The names for the dimensions (eg. \dQuote{PC_1}) \code{print}: Displays set of features defining the components and invisibly returns \code{x} \code{subset}: \code{x} for cells \code{cells} and features \code{features} \code{show}: Prints summary to \code{\link[base]{stdout}} and invisibly returns \code{NULL} } \description{ Methods for \code{\link{DimReduc}} objects for generics defined in other packages } \section{Functions}{ \itemize{ \item \code{[.DimReduc}: Pull feature loadings \item \code{[[.DimReduc}: Pull cell embeddings \item \code{dim.DimReduc}: The number of cells and dimensions for a \code{DimReduc} \item \code{dimnames.DimReduc}: The cell and dimension names for a \code{DimReduc} object \item \code{length.DimReduc}: The number of dimensions for a \code{DimReduc} object \item \code{merge.DimReduc}: Merge two or more \code{DimReduc} objects together \item \code{names.DimReduc}: The dimension names for a \code{DimReduc} object \item \code{print.DimReduc}: Prints a set of features that most strongly define a set of components; \strong{note}: requires feature loadings to be present in order to work \item \code{subset.DimReduc}: Subset a \code{DimReduc} object \item \code{show,DimReduc-method}: Show basic summary of a \code{DimReduc} object }} \seealso{ \code{\link[base]{cat}} } \concept{dimreduc} SeuratObject/man/as.Seurat.Rd0000644000175000017500000000066714133577537015735 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R \name{as.Seurat} \alias{as.Seurat} \title{Coerce to a \code{Seurat} Object} \usage{ as.Seurat(x, ...) } \arguments{ \item{x}{An object to convert to class \code{Seurat}} \item{...}{Arguments passed to other methods} } \value{ A \code{\link{Seurat}} object generated from \code{x} } \description{ Convert objects to Seurat objects } \concept{seurat} SeuratObject/man/PackageCheck.Rd0000644000175000017500000000076214143043627016342 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{PackageCheck} \alias{PackageCheck} \title{Check the existence of a package} \usage{ PackageCheck(..., error = TRUE) } \arguments{ \item{...}{Package names} \item{error}{If true, throw an error if the package doesn't exist} } \value{ Invisibly returns boolean denoting if the package is installed } \description{ Check the existence of a package } \examples{ PackageCheck("SeuratObject", error = FALSE) } SeuratObject/man/JackStrawData-methods.Rd0000644000175000017500000000272714133577537020213 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/jackstraw.R \name{JackStrawData-methods} \alias{JackStrawData-methods} \alias{.DollarNames.JackStrawData} \alias{$.JackStrawData} \alias{as.logical.JackStrawData} \alias{show,JackStrawData-method} \title{\code{JackStrawData} Methods} \usage{ \method{.DollarNames}{JackStrawData}(x, pattern = "") \method{$}{JackStrawData}(x, i, ...) \method{as.logical}{JackStrawData}(x, ...) \S4method{show}{JackStrawData}(object) } \arguments{ \item{x, object}{A \code{\link{JackStrawData}} object} \item{pattern}{ A regular expression. Only matching names are returned. } \item{i}{A \code{JackStrawData} slot name} \item{...}{Ignored} } \value{ \code{$}: Slot \code{i} from \code{x} \code{as.logical}: \code{TRUE} if empirical p-values have been calculated otherwise \code{FALSE} \code{show}: Prints summary to \code{\link[base]{stdout}} and invisibly returns \code{NULL} } \description{ Methods for \code{\link{JackStrawData}} objects for generics defined in other packages } \section{Functions}{ \itemize{ \item \code{.DollarNames.JackStrawData}: Autocompletion for \code{$} access on a \code{JackStrawData} object \item \code{$.JackStrawData}: Access data from a \code{JackStrawData} object \item \code{as.logical.JackStrawData}: Have empirical p-values for a \code{JackStrawData} object been calculated \item \code{show,JackStrawData-method}: Overview of a \code{JackStrawData} object }} \concept{jackstraw} SeuratObject/man/SeuratObject-package.Rd0000644000175000017500000000372514147220062020030 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/zzz.R \docType{package} \name{SeuratObject-package} \alias{SeuratObject} \alias{SeuratObject-package} \title{SeuratObject: Data Structures for Single Cell Data} \description{ Defines S4 classes for single-cell genomic data and associated information, such as dimensionality reduction embeddings, nearest-neighbor graphs, and spatially-resolved coordinates. Provides data access methods and R-native hooks to ensure the Seurat object is familiar to other R users. See Satija R, Farrell J, Gennert D, et al (2015) , Macosko E, Basu A, Satija R, et al (2015) , and Stuart T, Butler A, et al (2019) for more details. } \seealso{ Useful links: \itemize{ \item \url{https://mojaveazure.github.io/seurat-object/} \item \url{https://github.com/mojaveazure/seurat-object} \item Report bugs at \url{https://github.com/mojaveazure/seurat-object/issues} } } \author{ \strong{Maintainer}: Paul Hoffman \email{seurat@nygenome.org} (\href{https://orcid.org/0000-0002-7693-8957}{ORCID}) Authors: \itemize{ \item Rahul Satija \email{rsatija@nygenome.org} (\href{https://orcid.org/0000-0001-9448-8833}{ORCID}) \item Andrew Butler \email{abutler@nygenome.org} (\href{https://orcid.org/0000-0003-3608-0463}{ORCID}) \item Tim Stuart \email{tstuart@nygenome.org} (\href{https://orcid.org/0000-0002-3044-0897}{ORCID}) } Other contributors: \itemize{ \item Jeff Farrell \email{jfarrell@g.harvard.edu} [contributor] \item Shiwei Zheng \email{szheng@nygenome.org} (\href{https://orcid.org/0000-0001-6682-6743}{ORCID}) [contributor] \item Christoph Hafemeister \email{chafemeister@nygenome.org} (\href{https://orcid.org/0000-0001-6365-8254}{ORCID}) [contributor] \item Patrick Roelli \email{proelli@nygenome.org} [contributor] \item Yuhan Hao \email{yhao@nygenome.org} (\href{https://orcid.org/0000-0002-1810-0822}{ORCID}) [contributor] } } SeuratObject/man/as.sparse.Rd0000644000175000017500000000131114133577537015752 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{as.sparse} \alias{as.sparse} \alias{as.sparse.data.frame} \alias{as.sparse.Matrix} \alias{as.sparse.matrix} \title{Cast to Sparse} \usage{ as.sparse(x, ...) \method{as.sparse}{data.frame}(x, row.names = NULL, ...) \method{as.sparse}{Matrix}(x, ...) \method{as.sparse}{matrix}(x, ...) } \arguments{ \item{x}{An object} \item{...}{Arguments passed to other methods} \item{row.names}{\code{NULL} or a character vector giving the row names for the data; missing values are not allowed} } \value{ A sparse representation of the input data } \description{ Convert dense objects to sparse representations } \concept{utils} SeuratObject/man/Stdev.Rd0000644000175000017500000000150114133577537015141 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/dimreduc.R, R/seurat.R \name{Stdev} \alias{Stdev} \alias{Stdev.DimReduc} \alias{Stdev.Seurat} \title{Get the standard deviations for an object} \usage{ Stdev(object, ...) \method{Stdev}{DimReduc}(object, ...) \method{Stdev}{Seurat}(object, reduction = "pca", ...) } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} \item{reduction}{Name of reduction to use} } \value{ The standard deviations } \description{ Get the standard deviations for an object } \examples{ # Get the standard deviations for each PC from the DimReduc object Stdev(object = pbmc_small[["pca"]]) # Get the standard deviations for each PC from the Seurat object Stdev(object = pbmc_small, reduction = "pca") } \concept{data-access} SeuratObject/man/Assay-methods.Rd0000644000175000017500000001133714146000252016560 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assay.R \name{Assay-methods} \alias{Assay-methods} \alias{[.Assay} \alias{[[.Assay} \alias{dim.Assay} \alias{dimnames.Assay} \alias{head.Assay} \alias{merge.Assay} \alias{subset.Assay} \alias{tail.Assay} \alias{[[<-,Assay-method} \alias{colMeans,Assay-method} \alias{colSums,Assay-method} \alias{rowMeans,Assay-method} \alias{rowSums,Assay-method} \alias{show,Assay-method} \title{\code{Assay} Methods} \usage{ \method{[}{Assay}(x, i, j, ...) \method{[[}{Assay}(x, i, ..., drop = FALSE) \method{dim}{Assay}(x) \method{dimnames}{Assay}(x) \method{head}{Assay}(x, n = 10L, ...) \method{merge}{Assay}(x = NULL, y = NULL, add.cell.ids = NULL, merge.data = TRUE, ...) \method{subset}{Assay}(x, cells = NULL, features = NULL, ...) \method{tail}{Assay}(x, n = 10L, ...) \S4method{[[}{Assay}(x, i, j, ...) <- value \S4method{colMeans}{Assay}(x, na.rm = FALSE, dims = 1, ..., slot = "data") \S4method{colSums}{Assay}(x, na.rm = FALSE, dims = 1, ..., slot = "data") \S4method{rowMeans}{Assay}(x, na.rm = FALSE, dims = 1, ..., slot = "data") \S4method{rowSums}{Assay}(x, na.rm = FALSE, dims = 1, ..., slot = "data") \S4method{show}{Assay}(object) } \arguments{ \item{x, object}{An \code{\link{Assay}} object} \item{i, features}{For \code{[[}: metadata names; for all other methods, feature names or indices} \item{j, cells}{Cell names or indices} \item{...}{Arguments passed to other methods} \item{drop}{See \code{\link[base]{drop}}} \item{n}{an integer vector of length up to \code{dim(x)} (or 1, for non-dimensioned objects). Values specify the indices to be selected in the corresponding dimension (or along the length) of the object. A positive value of \code{n[i]} includes the first/last \code{n[i]} indices in that dimension, while a negative value excludes the last/first \code{abs(n[i])}, including all remaining indices. \code{NA} or non-specified values (when \code{length(n) < length(dim(x))}) select all indices in that dimension. Must contain at least one non-missing value.} \item{y}{A vector or list of one or more objects to merge} \item{add.cell.ids}{A character vector of \code{length(x = c(x, y))}; appends the corresponding values to the start of each objects' cell names} \item{merge.data}{Merge the data slots instead of just merging the counts (which requires renormalization); this is recommended if the same normalization approach was applied to all objects} \item{value}{Additional metadata to add} \item{na.rm}{logical. Should missing values (including \code{NaN}) be omitted from the calculations?} \item{dims}{completely ignored by the \code{Matrix} methods.} \item{slot}{Name of assay expression matrix to calculate column/row means/sums on} } \value{ \code{[}: The \code{data} slot for features \code{i} and cells \code{j} \code{[[}: The feature-level metadata for \code{i} \code{dim}: The number of features (\code{nrow}) and cells (\code{ncol}) \code{dimnames}: Feature (row) and cell (column) names \code{head}: The first \code{n} rows of feature-level metadata \code{merge}: Merged object \code{subset}: A subsetted \code{Assay} \code{tail}: The last \code{n} rows of feature-level metadata \code{[[<-}: \code{x} with metadata \code{value} added as \code{i} \code{colMeans}: The column (cell-wise) means of \code{slot} \code{colSums}: The column (cell-wise) sums of \code{slot} \code{rowMeans}: The row (feature-wise) means of \code{slot} \code{rowSums}: The row (feature-wise) sums of \code{slot} \code{show}: Prints summary to \code{\link[base]{stdout}} and invisibly returns \code{NULL} } \description{ Methods for \code{\link{Assay}} objects for generics defined in other packages } \section{Functions}{ \itemize{ \item \code{[.Assay}: Get expression data from an \code{Assay} \item \code{[[.Assay}: Get feature-level metadata \item \code{dim.Assay}: Number of cells and features for an \code{Assay} \item \code{dimnames.Assay}: Cell- and feature-names for an \code{Assay} \item \code{head.Assay}: Get the first rows of feature-level metadata \item \code{merge.Assay}: Merge \code{Assay} objects \item \code{subset.Assay}: Subset an \code{Assay} \item \code{tail.Assay}: Get the last rows of feature-level metadata \item \code{[[<-,Assay-method}: Add feature-level metadata \item \code{colMeans,Assay-method}: Calculate \code{\link[base]{colMeans}} on an \code{Assay} \item \code{colSums,Assay-method}: Calculate \code{\link[base]{colSums}} on an \code{Assay} \item \code{rowMeans,Assay-method}: Calculate \code{\link[base]{rowMeans}} on an \code{Assay} \item \code{rowSums,Assay-method}: Calculate \code{\link[base]{rowSums}} on an \code{Assay} \item \code{show,Assay-method}: Overview of an \code{Assay} object }} \concept{assay} SeuratObject/man/s4list.Rd0000644000175000017500000000267614133577537015314 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{s4list} \alias{s4list} \alias{S4ToList} \alias{IsS4List} \alias{ListToS4} \alias{S4ToList.default} \alias{S4ToList.list} \title{S4/List Conversion} \usage{ S4ToList(object) IsS4List(x) ListToS4(x) \method{S4ToList}{default}(object) \method{S4ToList}{list}(object) } \arguments{ \item{object}{An S4 object} \item{x}{A list with an S4 class definition attribute} } \value{ \code{S4ToList}: A list with an S4 class definition attribute \code{IsS4List}: \code{TRUE} if \code{x} is a list with an S4 class definition attribute \code{ListToS4}: An S4 object as defined by the S4 class definition attribute } \description{ Convert S4 objects to lists and vice versa. Useful for declassing an S4 object while keeping track of it's class using attributes (see section \strong{S4 Class Definition Attributes} below for more details). Both \code{ListToS4} and \code{S4ToList} are recursive functions, affecting all lists/S4 objects contained as sub-lists/sub-objects. } \section{S4 Class Definition Attributes}{ S4 classes are scoped to the package and class name. In order to properly track which class a list is generated from in order to build a new one, these function use an \code{\link[base:attr]{attribute}} to denote the class name and package of origin. This attribute is stored as \dQuote{classDef} and takes the form of \dQuote{\code{package:class}}. } \concept{utils} SeuratObject/man/IsGlobal.Rd0000644000175000017500000000163214133577537015555 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/default.R, R/dimreduc.R \name{IsGlobal} \alias{IsGlobal} \alias{IsGlobal.default} \alias{IsGlobal.DimReduc} \title{Is an object global/persistent?} \usage{ IsGlobal(object, ...) \method{IsGlobal}{default}(object, ...) \method{IsGlobal}{DimReduc}(object, ...) } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} } \value{ \code{TRUE} if the object is global/persistent otherwise \code{FALSE} } \description{ Typically, when removing \code{Assay} objects from an \code{Seurat} object, all associated objects (eg. \code{DimReduc}, \code{Graph}, and \code{SeuratCommand} objects) are removed as well. If an associated object is marked as global/persistent, the associated object will remain even if its original assay was deleted } \examples{ IsGlobal(pbmc_small[['pca']]) } \concept{data-access} SeuratObject/man/SeuratCommand-methods.Rd0000644000175000017500000000345514133577537020271 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/command.R \name{SeuratCommand-methods} \alias{SeuratCommand-methods} \alias{.DollarNames.SeuratCommand} \alias{$.SeuratCommand} \alias{[.SeuratCommand} \alias{as.list.SeuratCommand} \alias{show,SeuratCommand-method} \title{\code{SeuratCommand} Methods} \usage{ \method{.DollarNames}{SeuratCommand}(x, pattern = "") \method{$}{SeuratCommand}(x, i, ...) \method{[}{SeuratCommand}(x, i, ...) \method{as.list}{SeuratCommand}(x, complete = FALSE, ...) \S4method{show}{SeuratCommand}(object) } \arguments{ \item{x, object}{A \code{\link{SeuratCommand}} object} \item{pattern}{ A regular expression. Only matching names are returned. } \item{i}{For a \code{$}, a parameter name; for \code{[}, a \code{SeuratCommand} slot name} \item{...}{Arguments passed to other methods} \item{complete}{Include slots besides just parameters (eg. call string, name, timestamp)} } \value{ \code{$}: The value for parameter \code{i} \code{[}: Slot \code{i} from \code{x} \code{as.list}: A list with the parameters and, if \code{complete = TRUE}, the call string, name, and timestamp \code{show}: Prints summary to \code{\link[base]{stdout}} and invisibly returns \code{NULL} } \description{ Methods for \code{\link{SeuratCommand}} objects for generics defined in other packages } \section{Functions}{ \itemize{ \item \code{.DollarNames.SeuratCommand}: Autocompletion for \code{$} access on a \code{SeuratCommand} object \item \code{$.SeuratCommand}: Access a parameter from a \code{SeuratCommand} object \item \code{[.SeuratCommand}: Access data from a \code{SeuratCommand} object \item \code{as.list.SeuratCommand}: Coerce a \code{SeuratCommand} to a list \item \code{show,SeuratCommand-method}: Overview of a \code{SeuratCommand} object }} \concept{command} SeuratObject/man/JackStrawData-class.Rd0000644000175000017500000000111514133577537017643 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/jackstraw.R \docType{class} \name{JackStrawData-class} \alias{JackStrawData-class} \alias{JackStrawData} \title{The JackStrawData Class} \description{ The JackStrawData is used to store the results of a JackStraw computation. } \section{Slots}{ \describe{ \item{\code{empirical.p.values}}{Empirical p-values} \item{\code{fake.reduction.scores}}{Fake reduction scores} \item{\code{empirical.p.values.full}}{Empirical p-values on full} \item{\code{overall.p.values}}{Overall p-values from ScoreJackStraw} }} SeuratObject/man/AttachDeps.Rd0000644000175000017500000000116514133577537016102 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/utils.R \name{AttachDeps} \alias{AttachDeps} \title{Attach Required Packages} \usage{ AttachDeps(deps) } \arguments{ \item{deps}{A character vector of packages to attach} } \value{ Invisibly returns \code{NULL} } \description{ Helper function to attach required packages. Detects if a package is already attached and if so, skips it. Should be called in \code{\link[base]{.onAttach}} } \examples{ # Use in your .onAttach hook if (FALSE) { .onAttach <- function(libname, pkgname) { AttachDeps(c("SeuratObject", "rlang")) } } } \concept{utils} SeuratObject/man/UpdateSeuratObject.Rd0000644000175000017500000000122214133577537017611 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/seurat.R \name{UpdateSeuratObject} \alias{UpdateSeuratObject} \title{Update old Seurat object to accommodate new features} \usage{ UpdateSeuratObject(object) } \arguments{ \item{object}{Seurat object} } \value{ Returns a Seurat object compatible with latest changes } \description{ Updates Seurat objects to new structure for storing data/calculations. For Seurat v3 objects, will validate object structure ensuring all keys and feature names are formed properly. } \examples{ \dontrun{ updated_seurat_object = UpdateSeuratObject(object = old_seurat_object) } } \concept{seurat} SeuratObject/man/Images.Rd0000644000175000017500000000106014133577537015261 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/seurat.R \name{Images} \alias{Images} \title{Pull spatial image names} \usage{ Images(object, assay = NULL) } \arguments{ \item{object}{A \code{Seurat} object} \item{assay}{Name of assay to limit search to} } \value{ A list of image names } \description{ List the names of \code{SpatialImage} objects present in a \code{Seurat} object. If \code{assay} is provided, limits search to images associated with that assay } \examples{ \dontrun{ Images(object) } } \concept{data-access} SeuratObject/man/Misc.Rd0000644000175000017500000000220414145250210014723 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/assay.R, R/dimreduc.R, R/seurat.R \name{Misc} \alias{Misc} \alias{Misc<-} \alias{Misc.Assay} \alias{Misc<-.Assay} \alias{Misc.DimReduc} \alias{Misc<-.DimReduc} \alias{Misc.Seurat} \alias{Misc<-.Seurat} \title{Get and set miscellaneous data} \usage{ Misc(object, ...) Misc(object, ...) <- value \method{Misc}{Assay}(object, slot = NULL, ...) \method{Misc}{Assay}(object, slot, ...) <- value \method{Misc}{DimReduc}(object, slot = NULL, ...) \method{Misc}{DimReduc}(object, slot, ...) <- value \method{Misc}{Seurat}(object, slot = NULL, ...) \method{Misc}{Seurat}(object, slot, ...) <- value } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} \item{value}{Data to add} \item{slot}{Name of specific bit of meta data to pull} } \value{ Miscellaneous data An object with miscellaneous data added } \description{ Get and set miscellaneous data } \examples{ # Get the misc info Misc(object = pbmc_small, slot = "example") # Add misc info Misc(object = pbmc_small, slot = "example") <- "testing_misc" } \concept{data-access} SeuratObject/man/SpatialImage-methods.Rd0000644000175000017500000001502214146000252020033 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/spatial.R \name{SpatialImage-methods} \alias{SpatialImage-methods} \alias{Cells.SpatialImage} \alias{DefaultAssay.SpatialImage} \alias{DefaultAssay<-.SpatialImage} \alias{GetImage.SpatialImage} \alias{GetTissueCoordinates.SpatialImage} \alias{IsGlobal.SpatialImage} \alias{Key.SpatialImage} \alias{Key<-.SpatialImage} \alias{Radius.SpatialImage} \alias{RenameCells.SpatialImage} \alias{[.SpatialImage} \alias{dim.SpatialImage} \alias{subset.SpatialImage} \alias{show,SpatialImage-method} \title{\code{SpatialImage} methods} \usage{ \method{Cells}{SpatialImage}(x) \method{DefaultAssay}{SpatialImage}(object, ...) \method{DefaultAssay}{SpatialImage}(object, ...) <- value \method{GetImage}{SpatialImage}(object, mode = c("grob", "raster", "plotly", "raw"), ...) \method{GetTissueCoordinates}{SpatialImage}(object, ...) \method{IsGlobal}{SpatialImage}(object, ...) \method{Key}{SpatialImage}(object, ...) \method{Key}{SpatialImage}(object, ...) <- value \method{Radius}{SpatialImage}(object) \method{RenameCells}{SpatialImage}(object, new.names = NULL, ...) \method{[}{SpatialImage}(x, i, ...) \method{dim}{SpatialImage}(x) \method{subset}{SpatialImage}(x, cells, ...) \S4method{show}{SpatialImage}(object) } \arguments{ \item{x, object}{A \code{SpatialImage}-derived object} \item{...}{Arguments passed to other methods} \item{value}{Depends on the method: \describe{ \item{\code{DefaultAssay<-}}{Assay that the image should be associated with} \item{\code{Key<-}}{New key for the image} }} \item{mode}{How to return the image; should accept one of \dQuote{grob}, \dQuote{raster}, \dQuote{plotly}, or \dQuote{raw}} \item{new.names}{vector of new cell names} \item{i, cells}{A vector of cells to keep} } \value{ \strong{[Override]} \code{Cells}: should return cell names \code{DefaultAssay}: The associated assay of a \code{SpatialImage}-derived object \code{DefaultAssay<-}: \code{object} with the associated assay updated \strong{[Override]} \code{GetImage}: The image data from a \code{SpatialImage}-derived object \strong{[Override]} \code{GetTissueCoordinates}: ... \code{IsGlobal}: returns \code{TRUE} as images are, by default, global \code{Key}: The key for a \code{SpatialImage}-derived object \code{Key<-}: \code{object} with the key set to \code{value} \code{Radius}: The spot radius size; by default, returns \code{NULL} \strong{[Override]} \code{RenameCells}: \code{object} with the new cell names \code{[}, \code{subset}: \code{x}/\code{object} for only the cells requested \strong{[Override]} \code{dim}: The dimensions of the image data in (Y, X) format \code{show}: Prints summary to \code{\link[base]{stdout}} and invisibly returns \code{NULL} } \description{ Methods defined on the \code{\link{SpatialImage}} class. Some of these methods must be overridden in order to ensure proper functionality of the derived classes (see \strong{Required methods} below). Other methods are designed to work across all \code{SpatialImage}-derived subclasses, and should only be overridden if necessary } \section{Functions}{ \itemize{ \item \code{Cells.SpatialImage}: Get the cell names from an image (\strong{[Override]}) \item \code{DefaultAssay.SpatialImage}: Get the associated assay of a \code{SpatialImage}-derived object \item \code{DefaultAssay<-.SpatialImage}: Set the associated assay of a \code{SpatialImage}-derived object \item \code{GetImage.SpatialImage}: Get the image data from a \code{SpatialImage}-derived object \item \code{GetTissueCoordinates.SpatialImage}: Get tissue coordinates for a \code{SpatialImage}-derived object (\strong{[Override]}) \item \code{IsGlobal.SpatialImage}: Globality test for \code{SpatialImage}-derived object \item \code{Key.SpatialImage}: Get the key for a \code{SpatialImage}-derived object \item \code{Key<-.SpatialImage}: Set the key for a \code{SpatialImage}-derived object \item \code{Radius.SpatialImage}: Get the spot radius size \item \code{RenameCells.SpatialImage}: Rename cells in a \code{SpatialImage}-derived object (\strong{[Override]}) \item \code{[.SpatialImage}: Subset a \code{SpatialImage}-derived object \item \code{dim.SpatialImage}: Get the plotting dimensions of an image (\strong{[Override]}) \item \code{subset.SpatialImage}: Subset a \code{SpatialImage}-derived object (\strong{[Override]}) \item \code{show,SpatialImage-method}: Overview of a \code{SpatialImage}-derived object }} \section{Provided methods}{ These methods are defined on the \code{SpatialImage} object and should not be overridden without careful thought \itemize{ \item \code{\link{DefaultAssay}} and \code{\link{DefaultAssay<-}} \item \code{\link{Key}} and \code{\link{Key<-}} \item \code{\link{GetImage}}; this method \emph{can} be overridden to provide image data, normally returns empty image data. If overridden, should default to returning a \code{\link[grid]{grob}} object \item \code{\link{IsGlobal}} \item \code{\link{Radius}}; this method \emph{can} be overridden to provide a spot radius for image objects \item \code{\link[base:Extract]{[}}; this method \emph{can} be overridden to change default subset behavior, normally returns \code{subset(x = x, cells = i)}. If overridden, should only accept \code{i} } } \section{Required methods}{ All subclasses of the \code{SpatialImage} class must define the following methods; simply relying on the \code{SpatialImage} method will result in errors. For required parameters and their values, see the \code{Usage} and \code{Arguments} sections \describe{ \item{\code{\link{Cells}}}{ Return the cell/spot barcodes associated with each position } \item{\code{\link{dim}}}{ Return the dimensions of the image for plotting in \code{(Y, X)} format } \item{\code{\link{GetTissueCoordinates}}}{ Return tissue coordinates; by default, must return a two-column \code{data.frame} with x-coordinates in the first column and y-coordinates in the second } \item{\code{\link{Radius}}}{ Return the spot radius; returns \code{NULL} by default for use with non-spot image technologies } \item{\code{\link{RenameCells}}}{ Rename the cell/spot barcodes for this image } \item{\code{\link{subset}}}{ Subset the image data by cells/spots } } These methods are used throughout Seurat, so defining them and setting the proper defaults will allow subclasses of \code{SpatialImage} to work seamlessly } \seealso{ \code{\link{DefaultAssay}} \code{\link{GetImage}} \code{\link{GetTissueCoordinates}} \code{\link{IsGlobal}} \code{\link{Key}} \code{\link{RenameCells}} } \concept{spatialimage} SeuratObject/man/Tool.Rd0000644000175000017500000000265714133577537015006 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/seurat.R \name{Tool} \alias{Tool} \alias{Tools} \alias{Tool<-} \alias{Tool.Seurat} \alias{Tool<-.Seurat} \title{Get and set additional tool data} \usage{ Tool(object, ...) Tool(object, ...) <- value \method{Tool}{Seurat}(object, slot = NULL, ...) \method{Tool}{Seurat}(object, ...) <- value } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} \item{value}{Information to be added to tool list} \item{slot}{Name of tool to pull} } \value{ If no additional arguments, returns the names of the tools in the object; otherwise returns the data placed by the tool requested } \description{ Use \code{Tool} to get tool data. If no additional arguments are provided, will return a vector with the names of tools in the object. } \note{ For developers: set tool data using \code{Tool<-}. \code{Tool<-} will automatically set the name of the tool to the function that called \code{Tool<-},so each function gets one entry in the tools list and cannot overwrite another function's entry. The automatic naming will also remove any method identifiers (eg. RunPCA.Seurat will become RunPCA); please plan accordingly. } \examples{ Tool(object = pbmc_small) \dontrun{ sample.tool.output <- matrix(data = rnorm(n = 16), nrow = 4) # must be run from within a function Tool(object = pbmc_small) <- sample.tool.output } } \concept{data-access} SeuratObject/man/FilterObjects.Rd0000644000175000017500000000115014143043627016600 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/seurat.R \name{FilterObjects} \alias{FilterObjects} \title{Find Sub-objects of a Certain Class} \usage{ FilterObjects(object, classes.keep = c("Assay", "DimReduc")) } \arguments{ \item{object}{A \code{\link{Seurat}} object} \item{classes.keep}{A vector of names of classes to get} } \value{ A vector with the names of objects within the \code{Seurat} object that are of class \code{classes.keep} } \description{ Get the names of objects within a \code{Seurat} object that are of a certain class } \examples{ FilterObjects(pbmc_small) } SeuratObject/man/Project.Rd0000644000175000017500000000121414133577537015463 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/seurat.R \name{Project} \alias{Project} \alias{Project<-} \alias{Project.Seurat} \alias{Project<-.Seurat} \title{Get and set project information} \usage{ Project(object, ...) Project(object, ...) <- value \method{Project}{Seurat}(object, ...) \method{Project}{Seurat}(object, ...) <- value } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} \item{value}{Project information to set} } \value{ Project information An object with project information added } \description{ Get and set project information } \concept{seurat} SeuratObject/man/Assay-class.Rd0000644000175000017500000000213614133577537016244 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/assay.R \docType{class} \name{Assay-class} \alias{Assay-class} \alias{Assay} \title{The Assay Class} \description{ The Assay object is the basic unit of Seurat; each Assay stores raw, normalized, and scaled data as well as cluster information, variable features, and any other assay-specific metadata. Assays should contain single cell expression data such as RNA-seq, protein, or imputed expression data. } \section{Slots}{ \describe{ \item{\code{counts}}{Unnormalized data such as raw counts or TPMs} \item{\code{data}}{Normalized expression data} \item{\code{scale.data}}{Scaled expression data} \item{\code{key}}{Key for the Assay} \item{\code{assay.orig}}{Original assay that this assay is based off of. Used to track assay provenance} \item{\code{var.features}}{Vector of features exhibiting high variance across single cells} \item{\code{meta.features}}{Feature-level metadata} \item{\code{misc}}{Utility slot for storing additional data associated with the assay} }} \seealso{ \code{\link{Assay-methods}} } \concept{assay} SeuratObject/man/GetImage.Rd0000644000175000017500000000241014133577537015536 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/seurat.R \name{GetImage} \alias{GetImage} \alias{GetImage.Seurat} \title{Get image data} \usage{ GetImage(object, mode = c("grob", "raster", "plotly", "raw"), ...) \method{GetImage}{Seurat}( object, mode = c("grob", "raster", "plotly", "raw"), image = NULL, ... ) } \arguments{ \item{object}{An object} \item{mode}{How to return the image; should accept one of \dQuote{grob}, \dQuote{raster}, \dQuote{plotly}, or \dQuote{raw}} \item{...}{Arguments passed to other methods} \item{image}{Name of \code{SpatialImage} object to pull image data for; if \code{NULL}, will attempt to select an image automatically} } \value{ Image data, varying depending on the value of \code{mode}: \describe{ \item{\dQuote{grob}}{ An object representing image data inheriting from \code{grob} objects (eg. \code{rastergrob}) } \item{\dQuote{raster}}{An object of class \code{raster}} \item{\dQuote{plotly}}{ A list with image data suitable for Plotly rendering, see \code{\link[plotly:layout]{plotly::layout}} for more details } \item{\dQuote{raw}}{The raw image data as stored in the object} } } \description{ Get image data } \seealso{ \code{\link[plotly]{layout}} } \concept{data-access} SeuratObject/man/DefaultAssay.Rd0000644000175000017500000000323314145250210016420 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/assay.R, R/command.R, % R/dimreduc.R, R/graph.R, R/seurat.R \name{DefaultAssay} \alias{DefaultAssay} \alias{DefaultAssay<-} \alias{DefaultAssay.Assay} \alias{DefaultAssay<-.Assay} \alias{DefaultAssay.SeuratCommand} \alias{DefaultAssay.DimReduc} \alias{DefaultAssay<-.DimReduc} \alias{DefaultAssay.Graph} \alias{DefaultAssay<-.Graph} \alias{DefaultAssay.Seurat} \alias{DefaultAssay<-.Seurat} \title{Default Assay} \usage{ DefaultAssay(object, ...) DefaultAssay(object, ...) <- value \method{DefaultAssay}{Assay}(object, ...) \method{DefaultAssay}{Assay}(object, ...) <- value \method{DefaultAssay}{SeuratCommand}(object, ...) \method{DefaultAssay}{DimReduc}(object, ...) \method{DefaultAssay}{DimReduc}(object, ...) <- value \method{DefaultAssay}{Graph}(object, ...) \method{DefaultAssay}{Graph}(object, ...) <- value \method{DefaultAssay}{Seurat}(object, ...) \method{DefaultAssay}{Seurat}(object, ...) <- value } \arguments{ \item{object}{An object} \item{...}{Arguments passed to other methods} \item{value}{Name of assay to set as default} } \value{ \code{DefaultAssay}: The name of the default assay \code{DefaultAssay<-}: An object with the default assay updated } \description{ Get and set the default assay } \examples{ # Get current default assay DefaultAssay(object = pbmc_small) # Create dummy new assay to demo switching default assays new.assay <- pbmc_small[["RNA"]] Key(object = new.assay) <- "RNA2_" pbmc_small[["RNA2"]] <- new.assay # switch default assay to RNA2 DefaultAssay(object = pbmc_small) <- "RNA2" DefaultAssay(object = pbmc_small) } \concept{data-access} SeuratObject/man/Neighbor-class.Rd0000644000175000017500000000147314133577537016724 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/neighbor.R \docType{class} \name{Neighbor-class} \alias{Neighbor-class} \alias{Neighbor} \title{The Neighbor class} \description{ The Neighbor class is used to store the results of neighbor finding algorithms } \section{Slots}{ \describe{ \item{\code{nn.idx}}{Matrix containing the nearest neighbor indices} \item{\code{nn.dist}}{Matrix containing the nearest neighbor distances} \item{\code{alg.idx}}{The neighbor finding index (if applicable). E.g. the annoy index} \item{\code{alg.info}}{Any information associated with the algorithm that may be needed downstream (e.g. distance metric used with annoy is needed when reading in from stored file).} \item{\code{cell.names}}{Names of the cells for which the neighbors have been computed.} }} SeuratObject/man/Idents.Rd0000644000175000017500000000672414133577537015316 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/seurat.R \name{Idents} \alias{Idents} \alias{Idents<-} \alias{RenameIdents} \alias{RenameIdent} \alias{ReorderIdent} \alias{SetIdent} \alias{StashIdent} \alias{Idents.Seurat} \alias{Idents<-.Seurat} \alias{ReorderIdent.Seurat} \alias{RenameIdents.Seurat} \alias{SetIdent.Seurat} \alias{StashIdent.Seurat} \alias{droplevels.Seurat} \alias{levels.Seurat} \alias{levels<-.Seurat} \title{Get, set, and manipulate an object's identity classes} \usage{ Idents(object, ...) Idents(object, ...) <- value RenameIdents(object, ...) ReorderIdent(object, var, ...) SetIdent(object, ...) StashIdent(object, save.name, ...) \method{Idents}{Seurat}(object, ...) \method{Idents}{Seurat}(object, cells = NULL, drop = FALSE, ...) <- value \method{ReorderIdent}{Seurat}( object, var, reverse = FALSE, afxn = mean, reorder.numeric = FALSE, ... ) \method{RenameIdents}{Seurat}(object, ...) \method{SetIdent}{Seurat}(object, cells = NULL, value, ...) \method{StashIdent}{Seurat}(object, save.name = "orig.ident", ...) \method{droplevels}{Seurat}(x, ...) \method{levels}{Seurat}(x) \method{levels}{Seurat}(x) <- value } \arguments{ \item{...}{Arguments passed to other methods; for \code{RenameIdents}: named arguments as \code{old.ident = new.ident}; for \code{ReorderIdent}: arguments passed on to \code{\link{FetchData}}} \item{value}{The name of the identities to pull from object metadata or the identities themselves} \item{var}{Feature or variable to order on} \item{save.name}{Store current identity information under this name} \item{cells}{Set cell identities for specific cells} \item{drop}{Drop unused levels} \item{reverse}{Reverse ordering} \item{afxn}{Function to evaluate each identity class based on; default is \code{\link[base]{mean}}} \item{reorder.numeric}{Rename all identity classes to be increasing numbers starting from 1 (default is FALSE)} \item{x, object}{An object} } \value{ \code{Idents}: The cell identities \code{Idents<-}: \code{object} with the cell identities changed \code{RenameIdents}: An object with selected identity classes renamed \code{ReorderIdent}: An object with \code{SetIdent}: An object with new identity classes set \code{StashIdent}: An object with the identities stashed } \description{ Get, set, and manipulate an object's identity classes } \examples{ # Get cell identity classes Idents(pbmc_small) # Set cell identity classes # Can be used to set identities for specific cells to a new level Idents(pbmc_small, cells = 1:4) <- 'a' head(Idents(pbmc_small)) # Can also set idents from a value in object metadata colnames(pbmc_small[[]]) Idents(pbmc_small) <- 'RNA_snn_res.1' levels(pbmc_small) # Rename cell identity classes # Can provide an arbitrary amount of idents to rename levels(pbmc_small) pbmc_small <- RenameIdents(pbmc_small, '0' = 'A', '2' = 'C') levels(pbmc_small) \dontrun{ head(Idents(pbmc_small)) pbmc_small <- ReorderIdent(pbmc_small, var = 'PC_1') head(Idents(pbmc_small)) } # Set cell identity classes using SetIdent cells.use <- WhichCells(pbmc_small, idents = '1') pbmc_small <- SetIdent(pbmc_small, cells = cells.use, value = 'B') head(pbmc_small[[]]) pbmc_small <- StashIdent(pbmc_small, save.name = 'idents') head(pbmc_small[[]]) # Get the levels of identity classes of a Seurat object levels(x = pbmc_small) # Reorder identity classes levels(x = pbmc_small) levels(x = pbmc_small) <- c('C', 'A', 'B') levels(x = pbmc_small) } \concept{seurat} SeuratObject/man/oldseurat-class.Rd0000644000175000017500000000510714133577537017167 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/seurat.R \docType{class} \name{seurat-class} \alias{seurat-class} \alias{seurat} \alias{show,seurat-method} \title{The Seurat Class} \usage{ \S4method{show}{seurat}(object) } \arguments{ \item{object}{A \code{\link{Seurat}} object} } \description{ The Seurat object is the center of each single cell analysis. It stores all information associated with the dataset, including data, annotations, analyses, etc. All that is needed to construct a Seurat object is an expression matrix (rows are genes, columns are cells), which should be log-scale } \details{ Each Seurat object has a number of slots which store information. Key slots to access are listed below. } \section{Slots}{ \describe{ \item{\code{raw.data}}{The raw project data} \item{\code{data}}{The normalized expression matrix (log-scale)} \item{\code{scale.data}}{scaled (default is z-scoring each gene) expression matrix; used for dimensional reduction and heatmap visualization} \item{\code{var.genes}}{Vector of genes exhibiting high variance across single cells} \item{\code{is.expr}}{Expression threshold to determine if a gene is expressed (0 by default)} \item{\code{ident}}{THe 'identity class' for each cell} \item{\code{meta.data}}{Contains meta-information about each cell, starting with number of genes detected (nFeature) and the original identity class (orig.ident); more information is added using \code{AddMetaData}} \item{\code{project.name}}{Name of the project (for record keeping)} \item{\code{dr}}{List of stored dimensional reductions; named by technique} \item{\code{assay}}{List of additional assays for multimodal analysis; named by technique} \item{\code{hvg.info}}{The output of the mean/variability analysis for all genes} \item{\code{imputed}}{Matrix of imputed gene scores} \item{\code{cell.names}}{Names of all single cells (column names of the expression matrix)} \item{\code{cluster.tree}}{List where the first element is a phylo object containing the phylogenetic tree relating different identity classes} \item{\code{snn}}{Spare matrix object representation of the SNN graph} \item{\code{calc.params}}{Named list to store all calculation-related parameter choices} \item{\code{kmeans}}{Stores output of gene-based clustering from \code{DoKMeans}} \item{\code{spatial}}{Stores internal data and calculations for spatial mapping of single cells} \item{\code{misc}}{Miscellaneous spot to store any data alongside the object (for example, gene lists)} \item{\code{version}}{Version of package used in object creation} }} \concept{unsorted} SeuratObject/man/AddMetaData.Rd0000644000175000017500000000251314145250210016124 0ustar nileshnilesh% Generated by roxygen2: do not edit by hand % Please edit documentation in R/generics.R, R/assay.R, R/seurat.R \name{AddMetaData} \alias{AddMetaData} \alias{SeuratAccess} \alias{AddMetaData.Assay} \alias{AddMetaData.Seurat} \title{Add in metadata associated with either cells or features.} \usage{ AddMetaData(object, metadata, col.name = NULL) \method{AddMetaData}{Assay}(object, metadata, col.name = NULL) \method{AddMetaData}{Seurat}(object, metadata, col.name = NULL) } \arguments{ \item{object}{An object} \item{metadata}{A vector, list, or data.frame with metadata to add} \item{col.name}{A name for meta data if not a named list or data.frame} } \value{ \code{object} with metadata added } \description{ Adds additional data to the object. Can be any piece of information associated with a cell (examples include read depth, alignment rate, experimental batch, or subpopulation identity) or feature (ENSG name, variance). To add cell level information, add to the Seurat object. If adding feature-level metadata, add to the Assay object (e.g. \code{object[["RNA"]]}) } \examples{ cluster_letters <- LETTERS[Idents(object = pbmc_small)] names(cluster_letters) <- colnames(x = pbmc_small) pbmc_small <- AddMetaData( object = pbmc_small, metadata = cluster_letters, col.name = 'letter.idents' ) head(x = pbmc_small[[]]) } \concept{seurat} SeuratObject/src/0000755000175000017500000000000014147220105013561 5ustar nileshnileshSeuratObject/src/data_manipulation.h0000644000175000017500000000065614133577537017455 0ustar nileshnilesh#include #include #include #include #include #include using namespace Rcpp; Eigen::SparseMatrix RowMergeMatricesList( List mat_list, List mat_rownames, std::vector all_rownames ); template std::vector sort_indexes(const std::vector &v); List GraphToNeighborHelper(Eigen::SparseMatrix mat); SeuratObject/src/RcppExports.cpp0000644000175000017500000000357614146005417016577 0ustar nileshnilesh// Generated by using Rcpp::compileAttributes() -> do not edit by hand // Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 #include #include using namespace Rcpp; #ifdef RCPP_USE_GLOBAL_ROSTREAM Rcpp::Rostream& Rcpp::Rcout = Rcpp::Rcpp_cout_get(); Rcpp::Rostream& Rcpp::Rcerr = Rcpp::Rcpp_cerr_get(); #endif // GraphToNeighborHelper List GraphToNeighborHelper(Eigen::SparseMatrix mat); RcppExport SEXP _SeuratObject_GraphToNeighborHelper(SEXP matSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< Eigen::SparseMatrix >::type mat(matSEXP); rcpp_result_gen = Rcpp::wrap(GraphToNeighborHelper(mat)); return rcpp_result_gen; END_RCPP } // RowMergeMatricesList Eigen::SparseMatrix RowMergeMatricesList(List mat_list, List mat_rownames, std::vector all_rownames); RcppExport SEXP _SeuratObject_RowMergeMatricesList(SEXP mat_listSEXP, SEXP mat_rownamesSEXP, SEXP all_rownamesSEXP) { BEGIN_RCPP Rcpp::RObject rcpp_result_gen; Rcpp::traits::input_parameter< List >::type mat_list(mat_listSEXP); Rcpp::traits::input_parameter< List >::type mat_rownames(mat_rownamesSEXP); Rcpp::traits::input_parameter< std::vector >::type all_rownames(all_rownamesSEXP); rcpp_result_gen = Rcpp::wrap(RowMergeMatricesList(mat_list, mat_rownames, all_rownames)); return rcpp_result_gen; END_RCPP } RcppExport SEXP isnull(SEXP); static const R_CallMethodDef CallEntries[] = { {"_SeuratObject_GraphToNeighborHelper", (DL_FUNC) &_SeuratObject_GraphToNeighborHelper, 1}, {"_SeuratObject_RowMergeMatricesList", (DL_FUNC) &_SeuratObject_RowMergeMatricesList, 3}, {"isnull", (DL_FUNC) &isnull, 1}, {NULL, NULL, 0} }; RcppExport void R_init_SeuratObject(DllInfo *dll) { R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); R_useDynamicSymbols(dll, FALSE); } SeuratObject/src/valid_pointer.c0000644000175000017500000000024714133577537016612 0ustar nileshnilesh#include // helper to determine if external c++ pointer is valid SEXP isnull(SEXP pointer) { return Rf_ScalarLogical(!R_ExternalPtrAddr(pointer)); } SeuratObject/src/data_manipulation.cpp0000644000175000017500000000726314133577537020011 0ustar nileshnilesh#include #include #include #include #include #include using namespace Rcpp; // [[Rcpp::depends(RcppEigen)]] typedef Eigen::Triplet T; template std::vector sort_indexes(const std::vector &v) { // initialize original index locations std::vector idx(v.size()); std::iota(idx.begin(), idx.end(), 0); std::stable_sort(idx.begin(), idx.end(), [&v](size_t i1, size_t i2) {return v[i1] < v[i2];}); return idx; } // [[Rcpp::export(rng = false) // [[Rcpp::export(rng = false)]] List GraphToNeighborHelper(Eigen::SparseMatrix mat) { mat = mat.transpose(); //determine the number of neighbors int n = 0; for(Eigen::SparseMatrix::InnerIterator it(mat, 0); it; ++it) { n += 1; } Eigen::MatrixXd nn_idx(mat.rows(), n); Eigen::MatrixXd nn_dist(mat.rows(), n); for (int k=0; k row_idx; std::vector row_dist; row_idx.reserve(n); row_dist.reserve(n); for (Eigen::SparseMatrix::InnerIterator it(mat,k); it; ++it) { if (n_k > (n-1)) { Rcpp::stop("Not all cells have an equal number of neighbors."); } row_idx.push_back(it.row() + 1); row_dist.push_back(it.value()); n_k += 1; } if (n_k != n) { Rcpp::Rcout << n << ":::" << n_k << std::endl; Rcpp::stop("Not all cells have an equal number of neighbors."); } //order the idx based on dist std::vector idx_order = sort_indexes(row_dist); for(int i = 0; i < n; ++i) { nn_idx(k, i) = row_idx[idx_order[i]]; nn_dist(k, i) = row_dist[idx_order[i]]; } } List neighbors = List::create(nn_idx, nn_dist); return(neighbors); } // [[Rcpp::export(rng = false)]] Eigen::SparseMatrix RowMergeMatricesList( List mat_list, List mat_rownames, std::vector all_rownames ) { // Convert Rcpp lists to c++ vectors std::vector> mat_vec; mat_vec.reserve(mat_list.size()); std::vector> rownames_vec; rownames_vec.reserve(mat_rownames.size()); std::vector> map_vec; map_vec.reserve(mat_list.size()); int num_cols = 0; int num_nZero = 0; // offsets keep track of which column to add in to std::vector offsets; for (unsigned int i = 0; i < mat_list.size(); i++) { mat_vec.emplace_back(Rcpp::as>(mat_list.at(i))); rownames_vec.push_back(mat_rownames[i]); // Set up hash maps for rowname based lookup std::unordered_map mat_map; for (unsigned int j = 0; j < rownames_vec[i].size(); j++) { mat_map[rownames_vec[i][j]] = j; } map_vec.emplace_back(mat_map); offsets.push_back(num_cols); num_cols += mat_vec[i].cols(); num_nZero += mat_vec[i].nonZeros(); } // set up tripletList for new matrix creation std::vector tripletList; int num_rows = all_rownames.size(); tripletList.reserve(num_nZero); // loop over all rows and add nonzero entries to tripletList for(int i = 0; i < num_rows; i++) { std::string key = all_rownames[i]; for(int j = 0; j < mat_vec.size(); j++) { if (map_vec[j].count(key)) { for(Eigen::SparseMatrix::InnerIterator it1(mat_vec[j], map_vec[j][key]); it1; ++it1){ tripletList.emplace_back(i, it1.col() + offsets[j], it1.value()); } } } } Eigen::SparseMatrix combined_mat(num_rows, num_cols); combined_mat.setFromTriplets(tripletList.begin(), tripletList.end()); return combined_mat; } SeuratObject/R/0000755000175000017500000000000014147216431013202 5ustar nileshnileshSeuratObject/R/default.R0000644000175000017500000000070014146000252014735 0ustar nileshnilesh#' @include generics.R #' NULL #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for Seurat-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @rdname Cells #' @export #' Cells.default <- function(x) { return(colnames(x = x)) } #' @rdname IsGlobal #' @export #' @method IsGlobal default #' IsGlobal.default <- function(object, ...) { return(FALSE) } SeuratObject/R/generics.R0000644000175000017500000005274014146006455015136 0ustar nileshnilesh#' @include zzz.R #' NULL #' Add in metadata associated with either cells or features. #' #' Adds additional data to the object. Can be any piece of information #' associated with a cell (examples include read depth, alignment rate, #' experimental batch, or subpopulation identity) or feature (ENSG name, #' variance). To add cell level information, add to the Seurat object. If adding #' feature-level metadata, add to the Assay object (e.g. \code{object[["RNA"]]}) #' #' @param object An object #' @param metadata A vector, list, or data.frame with metadata to add #' @param col.name A name for meta data if not a named list or data.frame #' #' @return \code{object} with metadata added #' #' @rdname AddMetaData #' @export AddMetaData #' #' @aliases SeuratAccess #' #' @concept seurat #' #' @examples #' cluster_letters <- LETTERS[Idents(object = pbmc_small)] #' names(cluster_letters) <- colnames(x = pbmc_small) #' pbmc_small <- AddMetaData( #' object = pbmc_small, #' metadata = cluster_letters, #' col.name = 'letter.idents' #' ) #' head(x = pbmc_small[[]]) #' AddMetaData <- function(object, metadata, col.name = NULL) { UseMethod(generic = 'AddMetaData', object = object) } #' Coerce to a \code{Graph} Object #' #' Convert a \code{\link[base]{matrix}} (or \code{\link[Matrix]{Matrix}}) to #' a \code{\link{Graph}} object #' #' @param x The matrix to convert #' @param ... Arguments passed to other methods (ignored for now) #' #' @return A \code{\link{Graph}} object #' #' @rdname as.Graph #' @export as.Graph #' #' @concept graph #' as.Graph <- function(x, ...) { UseMethod(generic = "as.Graph", object = x) } #' Coerce to a \code{Neighbor} Object #' #' Convert objects to \code{\link{Neighbor}} objects #' #' @param x An object to convert to \code{\link{Neighbor}} #' @param ... Arguments passed to other methods #' #' @return A \code{\link{Neighbor}} object #' #' @rdname as.Neighbor #' @export as.Neighbor #' #' @concept neighbor #' as.Neighbor <- function(x, ...) { UseMethod(generic = 'as.Neighbor', object = x) } #' Coerce to a \code{Seurat} Object #' #' Convert objects to Seurat objects #' #' @param x An object to convert to class \code{Seurat} #' @param ... Arguments passed to other methods #' #' @return A \code{\link{Seurat}} object generated from \code{x} #' #' @rdname as.Seurat #' @export as.Seurat #' #' @concept seurat #' as.Seurat <- function(x, ...) { UseMethod(generic = 'as.Seurat', object = x) } #' Get cells present in an object #' #' @param x An object #' #' @return A vector of cell names #' #' @rdname Cells #' @export Cells #' #' @concept data-access #' #' @examples #' Cells(x = pbmc_small) #' Cells <- function(x) { UseMethod(generic = 'Cells', object = x) } #' Get SeuratCommands #' #' Pull information on previously run commands in the Seurat object. #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return Either a SeuratCommand object or the requested parameter value #' #' @rdname Command #' @export Command #' #' @concept data-access #' Command <- function(object, ...) { UseMethod(generic = 'Command', object = object) } #' Create a \code{Seurat} object #' #' Create a \code{Seurat} object from raw data #' #' @inheritParams CreateAssayObject #' @param counts Either a \code{\link[base]{matrix}}-like object with #' unnormalized data with cells as columns and features as rows or an #' \code{\link{Assay}}-derived object #' @param project \link{Project} name for the \code{Seurat} object #' @param assay Name of the initial assay #' @param names.field For the initial identity class for each cell, choose this #' field from the cell's name. E.g. If your cells are named as #' BARCODE_CLUSTER_CELLTYPE in the input matrix, set \code{names.field} to 3 to #' set the initial identities to CELLTYPE. #' @param names.delim For the initial identity class for each cell, choose this #' delimiter from the cell's column name. E.g. If your cells are named as #' BARCODE-CLUSTER-CELLTYPE, set this to \dQuote{-} to separate the cell name #' into its component parts for picking the relevant field. #' @param meta.data Additional cell-level metadata to add to the Seurat object. #' Should be a \code{\link[base]{data.frame}} where the rows are cell names and #' the columns are additional metadata fields. Row names in the metadata need #' to match the column names of the counts matrix. #' @param ... Arguments passed to other methods #' #' @note In previous versions (<3.0), this function also accepted a parameter to #' set the expression threshold for a \sQuote{detected} feature (gene). This #' functionality has been removed to simplify the initialization #' process/assumptions. If you would still like to impose this threshold for #' your particular dataset, simply filter the input expression matrix before #' calling this function. #' #' @return A \code{\link{Seurat}} object #' #' @rdname CreateSeuratObject #' @export #' #' @concept seurat #' #' @examples #' \dontrun{ #' pbmc_raw <- read.table( #' file = system.file('extdata', 'pbmc_raw.txt', package = 'Seurat'), #' as.is = TRUE #' ) #' pbmc_small <- CreateSeuratObject(counts = pbmc_raw) #' pbmc_small #' } #' CreateSeuratObject <- function( counts, project = 'CreateSeuratObject', assay = 'RNA', names.field = 1, names.delim = '_', meta.data = NULL, ... ) { UseMethod(generic = 'CreateSeuratObject', object = counts) } #' Default Assay #' #' Get and set the default assay #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return \code{DefaultAssay}: The name of the default assay #' #' @rdname DefaultAssay #' @export DefaultAssay #' #' @concept data-access #' DefaultAssay <- function(object, ...) { UseMethod(generic = 'DefaultAssay', object = object) } #' @param value Name of assay to set as default #' #' @return \code{DefaultAssay<-}: An object with the default assay updated #' #' @rdname DefaultAssay #' @export DefaultAssay<- #' "DefaultAssay<-" <- function(object, ..., value) { UseMethod(generic = 'DefaultAssay<-', object = object) } #' Get the Neighbor nearest neighbors distance matrix #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return The distance matrix #' #' @rdname Distances #' @export Distances #' #' @concept data-access #' Distances <- function(object, ...) { UseMethod(generic = 'Distances', object = object) } #' Get Cell Embeddings #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return The embeddings matrix #' #' @rdname Embeddings #' @export Embeddings #' #' @concept data-access #' Embeddings <- function(object, ...) { UseMethod(generic = 'Embeddings', object = object) } #' Get and Set Assay Data #' #' General accessor and setter functions for \code{\link{Assay}} objects. #' \code{GetAssayData} can be used to pull information from any of the #' expression matrices (eg. \dQuote{counts}, \dQuote{data}, or #' \dQuote{scale.data}). \code{SetAssayData} can be used to replace one of these #' expression matrices #' #' @param object An object #' @param slot Specific assay data to get or set #' @param ... Arguments passed to other methods #' #' @return \code{GetAssayData}: returns the specified assay data #' #' @name AssayData #' @rdname AssayData #' @export GetAssayData #' #' @order 1 #' #' @concept data-access #' GetAssayData <- function(object, slot, ...) { UseMethod(generic = 'GetAssayData', object = object) } #' Get image data #' #' @param object An object #' @param mode How to return the image; should accept one of \dQuote{grob}, #' \dQuote{raster}, \dQuote{plotly}, or \dQuote{raw} #' @param ... Arguments passed to other methods #' #' @return Image data, varying depending on the value of \code{mode}: #' \describe{ #' \item{\dQuote{grob}}{ #' An object representing image data inheriting from \code{grob} objects #' (eg. \code{rastergrob}) #' } #' \item{\dQuote{raster}}{An object of class \code{raster}} #' \item{\dQuote{plotly}}{ #' A list with image data suitable for Plotly rendering, see #' \code{\link[plotly:layout]{plotly::layout}} for more details #' } #' \item{\dQuote{raw}}{The raw image data as stored in the object} #' } #' #' @seealso \code{\link[plotly]{layout}} #' #' @rdname GetImage #' @export GetImage #' #' @concept data-access #' GetImage <- function(object, mode = c('grob', 'raster', 'plotly', 'raw'), ...) { mode <- mode[1] mode <- match.arg(arg = mode) UseMethod(generic = 'GetImage', object = object) } #' Get tissue coordinates #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return A data frame with tissue coordinates #' #' @rdname GetTissueCoordinates #' @export GetTissueCoordinates #' #' @concept data-access #' GetTissueCoordinates <- function(object, ...) { UseMethod(generic = 'GetTissueCoordinates', object = object) } #' Highly Variable Features #' #' Get and set variable feature information for an \code{\link{Assay}} object. #' \code{HVFInfo} and \code{VariableFeatures} utilize generally variable #' features, while \code{SVFInfo} and \code{SpatiallyVariableFeatures} are #' restricted to spatially variable features #' #' @param object An object #' @param selection.method Which method to pull. For \code{HVFInfo} and #' \code{VariableFeatures}, choose one from one of the #' following: #' \itemize{ #' \item \dQuote{vst} #' \item \dQuote{sctransform} or \dQuote{sct} #' \item \dQuote{mean.var.plot}, \dQuote{dispersion}, \dQuote{mvp}, or #' \dQuote{disp} #' } #' For \code{SVFInfo} and \code{SpatiallyVariableFeatures}, choose from: #' \itemize{ #' \item \dQuote{markvariogram} #' \item \dQuote{moransi} #' } #' @param status Add variable status to the resulting data frame #' #' @param ... Arguments passed to other methods #' #' @return \code{HVFInfo}: A data frame with feature means, dispersion, and #' scaled dispersion #' #' @rdname VariableFeatures #' @export HVFInfo #' #' @order 1 #' #' @concept data-access #' HVFInfo <- function(object, selection.method, status = FALSE, ...) { UseMethod(generic = 'HVFInfo', object = object) } #' Get, set, and manipulate an object's identity classes #' #' @param x,object An object #' @param ... Arguments passed to other methods; for \code{RenameIdents}: named #' arguments as \code{old.ident = new.ident}; for \code{ReorderIdent}: arguments #' passed on to \code{\link{FetchData}} #' #' @return \code{Idents}: The cell identities #' #' @rdname Idents #' @export Idents #' #' @concept seurat #' #' @examples #' # Get cell identity classes #' Idents(pbmc_small) #' Idents <- function(object, ... ) { UseMethod(generic = 'Idents', object = object) } #' @param value The name of the identities to pull from object metadata or the #' identities themselves #' #' @return \code{Idents<-}: \code{object} with the cell identities changed #' #' @rdname Idents #' @export Idents<- #' #' @examples #' # Set cell identity classes #' # Can be used to set identities for specific cells to a new level #' Idents(pbmc_small, cells = 1:4) <- 'a' #' head(Idents(pbmc_small)) #' #' # Can also set idents from a value in object metadata #' colnames(pbmc_small[[]]) #' Idents(pbmc_small) <- 'RNA_snn_res.1' #' levels(pbmc_small) #' "Idents<-" <- function(object, ..., value) { UseMethod(generic = 'Idents<-', object = object) } #' Get Neighbor algorithm index #' #' @param object An object #' @param ... Arguments passed to other methods; #' #' @return Returns the value in the alg.idx slot of the Neighbor object #' #' @rdname Index #' @export Index #' #' @concept data-access #' Index <- function(object, ...) { UseMethod(generic = "Index", object = object) } #' @param value The index to store #' #' @return \code{Idents<-}: A Neighbor object with the index stored #' #' @rdname Index #' @export Index<- #' "Index<-" <- function(object, ..., value) { UseMethod(generic = 'Index<-', object = object) } #' Get Neighbor nearest neighbor index matrices #' #' @param object An object #' @param ... Arguments passed to other methods; #' #' @return A matrix with the nearest neighbor indices #' #' @rdname Indices #' @export Indices #' #' @concept data-access #' Indices <- function(object, ...) { UseMethod(generic = "Indices", object = object) } #' Is an object global/persistent? #' #' Typically, when removing \code{Assay} objects from an \code{Seurat} object, #' all associated objects (eg. \code{DimReduc}, \code{Graph}, and #' \code{SeuratCommand} objects) #' are removed as well. If an associated object is marked as global/persistent, #' the associated object will remain even if its original assay was deleted #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return \code{TRUE} if the object is global/persistent otherwise \code{FALSE} #' #' @rdname IsGlobal #' @export IsGlobal #' #' @concept data-access #' #' @examples #' IsGlobal(pbmc_small[['pca']]) #' IsGlobal <- function(object, ...) { UseMethod(generic = 'IsGlobal', object = object) } #' Get and set JackStraw information #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return \code{JS}: either a \code{\link{JackStrawData}} object or the #' specified jackstraw data #' #' @rdname JS #' @export JS #' #' @concept jackstraw #' JS <- function(object, ...) { UseMethod(generic = 'JS', object = object) } #' @param value JackStraw information #' #' @return \code{JS<-}: \code{object} with the update jackstraw information #' #' @rdname JS #' @export JS<- #' "JS<-" <- function(object, ..., value) { UseMethod(generic = 'JS<-', object = object) } #' Get and set object keys #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return \code{Key}: the object key #' #' @rdname Key #' @export Key #' #' @concept data-access #' Key <- function(object, ...) { UseMethod(generic = 'Key', object = object) } #' @param value Key value #' #' @return \code{Key<-}: \code{object} with an updated key #' #' @rdname Key #' @export Key<- #' #' @concept data-access #' "Key<-" <- function(object, ..., value) { UseMethod(generic = 'Key<-', object = object) } #' Get and set feature loadings #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return \code{Loadings}: the feature loadings for \code{object} #' #' @rdname Loadings #' @export Loadings #' #' @concept data-access #' Loadings <- function(object, ...) { UseMethod(generic = 'Loadings', object = object) } #' @param value Feature loadings to add #' #' @return \code{Loadings<-}: \code{object} with the updated loadings #' #' @rdname Loadings #' @export Loadings<- #' "Loadings<-" <- function(object, ..., value) { UseMethod(generic = 'Loadings<-', object = object) } #' Get and set miscellaneous data #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return Miscellaneous data #' #' @rdname Misc #' @export Misc #' #' @concept data-access #' Misc <- function(object, ...) { UseMethod(generic = 'Misc', object = object) } #' @param value Data to add #' #' @return An object with miscellaneous data added #' #' @rdname Misc #' @export Misc<- #' "Misc<-" <- function(object, ..., value) { UseMethod(generic = 'Misc<-', object = object) } #' Get and set project information #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return Project information #' #' @rdname Project #' @export Project #' #' @concept seurat #' Project <- function(object, ...) { UseMethod(generic = 'Project', object = object) } #' @param value Project information to set #' #' @return An object with project information added #' #' @rdname Project #' @export Project<- #' "Project<-" <- function(object, ..., value) { UseMethod(generic = 'Project<-', object = object) } #' Get the spot radius from an image #' #' @param object An image object #' #' @return The radius size #' #' @rdname Radius #' @export Radius #' #' @concept spatialimage #' Radius <- function(object) { UseMethod(generic = 'Radius', object = object) } #' Rename cells #' #' Change the cell names in all the different parts of an object. Can be useful #' before combining multiple objects. #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return An object with new cell names #' #' @rdname RenameCells #' @export RenameCells #' #' @concept seurat #' RenameCells <- function(object, ...) { UseMethod(generic = 'RenameCells', object = object) } #' @return \code{RenameIdents}: An object with selected identity classes renamed #' #' @rdname Idents #' @export RenameIdents #' @aliases RenameIdent #' #' @examples #' # Rename cell identity classes #' # Can provide an arbitrary amount of idents to rename #' levels(pbmc_small) #' pbmc_small <- RenameIdents(pbmc_small, '0' = 'A', '2' = 'C') #' levels(pbmc_small) #' RenameIdents <- function(object, ...) { UseMethod(generic = 'RenameIdents', object = object) } #' @param var Feature or variable to order on #' #' @return \code{ReorderIdent}: An object with #' #' @rdname Idents #' @export ReorderIdent #' @aliases ReorderIdent #' #' @examples #' \dontrun{ #' head(Idents(pbmc_small)) #' pbmc_small <- ReorderIdent(pbmc_small, var = 'PC_1') #' head(Idents(pbmc_small)) #' } #' ReorderIdent <- function(object, var, ...) { UseMethod(generic = 'ReorderIdent', object = object) } #' @param new.data New assay data to add #' #' @return \code{SetAssayData}: \code{object} with the assay data set #' #' @rdname AssayData #' @export SetAssayData #' #' @order 2 #' #' SetAssayData <- function(object, slot, new.data, ...) { UseMethod(generic = 'SetAssayData', object = object) } #' @return \code{SetIdent}: An object with new identity classes set #' #' @rdname Idents #' @export SetIdent #' #' @examples #' # Set cell identity classes using SetIdent #' cells.use <- WhichCells(pbmc_small, idents = '1') #' pbmc_small <- SetIdent(pbmc_small, cells = cells.use, value = 'B') #' SetIdent <- function(object, ...) { UseMethod(generic = 'SetIdent', object = object) } #' @return \code{SpatiallyVariableFeatures}: a character vector of the spatially #' variable features #' #' @rdname VariableFeatures #' @export SpatiallyVariableFeatures #' #' @order 5 #' SpatiallyVariableFeatures <- function(object, selection.method, ...) { UseMethod(generic = 'SpatiallyVariableFeatures', object = object) } #' @return \code{StashIdent}: An object with the identities stashed #' #' @rdname Idents #' @export StashIdent #' #' @examples #' head(pbmc_small[[]]) #' pbmc_small <- StashIdent(pbmc_small, save.name = 'idents') #' head(pbmc_small[[]]) #' StashIdent <- function(object, save.name, ...) { UseMethod(generic = 'StashIdent', object = object) } #' Get the standard deviations for an object #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return The standard deviations #' #' @rdname Stdev #' @export Stdev #' #' @concept data-access #' Stdev <- function(object, ...) { UseMethod(generic = 'Stdev', object = object) } #' @return \code{SVFInfo}: a data frame with the spatially variable features #' #' @rdname VariableFeatures #' @export SVFInfo #' #' @order 4 #' SVFInfo <- function(object, selection.method, status, ...) { UseMethod(generic = 'SVFInfo', object = object) } #' Get and set additional tool data #' #' Use \code{Tool} to get tool data. If no additional arguments are provided, #' will return a vector with the names of tools in the object. #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return If no additional arguments, returns the names of the tools in the #' object; otherwise returns the data placed by the tool requested #' #'@note For developers: set tool data using \code{Tool<-}. \code{Tool<-} will #'automatically set the name of the tool to the function that called #'\code{Tool<-},so each function gets one entry in the tools list and cannot #'overwrite another function's entry. The automatic naming will also remove any #'method identifiers (eg. RunPCA.Seurat will become RunPCA); please #'plan accordingly. #' #' @rdname Tool #' @export Tool #' #' @aliases Tools #' #' @concept data-access #' Tool <- function(object, ...) { UseMethod(generic = 'Tool', object = object) } #' @param value Information to be added to tool list #' #' @rdname Tool #' @export Tool<- #' "Tool<-" <- function(object, ..., value) { UseMethod(generic = 'Tool<-', object = object) } #' @return \code{VariableFeatures}: a vector of the variable features #' #' @rdname VariableFeatures #' @export VariableFeatures #' #' @order 2 #' VariableFeatures <- function(object, selection.method = NULL, ...) { UseMethod(generic = 'VariableFeatures', object = object) } #' @param value A character vector of variable features #' #' @order 3 #' #' @rdname VariableFeatures #' @export VariableFeatures<- #' "VariableFeatures<-" <- function(object, ..., value) { UseMethod(generic = 'VariableFeatures<-', object = object) } #' Get Version Information #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @rdname Version #' @export Version #' #' @concept data-access #' #' @examples #' Version(pbmc_small) #' Version <- function(object, ...) { UseMethod(generic = "Version", object = object) } #' Identify cells matching certain criteria #' #' Returns a list of cells that match a particular set of criteria such as #' identity class, high/low values for particular PCs, etc. #' #' @param object An object #' @param ... Arguments passed to other methods #' #' @return A vector of cell names #' #' @rdname WhichCells #' @export WhichCells #' #' @concept data-access #' #' @seealso \code{\link{FetchData}} #' #' @examples #' WhichCells(pbmc_small, idents = 2) #' WhichCells(pbmc_small, expression = MS4A1 > 3) #' levels(pbmc_small) #' WhichCells(pbmc_small, idents = c(1, 2), invert = TRUE) #' WhichCells <- function(object, ...) { UseMethod(generic = 'WhichCells', object = object) } SeuratObject/R/zzz.R0000644000175000017500000000736314146000252014162 0ustar nileshnilesh#' @include utils.R #' @importFrom methods setOldClass setClassUnion slot slot<- #' @importClassesFrom Matrix dgCMatrix #' NULL #' @docType package #' @name SeuratObject-package #' @rdname SeuratObject-package #' "_PACKAGE" #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Reexports #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @importFrom Matrix colMeans #' @export #' Matrix::colMeans #' @importFrom Matrix colSums #' @export #' Matrix::colSums #' @importFrom Matrix rowMeans #' @export #' Matrix::rowMeans #' @importFrom Matrix rowSums #' @export #' Matrix::rowSums #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Class definitions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% setClassUnion(name = 'AnyMatrix', members = c("matrix", "dgCMatrix")) setClassUnion(name = 'OptionalCharacter', members = c('NULL', 'character')) setClassUnion(name = 'OptionalList', members = c('NULL', 'list')) setOldClass(Classes = 'package_version') #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Internal #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Add Object Metadata #' #' Internal \code{\link{AddMetaData}} definition #' #' @param object An object #' @param metadata A vector, list, or data.frame with metadata to add #' @param col.name A name for meta data if not a named list or data.frame #' #' @return object with metadata added #' #' @keywords internal #' #' @noRd #' .AddMetaData <- function(object, metadata, col.name = NULL) { if (is.null(x = col.name) && is.atomic(x = metadata)) { stop("'col.name' must be provided for atomic metadata types (eg. vectors)") } if (inherits(x = metadata, what = c('matrix', 'Matrix'))) { metadata <- as.data.frame(x = metadata) } col.name <- col.name %||% names(x = metadata) %||% colnames(x = metadata) if (is.null(x = col.name)) { stop("No metadata name provided and could not infer it from metadata object") } object[[col.name]] <- metadata return(object) } #' Head and Tail Object Metadata #' #' Internal \code{\link[utils]{head}} and \code{\link[utils]{tail}} definitions #' #' @param x An object #' @param n Number of rows to return #' @inheritDotParams utils::head #' #' @return The first or last \code{n} rows of object metadata #' #' @keywords internal #' #' @noRd #' .head <- function(x, n = 10L, ...) { return(head(x = x[[]], n = n, ...)) } .tail <- function(x, n = 10L, ...) { return(tail(x = x[[]], n = n, ...)) } #' Miscellaneous Data #' #' Internal functions for getting and setting miscellaneous data #' #' @param object An object #' @param slot Name of miscellaneous data to get or set #' @param ... Arguments passed to other methods #' #' @return \code{.Misc}: If \code{slot} is \code{NULL}, all miscellaneous #' data, otherwise the miscellaneous data for \code{slot} #' #' @keywords internal #' #' @noRd #' .Misc <- function(object, slot = NULL, ...) { CheckDots(...) if (is.null(x = slot)) { return(slot(object = object, name = 'misc')) } return(slot(object = object, name = 'misc')[[slot]]) } #' @param value Data to add #' #' @return \code{.Misc<-}: \code{object} with \code{value} added to the #' miscellaneous data slot \code{slot} #' #' @rdname dot-Misc #' #' @noRd #' ".Misc<-" <- function(object, slot, ..., value) { CheckDots(...) if (slot %in% names(x = Misc(object = object))) { warning( "Overwriting miscellanous data for ", slot, call. = FALSE, immediate. = TRUE ) } if (is.list(x = value)) { slot(object = object, name = 'misc')[[slot]] <- c(value) } else { slot(object = object, name = 'misc')[[slot]] <- value } return(object) } SeuratObject/R/jackstraw.R0000644000175000017500000001131214133577537015330 0ustar nileshnilesh#' @include zzz.R #' @include generics.R #' @importFrom methods slot slot<- slotNames #' NULL #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Class definitions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' The JackStrawData Class #' #' The JackStrawData is used to store the results of a JackStraw computation. #' #' @slot empirical.p.values Empirical p-values #' @slot fake.reduction.scores Fake reduction scores #' @slot empirical.p.values.full Empirical p-values on full #' @slot overall.p.values Overall p-values from ScoreJackStraw #' #' @name JackStrawData-class #' @rdname JackStrawData-class #' @exportClass JackStrawData #' JackStrawData <- setClass( Class = "JackStrawData", slots = list( empirical.p.values = "matrix", fake.reduction.scores = "matrix", empirical.p.values.full = "matrix", overall.p.values = "matrix" ) ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Functions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for Seurat-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @rdname JS #' @export #' @method JS JackStrawData #' JS.JackStrawData <- function(object, slot, ...) { CheckDots(...) slot <- switch( EXPR = slot, 'empirical' = 'empirical.p.values', 'fake' = 'fake.reduction.scores', 'full' = 'empirical.p.values.full', 'overall' = 'overall.p.values', slot ) return(slot(object = object, name = slot)) } #' @rdname JS #' @export #' @method JS<- JackStrawData #' "JS<-.JackStrawData" <- function(object, slot, ..., value) { CheckDots(...) slot <- switch( EXPR = slot, 'empirical' = 'empirical.p.values', 'fake' = 'fake.reduction.scores', 'full' = 'empirical.p.values.full', 'overall' = 'overall.p.values', slot ) slot(object = object, name = slot) <- value return(object) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for R-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' \code{JackStrawData} Methods #' #' Methods for \code{\link{JackStrawData}} objects for generics defined in #' other packages #' #' @param x,object A \code{\link{JackStrawData}} object #' @param ... Ignored #' #' @name JackStrawData-methods #' @rdname JackStrawData-methods #' #' @concept jackstraw #' NULL #' @describeIn JackStrawData-methods Autocompletion for \code{$} access on a #' \code{JackStrawData} object #' #' @inheritParams utils::.DollarNames #' #' @importFrom utils .DollarNames #' @export #' @method .DollarNames JackStrawData #' ".DollarNames.JackStrawData" <- function(x, pattern = '') { slotnames <- as.list(x = slotNames(x = x)) names(x = slotnames) <- unlist(x = slotnames) return(.DollarNames(x = slotnames, pattern = pattern)) } #' @describeIn JackStrawData-methods Access data from a \code{JackStrawData} #' object #' #' @param i A \code{JackStrawData} slot name #' #' @return \code{$}: Slot \code{i} from \code{x} #' @export #' "$.JackStrawData" <- function(x, i, ...) { return(slot(object = x, name = i)) } #' @describeIn JackStrawData-methods Have empirical p-values for a #' \code{JackStrawData} object been calculated #' #' @return \code{as.logical}: \code{TRUE} if empirical p-values have been #' calculated otherwise \code{FALSE} #' #' @export #' @method as.logical JackStrawData #' as.logical.JackStrawData <- function(x, ...) { CheckDots(...) empP <- JS(object = x, slot = 'empirical') return(!(all(dim(x = empP) == 0) || all(is.na(x = empP)))) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # S4 methods #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @describeIn JackStrawData-methods Overview of a \code{JackStrawData} object #' #' @return \code{show}: Prints summary to \code{\link[base]{stdout}} and #' invisibly returns \code{NULL} #' #' @importFrom utils head #' @importFrom methods show #' #' @export #' setMethod( f = 'show', signature = 'JackStrawData', definition = function(object) { empp <- object$empirical.p.values scored <- object$overall.p.values cat( "A JackStrawData object simulated on", nrow(x = empp), "features for", ncol(x = empp), "dimensions.\n", "Scored for:", nrow(x = scored), "dimensions.\n" ) return(invisible(x = NULL)) } ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Internal #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SeuratObject/R/command.R0000644000175000017500000002064514133577537014766 0ustar nileshnilesh#' @include zzz.R #' @include generics.R #' @importFrom methods new slot slot<- #' NULL #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Class definitions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' The SeuratCommand Class #' #' The SeuratCommand is used for logging commands that are run on a #' \code{Seurat} object; it stores parameters and timestamps #' #' @slot name Command name #' @slot time.stamp Timestamp of when command was tun #' @slot assay.used Optional name of assay used to generate #' \code{SeuratCommand} object #' @slot call.string String of the command call #' @slot params List of parameters used in the command call #' #' @name SeuratCommand-class #' @rdname SeuratCommand-class #' @exportClass SeuratCommand #' SeuratCommand <- setClass( Class = 'SeuratCommand', slots = c( name = 'character', time.stamp = 'POSIXct', assay.used = 'OptionalCharacter', call.string = 'character', params = 'ANY' ) ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Functions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Log a command #' #' Logs command run, storing the name, timestamp, and argument list. Stores in #' the Seurat object #' #' @param object Name of Seurat object #' @param return.command Return a \link{SeuratCommand} object instead #' #' @return If \code{return.command}, returns a SeuratCommand object. Otherwise, #' returns the Seurat object with command stored #' #' @export #' #' @concept command #' #' @seealso \code{\link{Command}} #' LogSeuratCommand <- function(object, return.command = FALSE) { time.stamp <- Sys.time() object <- UpdateSlots(object = object) #capture function name which.frame <- sys.nframe() - 1 if (which.frame < 1) { stop("'LogSeuratCommand' cannot be called at the top level", call. = FALSE) } if (as.character(x = sys.calls()[[1]])[1] == "do.call") { call.string <- deparse(expr = sys.calls()[[1]]) command.name <- as.character(x = sys.calls()[[1]])[2] } else { command.name <- as.character(x = deparse(expr = sys.calls()[[which.frame]])) command.name <- gsub( pattern = "\\.Seurat", replacement = "", x = command.name ) call.string <- command.name command.name <- ExtractField( string = command.name, field = 1, delim = "\\(" ) } #capture function arguments argnames <- names(x = formals(fun = sys.function(which = sys.parent(n = 1)))) argnames <- grep( pattern = "object", x = argnames, invert = TRUE, value = TRUE ) argnames <- grep( pattern = "anchorset", x = argnames, invert = TRUE, value = TRUE ) argnames <- grep( pattern = "\\.\\.\\.", x = argnames, invert = TRUE, value = TRUE ) params <- list() p.env <- parent.frame(n = 1) argnames <- intersect(x = argnames, y = ls(name = p.env)) # fill in params list for (arg in argnames) { param_value <- get(x = arg, envir = p.env) if (inherits(x = param_value, what = 'Seurat')) { next } #TODO Institute some check of object size? params[[arg]] <- param_value } # check if function works on the Assay and/or the DimReduc Level assay <- params[["assay"]] reduction <- params[["reduction"]] # Get assay used for command cmd.assay <- assay %||% (reduction %iff% if (inherits(x = reduction, what = 'DimReduc')) { DefaultAssay(object = reduction) } else if (reduction %in% Reductions(object = object)) { DefaultAssay(object = object[[reduction]]) }) if (inherits(x = reduction, what = 'DimReduc')) { reduction <- 'DimReduc' } # rename function name to include Assay/DimReduc info if (length(x = assay) == 1) { command.name <- paste(command.name, assay, reduction, sep = '.') } command.name <- sub( pattern = "[\\.]+$", replacement = "", x = command.name, perl = TRUE ) command.name <- sub(pattern = "\\.\\.", replacement = "\\.", x = command.name, perl = TRUE) # store results seurat.command <- new( Class = 'SeuratCommand', name = command.name, params = params, time.stamp = time.stamp, call.string = call.string, assay.used = cmd.assay ) if (return.command) { return(seurat.command) } object[[command.name]] <- seurat.command return(object) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for Seurat-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @rdname DefaultAssay #' @export #' @method DefaultAssay SeuratCommand #' DefaultAssay.SeuratCommand <- function(object, ...) { object <- UpdateSlots(object = object) return(slot(object = object, name = 'assay.used')) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for R-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' \code{SeuratCommand} Methods #' #' Methods for \code{\link{SeuratCommand}} objects for generics defined in #' other packages #' #' @param x,object A \code{\link{SeuratCommand}} object #' @param ... Arguments passed to other methods #' #' @name SeuratCommand-methods #' @rdname SeuratCommand-methods #' #' @concept command #' NULL #' @describeIn SeuratCommand-methods Autocompletion for \code{$} access on a #' \code{SeuratCommand} object #' #' @inheritParams utils::.DollarNames #' #' @importFrom utils .DollarNames #' @export #' @method .DollarNames SeuratCommand #' ".DollarNames.SeuratCommand" <- function(x, pattern = '') { return(.DollarNames(x = slot(object = x, name = "params"), pattern = pattern)) } #' @describeIn SeuratCommand-methods Access a parameter from a #' \code{SeuratCommand} object #' #' @param i For a \code{$}, a parameter name; for \code{[}, a #' \code{SeuratCommand} slot name #' #' @return \code{$}: The value for parameter \code{i} #' #' @export #' "$.SeuratCommand" <- function(x, i, ...) { params <- slot(object = x, name = "params") return(params[[i]]) } #' @describeIn SeuratCommand-methods Access data from a \code{SeuratCommand} #' object #' #' @return \code{[}: Slot \code{i} from \code{x} #' #' @export #' @method [ SeuratCommand #' "[.SeuratCommand" <- function(x, i, ...) { slot.use <- c("name", "timestamp", "call_string", "params") if (!i %in% slot.use) { stop("Invalid slot") } return(slot(object = x, name = i)) } #' @describeIn SeuratCommand-methods Coerce a \code{SeuratCommand} to a list #' #' @param complete Include slots besides just parameters #' (eg. call string, name, timestamp) #' #' @return \code{as.list}: A list with the parameters and, if #' \code{complete = TRUE}, the call string, name, and timestamp #' #' @export #' @method as.list SeuratCommand #' as.list.SeuratCommand <- function(x, complete = FALSE, ...) { CheckDots(...) cmd <- slot(object = x, name = 'params') if (complete) { cmd <- append( x = cmd, values = sapply( X = grep( pattern = 'params', x = slotNames(x = x), invert = TRUE, value = TRUE ), FUN = slot, object = x, simplify = FALSE, USE.NAMES = TRUE ), after = 0 ) } for (i in 1:length(x = cmd)) { if (is.character(x = cmd[[i]])) { cmd[[i]] <- paste(trimws(x = cmd[[i]]), collapse = ' ') } } return(cmd) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # S4 methods #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @describeIn SeuratCommand-methods Overview of a \code{SeuratCommand} object #' #' @return \code{show}: Prints summary to \code{\link[base]{stdout}} and #' invisibly returns \code{NULL} #' #' @importFrom methods show #' #' @export #' setMethod( f = 'show', signature = 'SeuratCommand', definition = function(object) { params <- slot(object = object, name = "params") params <- params[sapply(X = params, FUN = class) != "function"] cat( "Command: ", slot(object = object, name = "call.string"), '\n', "Time: ", as.character(slot(object = object, name = "time.stamp")), '\n', sep = "" ) for (p in seq_len(length.out = length(x = params))) { cat( names(params[p]), ":", params[[p]], "\n" ) } } ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Internal #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SeuratObject/R/data.R0000644000175000017500000000207514133577537014256 0ustar nileshnilesh#' A small example version of the PBMC dataset #' #' A subsetted version of 10X Genomics' 3k PBMC dataset #' #' @format A Seurat object with the following slots filled #' \describe{ #' \item{assays}{ #' \itemize{Currently only contains one assay ("RNA" - scRNA-seq expression data) #' \item{counts - Raw expression data} #' \item{data - Normalized expression data} #' \item{scale.data - Scaled expression data} #' \item{var.features - names of the current features selected as variable} #' \item{meta.features - Assay level metadata such as mean and variance} #' }} #' \item{meta.data}{Cell level metadata} #' \item{active.assay}{Current default assay} #' \item{active.ident}{Current default idents} #' \item{graphs}{Neighbor graphs computed, currently stores the SNN} #' \item{reductions}{Dimensional reductions: currently PCA and tSNE} #' \item{version}{Seurat version used to create the object} #' \item{commands}{Command history} #' } #' @source \url{https://support.10xgenomics.com/single-cell-gene-expression/datasets/1.1.0/pbmc3k} #' "pbmc_small" SeuratObject/R/assay.R0000644000175000017500000010441314147216431014450 0ustar nileshnilesh#' @include zzz.R #' @include generics.R #' @importFrom methods new slot slot<- #' NULL #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Class definitions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' The Assay Class #' #' The Assay object is the basic unit of Seurat; each Assay stores raw, #' normalized, and scaled data as well as cluster information, variable #' features, and any other assay-specific metadata. Assays should contain single #' cell expression data such as RNA-seq, protein, or imputed expression data. #' #' @slot counts Unnormalized data such as raw counts or TPMs #' @slot data Normalized expression data #' @slot scale.data Scaled expression data #' @slot key Key for the Assay #' @slot assay.orig Original assay that this assay is based off of. Used to #' track assay provenance #' @slot var.features Vector of features exhibiting high variance across #' single cells #' @slot meta.features Feature-level metadata #' @slot misc Utility slot for storing additional data associated with the assay #' #' @name Assay-class #' @rdname Assay-class #' @exportClass Assay #' #' @concept assay #' #' @seealso \code{\link{Assay-methods}} #' Assay <- setClass( Class = 'Assay', slots = c( counts = 'AnyMatrix', data = 'AnyMatrix', scale.data = 'matrix', key = 'character', assay.orig = 'OptionalCharacter', var.features = 'vector', meta.features = 'data.frame', misc = 'OptionalList' ) ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Functions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Create an Assay object #' #' Create an Assay object from a feature (e.g. gene) expression matrix. The #' expected format of the input matrix is features x cells. #' #' Non-unique cell or feature names are not allowed. Please make unique before #' calling this function. #' #' @param counts Unnormalized data such as raw counts or TPMs #' @param data Prenormalized data; if provided, do not pass \code{counts} #' @param min.cells Include features detected in at least this many cells. Will #' subset the counts matrix as well. To reintroduce excluded features, create a #' 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 #' #' @importFrom methods as #' @importFrom Matrix colSums rowSums #' #' @export #' #' @concept assay #' #' @examples #' \dontrun{ #' pbmc_raw <- read.table( #' file = system.file('extdata', 'pbmc_raw.txt', package = 'Seurat'), #' as.is = TRUE #' ) #' pbmc_rna <- CreateAssayObject(counts = pbmc_raw) #' pbmc_rna #' } #' CreateAssayObject <- function( counts, data, min.cells = 0, min.features = 0, check.matrix = FALSE, ... ) { if (missing(x = counts) && missing(x = data)) { stop("Must provide either 'counts' or 'data'") } else if (!missing(x = counts) && !missing(x = data)) { stop("Either 'counts' or 'data' must be missing; both cannot be provided") } else if (!missing(x = counts)) { # check that dimnames of input counts are unique if (anyDuplicated(x = rownames(x = counts))) { warning( "Non-unique features (rownames) present in the input matrix, making unique", call. = FALSE, immediate. = TRUE ) rownames(x = counts) <- make.unique(names = rownames(x = counts)) } if (anyDuplicated(x = colnames(x = counts))) { warning( "Non-unique cell names (colnames) present in the input matrix, making unique", call. = FALSE, immediate. = TRUE ) colnames(x = counts) <- make.unique(names = colnames(x = counts)) } if (is.null(x = colnames(x = counts))) { stop("No cell names (colnames) names present in the input matrix") } if (any(rownames(x = counts) == '')) { stop("Feature names of counts matrix cannot be empty", call. = FALSE) } if (nrow(x = counts) > 0 && is.null(x = rownames(x = counts))) { stop("No feature names (rownames) names present in the input matrix") } if (!inherits(x = counts, what = 'dgCMatrix')) { 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) { nfeatures <- Matrix::colSums(x = counts > 0) counts <- counts[, which(x = nfeatures >= min.features)] } # filter genes on the number of cells expressing if (min.cells > 0) { num.cells <- Matrix::rowSums(x = counts > 0) counts <- counts[which(x = num.cells >= min.cells), ] } data <- counts } else if (!missing(x = data)) { # check that dimnames of input data are unique if (anyDuplicated(x = rownames(x = data))) { warning( "Non-unique features (rownames) present in the input matrix, making unique", call. = FALSE, immediate. = TRUE ) rownames(x = data) <- make.unique(names = rownames(x = data)) } if (anyDuplicated(x = colnames(x = data))) { warning( "Non-unique cell names (colnames) present in the input matrix, making unique", call. = FALSE, immediate. = TRUE ) colnames(x = data) <- make.unique(names = colnames(x = data)) } if (is.null(x = colnames(x = data))) { stop("No cell names (colnames) names present in the input matrix") } if (any(rownames(x = data) == '')) { stop("Feature names of data matrix cannot be empty", call. = FALSE) } if (nrow(x = data) > 0 && is.null(x = rownames(x = data))) { stop("No feature names (rownames) names present in the input matrix") } if (min.cells != 0 | min.features != 0) { warning( "No filtering performed if passing to data rather than counts", call. = FALSE, immediate. = TRUE ) } counts <- new(Class = 'matrix') } # Ensure row- and column-names are vectors, not arrays if (!is.vector(x = rownames(x = counts))) { rownames(x = counts) <- as.vector(x = rownames(x = counts)) } if (!is.vector(x = colnames(x = counts))) { colnames(x = counts) <- as.vector(x = colnames(x = counts)) } if (!is.vector(x = rownames(x = data))) { rownames(x = data) <- as.vector(x = rownames(x = data)) } if (!is.vector(x = colnames(x = data))) { colnames(x = data) <- as.vector(x = colnames(x = data)) } if (any(grepl(pattern = '_', x = rownames(x = counts))) || any(grepl(pattern = '_', x = rownames(x = data)))) { warning( "Feature names cannot have underscores ('_'), replacing with dashes ('-')", call. = FALSE, immediate. = TRUE ) rownames(x = counts) <- gsub( pattern = '_', replacement = '-', x = rownames(x = counts) ) rownames(x = data) <- gsub( pattern = '_', replacement = '-', x = rownames(x = data) ) } if (any(grepl(pattern = '|', x = rownames(x = counts), fixed = TRUE)) || any(grepl(pattern = '|', x = rownames(x = data), fixed = TRUE))) { warning( "Feature names cannot have pipe characters ('|'), replacing with dashes ('-')", call. = FALSE, immediate. = TRUE ) rownames(x = counts) <- gsub( pattern = '|', replacement = '-', x = rownames(x = counts), fixed = TRUE ) rownames(x = data) <- gsub( pattern = '|', replacement = '-', x = rownames(x = data), fixed = TRUE ) } # Initialize meta.features init.meta.features <- data.frame(row.names = rownames(x = data)) assay <- new( Class = 'Assay', counts = counts, data = data, scale.data = new(Class = 'matrix'), meta.features = init.meta.features, misc = list() ) return(assay) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for Seurat-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @rdname AddMetaData #' @export #' @method AddMetaData Assay #' AddMetaData.Assay <- .AddMetaData #' @rdname DefaultAssay #' @export #' @method DefaultAssay Assay #' DefaultAssay.Assay <- function(object, ...) { object <- UpdateSlots(object = object) return(slot(object = object, name = 'assay.orig')) } #' @rdname DefaultAssay #' @export #' @method DefaultAssay<- Assay #' "DefaultAssay<-.Assay" <- function(object, ..., value) { object <- UpdateSlots(object = object) slot(object = object, name = 'assay.orig') <- value return(object) } #' @rdname AssayData #' @export #' @method GetAssayData Assay #' #' @examples #' # Get the data directly from an Assay object #' GetAssayData(pbmc_small[["RNA"]], slot = "data")[1:5,1:5] #' GetAssayData.Assay <- function( object, slot = c('data', 'scale.data', 'counts'), ... ) { CheckDots(...) slot <- slot[1] slot <- match.arg(arg = slot) return(slot(object = object, name = slot)) } #' @rdname VariableFeatures #' @export #' @method HVFInfo Assay #' #' @examples #' # Get the HVF info directly from an Assay object #' HVFInfo(pbmc_small[["RNA"]], selection.method = 'vst')[1:5, ] #' HVFInfo.Assay <- function(object, selection.method, status = FALSE, ...) { CheckDots(...) disp.methods <- c('mean.var.plot', 'dispersion', 'disp') if (tolower(x = selection.method) %in% disp.methods) { selection.method <- 'mvp' } selection.method <- switch( EXPR = tolower(x = selection.method), 'sctransform' = 'sct', selection.method ) vars <- switch( EXPR = selection.method, 'vst' = c('mean', 'variance', 'variance.standardized'), 'mvp' = c('mean', 'dispersion', 'dispersion.scaled'), 'sct' = c('gmean', 'variance', 'residual_variance'), stop("Unknown method: '", selection.method, "'", call. = FALSE) ) tryCatch( expr = hvf.info <- object[[paste(selection.method, vars, sep = '.')]], error = function(e) { stop( "Unable to find highly variable feature information for method '", selection.method, "'", call. = FALSE ) } ) colnames(x = hvf.info) <- vars if (status) { hvf.info$variable <- object[[paste0(selection.method, '.variable')]] } return(hvf.info) } #' @rdname Key #' @export #' @method Key Assay #' #' @examples #' # Get an Assay key #' Key(pbmc_small[["RNA"]]) #' Key.Assay <- function(object, ...) { CheckDots(...) return(slot(object = object, name = 'key')) } #' @rdname Key #' @export #' @method Key<- Assay #' #' @examples #' # Set the key for an Assay #' Key(pbmc_small[["RNA"]]) <- "newkey_" #' Key(pbmc_small[["RNA"]]) #' "Key<-.Assay" <- function(object, ..., value) { CheckDots(...) slot(object = object, name = 'key') <- value return(object) } #' @param slot Name of specific bit of meta data to pull #' #' @rdname Misc #' @export #' @method Misc Assay #' Misc.Assay <- .Misc #' @rdname Misc #' @export #' @method Misc<- Assay #' "Misc<-.Assay" <- `.Misc<-` #' @param new.names vector of new cell names #' #' @rdname RenameCells #' @export #' @method RenameCells Assay #' #' @examples #' # Rename cells in an Assay #' head(x = colnames(x = pbmc_small[["RNA"]])) #' renamed.assay <- RenameCells( #' pbmc_small[["RNA"]], #' new.names = paste0("A_", colnames(x = pbmc_small[["RNA"]])) #' ) #' head(x = colnames(x = renamed.assay)) #' RenameCells.Assay <- function(object, new.names = NULL, ...) { CheckDots(...) for (data.slot in c("counts", "data", "scale.data")) { old.data <- GetAssayData(object = object, slot = data.slot) if (ncol(x = old.data) <= 1) { next } colnames(x = slot(object = object, name = data.slot)) <- new.names } return(object) } #' @importFrom stats na.omit #' #' @rdname AssayData #' @export #' @method SetAssayData Assay #' #' @examples #' # Set an Assay slot directly #' count.data <- GetAssayData(pbmc_small[["RNA"]], slot = "counts") #' count.data <- as.matrix(x = count.data + 1) #' new.assay <- SetAssayData(pbmc_small[["RNA"]], slot = "counts", new.data = count.data) #' SetAssayData.Assay <- function( object, slot = c('data', 'scale.data', 'counts'), new.data, ... ) { CheckDots(...) slot <- slot[1] slot <- match.arg(arg = slot) if (!IsMatrixEmpty(x = new.data)) { if (any(grepl(pattern = '_', x = rownames(x = new.data)))) { warning( "Feature names cannot have underscores ('_'), replacing with dashes ('-')", call. = FALSE, immediate. = TRUE ) rownames(x = new.data) <- gsub( pattern = '_', replacement = '-', x = rownames(x = new.data) ) } if (ncol(x = new.data) != ncol(x = object)) { stop( "The new data doesn't have the same number of cells as the current data", call. = FALSE ) } num.counts <- nrow(x = object) counts.names <- rownames(x = object) if (slot == 'scale.data' && nrow(x = new.data) > num.counts) { warning( "Adding more features than present in current data", call. = FALSE, immediate. = TRUE ) } else if (slot %in% c('counts', 'data') && nrow(x = new.data) != num.counts) { warning( "The new data doesn't have the same number of features as the current data", call. = FALSE, immediate. = TRUE ) } if (!all(rownames(x = new.data) %in% counts.names)) { warning( "Adding features not currently present in the object", call. = FALSE, immediate. = TRUE ) } new.features <- na.omit(object = match( x = counts.names, table = rownames(x = new.data) )) new.cells <- colnames(x = new.data) if (!all(new.cells %in% colnames(x = object))) { stop( "All cell names must match current cell names", call. = FALSE ) } new.data <- new.data[new.features, colnames(x = object), drop = FALSE] if (slot %in% c('counts', 'data') && !all(dim(x = new.data) == dim(x = object))) { stop( "Attempting to add a different number of cells and/or features", call. = FALSE ) } } if (!is.vector(x = rownames(x = new.data))) { rownames(x = new.data) <- as.vector(x = rownames(x = new.data)) } if (!is.vector(x = colnames(x = new.data))) { colnames(x = new.data) <- as.vector(x = colnames(x = new.data)) } slot(object = object, name = slot) <- new.data return(object) } #' @param decreasing Return features in decreasing order (most spatially #' variable first). #' #' @rdname VariableFeatures #' @export #' @method SpatiallyVariableFeatures Assay #' SpatiallyVariableFeatures.Assay <- function( object, selection.method = "markvariogram", decreasing = TRUE, ... ) { CheckDots(...) vf <- SVFInfo(object = object, selection.method = selection.method, status = TRUE) vf <- vf[rownames(x = vf)[which(x = vf[, "variable"][, 1])], ] if (!is.null(x = decreasing)) { vf <- vf[order(x = vf[, "rank"], decreasing = !decreasing), ] } return(rownames(x = vf)[which(x = vf[, "variable"][, 1])]) } #' @rdname VariableFeatures #' @export #' @method SVFInfo Assay #' SVFInfo.Assay <- function( object, selection.method = c("markvariogram", "moransi"), status = FALSE, ... ) { CheckDots(...) selection.method <- selection.method[1] selection.method <- match.arg(arg = selection.method) vars <- switch( EXPR = selection.method, 'markvariogram' = grep( pattern = "r.metric", x = colnames(x = object[[]]), value = TRUE ), 'moransi' = grep( pattern = 'moransi', x = colnames(x = object[[]]), value = TRUE ), stop("Unknown method: '", selection.method, "'", call. = FALSE) ) tryCatch( expr = svf.info <- object[[vars]], error = function(e) { stop( "Unable to find highly variable feature information for method '", selection.method, "'", call. = FALSE ) } ) colnames(x = svf.info) <- vars if (status) { svf.info$variable <- object[[paste0(selection.method, '.spatially.variable')]] svf.info$rank <- object[[paste0(selection.method, '.spatially.variable.rank')]] } return(svf.info) } #' @rdname VariableFeatures #' @export #' @method VariableFeatures Assay #' VariableFeatures.Assay <- function(object, selection.method = NULL, ...) { CheckDots(...) if (!is.null(x = selection.method)) { vf <- HVFInfo( object = object, selection.method = selection.method, status = TRUE ) return(rownames(x = vf)[which(x = vf[, "variable"][, 1])]) } return(slot(object = object, name = 'var.features')) } #' @rdname VariableFeatures #' @export #' @method VariableFeatures<- Assay #' "VariableFeatures<-.Assay" <- function(object, ..., value) { CheckDots(...) if (length(x = value) == 0) { slot(object = object, name = 'var.features') <- character(length = 0) return(object) } if (any(grepl(pattern = '_', x = value))) { warning( "Feature names cannot have underscores '_', replacing with dashes '-'", call. = FALSE, immediate = TRUE ) value <- gsub(pattern = '_', replacement = '-', x = value) } value <- split(x = value, f = value %in% rownames(x = object)) if (length(x = value[['FALSE']]) > 0) { if (length(x = value[['TRUE']]) == 0) { stop( "None of the features provided are in this Assay object", call. = FALSE ) } else { warning( "Not all features provided are in this Assay object, removing the following feature(s): ", paste(value[['FALSE']], collapse = ', '), call. = FALSE, immediate. = TRUE ) } } slot(object = object, name = 'var.features') <- value[['TRUE']] return(object) } #' @param cells Subset of cell names #' @param expression A predicate expression for feature/variable expression, #' can evaluate anything that can be pulled by \code{FetchData}; please note, #' you may need to wrap feature names in backticks (\code{``}) if dashes #' between numbers are present in the feature name #' @param invert Invert the selection of cells #' #' @importFrom stats na.omit #' @importFrom rlang is_quosure enquo eval_tidy #' #' @rdname WhichCells #' @export #' @method WhichCells Assay #' WhichCells.Assay <- function( object, cells = NULL, expression, invert = FALSE, ... ) { CheckDots(...) cells <- cells %||% colnames(x = object) if (!missing(x = expression) && !is.null(x = substitute(expr = expression))) { key.pattern <- paste0('^', Key(object = object)) expr <- if (tryCatch(expr = is_quosure(x = expression), error = function(...) FALSE)) { expression } else if (is.call(x = enquo(arg = expression))) { enquo(arg = expression) } else { parse(text = expression) } expr.char <- suppressWarnings(expr = as.character(x = expr)) expr.char <- unlist(x = lapply(X = expr.char, FUN = strsplit, split = ' ')) expr.char <- gsub( pattern = key.pattern, replacement = '', x = expr.char, perl = TRUE ) expr.char <- gsub( pattern = '(', replacement = '', x = expr.char, fixed = TRUE ) expr.char <- gsub( pattern = '`', replacement = '', x = expr.char ) vars.use <- which(x = expr.char %in% rownames(x = object)) expr.char <- expr.char[vars.use] data.subset <- as.data.frame(x = t(x = as.matrix(x = object[expr.char, ]))) colnames(x = data.subset) <- expr.char cells <- rownames(x = data.subset)[eval_tidy(expr = expr, data = data.subset)] } if (invert) { cells <- colnames(x = object)[!colnames(x = object) %in% cells] } cells <- na.omit(object = unlist(x = cells, use.names = FALSE)) return(as.character(x = cells)) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for R-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' \code{Assay} Methods #' #' Methods for \code{\link{Assay}} objects for generics defined in #' other packages #' #' @param x,object An \code{\link{Assay}} object #' @param i,features For \code{[[}: metadata names; for all other methods, #' feature names or indices #' @param j,cells Cell names or indices #' @param ... Arguments passed to other methods #' #' @name Assay-methods #' @rdname Assay-methods #' #' @concept assay #' NULL #' @describeIn Assay-methods Get expression data from an \code{Assay} #' #' @return \code{[}: The \code{data} slot for features \code{i} and cells #' \code{j} #' #' @export #' @method [ Assay #' "[.Assay" <- function(x, i, j, ...) { if (missing(x = i)) { i <- seq_len(length.out = nrow(x = x)) } if (missing(x = j)) { j <- seq_len(length.out = ncol(x = x)) } return(GetAssayData(object = x)[i, j, ..., drop = FALSE]) } #' @describeIn Assay-methods Get feature-level metadata #' #' @param drop See \code{\link[base]{drop}} #' #' @return \code{[[}: The feature-level metadata for \code{i} #' #' @export #' @method [[ Assay #' "[[.Assay" <- function(x, i, ..., drop = FALSE) { if (missing(x = i)) { i <- colnames(x = slot(object = x, name = 'meta.features')) } data.return <- slot(object = x, name = 'meta.features')[, i, drop = FALSE, ...] if (drop) { data.return <- unlist(x = data.return, use.names = FALSE) names(x = data.return) <- rep.int(x = rownames(x = x), times = length(x = i)) } return(data.return) } #' @describeIn Assay-methods Number of cells and features for an \code{Assay} #' #' @return \code{dim}: The number of features (\code{nrow}) and cells #' (\code{ncol}) #' #' @export #' @method dim Assay #' dim.Assay <- function(x) { return(dim(x = GetAssayData(object = x))) } #' @describeIn Assay-methods Cell- and feature-names for an \code{Assay} #' #' @return \code{dimnames}: Feature (row) and cell (column) names #' #' @export #' @method dimnames Assay #' dimnames.Assay <- function(x) { return(dimnames(x = GetAssayData(object = x))) } #' @describeIn Assay-methods Get the first rows of feature-level metadata #' #' @inheritParams utils::head #' #' @return \code{head}: The first \code{n} rows of feature-level metadata #' #' @export #' @method head Assay #' head.Assay <- .head #' @describeIn Assay-methods Merge \code{Assay} objects #' #' @param y A vector or list of one or more objects to merge #' @param add.cell.ids A character vector of \code{length(x = c(x, y))}; #' appends the corresponding values to the start of each objects' cell names #' @param merge.data Merge the data slots instead of just merging the counts #' (which requires renormalization); this is recommended if the same #' normalization approach was applied to all objects #' #' @return \code{merge}: Merged object #' #' @export #' @method merge Assay #' merge.Assay <- function( x = NULL, y = NULL, add.cell.ids = NULL, merge.data = TRUE, ... ) { CheckDots(...) assays <- c(x, y) if (!is.null(x = add.cell.ids)) { for (i in seq_along(along.with = assays)) { assays[[i]] <- RenameCells( object = assays[[i]], new.names = add.cell.ids[i] ) } } # Merge the counts (if present) counts.mats <- lapply(X = assays, FUN = ValidateDataForMerge, slot = "counts") keys <- sapply(X = assays, FUN = Key) merged.counts <- RowMergeSparseMatrices( mat1 = counts.mats[[1]], mat2 = counts.mats[2:length(x = counts.mats)] ) combined.assay <- CreateAssayObject( counts = merged.counts, min.cells = -1, min.features = -1 ) if (length(x = unique(x = keys)) == 1) { Key(object = combined.assay) <- keys[1] } if (merge.data) { data.mats <- lapply(X = assays, FUN = ValidateDataForMerge, slot = "data") merged.data <- RowMergeSparseMatrices( mat1 = data.mats[[1]], mat2 = data.mats[2:length(x = data.mats)] ) # only keep cells that made it through counts filtering params if (!all.equal(target = colnames(x = combined.assay), current = colnames(x = merged.data))) { merged.data <- merged.data[, colnames(x = combined.assay)] } combined.assay <- SetAssayData( object = combined.assay, slot = "data", new.data = merged.data ) } return(combined.assay) } #' @describeIn Assay-methods Subset an \code{Assay} #' #' @return \code{subset}: A subsetted \code{Assay} #' #' @importFrom stats na.omit #' #' @export #' @method subset Assay #' subset.Assay <- function(x, cells = NULL, features = NULL, ...) { CheckDots(...) cells <- cells %||% colnames(x = x) if (all(is.na(x = cells))) { cells <- colnames(x = x) } else if (any(is.na(x = cells))) { warning("NAs passed in cells vector, removing NAs") cells <- na.omit(object = cells) } features <- features %||% rownames(x = x) if (all(is.na(x = features))) { features <- rownames(x = x) } else if (any(is.na(x = features))) { warning("NAs passed in the features vector, removing NAs") features <- na.omit(object = features) } if (all(sapply(X = list(features, cells), FUN = length) == dim(x = x))) { return(x) } if (is.numeric(x = features)) { features <- rownames(x = x)[features] } features <- gsub( pattern = paste0('^', Key(object = x)), replacement = '', x = features ) features <- intersect(x = features, y = rownames(x = x)) if (length(x = features) == 0) { stop("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] } slot(object = x, name = "data") <- GetAssayData(object = x, slot = "data")[features, cells, drop = FALSE] cells.scaled <- colnames(x = GetAssayData(object = x, slot = "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 <- features.scaled[features.scaled %in% features] 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] } else { new(Class = 'matrix') } VariableFeatures(object = x) <- VariableFeatures(object = x)[VariableFeatures(object = x) %in% features] slot(object = x, name = 'meta.features') <- x[[]][features, , drop = FALSE] return(x) } #' @describeIn Assay-methods Get the last rows of feature-level metadata #' #' @return \code{tail}: The last \code{n} rows of feature-level metadata #' #' @importFrom utils tail #' #' @export #' @method tail Assay #' tail.Assay <- .tail #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # S4 methods #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @describeIn Assay-methods Add feature-level metadata #' #' @param value Additional metadata to add #' #' @return \code{[[<-}: \code{x} with metadata \code{value} added as \code{i} #' #' @export #' setMethod( f = '[[<-', signature = c('x' = 'Assay'), definition = function(x, i, ..., value) { meta.data <- x[[]] feature.names <- rownames(x = meta.data) if (is.data.frame(x = value)) { value <- lapply( X = 1:ncol(x = value), FUN = function(index) { v <- value[[index]] names(x = v) <- rownames(x = value) return(v) } ) } err.msg <- "Cannot add more or fewer meta.features information without values being named with feature names" if (length(x = i) > 1) { # Add multiple bits of feature-level metadata value <- rep_len(x = value, length.out = length(x = i)) for (index in 1:length(x = i)) { names.intersect <- intersect(x = names(x = value[[index]]), feature.names) if (length(x = names.intersect) > 0) { meta.data[names.intersect, i[index]] <- value[[index]][names.intersect] } else if (length(x = value) %in% c(nrow(x = meta.data), 1) %||% is.null(x = value)) { meta.data[i[index]] <- value[index] } else { stop(err.msg, call. = FALSE) } } } else { # Add a single column to feature-level metadata value <- unlist(x = value) if (length(x = intersect(x = names(x = value), y = feature.names)) > 0) { meta.data[, i] <- value[feature.names] } else if (length(x = value) %in% c(nrow(x = meta.data), 1) || is.null(x = value)) { meta.data[, i] <- value } else { stop(err.msg, call. = FALSE) } } slot(object = x, name = 'meta.features') <- meta.data return(x) } ) #' @describeIn Assay-methods Calculate \code{\link[base]{colMeans}} on an #' \code{Assay} #' #' @param slot Name of assay expression matrix to calculate column/row #' means/sums on #' @inheritParams Matrix::colMeans #' #' @return \code{colMeans}: The column (cell-wise) means of \code{slot} #' #' @importFrom Matrix colMeans #' #' @export #' setMethod( f = 'colMeans', signature = c('x' = 'Assay'), definition = function(x, na.rm = FALSE, dims = 1, ..., slot = 'data') { return(Matrix::colMeans( x = GetAssayData(object = x, slot = slot), na.rm = na.rm, dims = dims, ... )) } ) #' @describeIn Assay-methods Calculate \code{\link[base]{colSums}} on an #' \code{Assay} #' #' @return \code{colSums}: The column (cell-wise) sums of \code{slot} #' #' @importFrom Matrix colSums #' #' @export #' setMethod( f = 'colSums', signature = c('x' = 'Assay'), definition = function(x, na.rm = FALSE, dims = 1, ..., slot = 'data') { return(Matrix::colSums( x = GetAssayData(object = x, slot = slot), na.rm = na.rm, dims = dims, ... )) } ) #' @describeIn Assay-methods Calculate \code{\link[base]{rowMeans}} on an #' \code{Assay} #' #' @return \code{rowMeans}: The row (feature-wise) means of \code{slot} #' #' @importFrom Matrix rowMeans #' #' @export #' setMethod( f = 'rowMeans', signature = c('x' = 'Assay'), definition = function(x, na.rm = FALSE, dims = 1, ..., slot = 'data') { return(Matrix::rowMeans( x = GetAssayData(object = x, slot = slot), na.rm = na.rm, dims = dims, ... )) } ) #' @describeIn Assay-methods Calculate \code{\link[base]{rowSums}} on an #' \code{Assay} #' #' @return \code{rowSums}: The row (feature-wise) sums of \code{slot} #' #' @importFrom Matrix rowSums #' #' @export #' setMethod( f = 'rowSums', signature = c('x' = 'Assay'), definition = function(x, na.rm = FALSE, dims = 1, ..., slot = 'data') { return(Matrix::rowSums( x = GetAssayData(object = x, slot = slot), na.rm = na.rm, dims = dims, ... )) } ) #' @describeIn Assay-methods Overview of an \code{Assay} object #' #' @return \code{show}: Prints summary to \code{\link[base]{stdout}} and #' invisibly returns \code{NULL} #' #' @importFrom utils head #' @importFrom methods show #' #' @export #' setMethod( f = 'show', signature = 'Assay', definition = function(object) { cat( 'Assay data with', nrow(x = object), 'features for', ncol(x = object), 'cells\n' ) if (length(x = VariableFeatures(object = object)) > 0) { top.ten <- head(x = VariableFeatures(object = object), n = 10L) top <- 'Top' variable <- 'variable' } else { top.ten <- head(x = rownames(x = object), n = 10L) top <- 'First' variable <- '' } features <- paste0( variable, ' feature', if (length(x = top.ten) != 1) { 's' }, ":\n" ) features <- gsub(pattern = '^\\s+', replacement = '', x = features) cat( top, length(x = top.ten), features, paste(strwrap(x = paste(top.ten, collapse = ', ')), collapse = '\n'), '\n' ) return(invisible(x = NULL)) } ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Internal #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Calculate nCount and nFeature #' #' @param object An \code{\link{Assay}} object #' #' @return A named list with nCount and nFeature #' #' @importFrom Matrix colSums #' #' @keywords internal #' #' @noRd #' #' @examples #' \donttest{ #' calcn <- SeuratObject:::CalcN(pbmc_small[["RNA"]]) #' head(as.data.frame(calcn)) #' } #' CalcN <- function(object) { if (IsMatrixEmpty(x = GetAssayData(object = object, slot = "counts"))) { return(NULL) } return(list( nCount = Matrix::colSums(x = object, slot = 'counts'), nFeature = Matrix::colSums(x = GetAssayData(object = object, slot = 'counts') > 0) )) } #' Subset cells in vst data #' #' @param sct.info A vst.out list #' @param cells vector of cells to retain #' @param features vector of features to retain #' #' @keywords internal #' #' @noRd #' SubsetVST <- function(sct.info, cells, features) { cells.keep <- intersect(x = cells, y = rownames(x = sct.info$cell_attr)) sct.info$cell_attr <- sct.info$cell_attr[cells.keep, ] # find which subset of features are in the SCT assay feat.keep <- intersect(x = features, y = rownames(x = sct.info$gene_attr)) sct.info$gene_attr <- sct.info$gene_attr[feat.keep, ] return(sct.info) } #' Validate Assay Data for Merge #' #' Pulls the proper data matrix for merging assay data. If the slot is empty, #' will return an empty matrix with the proper dimensions from one of the #' remaining data slots. #' #' @param assay Assay to pull data from #' @param slot Slot to pull from #' #' @return Returns the data matrix if present (i.e.) not 0x0. Otherwise, #' returns an appropriately sized empty sparse matrix #' #' @importFrom methods as #' @importFrom Matrix Matrix #' #' @keywords internal #' #' @noRd #' ValidateDataForMerge <- function(assay, slot) { mat <- GetAssayData(object = assay, slot = 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.slot <- ss if (!any(data.dims == c(0, 0))) { break } } if (any(data.dims == c(0, 0))) { stop("The counts, data, and scale.data slots are all empty for the provided assay.") } mat <- Matrix( data = 0, nrow = data.dims[1], ncol = data.dims[2], dimnames = dimnames(x = GetAssayData(object = assay, slot = data.slot)) ) mat <- as(object = mat, Class = "dgCMatrix") } return(mat) } SeuratObject/R/seurat.R0000644000175000017500000030543114146000254014627 0ustar nileshnilesh#' @include zzz.R #' @include generics.R #' @include assay.R #' @include command.R #' @include dimreduc.R #' @include graph.R #' @include spatial.R #' @importFrom methods setClass #' @importClassesFrom Matrix dgCMatrix #' NULL #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Class definitions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' The Seurat Class #' #' The Seurat object is a representation of single-cell expression data for R; #' each Seurat object revolves around a set of cells and consists of one or more #' \code{\link{Assay}} objects, or individual representations of #' expression data (eg. RNA-seq, ATAC-seq, etc). These assays can be reduced #' from their high-dimensional state to a lower-dimension state and stored as #' \code{\link{DimReduc}} objects. Seurat objects also #' store additional metadata, both at the cell and feature level (contained #' within individual assays). The object was designed to be as self-contained as #' possible, and easily extendable to new methods. #' #' @slot assays A list of assays for this project #' @slot meta.data Contains meta-information about each cell, starting with #' number of features detected (nFeature) and the original identity class #' (orig.ident); more information is added using \code{\link{AddMetaData}} #' @slot active.assay Name of the active, or default, assay; settable using #' \code{\link{DefaultAssay}} #' @slot active.ident The active cluster identity for this Seurat object; #' settable using \code{\link{Idents}} #' @slot graphs A list of \code{\link{Graph}} objects #' @slot neighbors ... #' @slot reductions A list of dimensional reduction objects for this object #' @slot images A list of spatial image objects #' @slot project.name Name of the project #' @slot misc A list of miscellaneous information #' @slot version Version of Seurat this object was built under #' @slot commands A list of logged commands run on this \code{Seurat} object #' @slot tools A list of miscellaneous data generated by other tools, should be #' filled by developers only using \code{\link{Tool}<-} #' #' @name Seurat-class #' @rdname Seurat-class #' @exportClass Seurat #' Seurat <- setClass( Class = 'Seurat', slots = c( assays = 'list', meta.data = 'data.frame', active.assay = 'character', active.ident = 'factor', graphs = 'list', neighbors = 'list', reductions = 'list', images = 'list', project.name = 'character', misc = 'list', version = 'package_version', commands = 'list', tools = 'list' ) ) #' The Seurat Class #' #' The Seurat object is the center of each single cell analysis. It stores all #' information associated with the dataset, including data, annotations, #' analyses, etc. All that is needed to construct a Seurat object is an #' expression matrix (rows are genes, columns are cells), which should #' be log-scale #' #' Each Seurat object has a number of slots which store information. Key slots #' to access are listed below. #' #' @slot raw.data The raw project data #' @slot data The normalized expression matrix (log-scale) #' @slot scale.data scaled (default is z-scoring each gene) expression matrix; #' used for dimensional reduction and heatmap visualization #' @slot var.genes Vector of genes exhibiting high variance across single cells #' @slot is.expr Expression threshold to determine if a gene is expressed #' (0 by default) #' @slot ident THe 'identity class' for each cell #' @slot meta.data Contains meta-information about each cell, starting with #' number of genes detected (nFeature) and the original identity class #' (orig.ident); more information is added using \code{AddMetaData} #' @slot project.name Name of the project (for record keeping) #' @slot dr List of stored dimensional reductions; named by technique #' @slot assay List of additional assays for multimodal analysis; named by #' technique #' @slot hvg.info The output of the mean/variability analysis for all genes #' @slot imputed Matrix of imputed gene scores #' @slot cell.names Names of all single cells #' (column names of the expression matrix) #' @slot cluster.tree List where the first element is a phylo object containing #' the phylogenetic tree relating different identity classes #' @slot snn Spare matrix object representation of the SNN graph #' @slot calc.params Named list to store all calculation-related #' parameter choices #' @slot kmeans Stores output of gene-based clustering from \code{DoKMeans} #' @slot spatial Stores internal data and calculations for spatial mapping of #' single cells #' @slot misc Miscellaneous spot to store any data alongside the object #' (for example, gene lists) #' @slot version Version of package used in object creation #' #' @name seurat-class #' @rdname oldseurat-class #' @aliases seurat-class #' #' @concept unsorted #' seurat <- setClass( Class = "seurat", slots = c( raw.data = "ANY", data = "ANY", scale.data = "ANY", var.genes = "vector", is.expr = "numeric", ident = "factor", meta.data = "data.frame", project.name = "character", dr = "list", assay = "list", hvg.info = "data.frame", imputed = "data.frame", cell.names = "vector", cluster.tree = "list", snn = "dgCMatrix", calc.params = "list", kmeans = "ANY", spatial = "ANY", misc = "ANY", version = "ANY" ) ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Functions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Query Specific Object Types #' #' List the names of \code{\link{Assay}}, \code{\link{DimReduc}}, #' \code{\link{Graph}}, \code{\link{Neighbor}} objects #' #' @param object A \code{\link{Seurat}} object #' @param slot Name of component object to return #' #' @return If \code{slot} is \code{NULL}, the names of all component objects #' in this \code{Seurat} object. Otherwise, the specific object specified #' #' @rdname ObjectAccess #' #' @export #' #' @concept data-access #' #' @examples #' Assays(object = pbmc_small) #' Assays <- function(object, slot = NULL) { assays <- FilterObjects(object = object, classes.keep = 'Assay') if (is.null(x = slot)) { return(assays) } if (!slot %in% assays) { warning( "Cannot find an assay of name ", slot, " in this Seurat object", call. = FALSE, immediate. = TRUE ) } return(slot(object = object, name = 'assays')[[slot]]) } #' Get cell names grouped by identity class #' #' @param object A Seurat object #' @param idents A vector of identity class levels to limit resulting list to; #' defaults to all identity class levels #' @param cells A vector of cells to grouping to #' @param return.null If no cells are request, return a \code{NULL}; #' by default, throws an error #' #' @return A named list where names are identity classes and values are vectors #' of cells belonging to that class #' #' @export #' #' @concept data-access #' #' @examples #' CellsByIdentities(object = pbmc_small) #' CellsByIdentities <- function( object, idents = NULL, cells = NULL, return.null = FALSE ) { cells <- cells %||% colnames(x = object) cells <- intersect(x = cells, y = colnames(x = object)) if (length(x = cells) == 0) { if (isTRUE(x = return.null)) { return(NULL) } stop("Cannot find cells provided") } idents <- idents %||% levels(x = object) idents <- intersect(x = idents, y = levels(x = object)) if (length(x = idents) == 0) { stop("None of the provided identity class levels were found", call. = FALSE) } cells.idents <- sapply( X = idents, FUN = function(i) { return(cells[as.vector(x = Idents(object = object)[cells]) == i]) }, simplify = FALSE, USE.NAMES = TRUE ) if (any(is.na(x = Idents(object = object)[cells]))) { cells.idents["NA"] <- names(x = which(x = is.na(x = Idents(object = object)[cells]))) } return(cells.idents) } #' Get a vector of cell names associated with an image (or set of images) #' #' @param object Seurat object #' @param images Vector of image names #' @param unlist Return as a single vector of cell names as opposed to a list, #' named by image name. #' #' @return A vector of cell names #' #' @concept data-access #' #' @examples #' \dontrun{ #' CellsByImage(object = object, images = "slice1") #' } #' CellsByImage <- function(object, images = NULL, unlist = FALSE) { images <- images %||% Images(object = object) cells <- sapply( X = images, FUN = function(x) { Cells(x = object[[x]]) }, simplify = FALSE, USE.NAMES = TRUE ) if (unlist) { cells <- unname(obj = unlist(x = cells)) } return(cells) } #' Access cellular data #' #' Retrieves data (feature expression, PCA scores, metrics, etc.) for a set #' of cells in a Seurat object #' #' @param object Seurat object #' @param vars List of all variables to fetch, use keyword \dQuote{ident} to #' pull identity classes #' @param cells Cells to collect data for (default is all cells) #' @param slot Slot to pull feature data for #' #' @return A data frame with cells as rows and cellular data as columns #' #' @export #' #' @concept data-access #' #' @examples #' pc1 <- FetchData(object = pbmc_small, vars = 'PC_1') #' head(x = pc1) #' head(x = FetchData(object = pbmc_small, vars = c('groups', 'ident'))) #' FetchData <- function(object, vars, cells = NULL, slot = 'data') { object <- UpdateSlots(object = object) cells <- cells %||% colnames(x = object) if (is.numeric(x = cells)) { cells <- colnames(x = object)[cells] } # Get a list of all objects to search through and their keys object.keys <- Key(object = object) # Find all vars that are keyed keyed.vars <- lapply( X = object.keys, FUN = function(key) { if (length(x = key) == 0 || nchar(x = key) == 0) { return(integer(length = 0L)) } return(grep(pattern = paste0('^', key), x = vars)) } ) keyed.vars <- Filter(f = length, x = keyed.vars) data.fetched <- lapply( X = names(x = keyed.vars), FUN = function(x) { vars.use <- vars[keyed.vars[[x]]] key.use <- object.keys[x] data.return <- if (inherits(x = object[[x]], what = 'DimReduc')) { vars.use <- grep( pattern = paste0('^', key.use, '[[:digit:]]+$'), x = vars.use, value = TRUE ) if (length(x = vars.use) > 0) { tryCatch( expr = object[[x]][[cells, vars.use, drop = FALSE]], error = function(...) { return(NULL) } ) } else { NULL } } else if (inherits(x = object[[x]], what = 'Assay')) { vars.use <- gsub(pattern = paste0('^', key.use), replacement = '', x = vars.use) data.assay <- GetAssayData( object = object, slot = slot, assay = x ) vars.use <- vars.use[vars.use %in% rownames(x = data.assay)] data.vars <- t(x = as.matrix(data.assay[vars.use, cells, drop = FALSE])) if (ncol(data.vars) > 0) { colnames(x = data.vars) <- paste0(key.use, vars.use) } data.vars } else if (inherits(x = object[[x]], what = 'SpatialImage')) { vars.unkeyed <- gsub(pattern = paste0('^', key.use), replacement = '', x = vars.use) names(x = vars.use) <- vars.unkeyed coords <- GetTissueCoordinates(object = object[[x]])[cells, vars.unkeyed, drop = FALSE] colnames(x = coords) <- vars.use[colnames(x = coords)] coords } data.return <- as.list(x = as.data.frame(x = data.return)) return(data.return) } ) data.fetched <- unlist(x = data.fetched, recursive = FALSE) # Pull vars from object metadata meta.vars <- vars[vars %in% colnames(x = object[[]]) & !(vars %in% names(x = data.fetched))] data.fetched <- c(data.fetched, object[[meta.vars]][cells, , drop = FALSE]) meta.default <- meta.vars[meta.vars %in% rownames(x = GetAssayData(object = object, slot = slot))] if (length(x = meta.default)) { warning( "The following variables were found in both object metadata and the default assay: ", paste0(meta.default, collapse = ", "), "\nReturning metadata; if you want the feature, please use the assay's key (eg. ", paste0(Key(object = object[[DefaultAssay(object = object)]]), meta.default[1]), ")", call. = FALSE ) } # Pull vars from the default assay default.vars <- vars[vars %in% rownames(x = GetAssayData(object = object, slot = slot)) & !(vars %in% names(x = data.fetched))] data.fetched <- c( data.fetched, tryCatch( expr = as.data.frame(x = t(x = as.matrix(x = GetAssayData( object = object, slot = slot )[default.vars, cells, drop = FALSE]))), error = function(...) { return(NULL) } ) ) # Pull identities if ('ident' %in% vars && !'ident' %in% colnames(x = object[[]])) { data.fetched[['ident']] <- Idents(object = object)[cells] } # Try to find ambiguous vars fetched <- names(x = data.fetched) vars.missing <- setdiff(x = vars, y = fetched) if (length(x = vars.missing) > 0) { # Search for vars in alternative assays vars.alt <- vector(mode = 'list', length = length(x = vars.missing)) names(x = vars.alt) <- vars.missing for (assay in FilterObjects(object = object, classes.keep = 'Assay')) { vars.assay <- Filter( f = function(x) { features.assay <- rownames(x = GetAssayData( object = object, assay = assay, slot = slot )) return(x %in% features.assay) }, x = vars.missing ) for (var in vars.assay) { vars.alt[[var]] <- append(x = vars.alt[[var]], values = assay) } } # Vars found in multiple alternative assays are truly ambiguous, will not pull vars.many <- names(x = Filter( f = function(x) { return(length(x = x) > 1) }, x = vars.alt )) if (length(x = vars.many) > 0) { warning( "Found the following features in more than one assay, excluding the default. We will not include these in the final data frame: ", paste(vars.many, collapse = ', '), call. = FALSE, immediate. = TRUE ) } vars.missing <- names(x = Filter( f = function(x) { return(length(x = x) != 1) }, x = vars.alt )) # Pull vars found in only one alternative assay # Key this var to highlight that it was found in an alternate assay vars.alt <- Filter( f = function(x) { return(length(x = x) == 1) }, x = vars.alt ) for (var in names(x = vars.alt)) { assay <- vars.alt[[var]] warning( 'Could not find ', var, ' in the default search locations, found in ', assay, ' assay instead', immediate. = TRUE, call. = FALSE ) keyed.var <- paste0(Key(object = object[[assay]]), var) data.fetched[[keyed.var]] <- as.vector( x = GetAssayData(object = object, assay = assay, slot = slot)[var, cells] ) vars <- sub( pattern = paste0('^', var, '$'), replacement = keyed.var, x = vars ) } fetched <- names(x = data.fetched) } # Name the vars not found in a warning (or error if no vars found) m2 <- if (length(x = vars.missing) > 10) { paste0(' (10 out of ', length(x = vars.missing), ' shown)') } else { '' } if (length(x = vars.missing) == length(x = vars)) { stop( "None of the requested variables were found", m2, ': ', paste(head(x = vars.missing, n = 10L), collapse = ', ') ) } else if (length(x = vars.missing) > 0) { warning( "The following requested variables were not found", m2, ': ', paste(head(x = vars.missing, n = 10L), collapse = ', ') ) } # Assembled fetched vars in a data frame data.fetched <- as.data.frame( x = data.fetched, row.names = cells, stringsAsFactors = FALSE ) data.order <- na.omit(object = pmatch( x = vars, table = fetched )) if (length(x = data.order) > 1) { data.fetched <- data.fetched[, data.order] } colnames(x = data.fetched) <- vars[vars %in% fetched] 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 #' #' @examples #' Graphs(pbmc_small) #' Graphs <- function(object, slot = NULL) { graphs <- FilterObjects(object = object, classes.keep = "Graph") if (is.null(x = slot)) { return(graphs) } if (!slot %in% graphs) { warning( "Cannot find a Graph object of name ", slot, " in this Seurat object", call. = FALSE, immediate. = TRUE ) } return(slot(object = object, name = 'graphs')[[slot]]) } #' Pull spatial image names #' #' List the names of \code{SpatialImage} objects present in a \code{Seurat} #' object. If \code{assay} is provided, limits search to images associated with #' that assay #' #' @param object A \code{Seurat} object #' @param assay Name of assay to limit search to #' #' @return A list of image names #' #' @export #' #' @concept data-access #' #' @examples #' \dontrun{ #' Images(object) #' } #' Images <- function(object, assay = NULL) { object <- UpdateSlots(object = object) images <- names(x = slot(object = object, name = 'images')) if (!is.null(x = assay)) { assays <- c(assay, DefaultAssay(object = object[[assay]])) images <- Filter( f = function(x) { return(DefaultAssay(object = object[[x]]) %in% assays) }, x = images ) } return(images) } #' @rdname ObjectAccess #' @export #' Neighbors <- function(object, slot = NULL) { neighbors <- FilterObjects(object = object, classes.keep = "Neighbor") if (is.null(x = slot)) { return(neighbors) } if (!slot %in% neighbors) { warning( "Cannot find a Neighbor object of name ", slot, " in this Seurat object", call. = FALSE, immediate. = TRUE ) } return(slot(object = object, name = 'neighbors')[[slot]]) } #' @rdname ObjectAccess #' @export #' #' @examples #' Reductions(object = pbmc_small) #' Reductions <- function(object, slot = NULL) { reductions <- FilterObjects(object = object, classes.keep = 'DimReduc') if (is.null(x = slot)) { return(reductions) } if (!slot %in% reductions) { warning( "Cannot find a DimReduc of name ", slot, " in this Seurat object", call. = FALSE, immediate. = TRUE ) } return(slot(object = object, name = 'reductions')[[slot]]) } #' Rename assays in a \code{Seurat} object #' #' @param object A \code{Seurat} object #' @param ... Named arguments as \code{old.assay = new.assay} #' #' @return \code{object} with assays renamed #' #' @export #' #' @concept seurat #' #' @examples #' RenameAssays(object = pbmc_small, RNA = 'rna') #' RenameAssays <- function(object, ...) { assay.pairs <- tryCatch( expr = as.list(x = ...), error = function(e) { return(list(...)) } ) old.assays <- names(x = assay.pairs) # Handle missing assays missing.assays <- setdiff(x = old.assays, y = Assays(object = object)) if (length(x = missing.assays) == length(x = old.assays)) { stop("None of the assays provided are present in this object", call. = FALSE) } else if (length(x = missing.assays)) { warning( "The following assays could not be found: ", paste(missing.assays, collapse = ', '), call. = FALSE, immediate. = TRUE ) } old.assays <- setdiff(x = old.assays, missing.assays) assay.pairs <- assay.pairs[old.assays] # Check to see that all old assays are named if (is.null(x = names(x = assay.pairs)) || any(sapply(X = old.assays, FUN = nchar) < 1)) { stop("All arguments must be named with the old assay name", call. = FALSE) } # Ensure each old assay is going to one new assay if (!all(sapply(X = assay.pairs, FUN = length) == 1) || length(x = old.assays) != length(x = unique(x = old.assays))) { stop("Can only rename assays to one new name", call. = FALSE) } # Ensure each new assay is coming from one old assay if (length(x = assay.pairs) != length(x = unique(x = assay.pairs))) { stop( "One or more assays are set to be lost due to duplicate new assay names", call. = FALSE ) } # Rename assays for (old in names(x = assay.pairs)) { new <- assay.pairs[[old]] # If we aren't actually renaming any if (old == new) { next } old.key <- Key(object = object[[old]]) suppressWarnings(expr = object[[new]] <- object[[old]]) if (old == DefaultAssay(object = object)) { message("Renaming default assay from ", old, " to ", new) DefaultAssay(object = object) <- new } Key(object = object[[new]]) <- old.key # change assay used in any dimreduc object for (i in Reductions(object = object)) { if (DefaultAssay(object = object[[i]]) == old) { DefaultAssay(object = object[[i]]) <- new } } object[[old]] <- NULL } return(object) } #' Update old Seurat object to accommodate new features #' #' Updates Seurat objects to new structure for storing data/calculations. #' For Seurat v3 objects, will validate object structure ensuring all keys #' and feature names are formed properly. #' #' @param object Seurat object #' #' @return Returns a Seurat object compatible with latest changes #' #' @importFrom methods .hasSlot new slot #' @importFrom utils packageVersion #' #' @export #' #' @concept seurat #' #' @examples #' \dontrun{ #' updated_seurat_object = UpdateSeuratObject(object = old_seurat_object) #' } #' UpdateSeuratObject <- function(object) { if (.hasSlot(object, "version")) { if (slot(object = object, name = 'version') >= package_version(x = "2.0.0") && slot(object = object, name = 'version') < package_version(x = '3.0.0')) { # Run update message("Updating from v2.X to v3.X") seurat.version <- packageVersion(pkg = "Seurat") new.assay <- UpdateAssay(old.assay = object, assay = "RNA") assay.list <- list(new.assay) names(x = assay.list) <- "RNA" for (i in names(x = object@assay)) { assay.list[[i]] <- UpdateAssay(old.assay = object@assay[[i]], assay = i) } new.dr <- UpdateDimReduction(old.dr = object@dr, assay = "RNA") object <- new( Class = "Seurat", version = seurat.version, assays = assay.list, active.assay = "RNA", project.name = object@project.name, misc = object@misc %||% list(), active.ident = object@ident, reductions = new.dr, meta.data = object@meta.data, tools = list() ) # Run CalcN for (assay in Assays(object = object)) { n.calc <- CalcN(object = object[[assay]]) if (!is.null(x = n.calc)) { names(x = n.calc) <- paste(names(x = n.calc), assay, sep = '_') object[[names(x = n.calc)]] <- n.calc } to.remove <- c("nGene", "nUMI") for (i in to.remove) { if (i %in% colnames(x = object[[]])) { object[[i]] <- NULL } } } } if (package_version(x = slot(object = object, name = 'version')) >= package_version(x = "3.0.0")) { # Run validation message("Validating object structure") # Update object slots message("Updating object slots") object <- UpdateSlots(object = object) # Rename assays 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'))) { suppressWarnings(expr = object[[obj]] <- UpdateSlots(object = object[[obj]])) } for (cmd in Command(object = object)) { slot(object = object, name = 'commands')[[cmd]] <- UpdateSlots( 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')) { assay <- object[[assay.name]] for (slot in c('counts', 'data', 'scale.data')) { if (!IsMatrixEmpty(x = slot(object = assay, name = slot))) { rownames(x = slot(object = assay, name = slot)) <- gsub( pattern = '_', replacement = '-', x = rownames(x = slot(object = assay, name = slot)) ) rownames(x = slot(object = assay, name = slot)) <- gsub( pattern = '|', replacement = '-', x = rownames(x = slot(object = assay, name = slot)), fixed = TRUE ) } } VariableFeatures(object = assay) <- gsub( pattern = '_', replacement = '-', x = VariableFeatures(object = assay) ) VariableFeatures(object = assay) <- gsub( pattern = '|', replacement = '-', x = VariableFeatures(object = assay), fixed = TRUE ) rownames(x = slot(object = assay, name = "meta.features")) <- gsub( pattern = '_', replacement = '-', x = rownames(x = assay[[]]) ) rownames(x = slot(object = assay, name = "meta.features")) <- gsub( pattern = '|', replacement = '-', x = rownames(x = assay[[]]), fixed = TRUE ) object[[assay.name]] <- assay } 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))) { rownames(x = slot(object = reduc, name = slot)) <- gsub( pattern = '_', replacement = '-', x = rownames(x = slot(object = reduc, name = slot)) ) rownames(x = slot(object = reduc, name = slot)) <- gsub( pattern = '_', replacement = '-', x = rownames(x = slot(object = reduc, name = slot)), fixed = TRUE ) } } object[[reduc.name]] <- reduc } } if (package_version(x = slot(object = object, name = 'version')) <= package_version(x = '3.1.1')) { # Update Assays, DimReducs, and Graphs for (x in names(x = object)) { message("Updating slots in ", x) xobj <- object[[x]] xobj <- UpdateSlots(object = xobj) if (inherits(x = xobj, what = 'DimReduc')) { if (any(sapply(X = c('tsne', 'umap'), FUN = grepl, x = tolower(x = x)))) { message("Setting ", x, " DimReduc to global") slot(object = xobj, name = 'global') <- TRUE } } else if (inherits(x = xobj, what = 'Graph')) { graph.assay <- unlist(x = strsplit(x = x, split = '_'))[1] if (graph.assay %in% Assays(object = object)) { message("Setting default assay of ", x, " to ", graph.assay) DefaultAssay(object = xobj) <- graph.assay } } object[[x]] <- xobj } # Update SeuratCommands for (cmd in Command(object = object)) { cobj <- Command(object = object, command = cmd) cobj <- UpdateSlots(object = cobj) cmd.assay <- unlist(x = strsplit(x = cmd, split = '\\.')) cmd.assay <- cmd.assay[length(x = cmd.assay)] cmd.assay <- if (cmd.assay %in% Assays(object = object)) { cmd.assay } else if (cmd.assay %in% Reductions(object = object)) { DefaultAssay(object = object[[cmd.assay]]) } else { NULL } if (is.null(x = cmd.assay)) { message("No assay information could be found for ", cmd) } else { message("Setting assay used for ", cmd, " to ", cmd.assay) } slot(object = cobj, name = 'assay.used') <- cmd.assay object[[cmd]] <- cobj } # Update object version slot(object = object, name = 'version') <- packageVersion(pkg = 'Seurat') } object <- UpdateSlots(object = object) if (package_version(x = slot(object = object, name = 'version')) <= package_version(x = '4.0.0')) { # Transfer the object to the SeuratObject namespace object <- UpdateClassPkg( object = object, from = 'Seurat', to = 'SeuratObject' ) slot(object = object, name = 'version') <- max( package_version(x = '4.0.0'), packageVersion(pkg = 'SeuratObject') ) } message("Object representation is consistent with the most current Seurat version") return(object) } stop( "We are unable to convert Seurat objects less than version 2.X to version 3.X\n", 'Please use devtools::install_version to install Seurat v2.3.4 and update your object to a 2.X object', call. = FALSE ) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for Seurat-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @rdname AddMetaData #' @export #' @method AddMetaData Seurat #' AddMetaData.Seurat <- .AddMetaData #' @param command Name of the command to pull, pass \code{NULL} to get the #' names of all commands run #' @param value Name of the parameter to pull the value for #' #' @rdname Command #' @export #' @method Command Seurat #' Command.Seurat <- function(object, command = NULL, value = NULL, ...) { CheckDots(...) object <- UpdateSlots(object = object) commands <- slot(object = object, name = "commands") if (is.null(x = command)) { return(names(x = commands)) } if (is.null(x = commands[[command]])) { stop(command, " has not been run or is not a valid command.") } command <- commands[[command]] if (is.null(x = value)) { return(command) } params <- slot(object = command, name = "params") if (!value %in% names(x = params)) { stop(value, " is not a valid parameter for ", slot(object = command, name = "name")) } return(params[[value]]) } #' @param row.names When \code{counts} is a \code{data.frame} or #' \code{data.frame}-derived object: an optional vector of feature names to be #' used #' #' @rdname CreateSeuratObject #' @method CreateSeuratObject default #' @export #' CreateSeuratObject.default <- function( counts, project = 'SeuratProject', assay = 'RNA', names.field = 1, names.delim = '_', meta.data = NULL, min.cells = 0, min.features = 0, row.names = NULL, ... ) { if (!is.null(x = meta.data)) { if (!all(rownames(x = meta.data) %in% colnames(x = counts))) { warning("Some cells in meta.data not present in provided counts matrix") } } assay.data <- CreateAssayObject( counts = counts, min.cells = min.cells, min.features = min.features, row.names = row.names ) if (!is.null(x = meta.data)) { common.cells <- intersect( x = rownames(x = meta.data), y = colnames(x = assay.data) ) meta.data <- meta.data[common.cells, , drop = FALSE] } Key(object = assay.data) <- suppressWarnings(expr = UpdateKey(key = tolower( x = assay ))) return(CreateSeuratObject( counts = assay.data, project = project, assay = assay, names.field = names.field, names.delim = names.delim, meta.data = meta.data, ... )) } #' @rdname CreateSeuratObject #' @method CreateSeuratObject Assay #' @export #' CreateSeuratObject.Assay <- function( counts, project = 'SeuratProject', assay = 'RNA', names.field = 1, names.delim = '_', meta.data = NULL, ... ) { if (!is.null(x = meta.data)) { if (is.null(x = rownames(x = meta.data))) { stop("Row names not set in metadata. Please ensure that rownames of metadata match column names of data matrix") } if (length(x = setdiff(x = rownames(x = meta.data), y = colnames(x = counts)))) { warning("Some cells in meta.data not present in provided counts matrix.") meta.data <- meta.data[intersect(x = rownames(x = meta.data), y = colnames(x = counts)), , drop = FALSE] } if (is.data.frame(x = meta.data)) { new.meta.data <- data.frame(row.names = colnames(x = counts)) for (ii in 1:ncol(x = meta.data)) { new.meta.data[rownames(x = meta.data), colnames(x = meta.data)[ii]] <- meta.data[, ii, drop = FALSE] } 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 idents <- factor(x = unlist(x = lapply( X = colnames(x = counts), FUN = ExtractField, field = names.field, delim = names.delim ))) if (any(is.na(x = idents))) { warning( "Input parameters result in NA values for initial cell identities. Setting all initial idents to the project name", call. = FALSE, immediate. = TRUE ) } # if there are more than 100 idents, set all idents to ... name ident.levels <- length(x = unique(x = idents)) if (ident.levels > 100 || ident.levels == 0 || ident.levels == length(x = idents)) { idents <- rep.int(x = factor(x = project), times = ncol(x = counts)) } names(x = idents) <- colnames(x = counts) object <- new( Class = 'Seurat', assays = assay.list, meta.data = data.frame(row.names = colnames(x = counts)), active.assay = assay, active.ident = idents, project.name = project, version = packageVersion(pkg = 'SeuratObject') ) object[['orig.ident']] <- idents # Calculate nCount and nFeature n.calc <- CalcN(object = counts) if (!is.null(x = n.calc)) { names(x = n.calc) <- paste(names(x = n.calc), assay, sep = '_') object[[names(x = n.calc)]] <- n.calc } # Add metadata if (!is.null(x = meta.data)) { object <- AddMetaData(object = object, metadata = meta.data) } return(object) } #' @rdname DefaultAssay #' @export #' @method DefaultAssay Seurat #' #' @examples #' # Get current default assay #' DefaultAssay(object = pbmc_small) #' DefaultAssay.Seurat <- function(object, ...) { CheckDots(...) object <- UpdateSlots(object = object) return(slot(object = object, name = 'active.assay')) } #' @rdname DefaultAssay #' @export #' @method DefaultAssay<- Seurat #' #' @examples #' # Create dummy new assay to demo switching default assays #' new.assay <- pbmc_small[["RNA"]] #' Key(object = new.assay) <- "RNA2_" #' pbmc_small[["RNA2"]] <- new.assay #' # switch default assay to RNA2 #' DefaultAssay(object = pbmc_small) <- "RNA2" #' DefaultAssay(object = pbmc_small) #' "DefaultAssay<-.Seurat" <- function(object, ..., value) { CheckDots(...) object <- UpdateSlots(object = object) if (!value %in% names(x = slot(object = object, name = 'assays'))) { stop("Cannot find assay ", value) } slot(object = object, name = 'active.assay') <- value return(object) } #' @param reduction Name of reduction to pull cell embeddings for #' #' @rdname Embeddings #' @export #' @method Embeddings Seurat #' #' @examples #' # Get the embeddings from a specific DimReduc in a Seurat object #' Embeddings(object = pbmc_small, reduction = "pca")[1:5, 1:5] #' Embeddings.Seurat <- function(object, reduction = 'pca', ...) { object <- UpdateSlots(object = object) return(Embeddings(object = object[[reduction]], ...)) } #' @param assay Specific assay to get data from or set data for; defaults to #' the \link[SeuratObject:DefaultAssay]{default assay} #' #' @rdname AssayData #' @export #' @method GetAssayData Seurat #' #' @order 3 #' #' @examples #' # Get assay data from the default assay in a Seurat object #' GetAssayData(object = pbmc_small, slot = "data")[1:5,1:5] #' GetAssayData.Seurat <- function(object, slot = 'data', assay = NULL, ...) { CheckDots(...) object <- UpdateSlots(object = object) assay <- assay %||% DefaultAssay(object = object) if (!assay %in% Assays(object = object)) { stop("'", assay, "' is not an assay", call. = FALSE) } return(GetAssayData( object = object[[assay]], slot = slot )) } #' @param image Name of \code{SpatialImage} object to pull image data for; if #' \code{NULL}, will attempt to select an image automatically #' #' @rdname GetImage #' @method GetImage Seurat #' @export #' GetImage.Seurat <- function( object, mode = c('grob', 'raster', 'plotly', 'raw'), image = NULL, ... ) { mode <- match.arg(arg = mode) image <- image %||% DefaultImage(object = object) if (is.null(x = image)) { stop("No images present in this Seurat object", call. = FALSE) } return(GetImage(object = object[[image]], mode = mode, ...)) } #' @param image Name of \code{SpatialImage} object to get coordinates for; if #' \code{NULL}, will attempt to select an image automatically #' #' @rdname GetTissueCoordinates #' @method GetTissueCoordinates Seurat #' @export #' GetTissueCoordinates.Seurat <- function(object, image = NULL, ...) { image <- image %||% DefaultImage(object = object) if (is.null(x = image)) { stop("No images present in this Seurat object", call. = FALSE) } return(GetTissueCoordinates(object = object[[image]], ...)) } #' @param assay Name of assay to pull highly variable feature information for #' #' @importFrom tools file_path_sans_ext #' #' @rdname VariableFeatures #' @export #' @method HVFInfo Seurat #' #' @order 6 #' #' @examples #' # Get the HVF info from a specific Assay in a Seurat object #' HVFInfo(object = pbmc_small, assay = "RNA")[1:5, ] #' HVFInfo.Seurat <- function( object, selection.method = NULL, status = FALSE, assay = NULL, ... ) { CheckDots(...) object <- UpdateSlots(object = object) assay <- assay %||% DefaultAssay(object = object) if (is.null(x = selection.method)) { cmds <- apply( X = expand.grid( c('FindVariableFeatures', 'SCTransform'), FilterObjects(object = object, classes.keep = 'Assay') ), MARGIN = 1, FUN = paste, collapse = '.' ) find.command <- Command(object = object)[Command(object = object) %in% cmds] if (length(x = find.command) < 1) { stop( "Please run either 'FindVariableFeatures' or 'SCTransform'", call. = FALSE ) } find.command <- find.command[length(x = find.command)] test.command <- paste(file_path_sans_ext(x = find.command), assay, sep = '.') find.command <- ifelse( test = test.command %in% Command(object = object), yes = test.command, no = find.command ) selection.method <- switch( EXPR = file_path_sans_ext(x = find.command), 'FindVariableFeatures' = Command( object = object, command = find.command, value = 'selection.method' ), 'SCTransform' = 'sct', stop("Unknown command for finding variable features: '", find.command, "'", call. = FALSE) ) } return(HVFInfo( object = object[[assay]], selection.method = selection.method, status = status )) } #' @rdname Idents #' @export #' @method Idents Seurat #' Idents.Seurat <- function(object, ...) { CheckDots(...) object <- UpdateSlots(object = object) return(slot(object = object, name = 'active.ident')) } #' @param cells Set cell identities for specific cells #' @param drop Drop unused levels #' #' @rdname Idents #' @export #' @method Idents<- Seurat #' "Idents<-.Seurat" <- function(object, cells = NULL, drop = FALSE, ..., value) { CheckDots(...) object <- UpdateSlots(object = object) cells <- cells %||% colnames(x = object) if (is.numeric(x = cells)) { cells <- colnames(x = object)[cells] } cells <- intersect(x = cells, y = colnames(x = object)) cells <- match(x = cells, table = colnames(x = object)) if (length(x = cells) == 0) { warning("Cannot find cells provided") return(object) } idents.new <- if (length(x = value) == 1 && value %in% colnames(x = object[[]])) { unlist(x = object[[value]], use.names = FALSE)[cells] } else { if (is.list(x = value)) { value <- unlist(x = value, use.names = FALSE) } rep_len(x = value, length.out = length(x = cells)) } new.levels <- if (is.factor(x = idents.new)) { levels(x = idents.new) } else { unique(x = idents.new) } old.levels <- levels(x = object) levels <- c(new.levels, old.levels) idents.new <- as.vector(x = idents.new) idents <- as.vector(x = Idents(object = object)) idents[cells] <- idents.new idents[is.na(x = idents)] <- 'NA' levels <- intersect(x = levels, y = unique(x = idents)) names(x = idents) <- colnames(x = object) missing.cells <- which(x = is.na(x = names(x = idents))) if (length(x = missing.cells) > 0) { idents <- idents[-missing.cells] } idents <- factor(x = idents, levels = levels) slot(object = object, name = 'active.ident') <- idents if (drop) { object <- droplevels(x = object) } return(object) } #' @rdname Key #' @export #' @method Key Seurat #' #' @examples #' # Show all keys associated with a Seurat object #' Key(object = pbmc_small) #' Key.Seurat <- function(object, ...) { CheckDots(...) object <- UpdateSlots(object = object) keyed.objects <- FilterObjects( object = object, classes.keep = c('Assay', 'DimReduc', 'SpatialImage') ) 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 #' #' @rdname Loadings #' @export #' @method Loadings Seurat #' #' @examples #' # Get the feature loadings for a specified DimReduc in a Seurat object #' Loadings(object = pbmc_small, reduction = "pca")[1:5,1:5] #' Loadings.Seurat <- function(object, reduction = 'pca', projected = FALSE, ...) { object <- UpdateSlots(object = object) return(Loadings(object = object[[reduction]], projected = projected, ...)) } #' @rdname Misc #' @export #' @method Misc Seurat #' #' @examples #' # Get the misc info #' Misc(object = pbmc_small, slot = "example") #' Misc.Seurat <- .Misc #' @rdname Misc #' @export #' @method Misc<- Seurat #' #' @examples #'# Add misc info #' Misc(object = pbmc_small, slot = "example") <- "testing_misc" #' "Misc<-.Seurat" <- `.Misc<-` #' @rdname Project #' @export #' @method Project Seurat #' Project.Seurat <- function(object, ...) { CheckDots(...) object <- UpdateSlots(object = object) return(slot(object = object, name = 'project.name')) } #' @rdname Project #' @export #' @method Project<- Seurat #' "Project<-.Seurat" <- function(object, ..., value) { CheckDots(...) object <- UpdateSlots(object = object) slot(object = object, name = 'project.name') <- as.character(x = value) return(object) } #' @param reverse Reverse ordering #' @param afxn Function to evaluate each identity class based on; default is #' \code{\link[base]{mean}} #' @param reorder.numeric Rename all identity classes to be increasing numbers #' starting from 1 (default is FALSE) #' #' @rdname Idents #' @export #' @method ReorderIdent Seurat #' ReorderIdent.Seurat <- function( object, var, reverse = FALSE, afxn = mean, reorder.numeric = FALSE, ... ) { object <- UpdateSlots(object = object) data.use <- FetchData(object = object, vars = var, ...)[, 1] rfxn <- ifelse( test = reverse, yes = function(x) { return(max(x) + 1 - x) }, no = identity ) new.levels <- names(x = rfxn(x = sort(x = tapply( X = data.use, INDEX = Idents(object = object), FUN = afxn )))) new.idents <- factor( x = Idents(object = object), levels = new.levels, ordered = TRUE ) if (reorder.numeric) { new.idents <- rfxn(x = rank(x = tapply( X = data.use, INDEX = as.numeric(x = new.idents), FUN = mean )))[as.numeric(x = new.idents)] new.idents <- factor( x = new.idents, levels = 1:length(x = new.idents), ordered = TRUE ) } Idents(object = object) <- new.idents return(object) } #' @param for.merge Only rename slots needed for merging Seurat objects. #' Currently only renames the raw.data and meta.data slots. #' @param add.cell.id prefix to add cell names #' #' @details #' If \code{add.cell.id} is set a prefix is added to existing cell names. If #' \code{new.names} is set these will be used to replace existing names. #' #' @rdname RenameCells #' @export #' @method RenameCells Seurat #' #' @examples #' # Rename cells in a Seurat object #' head(x = colnames(x = pbmc_small)) #' pbmc_small <- RenameCells(object = pbmc_small, add.cell.id = "A") #' head(x = colnames(x = pbmc_small)) #' RenameCells.Seurat <- function( object, add.cell.id = NULL, new.names = NULL, for.merge = FALSE, ... ) { CheckDots(...) object <- UpdateSlots(object = object) if (missing(x = add.cell.id) && missing(x = new.names)) { stop("One of 'add.cell.id' and 'new.names' must be set") } if (!missing(x = add.cell.id) && !missing(x = new.names)) { stop("Only one of 'add.cell.id' and 'new.names' may be set") } if (!missing(x = add.cell.id)) { new.cell.names <- paste(add.cell.id, colnames(x = object), sep = "_") } else { if (length(x = new.names) == ncol(x = object)) { new.cell.names <- new.names } else { stop( "the length of 'new.names' (", length(x = new.names), ") must be the same as the number of cells (", ncol(x = object), ")" ) } } old.names <- colnames(x = object) # rename in the assay objects assays <- FilterObjects(object = object, classes.keep = 'Assay') for (assay in assays) { slot(object = object, name = "assays")[[assay]] <- RenameCells( object = object[[assay]], new.names = new.cell.names ) } # rename in the DimReduc objects dimreducs <- FilterObjects(object = object, classes.keep = 'DimReduc') for (dr in dimreducs) { object[[dr]] <- RenameCells( object = object[[dr]], new.names = new.cell.names ) } # rename the active.idents old.ids <- Idents(object = object) names(x = old.ids) <- new.cell.names Idents(object = object) <- old.ids # rename the cell-level metadata old.meta.data <- object[[]] rownames(x = old.meta.data) <- new.cell.names slot(object = object, name = "meta.data") <- old.meta.data # rename the graphs graphs <- FilterObjects(object = object, classes.keep = "Graph") for (g in graphs) { rownames(x = object[[g]]) <- colnames(x = object[[g]]) <- new.cell.names } # Rename the images names(x = new.cell.names) <- old.names for (i in Images(object = object)) { object[[i]] <- RenameCells( object = object[[i]], new.names = unname(obj = new.cell.names[Cells(x = object[[i]])]) ) } # Rename the Neighbor for (i in Neighbors(object = object)) { object[[i]] <- RenameCells( object = object[[i]], old.names = old.names, new.names = new.cell.names ) } return(object) } #' @rdname Idents #' @export #' @method RenameIdents Seurat #' RenameIdents.Seurat <- function(object, ...) { ident.pairs <- tryCatch( expr = as.list(x = ...), error = function(e) { return(list(...)) } ) if (is.null(x = names(x = ident.pairs))) { stop("All arguments must be named with the old identity class") } if (!all(sapply(X = ident.pairs, FUN = length) == 1)) { stop("Can only rename identity classes to one value") } if (!any(names(x = ident.pairs) %in% levels(x = object))) { stop("Cannot find any of the provided identities") } cells.idents <- CellsByIdentities(object = object) for (i in rev(x = names(x = ident.pairs))) { if (!i %in% names(x = cells.idents)) { warning("Cannot find identity ", i, call. = FALSE, immediate. = TRUE) next } Idents(object = object, cells = cells.idents[[i]]) <- ident.pairs[[i]] } return(object) } #' @rdname AssayData #' @export #' @method SetAssayData Seurat #' #' @order 4 #' #' @examples #' # Set an Assay slot through the Seurat object #' count.data <- GetAssayData(object = pbmc_small[["RNA"]], slot = "counts") #' count.data <- as.matrix(x = count.data + 1) #' new.seurat.object <- SetAssayData( #' object = pbmc_small, #' slot = "counts", #' new.data = count.data, #' assay = "RNA" #' ) #' SetAssayData.Seurat <- function( object, slot = 'data', new.data, assay = NULL, ... ) { CheckDots(...) object <- UpdateSlots(object = object) assay <- assay %||% DefaultAssay(object = object) object[[assay]] <- SetAssayData( object = object[[assay]], slot = slot, new.data = new.data, ... ) return(object) } #' @rdname Idents #' @export #' @method SetIdent Seurat #' SetIdent.Seurat <- function(object, cells = NULL, value, ...) { #message( # 'With Seurat 3.X, setting identity classes can be done as follows:\n', # 'Idents(object = ', # deparse(expr = substitute(expr = object)), # if (!is.null(x = cells)) { # paste0(', cells = ', deparse(expr = substitute(expr = cells))) # }, # ') <- ', # deparse(expr = substitute(expr = value)) #) CheckDots(...) object <- UpdateSlots(object = object) Idents(object = object, cells = cells) <- value return(object) } #' @rdname VariableFeatures #' @export #' @method SpatiallyVariableFeatures Seurat #' #' @order 10 #' SpatiallyVariableFeatures.Seurat <- function( object, selection.method = "markvariogram", assay = NULL, decreasing = TRUE, ... ) { CheckDots(...) assay <- assay %||% DefaultAssay(object = object) return(SpatiallyVariableFeatures( object = object[[assay]], selection.method = selection.method, decreasing = decreasing )) } #' @param save.name Store current identity information under this name #' #' @rdname Idents #' @export #' @method StashIdent Seurat #' StashIdent.Seurat <- function(object, save.name = 'orig.ident', ...) { message( 'With Seurat 3.X, stashing identity classes can be accomplished with the following:\n', deparse(expr = substitute(expr = object)), '[[', deparse(expr = substitute(expr = save.name)), ']] <- Idents(object = ', deparse(expr = substitute(expr = object)), ')' ) CheckDots(...) object <- UpdateSlots(object = object) object[[save.name]] <- Idents(object = object) return(object) } #' @param reduction Name of reduction to use #' #' @rdname Stdev #' @export #' @method Stdev Seurat #' #' @examples #' # Get the standard deviations for each PC from the Seurat object #' Stdev(object = pbmc_small, reduction = "pca") #' Stdev.Seurat <- function(object, reduction = 'pca', ...) { CheckDots(...) return(Stdev(object = object[[reduction]])) } #' @importFrom tools file_path_sans_ext #' #' @rdname VariableFeatures #' @export #' @method SVFInfo Seurat #' #' @order 9 #' SVFInfo.Seurat <- function( object, selection.method = c("markvariogram", "moransi"), status = FALSE, assay = NULL, ... ) { CheckDots(...) assay <- assay %||% DefaultAssay(object = object) return(SVFInfo( object = object[[assay]], selection.method = selection.method, status = status )) } #' @param slot Name of tool to pull #' #' @rdname Tool #' @export #' @method Tool Seurat #' #' @examples #' Tool(object = pbmc_small) #' Tool.Seurat <- function(object, slot = NULL, ...) { CheckDots(...) object <- UpdateSlots(object = object) if (is.null(x = slot)) { return(names(x = slot(object = object, name = 'tools'))) } return(slot(object = object, name = 'tools')[[slot]]) } #' @rdname Tool #' @export #' @method Tool<- Seurat #' #' @examples #' \dontrun{ #' sample.tool.output <- matrix(data = rnorm(n = 16), nrow = 4) #' # must be run from within a function #' Tool(object = pbmc_small) <- sample.tool.output #' } "Tool<-.Seurat" <- function(object, ..., value) { CheckDots(...) object <- UpdateSlots(object = object) calls <- as.character(x = sys.calls()) calls <- lapply( X = strsplit(x = calls, split = '(', fixed = TRUE), FUN = '[', 1 ) tool.call <- min(grep(pattern = 'Tool<-', x = calls)) if (tool.call <= 1) { stop("'Tool<-' cannot be called at the top level", call. = FALSE) } tool.call <- calls[[tool.call - 1]] class.call <- unlist(x = strsplit( x = as.character(x = sys.call())[1], split = '.', fixed = TRUE )) class.call <- class.call[length(x = class.call)] tool.call <- sub( pattern = paste0('\\.', class.call, '$'), replacement = '', x = tool.call, perl = TRUE ) slot(object = object, name = 'tools')[[tool.call]] <- value return(object) } #' @rdname VariableFeatures #' @export #' @method VariableFeatures Seurat #' #' @order 7 #' VariableFeatures.Seurat <- function( object, selection.method = NULL, assay = NULL, ... ) { CheckDots(...) object <- UpdateSlots(object = object) assay <- assay %||% DefaultAssay(object = object) return(VariableFeatures(object = object[[assay]], selection.method = selection.method)) } #' @rdname VariableFeatures #' @export #' @method VariableFeatures<- Seurat #' #' @order 8 #' "VariableFeatures<-.Seurat" <- function(object, assay = NULL, ..., value) { CheckDots(...) object <- UpdateSlots(object = object) assay <- assay %||% DefaultAssay(object = object) VariableFeatures(object = object[[assay]]) <- value return(object) } #' @param idents A vector of identity classes to keep #' @param slot Slot to pull feature data for #' @param downsample Maximum number of cells per identity class, default is #' \code{Inf}; downsampling will happen after all other operations, including #' inverting the cell selection #' @param seed Random seed for downsampling. If NULL, does not set a seed #' @inheritDotParams CellsByIdentities #' #' @importFrom stats na.omit #' @importFrom rlang is_quosure enquo eval_tidy #' #' @rdname WhichCells #' @export #' @method WhichCells Seurat #' WhichCells.Seurat <- function( object, cells = NULL, idents = NULL, expression, slot = 'data', invert = FALSE, downsample = Inf, seed = 1, ... ) { CheckDots(..., fxns = CellsByIdentities) if (!is.null(x = seed)) { set.seed(seed = seed) } object <- UpdateSlots(object = object) cells <- cells %||% colnames(x = object) if (is.numeric(x = cells)) { cells <- colnames(x = object)[cells] } cell.order <- cells if (!is.null(x = idents)) { if (any(!idents %in% levels(x = Idents(object = object)))) { stop( "Cannot find the following identities in the object: ", paste( idents[!idents %in% levels(x = Idents(object = object))], sep = ', ' ) ) } cells.idents <- unlist(x = lapply( X = idents, FUN = function(i) { cells.use <- which(x = as.vector(x = Idents(object = object)) == i) cells.use <- names(x = Idents(object = object)[cells.use]) return(cells.use) } )) cells <- intersect(x = cells, y = cells.idents) } if (!missing(x = expression)) { objects.use <- FilterObjects( object = object, classes.keep = c('Assay', 'DimReduc', 'SpatialImage') ) object.keys <- sapply( X = objects.use, FUN = function(i) { return(Key(object = object[[i]])) } ) key.pattern <- paste0('^', object.keys, collapse = '|') expr <- if (tryCatch(expr = is_quosure(x = expression), error = function(...) FALSE)) { expression } else if (is.call(x = enquo(arg = expression))) { enquo(arg = expression) } else { parse(text = expression) } expr.char <- suppressWarnings(expr = as.character(x = expr)) expr.char <- unlist(x = lapply(X = expr.char, FUN = strsplit, split = ' ')) expr.char <- gsub( pattern = '(', replacement = '', x = expr.char, fixed = TRUE ) expr.char <- gsub( pattern = '`', replacement = '', x = expr.char ) vars.use <- which( x = expr.char %in% rownames(x = object) | expr.char %in% colnames(x = object[[]]) | grepl(pattern = key.pattern, x = expr.char, perl = TRUE) ) data.subset <- FetchData( object = object, vars = unique(x = expr.char[vars.use]), cells = cells, slot = slot ) cells <- rownames(x = data.subset)[eval_tidy(expr = expr, data = data.subset)] } if (isTRUE(x = invert)) { cell.order <- colnames(x = object) cells <- colnames(x = object)[!colnames(x = object) %in% cells] } cells <- CellsByIdentities(object = object, cells = cells, ...) cells <- lapply( X = cells, FUN = function(x) { if (length(x = x) > downsample) { x <- sample(x = x, size = downsample, replace = FALSE) } return(x) } ) cells <- as.character(x = na.omit(object = unlist(x = cells, use.names = FALSE))) cells <- cells[na.omit(object = match(x = cell.order, table = cells))] return(cells) } #' @rdname Version #' @method Version Seurat #' @export #' Version.Seurat <- function(object, ...) { CheckDots(...) return(slot(object = object, name = 'version')) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for R-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Seurat Methods #' #' Methods for \code{\link{Seurat}} objects for generics defined in other #' packages #' #' @param x,object A \code{\link{Seurat}} object #' @param i,features Depends on the method #' \describe{ #' \item{\code{[}, \code{subset}}{Feature names or indices} #' \item{\code{$}, \code{$<-}}{Name of a single metadata column} #' \item{\code{[[}, \code{[[<-}}{ #' Name of one or more metadata columns or an associated object; associated #' objects include \code{\link{Assay}}, \code{\link{DimReduc}}, #' \code{\link{Graph}}, \code{\link{SeuratCommand}}, or #' \code{\link{SpatialImage}} objects #' } #' } #' @param j,cells Cell names or indices #' @param n The number of rows of metadata to return #' @param ... Arguments passed to other methods #' #' @name Seurat-methods #' @rdname Seurat-methods #' #' @concept seurat #' NULL #' @describeIn Seurat-methods Autocompletion for \code{$} access on a #' \code{Seurat} object #' #' @inheritParams utils::.DollarNames #' #' @importFrom utils .DollarNames #' @export #' @method .DollarNames Seurat #' ".DollarNames.Seurat" <- function(x, pattern = '') { meta.data <- as.list(x = colnames(x = x[[]])) names(x = meta.data) <- unlist(x = meta.data) return(.DollarNames(x = meta.data, pattern = pattern)) } #' @describeIn Seurat-methods Metadata access for \code{Seurat} objects #' #' @return \code{$}: metadata column \code{i} for object \code{x}; #' \strong{note}: unlike \code{[[}, \code{$} drops the shape of the metadata #' to return a vector instead of a data frame #' #' @export #' @method $ Seurat #' #' @examples #' # Get metadata using `$' #' head(pbmc_small$groups) #' "$.Seurat" <- function(x, i, ...) { return(x[[i, drop = TRUE]]) } #' @describeIn Seurat-methods Metadata setter for \code{Seurat} objects #' #' @return \code{$<-}: object \code{x} with metadata \code{value} saved as #' \code{i} #' #' @export #' @method $<- Seurat #' #' @examples #' # Add metadata using the `$' operator #' set.seed(42) #' pbmc_small$value <- sample(1:3, size = ncol(pbmc_small), replace = TRUE) #' head(pbmc_small[["value"]]) #' "$<-.Seurat" <- function(x, i, ..., value) { x[[i]] <- value return(x) } #' @describeIn Seurat-methods Simple subsetter for \code{Seurat} objects #' #' @return \code{[}: object \code{x} with features \code{i} and cells \code{j} #' #' @export #' @method [ Seurat #' #' @examples #' # `[' examples #' pbmc_small[VariableFeatures(object = pbmc_small), ] #' pbmc_small[, 1:10] #' "[.Seurat" <- function(x, i, j, ...) { x <- UpdateSlots(object = x) if (missing(x = i) && missing(x = j)) { return(x) } if (missing(x = i)) { i <- NULL } else if (missing(x = j)) { j <- colnames(x = x) } if (is.logical(x = i)) { if (length(i) != nrow(x = x)) { stop("Incorrect number of logical values provided to subset features") } i <- rownames(x = x)[i] } if (is.logical(x = j)) { if (length(j) != ncol(x = x)) { stop("Incorrect number of logical values provided to subset cells") } j <- colnames(x = x)[j] } if (is.numeric(x = i)) { i <- rownames(x = x)[i] } if (is.numeric(x = j)) { j <- colnames(x = x)[j] } return(subset.Seurat(x = x, features = i, cells = j, ...)) } #' @describeIn Seurat-methods Metadata and associated object accessor #' #' @param drop See \code{\link[base]{drop}} #' #' @return \code{[[}: If \code{i} is missing, the metadata data frame; if #' \code{i} is a vector of metadata names, a data frame with the requested #' metadata, otherwise, the requested associated object #' #' @export #' @method [[ Seurat #' #' @examples #' # Get the cell-level metadata data frame #' head(pbmc_small[[]]) #' #' # Pull specific metadata information #' head(pbmc_small[[c("letter.idents", "groups")]]) #' head(pbmc_small[["groups", drop = TRUE]]) #' #' # Get a sub-object (eg. an `Assay' or `DimReduc') #' pbmc_small[["RNA"]] #' pbmc_small[["pca"]] #' "[[.Seurat" <- function(x, i, ..., drop = FALSE) { x <- UpdateSlots(object = x) if (missing(x = i)) { i <- colnames(x = slot(object = x, name = 'meta.data')) } if (length(x = i) == 0) { return(data.frame(row.names = colnames(x = x))) } else if (length(x = i) > 1 || any(i %in% colnames(x = slot(object = x, name = 'meta.data')))) { if (any(!i %in% colnames(x = slot(object = x, name = 'meta.data')))) { warning( "Cannot find the following bits of meta data: ", paste0( i[!i %in% colnames(x = slot(object = x, name = 'meta.data'))], collapse = ', ' ) ) } i <- i[i %in% colnames(x = slot(object = x, name = 'meta.data'))] data.return <- slot(object = x, name = 'meta.data')[, i, drop = FALSE, ...] if (drop) { data.return <- unlist(x = data.return, use.names = FALSE) names(x = data.return) <- rep.int(x = colnames(x = x), times = length(x = i)) } } else { slot.use <- unlist(x = lapply( X = c('assays', 'reductions', 'graphs', 'neighbors', 'commands', 'images'), FUN = function(s) { if (any(i %in% names(x = slot(object = x, name = s)))) { return(s) } return(NULL) } )) if (is.null(x = slot.use)) { stop("Cannot find '", i, "' in this Seurat object", call. = FALSE) } data.return <- slot(object = x, name = slot.use)[[i]] } return(data.return) } #' @describeIn Seurat-methods Number of cells and features for the active assay #' #' @return \code{dim}: The number of features (\code{nrow}) and cells #' (\code{ncol}) for the default assay; \strong{note}: while the number of #' features changes depending on the active assay, the number of cells remains #' the same across all assays #' #' @export #' @method dim Seurat #' #' @examples #' # Get the number of features in an object #' nrow(pbmc_small) #' #' # Get the number of cells in an object #' ncol(pbmc_small) #' dim.Seurat <- function(x) { x <- UpdateSlots(object = x) return(dim(x = x[[DefaultAssay(object = x)]])) } #' @describeIn Seurat-methods The cell and feature names for the active assay #' #' @return \code{dimnames}: The feature (row) and cell (column) names; #' \strong{note}: while the features change depending on the active assay, the #' cell names remain the same across all assays #' #' @export #' @method dimnames Seurat #' #' @examples #' # Get the feature names of an object #' rownames(pbmc_small) #' #' # Get the cell names of an object #' colnames(pbmc_small) #' dimnames.Seurat <- function(x) { x <- UpdateSlots(object = x) return(dimnames(x = x[[DefaultAssay(object = x)]])) } #' @rdname Idents #' @export #' @method droplevels Seurat #' droplevels.Seurat <- function(x, ...) { x <- UpdateSlots(object = x) slot(object = x, name = 'active.ident') <- droplevels(x = Idents(object = x), ...) return(x) } #' @describeIn Seurat-methods Get the first rows of cell-level metadata #' #' @return \code{head}: The first \code{n} rows of cell-level metadata #' #' @importFrom utils head #' #' @export #' @method head Seurat #' #' @examples #' # Get the first 10 rows of cell-level metadata #' head(pbmc_small) #' head.Seurat <- .head #' @rdname Idents #' @export #' @method levels Seurat #' #' @examples #' # Get the levels of identity classes of a Seurat object #' levels(x = pbmc_small) #' levels.Seurat <- function(x) { x <- UpdateSlots(object = x) return(levels(x = Idents(object = x))) } #' @rdname Idents #' @export #' @method levels<- Seurat #' #' @examples #' # Reorder identity classes #' levels(x = pbmc_small) #' levels(x = pbmc_small) <- c('C', 'A', 'B') #' levels(x = pbmc_small) #' "levels<-.Seurat" <- function(x, value) { x <- UpdateSlots(object = x) idents <- Idents(object = x) if (!all(levels(x = idents) %in% value)) { stop("NA's generated by missing levels", call. = FALSE) } idents <- factor(x = idents, levels = value) Idents(object = x) <- idents return(x) } #' @describeIn Seurat-methods Merge two or more \code{Seurat} objects together #' #' @inheritParams CreateSeuratObject #' @param y A single \code{Seurat} object or a list of \code{Seurat} objects #' @param add.cell.ids A character vector of \code{length(x = c(x, y))}; #' appends the corresponding values to the start of each objects' cell names #' @param merge.data Merge the data slots instead of just merging the counts #' (which requires renormalization); this is recommended if the same #' normalization approach was applied to all objects #' @param merge.dr Merge specified DimReducs that are present in all objects; #' will only merge the embeddings slots for the first \code{N} dimensions that #' are shared across all objects. #' #' @return \code{merge}: Merged object #' #' @section Merge Details: #' When merging Seurat objects, the merge procedure will merge the Assay level #' counts and potentially the data slots (depending on the merge.data parameter). #' It will also merge the cell-level meta data that was stored with each object #' and preserve the cell identities that were active in the objects pre-merge. #' The merge will optionally merge reductions depending on the values passed to #' \code{merge.dr} if they have the same name across objects. Here the #' embeddings slots will be merged and if there are differing numbers of #' dimensions across objects, only the first N shared dimensions will be merged. #' The feature loadings slots will be filled by the values present in the first #' object.The merge will not preserve graphs, logged commands, or feature-level #' metadata that were present in the original objects. If add.cell.ids isn't #' specified and any cell names are duplicated, cell names will be appended #' with _X, where X is the numeric index of the object in c(x, y). #' #' @aliases merge MergeSeurat AddSamples #' #' @export #' @method merge Seurat #' #' @examples #' # `merge' examples #' # merge two objects #' merge(pbmc_small, y = pbmc_small) #' # to merge more than two objects, pass one to x and a list of objects to y #' merge(pbmc_small, y = c(pbmc_small, pbmc_small)) #' merge.Seurat <- function( x = NULL, y = NULL, add.cell.ids = NULL, merge.data = TRUE, merge.dr = NULL, project = "SeuratProject", ... ) { CheckDots(...) objects <- c(x, y) if (!is.null(x = add.cell.ids)) { if (length(x = add.cell.ids) != length(x = objects)) { stop("Please provide a cell identifier for each object provided to merge") } for (i in 1:length(x = objects)) { objects[[i]] <- RenameCells(object = objects[[i]], add.cell.id = add.cell.ids[i]) } } # ensure unique cell names objects <- CheckDuplicateCellNames(object.list = objects) assays <- lapply( X = objects, FUN = FilterObjects, classes.keep = 'Assay' ) fake.feature <- RandomName(length = 17) assays <- unique(x = unlist(x = assays, use.names = FALSE)) combined.assays <- vector(mode = 'list', length = length(x = assays)) names(x = combined.assays) <- assays for (assay in assays) { assays.merge <- lapply( X = objects, FUN = function(object) { return(tryCatch( expr = object[[assay]], error = function(e) { return(CreateAssayObject(counts = Matrix( data = 0, ncol = ncol(x = object), dimnames = list(fake.feature, colnames(x = object)), sparse = TRUE ))) } )) } ) merged.assay <- merge( x = assays.merge[[1]], y = assays.merge[2:length(x = assays.merge)], merge.data = merge.data ) merged.assay <- subset( x = merged.assay, features = rownames(x = merged.assay)[rownames(x = merged.assay) != fake.feature] ) if (length(x = Key(object = merged.assay)) == 0) { Key(object = merged.assay) <- paste0(assay, '_') } combined.assays[[assay]] <- merged.assay } # Merge the meta.data combined.meta.data <- data.frame(row.names = colnames(x = combined.assays[[1]])) new.idents <- c() for (object in objects) { old.meta.data <- object[[]] if (any(!colnames(x = old.meta.data) %in% colnames(x = combined.meta.data))) { cols.to.add <- colnames(x = old.meta.data)[!colnames(x = old.meta.data) %in% colnames(x = combined.meta.data)] combined.meta.data[, cols.to.add] <- NA } # unfactorize any factor columns i <- sapply(X = old.meta.data, FUN = is.factor) old.meta.data[i] <- lapply(X = old.meta.data[i], FUN = as.vector) combined.meta.data[rownames(x = old.meta.data), colnames(x = old.meta.data)] <- old.meta.data new.idents <- c(new.idents, as.vector(Idents(object = object))) } names(x = new.idents) <- rownames(x = combined.meta.data) new.idents <- factor(x = new.idents) if (DefaultAssay(object = x) %in% assays) { new.default.assay <- DefaultAssay(object = x) } else if (DefaultAssay(object = y) %in% assays) { new.default.assay <- DefaultAssay(object = y) } else { new.default.assay <- assays[1] } # Merge images combined.images <- vector( mode = 'list', length = length(x = unlist(x = lapply(X = objects, FUN = Images))) ) index <- 1L for (i in 1:length(x = objects)) { object <- objects[[i]] for (image in Images(object = object)) { image.obj <- object[[image]] if (image %in% names(x = combined.images)) { image <- if (is.null(x = add.cell.ids)) { make.unique(names = c( na.omit(object = names(x = combined.images)), image ))[index] } else { paste(image, add.cell.ids[i], sep = '_') } } combined.images[[index]] <- image.obj names(x = combined.images)[index] <- image index <- index + 1L } } # Merge DimReducs combined.reductions <- list() if (!is.null(x = merge.dr)) { for (dr in merge.dr) { drs.to.merge <- list() for (i in 1:length(x = objects)) { if (!dr %in% Reductions(object = objects[[i]])) { warning("The DimReduc ", dr, " is not present in all objects being ", "merged. Skipping and continuing.", call. = FALSE, immediate. = TRUE) break } drs.to.merge[[i]] <- objects[[i]][[dr]] } if (length(x = drs.to.merge) == length(x = objects)) { combined.reductions[[dr]] <- merge( x = drs.to.merge[[1]], y = drs.to.merge[2:length(x = drs.to.merge)] ) } } } # Create merged Seurat object merged.object <- new( Class = 'Seurat', assays = combined.assays, reductions = combined.reductions, images = combined.images, meta.data = combined.meta.data, active.assay = new.default.assay, active.ident = new.idents, project.name = project, version = packageVersion(pkg = 'SeuratObject') ) return(merged.object) } #' @describeIn Seurat-methods Common associated objects #' #' @return \code{names}: The names of all \code{\link{Assay}}, #' \code{\link{DimReduc}}, \code{\link{Graph}}, and \code{\link{SpatialImage}} #' objects in the \code{Seurat} object #' #' @export #' @method names Seurat #' #' @examples #' names(pbmc_small) #' names.Seurat <- function(x) { return(FilterObjects( object = x, classes.keep = c('Assay', 'DimReduc', 'Graph', 'SpatialImage') )) } #' @describeIn Seurat-methods Subset a \code{\link{Seurat}} object #' #' @inheritParams CellsByIdentities #' @param subset Logical expression indicating features/variables to keep #' @param idents A vector of identity classes to keep #' #' @return \code{subset}: A subsetted \code{Seurat} object #' #' @importFrom rlang enquo # #' @aliases subset #' @seealso \code{\link[base]{subset}} \code{\link{WhichCells}} #' #' @export #' @method subset Seurat #' #' @examples #' # `subset' examples #' 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, features = VariableFeatures(object = pbmc_small)) #' subset.Seurat <- function( x, subset, cells = NULL, features = NULL, idents = NULL, return.null = FALSE, ... ) { x <- UpdateSlots(object = x) if (!missing(x = subset)) { subset <- enquo(arg = subset) } cells <- WhichCells( object = x, cells = cells, idents = idents, expression = subset, return.null = TRUE, ... ) if (length(x = cells) == 0) { if (isTRUE(x = return.null)) { return(NULL) } stop("No cells found", call. = FALSE) } if (all(cells %in% Cells(x = x)) && length(x = cells) == length(x = Cells(x = x)) && is.null(x = features)) { return(x) } if (!all(colnames(x = x) %in% cells)) { slot(object = x, name = 'graphs') <- list() slot(object = x, name = 'neighbors') <- list() } assays <- FilterObjects(object = x, classes.keep = 'Assay') # Filter Assay objects for (assay in assays) { assay.features <- features %||% rownames(x = x[[assay]]) slot(object = x, name = 'assays')[[assay]] <- tryCatch( # because subset is also an argument, we need to explictly use the base::subset function expr = base::subset(x = x[[assay]], cells = cells, features = assay.features), error = function(e) { if (e$message == "Cannot find features provided") { return(NULL) } else { stop(e) } } ) } slot(object = x, name = 'assays') <- Filter( f = Negate(f = is.null), x = slot(object = x, name = 'assays') ) if (length(x = FilterObjects(object = x, classes.keep = 'Assay')) == 0 || is.null(x = x[[DefaultAssay(object = x)]])) { stop("Under current subsetting parameters, the default assay will be removed. Please adjust subsetting parameters or change default assay.", call. = FALSE) } # Filter DimReduc objects for (dimreduc in FilterObjects(object = x, classes.keep = 'DimReduc')) { x[[dimreduc]] <- tryCatch( expr = subset.DimReduc(x = x[[dimreduc]], cells = cells, features = features), error = function(e) { if (e$message %in% c("Cannot find cell provided", "Cannot find features provided")) { return(NULL) } else { stop(e) } } ) } # Remove metadata for cells not present slot(object = x, name = 'meta.data') <- slot(object = x, name = 'meta.data')[cells, , drop = FALSE] # Recalculate nCount and nFeature 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 = '_') x[[names(x = n.calc)]] <- n.calc } } Idents(object = x, drop = TRUE) <- Idents(object = x)[cells] # subset images for (image in Images(object = x)) { x[[image]] <- base::subset(x = x[[image]], cells = cells) } return(x) } #' @describeIn Seurat-methods Get the last rows of cell-level metadata #' #' @return \code{tail}: The last \code{n} rows of cell-level metadata #' #' @importFrom utils tail #' #' @export #' @method tail Seurat #' #' @examples #' # Get the last 10 rows of cell-level metadata #' tail(pbmc_small) #' tail.Seurat <- .tail #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # S4 methods #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @describeIn Seurat-methods Add cell-level metadata or associated objects #' #' @param value Additional metadata or associated objects to add; \strong{note}: #' can pass \code{NULL} to remove metadata or an associated object #' #' @return \code{[[<-}: \code{x} with the metadata or associated objects added #' as \code{i}; if \code{value} is \code{NULL}, removes metadata or associated #' object \code{i} from object \code{x} #' #' @export #' setMethod( # because R doesn't allow S3-style [[<- for S4 classes f = '[[<-', signature = c('x' = 'Seurat'), definition = function(x, i, ..., value) { x <- UpdateSlots(object = x) # Require names, no index setting if (!is.character(x = i)) { stop("'i' must be a character", call. = FALSE) } # Allow removing of other object if (is.null(x = value)) { slot.use <- if (i %in% colnames(x = x[[]])) { 'meta.data' } else { FindObject(object = x, name = i) } if (is.null(x = slot.use)) { stop("Cannot find object ", i, call. = FALSE) } if (i == DefaultAssay(object = x)) { stop("Cannot delete the default assay", call. = FALSE) } } # remove disallowed characters from object name newi <- if (is.null(x = value)) { i } else { make.names(names = i) } if (any(i != newi)) { warning( "Invalid name supplied, making object name syntactically valid. New object name is ", newi, "; see ?make.names for more details on syntax validity", call. = FALSE, immediate. = TRUE ) i <- newi } # Figure out where to store data slot.use <- if (inherits(x = value, what = 'Assay')) { # Ensure we have the same number of cells if (ncol(x = value) != ncol(x = x)) { stop( "Cannot add a different number of cells than already present", call. = FALSE ) } # 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) if (!IsMatrixEmpty(x = assay.data)) { assay.data <- assay.data[, Cells(x = x), drop = FALSE] } # Use slot because SetAssayData is being weird slot(object = value, name = slot) <- assay.data } } 'assays' } else if (inherits(x = value, what = 'SpatialImage')) { # Ensure that all cells for this image are present if (!all(Cells(x = value) %in% Cells(x = x))) { stop("", call. = FALSE) } # Ensure Assay that SpatialImage is associated with is present in Seurat object if (!DefaultAssay(object = value) %in% Assays(object = x)) { warning( "Adding image data that isn't associated with any assay present", call. = FALSE, immediate. = TRUE ) } 'images' } else if (inherits(x = value, what = 'Graph')) { # Ensure Assay that Graph is associated with is present in the Seurat object if (is.null(x = DefaultAssay(object = value))) { warning( "Adding a Graph without an assay associated with it", call. = FALSE, immediate. = TRUE ) } else if (!any(DefaultAssay(object = value) %in% Assays(object = x))) { stop("Cannot find assay '", DefaultAssay(object = value), "' in this Seurat object", call. = FALSE) } # Ensure Graph object is in order if (all(Cells(x = value) %in% Cells(x = x)) && !all(Cells(x = value) == Cells(x = x))) { value <- value[Cells(x = x), Cells(x = x)] } 'graphs' } else if (inherits(x = value, what = 'DimReduc')) { # All DimReducs must be associated with an Assay if (is.null(x = DefaultAssay(object = value))) { stop("Cannot add a DimReduc without an assay associated with it", call. = FALSE) } # Ensure Assay that DimReduc is associated with is present in the Seurat object if (!IsGlobal(object = value) && !any(DefaultAssay(object = value) %in% Assays(object = x))) { stop("Cannot find assay '", DefaultAssay(object = value), "' in this Seurat object", call. = FALSE) } # Ensure DimReduc object is in order if (all(Cells(x = value) %in% Cells(x = x)) && !all(Cells(x = value) == Cells(x = x))) { slot(object = value, name = 'cell.embeddings') <- value[[Cells(x = x), ]] } 'reductions' } else if (inherits(x = value, what = "Neighbor")) { # Ensure all cells are present in the Seurat object if (length(x = Cells(x = value)) > length(x = Cells(x = x))) { stop( "Cannot have more cells in the Neighbor object than are present in the Seurat object.", call. = FALSE ) } if (!all(Cells(x = value) %in% Cells(x = x))) { stop( "Cannot add cells in the Neighbor object that aren't present in the Seurat object.", call. = FALSE ) } 'neighbors' } else if (inherits(x = value, what = 'SeuratCommand')) { # Ensure Assay that SeuratCommand is associated with is present in the Seurat object if (is.null(x = DefaultAssay(object = value))) { warning( "Adding a command log without an assay associated with it", call. = FALSE, immediate. = TRUE ) } else if (!any(DefaultAssay(object = value) %in% Assays(object = x))) { stop("Cannot find assay '", DefaultAssay(object = value), "' in this Seurat object", call. = FALSE) } 'commands' } else if (is.null(x = value)) { slot.use } else { 'meta.data' } if (slot.use == 'meta.data') { # Add data to object metadata meta.data <- x[[]] cell.names <- rownames(x = meta.data) # If we have metadata with names, ensure they match our order if (is.data.frame(x = value) && !is.null(x = rownames(x = value))) { meta.order <- match(x = rownames(x = meta.data), table = rownames(x = value)) value <- value[meta.order, , drop = FALSE] } if (length(x = i) > 1) { # Add multiple pieces of metadata value <- rep_len(x = value, length.out = length(x = i)) for (index in 1:length(x = i)) { meta.data[i[index]] <- value[index] } } else { # Add a single column to metadata if (length(x = intersect(x = names(x = value), y = cell.names)) > 0) { meta.data[, i] <- value[cell.names] } else if (length(x = value) %in% c(nrow(x = meta.data), 1) || is.null(x = value)) { meta.data[, i] <- value } else { stop("Cannot add more or fewer cell meta.data information without values being named with cell names", call. = FALSE) } } # Check to ensure that we aren't adding duplicate names if (any(colnames(x = meta.data) %in% FilterObjects(object = x))) { bad.cols <- colnames(x = meta.data)[which(colnames(x = meta.data) %in% FilterObjects(object = x))] stop( paste0( "Cannot add a metadata column with the same name as an Assay or DimReduc - ", paste(bad.cols, collapse = ", ")), call. = FALSE ) } # Store the revised metadata slot(object = x, name = 'meta.data') <- meta.data } else { # Add other object to Seurat object # Ensure cells match in value and order if (!inherits(x = value, what = c('SeuratCommand', 'NULL', 'SpatialImage', 'Neighbor')) && !all(Cells(x = value) == Cells(x = x))) { stop("All cells in the object being added must match the cells in this object", call. = FALSE) } # Ensure we're not duplicating object names duplicate <- !is.null(x = FindObject(object = x, name = i)) && !inherits(x = value, what = c(class(x = x[[i]]), 'NULL')) && !inherits(x = x[[i]], what = class(x = value)) if (isTRUE(x = duplicate)) { stop( "This object already contains ", i, " as a", ifelse( test = tolower(x = substring(text = class(x = x[[i]]), first = 1, last = 1)) %in% c('a', 'e', 'i', 'o', 'u'), yes = 'n ', no = ' ' ), class(x = x[[i]]), ", so ", i, " cannot be used for a ", class(x = value), call. = FALSE ) } # Check keyed objects if (inherits(x = value, what = c('Assay', 'DimReduc', 'SpatialImage'))) { if (length(x = Key(object = value)) == 0 || nchar(x = Key(object = value)) == 0) { Key(object = value) <- paste0(tolower(x = i), '_') } Key(object = value) <- UpdateKey(key = Key(object = value)) # Check for duplicate keys 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 { # 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] } # 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( x = GetAssayData(object = x, assay = i, slot = "counts"), y = GetAssayData(object = value, slot = "counts")) )) { n.calc <- CalcN(object = value) if (!is.null(x = n.calc)) { names(x = n.calc) <- paste(names(x = n.calc), i, sep = '_') x[[names(x = n.calc)]] <- n.calc } } } # When removing an Assay, clear out associated DimReducs, Graphs, and SeuratCommands if (is.null(x = value) && inherits(x = x[[i]], what = 'Assay')) { objs.assay <- FilterObjects( object = x, classes.keep = c('DimReduc', 'SeuratCommand', 'Graph') ) objs.assay <- Filter( f = function(o) { return(all(DefaultAssay(object = x[[o]]) == i) && !IsGlobal(object = x[[o]])) }, x = objs.assay ) for (o in objs.assay) { x[[o]] <- NULL } } # If adding a command, ensure it gets put at the end of the command list if (inherits(x = value, what = 'SeuratCommand')) { slot(object = x, name = slot.use)[[i]] <- NULL slot(object = x, name = slot.use) <- Filter( f = Negate(f = is.null), x = slot(object = x, name = slot.use) ) } slot(object = x, name = slot.use)[[i]] <- value slot(object = x, name = slot.use) <- Filter( f = Negate(f = is.null), x = slot(object = x, name = slot.use) ) } CheckGC() return(x) } ) #' @describeIn Seurat-methods Calculate \code{\link[base]{colMeans}} on a #' \code{Seurat} object #' #' @param slot Name of assay expression matrix to calculate column/row #' means/sums on #' @inheritParams Matrix::colMeans #' #' @importFrom Matrix colMeans #' #' @export #' #' @examples #' head(colMeans(pbmc_small)) #' setMethod( f = 'colMeans', signature = c('x' = 'Seurat'), definition = function(x, na.rm = FALSE, dims = 1, ..., slot = 'data') { return(colMeans( x = GetAssayData(object = x, slot = slot), na.rm = na.rm, dims = dims, ... )) } ) #' @describeIn Seurat-methods Calculate \code{\link[base]{colSums}} on a #' \code{Seurat} object #' #' @importFrom Matrix colSums #' #' @export #' #' @examples #' head(colSums(pbmc_small)) #' setMethod( f = 'colSums', signature = c('x' = 'Seurat'), definition = function(x, na.rm = FALSE, dims = 1, ..., slot = 'data') { return(Matrix::colSums( x = GetAssayData(object = x, slot = slot), na.rm = na.rm, dims = dims, ... )) } ) #' @describeIn Seurat-methods Calculate \code{\link[base]{rowMeans}} on a #' \code{rowMeans} object #' #' @importFrom Matrix colSums #' #' @export #' #' @examples #' head(rowMeans(pbmc_small)) #' setMethod( f = 'rowMeans', signature = c('x' = 'Seurat'), definition = function(x, na.rm = FALSE, dims = 1, ..., slot = 'data') { return(Matrix::rowMeans( x = GetAssayData(object = x, slot = slot), na.rm = na.rm, dims = dims, ... )) } ) #' @describeIn Seurat-methods Calculate \code{\link[base]{rowSums}} on a #' \code{Seurat} object #' #' @importFrom Matrix rowSums #' #' @export #' #' @examples #' head(rowSums(pbmc_small)) #' setMethod( f = 'rowSums', signature = c('x' = 'Seurat'), definition = function(x, na.rm = FALSE, dims = 1, ..., slot = 'data') { return(Matrix::rowSums( x = GetAssayData(object = x, slot = slot), na.rm = na.rm, dims = dims, ... )) } ) #' @describeIn Seurat-methods Overview of a \code{Seurat} object #' #' @return \code{show}: Prints summary to \code{\link[base]{stdout}} and #' invisibly returns \code{NULL} #' #' @importFrom methods show #' #' @export #' setMethod( f = "show", signature = "Seurat", definition = function(object) { object <- UpdateSlots(object = object) assays <- FilterObjects(object = object, classes.keep = 'Assay') nfeatures <- sum(vapply( X = assays, FUN = function(x) { return(nrow(x = object[[x]])) }, FUN.VALUE = integer(length = 1L) )) num.assays <- length(x = assays) cat("An object of class", class(x = object), "\n") cat( nfeatures, 'features across', ncol(x = object), 'samples within', num.assays, ifelse(test = num.assays == 1, yes = 'assay', no = 'assays'), "\n" ) cat( "Active assay:", DefaultAssay(object = object), paste0('(', nrow(x = object), ' features, ', length(x = VariableFeatures(object = object)), ' variable features)') ) other.assays <- assays[assays != DefaultAssay(object = object)] if (length(x = other.assays) > 0) { cat( '\n', length(x = other.assays), 'other', ifelse(test = length(x = other.assays) == 1, yes = 'assay', no = 'assays'), 'present:', strwrap(x = paste(other.assays, collapse = ', ')) ) } reductions <- FilterObjects(object = object, classes.keep = 'DimReduc') if (length(x = reductions) > 0) { cat( '\n', length(x = reductions), 'dimensional', ifelse(test = length(x = reductions) == 1, yes = 'reduction', no = 'reductions'), 'calculated:', strwrap(x = paste(reductions, collapse = ', ')) ) } cat('\n') } ) #' @rdname oldseurat-class #' #' @inheritParams Seurat-methods #' #' @importFrom methods show #' setMethod( f = 'show', signature = 'seurat', definition = function(object) { cat( "An old seurat object\n", nrow(x = object@data), 'genes across', ncol(x = object@data), 'samples\n' ) } ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Internal #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Object Collections #' #' Find the names of collections in an object #' #' @param object An S4 object #' #' @return A vector with the names of slots that are a list #' #' @keywords internal #' #' @noRd #' #' @examples #' \donttest{ #' SeuratObject:::Collections(pbmc_small) #' } #' Collections <- function(object) { if (!isS4(object)) { return(NULL) } collections <- vapply( X = slotNames(x = object), FUN = function(x) { return(inherits(x = slot(object = object, name = x), what = 'list')) }, FUN.VALUE = logical(length = 1L) ) collections <- Filter(f = isTRUE, x = collections) return(names(x = collections)) } #' Get the default image of an object #' #' Attempts to find all images associated with the default assay of the object. #' If none present, finds all images present in the object. Returns the name of #' the first image #' #' @param object A \code{\link{Seurat}} object #' #' @return The name of the default image #' #' @keywords internal #' #' @noRd #' DefaultImage <- function(object) { object <- UpdateSlots(object = object) images <- Images(object = object, assay = DefaultAssay(object = object)) if (length(x = images) < 1) { images <- Images(object = object) } return(images[[1]]) } #' Find the collection of an object within a Seurat object #' #' @param object A \code{\link{Seurat}} object #' @param name Name of object to find #' #' @return The collection (slot) of the object #' #' @keywords internal #' #' @noRd #' #' @examples #' \donttest{ #' SeuratObject:::FindObject(pbmc_small, name = "RNA") #' } #' FindObject <- function(object, name) { collections <- c( 'assays', 'graphs', 'neighbors', 'reductions', 'commands', 'images' ) object.names <- lapply( X = collections, FUN = function(x) { return(names(x = slot(object = object, name = x))) } ) names(x = object.names) <- collections object.names <- Filter(f = Negate(f = is.null), x = object.names) for (i in names(x = object.names)) { if (name %in% names(x = slot(object = object, name = i))) { return(i) } } return(NULL) } #' Update Seurat v2 Internal Objects #' #' Helper functions to update old Seurat v2 objects to v3/v4 objects #' #' @param old.assay,old.dr,old.jackstraw Seurat v2 assay, dimensional #' reduction, or jackstraw object #' @param assay Name to store for assay in new object #' #' @return A v3/v4 \code{\link{Assay}}, \code{\link{DimReduc}}, or #' \code{\link{JackStrawData}} object #' #' @name V2Update #' @rdname V2Update #' #' @keywords internal #' #' @noRd #' UpdateAssay <- function(old.assay, assay) { cells <- colnames(x = old.assay@data) counts <- old.assay@raw.data data <- old.assay@data if (!inherits(x = counts, what = 'dgCMatrix')) { counts <- as(object = as.matrix(x = counts), Class = 'dgCMatrix') } if (!inherits(x = data, what = 'dgCMatrix')) { data <- as(object = as.matrix(x = data), Class = 'dgCMatrix') } new.assay <- new( Class = 'Assay', counts = counts[, cells], data = data, scale.data = old.assay@scale.data %||% new(Class = 'matrix'), meta.features = data.frame(row.names = rownames(x = counts)), var.features = old.assay@var.genes, key = paste0(assay, "_") ) return(new.assay) } #' @param assay.used Name of assay used to compute dimension reduction #' #' @importFrom methods new #' #' @rdname V2Update #' #' @noRd #' UpdateDimReduction <- function(old.dr, assay) { new.dr <- list() for (i in names(x = old.dr)) { cell.embeddings <- old.dr[[i]]@cell.embeddings %||% new(Class = 'matrix') feature.loadings <- old.dr[[i]]@gene.loadings %||% new(Class = 'matrix') stdev <- old.dr[[i]]@sdev %||% numeric() misc <- old.dr[[i]]@misc %||% list() new.jackstraw <- UpdateJackstraw(old.jackstraw = old.dr[[i]]@jackstraw) old.key <- old.dr[[i]]@key if (length(x = old.key) == 0) { old.key <- gsub(pattern = "(.+?)(([0-9]+).*)", replacement = "\\1", x = colnames(cell.embeddings)[[1]]) if (length(x = old.key) == 0) { old.key <- i } } new.key <- suppressWarnings(expr = UpdateKey(key = old.key)) colnames(x = cell.embeddings) <- gsub( pattern = old.key, replacement = new.key, x = colnames(x = cell.embeddings) ) colnames(x = feature.loadings) <- gsub( pattern = old.key, replacement = new.key, x = colnames(x = feature.loadings) ) new.dr[[i]] <- new( Class = 'DimReduc', cell.embeddings = as(object = cell.embeddings, Class = 'matrix'), feature.loadings = as(object = feature.loadings, Class = 'matrix'), assay.used = assay, stdev = as(object = stdev, Class = 'numeric'), key = as(object = new.key, Class = 'character'), jackstraw = new.jackstraw, misc = as(object = misc, Class = 'list') ) } return(new.dr) } #' @importFrom methods .hasSlot new #' #' @rdname V2Update #' #' @keywords internal #' #' @noRd #' UpdateJackstraw <- function(old.jackstraw) { if (is.null(x = old.jackstraw)) { new.jackstraw <- new( Class = 'JackStrawData', empirical.p.values = new(Class = 'matrix'), fake.reduction.scores = new(Class = 'matrix'), empirical.p.values.full = new(Class = 'matrix'), overall.p.values = new(Class = 'matrix') ) } else { if (.hasSlot(object = old.jackstraw, name = 'overall.p.values')) { overall.p <- old.jackstraw@overall.p.values %||% new(Class = 'matrix') } else { overall.p <- new(Class = 'matrix') } new.jackstraw <- new( Class = 'JackStrawData', empirical.p.values = old.jackstraw@emperical.p.value %||% new(Class = 'matrix'), fake.reduction.scores = old.jackstraw@fake.pc.scores %||% new(Class = 'matrix'), empirical.p.values.full = old.jackstraw@emperical.p.value.full %||% new(Class = 'matrix'), overall.p.values = overall.p ) } return(new.jackstraw) } SeuratObject/R/spatial.R0000644000175000017500000002634614146000252014764 0ustar nileshnilesh#' @include zzz.R #' @include generics.R #' @importFrom methods setClass slot slot<- new #' NULL #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Class definitions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' The SpatialImage class #' #' The \code{SpatialImage} class is a virtual class representing spatial #' information for Seurat. All spatial image information must inherit from this #' class for use with \code{Seurat} objects #' #' @slot assay Name of assay to associate image data with; will give this image #' priority for visualization when the assay is set as the active/default assay #' in a \code{Seurat} object #' @slot key Key for the image #' #' @name SpatialImage-class #' @rdname SpatialImage-class #' @exportClass SpatialImage #' #' @seealso \code{\link{SpatialImage-methods}} for a list of required and #' provided methods #' SpatialImage <- setClass( Class = 'SpatialImage', contains = 'VIRTUAL', slots = list( 'assay' = 'character', 'key' = 'character' ) ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Functions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for Seurat-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' \code{SpatialImage} methods #' #' Methods defined on the \code{\link{SpatialImage}} class. Some of these #' methods must be overridden in order to ensure proper functionality of the #' derived classes (see \strong{Required methods} below). Other methods are #' designed to work across all \code{SpatialImage}-derived subclasses, and #' should only be overridden if necessary #' #' @param x,object A \code{SpatialImage}-derived object #' @param ... Arguments passed to other methods #' @param value Depends on the method: #' \describe{ #' \item{\code{DefaultAssay<-}}{Assay that the image should be #' associated with} #' \item{\code{Key<-}}{New key for the image} #' } #' @inheritParams RenameCells #' #' @section Provided methods: #' These methods are defined on the \code{SpatialImage} object and should not #' be overridden without careful thought #' \itemize{ #' \item \code{\link{DefaultAssay}} and \code{\link{DefaultAssay<-}} #' \item \code{\link{Key}} and \code{\link{Key<-}} #' \item \code{\link{GetImage}}; this method \emph{can} be overridden to #' provide image data, normally returns empty image data. If overridden, #' should default to returning a \code{\link[grid]{grob}} object #' \item \code{\link{IsGlobal}} #' \item \code{\link{Radius}}; this method \emph{can} be overridden to #' provide a spot radius for image objects #' \item \code{\link[base:Extract]{[}}; this method \emph{can} be overridden #' to change default subset behavior, normally returns #' \code{subset(x = x, cells = i)}. If overridden, should only accept \code{i} #' } #' #' @section Required methods: #' All subclasses of the \code{SpatialImage} class must define the following #' methods; simply relying on the \code{SpatialImage} method will result in #' errors. For required parameters and their values, see the \code{Usage} and #' \code{Arguments} sections #' \describe{ #' \item{\code{\link{Cells}}}{ #' Return the cell/spot barcodes associated with each position #' } #' \item{\code{\link{dim}}}{ #' Return the dimensions of the image for plotting in \code{(Y, X)} format #' } #' \item{\code{\link{GetTissueCoordinates}}}{ #' Return tissue coordinates; by default, must return a two-column #' \code{data.frame} with x-coordinates in the first column and #' y-coordinates in the second #' } #' \item{\code{\link{Radius}}}{ #' Return the spot radius; returns \code{NULL} by default for use with #' non-spot image technologies #' } #' \item{\code{\link{RenameCells}}}{ #' Rename the cell/spot barcodes for this image #' } #' \item{\code{\link{subset}}}{ #' Subset the image data by cells/spots #' } #' } #' These methods are used throughout Seurat, so defining them and setting the #' proper defaults will allow subclasses of \code{SpatialImage} to work #' seamlessly #' #' @name SpatialImage-methods #' @rdname SpatialImage-methods #' #' @concept spatialimage #' NULL #' @describeIn SpatialImage-methods Get the cell names from an image #' (\strong{[Override]}) #' #' @return \strong{[Override]} \code{Cells}: should return cell names #' #' @method Cells SpatialImage #' @export #' Cells.SpatialImage <- function(x) { stop( "'Cells' must be implemented for all subclasses of 'SpatialImage'", call. = FALSE ) } #' @describeIn SpatialImage-methods Get the associated assay of a #' \code{SpatialImage}-derived object #' #' @return \code{DefaultAssay}: The associated assay of a #' \code{SpatialImage}-derived object #' #' @method DefaultAssay SpatialImage #' @export #' #' @seealso \code{\link{DefaultAssay}} #' DefaultAssay.SpatialImage <- function(object, ...) { CheckDots(...) return(slot(object = object, name = 'assay')) } #' @describeIn SpatialImage-methods Set the associated assay of a #' \code{SpatialImage}-derived object #' #' @return \code{DefaultAssay<-}: \code{object} with the associated assay #' updated #' #' @method DefaultAssay<- SpatialImage #' @export #' "DefaultAssay<-.SpatialImage" <- function(object, ..., value) { CheckDots(...) slot(object = object, name = 'assay') <- value return(object) } #' @describeIn SpatialImage-methods Get the image data from a #' \code{SpatialImage}-derived object #' #' @inheritParams GetImage #' #' @return \strong{[Override]} \code{GetImage}: The image data from a #' \code{SpatialImage}-derived object #' #' @method GetImage SpatialImage #' @export #' #' @seealso \code{\link{GetImage}} #' GetImage.SpatialImage <- function( object, mode = c('grob', 'raster', 'plotly', 'raw'), ... ) { return(NullImage(mode = mode)) } #' @describeIn SpatialImage-methods Get tissue coordinates for a #' \code{SpatialImage}-derived object (\strong{[Override]}) #' #' @return \strong{[Override]} \code{GetTissueCoordinates}: ... #' #' @method GetTissueCoordinates SpatialImage #' @export #' #' @seealso \code{\link{GetTissueCoordinates}} #' GetTissueCoordinates.SpatialImage <- function(object, ...) { stop( "'GetTissueCoordinates' must be implemented for all subclasses of 'SpatialImage'", call. = FALSE ) } #' @describeIn SpatialImage-methods Globality test for #' \code{SpatialImage}-derived object #' #' @return \code{IsGlobal}: returns \code{TRUE} as images are, by default, #' global #' #' @method IsGlobal SpatialImage #' @export #' #' @seealso \code{\link{IsGlobal}} #' IsGlobal.SpatialImage <- function(object, ...) { return(TRUE) } #' @describeIn SpatialImage-methods Get the key for a #' \code{SpatialImage}-derived object #' #' @return \code{Key}: The key for a \code{SpatialImage}-derived object #' #' @method Key SpatialImage #' @export #' #' @seealso \code{\link{Key}} #' Key.SpatialImage <- function(object, ...) { CheckDots(...) object <- UpdateSlots(object = object) return(slot(object = object, name = 'key')) } #' @describeIn SpatialImage-methods Set the key for a #' \code{SpatialImage}-derived object #' #' @return \code{Key<-}: \code{object} with the key set to \code{value} #' #' @method Key<- SpatialImage #' @export #' "Key<-.SpatialImage" <- function(object, ..., value) { CheckDots(...) object <- UpdateSlots(object = object) value <- UpdateKey(key = value) slot(object = object, name = 'key') <- value return(object) } #' @describeIn SpatialImage-methods Get the spot radius size #' #' @return \code{Radius}: The spot radius size; by default, returns \code{NULL} #' #' @method Radius SpatialImage #' @export #' Radius.SpatialImage <- function(object) { return(NULL) } #' @describeIn SpatialImage-methods Rename cells in a #' \code{SpatialImage}-derived object (\strong{[Override]}) #' #' @return \strong{[Override]} \code{RenameCells}: \code{object} with the new #' cell names #' #' @method RenameCells SpatialImage #' @export #' #' @seealso \code{\link{RenameCells}} #' RenameCells.SpatialImage <- function(object, new.names = NULL, ...) { stop( "'RenameCells' must be implemented for all subclasses of 'SpatialImage'", call. = FALSE ) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for R-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @describeIn SpatialImage-methods Subset a \code{SpatialImage}-derived object #' #' @param i,cells A vector of cells to keep #' #' @return \code{[}, \code{subset}: \code{x}/\code{object} for only the cells #' requested #' #' @method [ SpatialImage #' @export #' "[.SpatialImage" <- function(x, i, ...) { return(subset(x = x, cells = i)) } #' @describeIn SpatialImage-methods Get the plotting dimensions of an image #' (\strong{[Override]}) #' #' @return \strong{[Override]} \code{dim}: The dimensions of the image data in #' (Y, X) format #' #' @method dim SpatialImage #' @export #' dim.SpatialImage <- function(x) { stop( "'dim' must be implemented for all subclasses of 'SpatialImage'", call. = FALSE ) } #' @describeIn SpatialImage-methods Subset a \code{SpatialImage}-derived object #' (\strong{[Override]}) #' #' @method subset SpatialImage #' @export #' subset.SpatialImage <- function(x, cells, ...) { stop("'subset' must be implemented for all subclasses of 'SpatialImage'") } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # S4 methods #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @describeIn SpatialImage-methods Overview of a \code{SpatialImage}-derived #' object #' #' @return \code{show}: Prints summary to \code{\link[base]{stdout}} and #' invisibly returns \code{NULL} #' #' @importFrom methods show #' #' @export #' setMethod( f = 'show', signature = 'SpatialImage', definition = function(object) { object <- UpdateSlots(object = object) cat( "Spatial data from the", class(x = object), "technology for", length(x = Cells(x = object)), "samples\n" ) cat("Associated assay:", DefaultAssay(object = object), "\n") cat("Image key:", Key(object = object), "\n") return(invisible(x = NULL)) } ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Internal #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Return a null image #' #' @inheritParams GetImage #' #' @return Varies by value of \code{mode}: #' \describe{ #' \item{\dQuote{grob}}{a \code{\link[grid]{nullGrob}}} #' \item{\dQuote{raster}}{an empty \code{\link[grDevices:as.raster]{raster}}} #' \item{\dQuote{plotly}}{a list with one named item: \code{value = FALSE}} #' \item{\dQuote{raw}}{returns \code{NULL}} #' } #' #' @importFrom grid nullGrob #' @importFrom grDevices as.raster #' #' @keywords internal #' #' @noRd #' NullImage <- function(mode = c('grob', 'raster', 'plotly', 'raw')) { mode <- mode[1] mode <- match.arg(arg = mode) image <- switch( EXPR = mode, 'grob' = nullGrob(), 'raster' = as.raster(x = new(Class = 'matrix')), 'plotly' = list('visible' = FALSE), 'raw' = NULL, stop("Unknown image mode: ", mode, call. = FALSE) ) return(image) } SeuratObject/R/utils.R0000644000175000017500000006570114147216431014476 0ustar nileshnilesh#' @importFrom Rcpp evalCpp #' @useDynLib SeuratObject #' NULL #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Cast to Sparse #' #' Convert dense objects to sparse representations #' #' @param x An object #' @param ... Arguments passed to other methods #' #' @return A sparse representation of the input data #' #' @rdname as.sparse #' @export as.sparse #' #' @concept utils #' 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 #' object while keeping track of it's class using attributes (see section #' \strong{S4 Class Definition Attributes} below for more details). Both #' \code{ListToS4} and \code{S4ToList} are recursive functions, affecting all #' lists/S4 objects contained as sub-lists/sub-objects. #' #' @param x A list with an S4 class definition attribute #' @param object An S4 object #' #' @return \code{S4ToList}: A list with an S4 class definition attribute #' #' @section S4 Class Definition Attributes: #' S4 classes are scoped to the package and class name. In order to properly #' track which class a list is generated from in order to build a new one, #' these function use an \code{\link[base:attr]{attribute}} to denote the #' class name and package of origin. This attribute is stored as #' \dQuote{classDef} and takes the form of \dQuote{\code{package:class}}. #' #' @name s4list #' @rdname s4list #' #' @concept utils #' #' @export #' S4ToList <- function(object) { if (!(isS4(object) || inherits(x = object, what = 'list'))) { return(object) } UseMethod(generic = 'S4ToList', object = object) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Functions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Set a default value depending on if an object is \code{NULL} #' #' @param x An object to test #' @param y A default value #' #' @return For \code{\%||\%}: \code{y} if \code{x} is \code{NULL} otherwise #' \code{x} #' #' @importFrom rlang %||% #' #' @name set-if-null #' @rdname set-if-null #' #' @export #' #' @concept utils #' #' @examples #' 1 %||% 2 #' NULL %||% 2 #' rlang::`%||%` #' @rdname set-if-null #' #' @return For \code{\%iff\%}: \code{y} if \code{x} is \strong{not} #' \code{NULL}; otherwise \code{x} #' #' @importFrom rlang is_null #' #' @export #' #' @examples #' 1 %iff% 2 #' NULL %iff% 2 #' `%iff%` <- function(x, y) { if (!is_null(x = x)) { return(y) } return(x) } #' Attach Required Packages #' #' Helper function to attach required packages. Detects if a package is already #' attached and if so, skips it. Should be called in \code{\link[base]{.onAttach}} #' #' @param deps A character vector of packages to attach #' #' @return Invisibly returns \code{NULL} #' #' @export #' #' @concept utils #' #' @examples #' # Use in your .onAttach hook #' if (FALSE) { #' .onAttach <- function(libname, pkgname) { #' AttachDeps(c("SeuratObject", "rlang")) #' } #' } #' AttachDeps <- function(deps) { for (d in deps) { if (!paste0('package:', d) %in% search()) { packageStartupMessage("Attaching ", d) attachNamespace(ns = d) } } return(invisible(x = NULL)) } #' Conditional Garbage Collection #' #' Call \code{gc} only when desired #' #' @param option ... #' #' @return Invisibly returns \code{NULL} #' #' @export #' #' @concept utils #' CheckGC <- function(option = 'SeuratObject.memsafe') { if (isTRUE(x = getOption(x = option, default = FALSE))) { gc(verbose = FALSE) } return(invisible(x = NULL)) } #' Find the default \code{\link{DimReduc}} #' #' Searches for \code{\link{DimReduc}s} matching \dQuote{umap}, \dQuote{tsne}, #' or \dQuote{pca}, case-insensitive, and in that order. Priority given to #' \code{\link{DimReduc}s} matching the \code{DefaultAssay} or assay specified #' (eg. \dQuote{pca} for the default assay weights higher than \dQuote{umap} #' for a non-default assay) #' #' @param object A \code{\link{Seurat}} object #' @param assay Name of assay to use; defaults to the default assay of the object #' #' @return The default \code{\link{DimReduc}}, if possible #' #' @export #' #' @examples #' DefaultDimReduc(pbmc_small) #' 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') drs.assay <- Filter( f = function(x) { return(DefaultAssay(object = object[[x]]) == assay) }, x = dim.reducs ) if (length(x = drs.assay) > 0) { index <- lapply( X = drs.use, FUN = grep, x = drs.assay, ignore.case = TRUE ) index <- Filter(f = length, x = index) if (length(x = index) > 0) { return(drs.assay[min(index[[1]])]) } } index <- lapply( X = drs.use, FUN = grep, x = dim.reducs, ignore.case = TRUE ) index <- Filter(f = length, x = index) if (length(x = index) < 1) { stop( "Unable to find a DimReduc matching one of '", paste(drs.use[1:(length(x = drs.use) - 1)], collapse = "', '"), "', or '", drs.use[length(x = drs.use)], "', please specify a dimensional reduction to use", call. = FALSE ) } return(dim.reducs[min(index[[1]])]) } #' Check if a matrix is empty #' #' Takes a matrix and asks if it's empty (either 0x0 or 1x1 with a value of NA) #' #' @param x A matrix #' #' @return Whether or not \code{x} is empty #' #' @export #' #' @concept utils #' #' @examples #' IsMatrixEmpty(new("matrix")) #' IsMatrixEmpty(matrix()) #' IsMatrixEmpty(matrix(1:3)) #' IsMatrixEmpty <- function(x) { matrix.dims <- dim(x = x) matrix.na <- all(matrix.dims == 1) && all(is.na(x = x)) return(all(matrix.dims == 0) || matrix.na) } #' @name s4list #' @rdname s4list #' #' @return \code{IsS4List}: \code{TRUE} if \code{x} is a list with an S4 class #' definition attribute #' #' @export #' IsS4List <- function(x) { return( inherits(x = x, what = 'list') && isTRUE(x = grepl( pattern = '^[[:alnum:]]+:[[:alnum:]]+$', x = attr(x = x, which = 'classDef') )) ) } #' @name s4list #' @rdname s4list #' #' @return \code{ListToS4}: An S4 object as defined by the S4 class definition #' attribute #' #' @importFrom methods getClassDef new #' #' @export #' ListToS4 <- function(x) { if (!inherits(x = x, what = 'list')) { return(x) } for (i in seq_along(along.with = x)) { if (!is.null(x = x[[i]])) { x[[i]] <- ListToS4(x = x[[i]]) } } classdef <- attr(x = x, which = 'classDef') x <- Filter(f = Negate(f = is.function), x = x) attr(x = x, which = 'classDef') <- classdef if (!IsS4List(x = x)) { return(x) } classdef <- unlist(x = strsplit( x = attr(x = x, which = 'classDef'), split = ':' )) pkg <- classdef[1] cls <- classdef[2] formal <- getClassDef(Class = cls, package = pkg, inherits = FALSE) return(do.call(what = new, args = c(list(Class = formal), x))) } #' Check the existence of a package #' #' @param ... Package names #' @param error If true, throw an error if the package doesn't exist #' #' @return Invisibly returns boolean denoting if the package is installed #' #' @export #' #' @examples #' PackageCheck("SeuratObject", error = FALSE) #' PackageCheck <- function(..., error = TRUE) { pkgs <- unlist(x = c(...), use.names = FALSE) package.installed <- vapply( X = pkgs, FUN = requireNamespace, FUN.VALUE = logical(length = 1L), quietly = TRUE ) if (error && any(!package.installed)) { stop( "Cannot find the following packages: ", paste(pkgs[!package.installed], collapse = ', '), ". Please install" ) } invisible(x = package.installed) } #' Generate a random name #' #' Make a name from randomly sampled lowercase letters, pasted together with no #' spaces or other characters #' #' @param length How long should the name be #' @param ... Extra parameters passed to \code{\link[base]{sample}} #' #' @return A character with \code{nchar == length} of randomly sampled letters #' #' @seealso \code{\link[base]{sample}} #' #' @export #' #' @examples #' set.seed(42L) #' RandomName() #' RandomName(7L, replace = TRUE) #' RandomName <- function(length = 5L, ...) { CheckDots(..., fxns = 'sample') return(paste(sample(x = letters, size = length, ...), collapse = '')) } #' Merge Sparse Matrices by Row #' #' Merge two or more sparse matrices by rowname. #' #' @details #' Shared matrix rows (with the same row name) will be merged, and unshared #' rows (with different names) will be filled with zeros in the matrix not #' containing the row. #' #' @param mat1 First matrix #' @param mat2 Second matrix or list of matrices #' #' @return Returns a sparse matrix #' #' @importFrom methods as # #' @export #' #' @concept utils #' RowMergeSparseMatrices <- function(mat1, mat2) { all.mat <- c(list(mat1), mat2) all.colnames <- all.rownames <- vector( mode = 'list', length = length(x = all.mat) ) for (i in seq_along(along.with = all.mat)) { if (is.data.frame(x = all.mat[[1]])) { all.mat[[i]] <- as.matrix(x = all.mat[[i]]) } all.rownames[[i]] <- rownames(x = all.mat[[i]]) all.colnames[[i]] <- colnames(x = all.mat[[i]]) } use.cbind <- all(duplicated(x = all.rownames)[2:length(x = all.rownames)]) if (isTRUE(x = use.cbind)) { new.mat <- do.call(what = cbind, args = all.mat) } else { all.mat <- lapply(X = all.mat, FUN = as, Class = "RsparseMatrix") all.names <- unique(x = unlist(x = all.rownames)) new.mat <- RowMergeMatricesList( mat_list = all.mat, mat_rownames = all.rownames, all_rownames = all.names ) rownames(x = new.mat) <- make.unique(names = all.names) } colnames(x = new.mat) <- make.unique(names = unlist(x = all.colnames)) return(new.mat) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for Seurat-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @param row.names \code{NULL} or a character vector giving the row names for #' the data; missing values are not allowed #' #' @rdname as.sparse #' @export #' @method as.sparse data.frame #' as.sparse.data.frame <- function(x, row.names = NULL, ...) { CheckDots(...) dnames <- list(row.names %||% rownames(x = x), colnames(x = x)) if (length(x = dnames[[1]]) != nrow(x = x)) { stop("Differing numbers of rownames and rows", call. = FALSE) } x <- as.data.frame(x = x) dimnames(x = x) <- dnames return(as.sparse(x = as.matrix(x = x))) } #' @importFrom methods as #' #' @rdname as.sparse #' @export #' @method as.sparse Matrix #' as.sparse.Matrix <- function(x, ...) { CheckDots(...) return(as(object = x, Class = 'dgCMatrix')) } #' @rdname as.sparse #' @export #' @method as.sparse matrix #' 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 #' @export #' @method S4ToList default #' S4ToList.default <- function(object) { obj.list <- sapply( X = slotNames(x = object), FUN = function(x) { return(S4ToList(object = slot(object = object, name = x))) }, simplify = FALSE, USE.NAMES = TRUE ) attr(x = obj.list, which = 'classDef') <- paste( c( attr(x = class(x = object), which = 'package'), class(x = object) ), collapse = ':' ) return(obj.list) } #' @rdname s4list #' @export #' @method S4ToList list #' S4ToList.list <- function(object) { if (length(x = object)) { for (i in seq_along(along.with = object)) { if (!is.null(x = object[[i]])) { object[[i]] <- S4ToList(object = object[[i]]) } } } return(object) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for R-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # S4 methods #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Internal #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Check the Use of Dots #' #' Function to check the use of unused arguments passed to \code{...}; this #' function is designed to be called from another function to see if an #' argument passed to \code{...} remains unused and alert the user if so. Also #' accepts a vector of function or function names to see if \code{...} can be #' used in a downstream function #' #' Behavior of \code{CheckDots} can be controlled by the following option(s): #' \describe{ #' \item{\dQuote{\code{Seurat.checkdots}}}{Control how to alert the presence #' of unused arguments in \code{...}; choose from #' \itemize{ #' \item \dQuote{\code{warn}}: emit a warning (default) #' \item \dQuote{\code{error}}: throw an error #' \item \dQuote{\code{silent}}: no not alert the presence of unused #' arguments in \code{...} #' } #' } #' } #' #' @param ... Arguments passed to a function that fall under \code{...} #' @param fxns A list/vector of functions or function names #' #' @return Emits either an error or warning if an argument passed is unused; #' invisibly returns \code{NULL} #' #' @importFrom utils isS3stdGeneric methods argsAnywhere isS3method #' #' @keywords internal #' #' @export #' #' @examples #' \dontrun{ #' f <- function(x, ...) { #' CheckDots(...) #' return(x ^ 2) #' } #' f(x = 3, y = 9) #' } #' CheckDots <- function(..., fxns = NULL) { args.names <- names(x = list(...)) if (length(x = list(...)) == 0) { return(invisible(x = NULL)) } if (is.null(x = args.names)) { stop("No named arguments passed") } if (length(x = fxns) == 1) { fxns <- list(fxns) } for (f in fxns) { if (!(is.character(x = f) || is.function(x = f))) { stop("CheckDots only works on characters or functions, not ", class(x = f)) } } fxn.args <- suppressWarnings(expr = sapply( X = fxns, FUN = function(x) { x <- tryCatch( expr = if (isS3stdGeneric(f = x)) { as.character(x = methods(generic.function = x)) } else { x }, error = function(...) { return(x) } ) x <- if (is.character(x = x)) { sapply(X = x, FUN = argsAnywhere, simplify = FALSE, USE.NAMES = TRUE) } else if (length(x = x) <= 1) { list(x) } return(sapply( X = x, FUN = function(f) { return(names(x = formals(fun = f))) }, simplify = FALSE, USE.NAMES = TRUE )) }, simplify = FALSE, USE.NAMES = TRUE )) fxn.args <- unlist(x = fxn.args, recursive = FALSE) fxn.null <- vapply( X = fxn.args, FUN = is.null, FUN.VALUE = logical(length = 1L) ) if (all(fxn.null) && !is.null(x = fxns)) { stop("None of the functions passed could be found", call. = FALSE) } else if (any(fxn.null)) { warning( "The following functions passed could not be found: ", paste(names(x = which(x = fxn.null)), collapse = ', '), call. = FALSE, immediate. = TRUE ) fxn.args <- Filter(f = Negate(f = is.null), x = fxn.args) } dfxns <- vector(mode = 'logical', length = length(x = fxn.args)) names(x = dfxns) <- names(x = fxn.args) for (i in 1:length(x = fxn.args)) { dfxns[i] <- any(grepl(pattern = '...', x = fxn.args[[i]], fixed = TRUE)) } if (any(dfxns)) { dfxns <- names(x = which(x = dfxns)) if (any(nchar(x = dfxns) > 0)) { fx <- vapply( X = Filter(f = nchar, x = dfxns), FUN = function(x) { if (isS3method(method = x)) { x <- unlist(x = strsplit(x = x, split = '\\.')) x <- x[length(x = x) - 1L] } return(x) }, FUN.VALUE = character(length = 1L) ) message( "The following functions and any applicable methods accept the dots: ", paste(unique(x = fx), collapse = ', ') ) if (any(nchar(x = dfxns) < 1)) { message( "In addition, there is/are ", length(x = Filter(f = Negate(f = nchar), x = dfxns)), " other function(s) that accept(s) the dots" ) } } else { message("There is/are ", length(x = dfxns), 'function(s) that accept(s) the dots') } } else { unused <- Filter( f = function(x) { return(!x %in% unlist(x = fxn.args)) }, x = args.names ) if (length(x = unused) > 0) { msg <- paste0( "The following arguments are not used: ", paste(unused, collapse = ', ') ) switch( EXPR = getOption(x = "Seurat.checkdots", default = 'warn'), "warn" = warning(msg, call. = FALSE, immediate. = TRUE), "stop" = stop(msg), "silent" = NULL, stop("Invalid Seurat.checkdots option. Please choose one of warn, stop, silent") ) # unused.hints <- sapply(X = unused, FUN = OldParamHints) # names(x = unused.hints) <- unused # unused.hints <- na.omit(object = unused.hints) # if (length(x = unused.hints) > 0) { # message( # "Suggested parameter: ", # paste(unused.hints, "instead of", names(x = unused.hints), collapse = '; '), # "\n" # ) # } } } return(invisible(x = NULL)) } #' Check a list of objects for duplicate cell names #' #' @param object.list List of Seurat objects #' @param verbose Print message about renaming #' @param stop Error out if any duplicate names exist #' #' @return Returns list of objects with duplicate cells renamed to be unique #' #' @keywords internal #' #' @noRd #' CheckDuplicateCellNames <- function(object.list, verbose = TRUE, stop = FALSE) { cell.names <- unlist(x = lapply(X = object.list, FUN = colnames)) if (any(duplicated(x = cell.names))) { if (stop) { stop("Duplicate cell names present across objects provided.") } if (verbose) { warning("Some cell names are duplicated across objects provided. Renaming to enforce unique cell names.") } object.list <- lapply( X = 1:length(x = object.list), FUN = function(x) { return(RenameCells( object = object.list[[x]], new.names = paste0(Cells(x = object.list[[x]]), "_", x) )) } ) } return(object.list) } #' Extract delimiter information from a string. #' #' Parses a string (usually a cell name) and extracts fields based #' on a delimiter #' #' @param string String to parse. #' @param field Integer(s) indicating which field(s) to extract. Can be a #' vector multiple numbers. #' @param delim Delimiter to use, set to underscore by default. #' #' @return A new string, that parses out the requested fields, and #' (if multiple), rejoins them with the same delimiter #' #' @keywords internal #' #' @noRd #' #' @examples #' \donttest{ #' SeuratObject:::ExtractField('Hello World', field = 1, delim = '_') #' } #' ExtractField <- function(string, field = 1, delim = "_") { fields <- as.numeric(x = unlist(x = strsplit( x = as.character(x = field), split = "," ))) if (length(x = fields) == 1) { return(strsplit(x = string, split = delim)[[1]][field]) } return(paste( strsplit(x = string, split = delim)[[1]][fields], collapse = delim )) } #' Test Null Pointers #' #' Check to see if a C++ pointer is a null pointer on the compiled side #' #' @param x An \link[methods:externalptr-class]{external pointer} object #' #' @return \code{TRUE} if \code{x} is a null pointer, otherwise \code{FALSE} #' #' @importFrom methods is #' #' @references \url{https://stackoverflow.com/questions/26666614/how-do-i-check-if-an-externalptr-is-null-from-within-r} #' #' @keywords internal #' #' @noRd #' IsNullPtr <- function(x) { stopifnot(is(object = x, class2 = 'externalptr')) return(.Call('isnull', x)) } #' Update a Class's Package #' #' Swap packages for an object's class definition. As classes move between #' packages, these functions rescope the namespace of the S4 class. This allows #' objects to depend only on the new package for class definitions rather than #' both the new and old packages #' #' @inheritParams s4list #' @param from A vector of one or more packages to limit conversion from #' @param to A character naming the package to search for new class definitions; #' defaults to the package of the function calling this function #' #' @return \code{SwapClassPkg}: \code{x} with an updated S4 class #' definition attribute #' #' @inheritSection s4list S4 Class Definition Attributes #' #' @name classpkg #' @rdname classpkg #' #' @keywords internal #' #' @seealso \code{\link{s4list}} #' #' @noRd #' SwapClassPkg <- function(x, from = NULL, to = NULL) { if (!inherits(x = x, what = 'list')) { return(x) } to <- to[1] %||% environmentName(env = environment( fun = sys.function(which = 1L) )) if (!nchar(x = to) || !paste0('package:', to) %in% search()) { to <- environmentName(env = environment(fun = sys.function(which = 0L))) } for (i in seq_along(along.with = x)) { if (!is.null(x = x[[i]])) { x[[i]] <- SwapClassPkg(x = x[[i]], from = from, to = to) } } if (!IsS4List(x = x)) { return(x) } classdef <- unlist(x = strsplit( x = attr(x = x, which = 'classDef'), split = ':' )) pkg <- classdef[1] cls <- classdef[2] if (is.null(x = from) || pkg %in% from) { pkg <- ifelse( test = is.null(x = getClassDef( Class = cls, package = to, inherits = FALSE )), yes = pkg, no = to ) } attr(x = x, which = 'classDef') <- paste(pkg, cls, sep = ':') return(x) } #' Get the top #' #' @param data Data to pull the top from #' @param num Pull top \code{num} #' @param balanced Pull even amounts of from positive and negative values #' #' @return The top \code{num} #' #' @importFrom utils head tail #' #' @keywords internal #' #' @noRd #' Top <- function(data, num = 20, balanced = FALSE) { nr <- nrow(x = data) if (num > nr) { warning( "Requested number is larger than the number of available items (", nr, "). Setting to ", nr , ".", call. = FALSE ) num <- nr } balanced <- ifelse(test = nr == 1, yes = FALSE, no = balanced) top <- if (isTRUE(x = balanced)) { num <- round(x = num / 2) data <- data[order(data, decreasing = TRUE), , drop = FALSE] positive <- head(x = rownames(x = data), n = num) negative <- rev(x = tail(x = rownames(x = data), n = num)) # remove duplicates if (positive[num] == negative[num]) { negative <- negative[-num] } list(positive = positive, negative = negative) } else { data <- data[rev(x = order(abs(x = data))), , drop = FALSE] top <- head(x = rownames(x = data), n = num) top[order(data[top, ])] } return(top) } #' @name classpkg #' @rdname classpkg #' #' @return \code{UpdateClassPkg}: \code{object} with the updated #' class definition #' #' @keywords internal #' #' @noRd #' UpdateClassPkg <- function(object, from = NULL, to = NULL) { if (!isS4(object)) { return(object) } obj.list <- S4ToList(object = object) obj.list <- SwapClassPkg(x = obj.list, from = from, to = to) # browser() return(ListToS4(x = obj.list)) } #' Update slots in an object #' #' @param object An object to update #' #' @return \code{object} with the latest slot definitions #' #' @importFrom methods slotNames slot #' #' @keywords internal #' #' @noRd #' UpdateSlots <- function(object) { object.list <- sapply( X = slotNames(x = object), FUN = function(x) { return(tryCatch( expr = slot(object = object, name = x), error = function(...) { return(NULL) } )) }, simplify = FALSE, USE.NAMES = TRUE ) object.list <- Filter(f = Negate(f = is.null), x = object.list) object.list <- c('Class' = class(x = object)[1], object.list) object <- do.call(what = 'new', args = object.list) for (x in setdiff(x = slotNames(x = object), y = names(x = object.list))) { xobj <- slot(object = object, name = x) if (is.vector(x = xobj) && !is.list(x = xobj) && length(x = xobj) == 0) { slot(object = object, name = x) <- vector( mode = class(x = xobj), length = 1L ) } } return(object) } #' Update a Key #' #' @param key A character to become a Seurat Key #' #' @return An updated Key that's valid for Seurat #' #' @section \code{Seurat} Object Keys: #' blah #' #' @keywords internal #' #' @noRd #' UpdateKey <- function(key) { if (grepl(pattern = '^[[:alnum:]]+_$', x = key)) { return(key) } else { new.key <- regmatches( x = key, m = gregexpr(pattern = '[[:alnum:]]+', text = key) ) new.key <- paste0(paste(unlist(x = new.key), collapse = ''), '_') if (new.key == '_') { new.key <- paste0(RandomName(length = 3), '_') } warning( "Keys should be one or more alphanumeric characters followed by an underscore, setting key from ", key, " to ", new.key, call. = FALSE, immediate. = TRUE ) return(new.key) } } SeuratObject/R/neighbor.R0000644000175000017500000001152314146000252015113 0ustar nileshnilesh#' @include zzz.R #' @include generics.R #' @importFrom methods new slot slot<- #' NULL #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Class definitions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' The Neighbor class #' #' The Neighbor class is used to store the results of neighbor finding #' algorithms #' #' @slot nn.idx Matrix containing the nearest neighbor indices #' @slot nn.dist Matrix containing the nearest neighbor distances #' @slot alg.idx The neighbor finding index (if applicable). E.g. the annoy #' index #' @slot alg.info Any information associated with the algorithm that may be #' needed downstream (e.g. distance metric used with annoy is needed when #' reading in from stored file). #' @slot cell.names Names of the cells for which the neighbors have been #' computed. #' #' @name Neighbor-class #' @rdname Neighbor-class #' @exportClass Neighbor #' Neighbor <- setClass( Class = 'Neighbor', slots = c( nn.idx = 'matrix', nn.dist = 'matrix', alg.idx = 'ANY', alg.info = 'list', cell.names = 'character' ) ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Functions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for Seurat-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @rdname as.Neighbor #' @export #' @method as.Neighbor Graph #' as.Neighbor.Graph <- function(x, ...) { nn.mats <- GraphToNeighborHelper(mat = x) return(Neighbor( nn.idx = nn.mats[[1]], nn.dist = nn.mats[[2]], cell.names = rownames(x = x) )) } #' @rdname Cells #' @method Cells Neighbor #' @export #' Cells.Neighbor <- function(x) { return(slot(object = x, name = "cell.names")) } #' @rdname Distances #' @export #' @method Distances Neighbor #' Distances.Neighbor <- function(object, ...) { object <- UpdateSlots(object = object) distances <- slot(object = object, name = "nn.dist") rownames(x = distances) <- slot(object = object, name = "cell.names") return(distances) } #' @rdname Index #' @export #' @method Index Neighbor #' Index.Neighbor <- function(object, ...) { object <- UpdateSlots(object = object) index <- slot(object = object, name = "alg.idx") if (is.null(x = index)) { return(NULL) } else if (IsNullPtr(x = index$.pointer)) { return(NULL) } return(index) } #' @rdname Index #' @export #' @method Index<- Neighbor #' "Index<-.Neighbor" <- function(object, ..., value) { CheckDots(...) slot(object = object, name = "alg.idx") <- value return(object) } #' @rdname Indices #' @export #' @method Indices Neighbor #' Indices.Neighbor <- function(object, ...) { object <- UpdateSlots(object = object) indices <- slot(object = object, name = "nn.idx") rownames(x = indices) <- slot(object = object, name = "cell.names") return(indices) } #' @param old.names vector of old cell names #' @rdname RenameCells #' @export #' @method RenameCells Neighbor #' RenameCells.Neighbor <- function( object, old.names = NULL, new.names = NULL, ... ) { CheckDots(...) neighbor.names <- Cells(x = object) names(x = new.names) <- old.names slot(object = object, name = "cell.names") <- unname(obj = new.names[neighbor.names]) return(object) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for R-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' \code{Neighbor} Methods #' #' Methods for \code{\link{Neighbor}} objects for generics defined in #' other packages #' #' @param x,object A \code{\link{Neighbor}} object #' #' @name Neighbor-methods #' @rdname Neighbor-methods #' #' @concept neighbor #' NULL #' @describeIn Neighbor-methods Dimensions of the neighbor indices #' #' @return \code{dim} Dimensions of the indices matrix #' #' @export #' @method dim Neighbor #' dim.Neighbor <- function(x) { return(dim(x = Indices(object = x))) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # S4 methods #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @describeIn Neighbor-methods Overview of a \code{Neighbor} object #' #' @return \code{show}: Prints summary to \code{\link[base]{stdout}} and #' invisibly returns \code{NULL} #' #' @importFrom methods show #' #' @export #' setMethod( f = 'show', signature = 'Neighbor', definition = function(object) { cat( "A Neighbor object containing the", ncol(x = object), "nearest neighbors for", nrow(x = object), "cells" ) } ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Internal #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SeuratObject/R/graph.R0000644000175000017500000000734014133577537014446 0ustar nileshnilesh#' @include zzz.R #' @include generics.R #' NULL #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Class definitions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' The Graph Class #' #' The Graph class inherits from \code{\link[Matrix:sparseMatrix]{dgCMatrix}}. #' We do this to enable future expandability of graphs. #' #' @slot assay.used Optional name of assay used to generate \code{Graph} object #' #' @name Graph-class #' @rdname Graph-class #' @exportClass Graph #' #' @seealso \code{\link[Matrix]{dgCMatrix-class}} #' Graph <- setClass( Class = 'Graph', contains = "dgCMatrix", slots = list( assay.used = 'OptionalCharacter' ) ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Functions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for Seurat-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @importFrom methods as #' #' @rdname as.Graph #' @export #' @method as.Graph Matrix #' #' @examples #' # converting sparse matrix #' mat <- Matrix::rsparsematrix(nrow = 10, ncol = 10, density = 0.1) #' rownames(x = mat) <- paste0("feature_", 1:10) #' colnames(x = mat) <- paste0("cell_", 1:10) #' g <- as.Graph(x = mat) #' as.Graph.Matrix <- function(x, ...) { CheckDots(...) x <- as.sparse(x = x) if (is.null(x = rownames(x = x))) { stop("Please provide rownames to the matrix before converting to a Graph.") } if (is.null(x = colnames(x = x))) { stop("Please provide colnames to the matrix before converting to a Graph.") } return(as(object = x, Class = "Graph")) } #' @rdname as.Graph #' @export #' @method as.Graph matrix #' #' @examples #' # converting dense matrix #' mat <- matrix(data = 1:16, nrow = 4) #' rownames(x = mat) <- paste0("feature_", 1:4) #' colnames(x = mat) <- paste0("cell_", 1:4) #' g <- as.Graph(x = mat) #' as.Graph.matrix <- as.Graph.Matrix #' @param weighted If TRUE, fill entries in Graph matrix with value from the #' nn.dist slot of the Neighbor object #' #' @rdname as.Graph #' @export #' @method as.Graph Neighbor #' as.Graph.Neighbor <- function(x, weighted = TRUE, ...) { CheckDots(...) j <- as.integer(x = Indices(object = x) - 1) i <- as.integer(x = rep(x = (1:nrow(x = x)) - 1, times = ncol(x = x))) vals <- if (weighted) { as.vector(x = Distances(object = x)) } else { 1 } graph <- new( Class = "dgTMatrix", i = i, j = j, x = vals, Dim = as.integer(x = c(nrow(x = x), nrow(x = x))) ) colnames(x = graph) <- rownames(x = graph) <- Cells(x = x) graph <- as.Graph.Matrix(x = graph) return(graph) } #' @rdname DefaultAssay #' @export #' @method DefaultAssay Graph #' DefaultAssay.Graph <- function(object, ...) { object <- UpdateSlots(object = object) return(slot(object = object, name = 'assay.used')) } #' @rdname DefaultAssay #' @export #' @method DefaultAssay<- Graph #' "DefaultAssay<-.Graph" <- function(object, ..., value) { object <- UpdateSlots(object = object) slot(object = object, name = 'assay.used') <- value return(object) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for R-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # S4 methods #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Internal #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SeuratObject/R/dimreduc.R0000644000175000017500000005375714146000252015131 0ustar nileshnilesh#' @include zzz.R #' @include generics.R #' @include jackstraw.R #' @importFrom methods new slot slot<- slotNames #' NULL #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Class definitions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' The Dimensional Reduction Class #' #' The DimReduc object stores a dimensionality reduction taken out in Seurat; #' each DimReduc consists of a cell embeddings matrix, a feature loadings #' matrix, and a projected feature loadings matrix. #' #' @slot cell.embeddings Cell embeddings matrix (required) #' @slot feature.loadings Feature loadings matrix (optional) #' @slot feature.loadings.projected Projected feature loadings matrix (optional) #' @slot assay.used Name of assay used to generate \code{DimReduc} object #' @slot global Is this \code{DimReduc} global/persistent? If so, it will not be #' removed when removing its associated assay #' @slot stdev A vector of standard deviations #' @slot key Key for the \code{DimReduc}, must be alphanumeric characters #' followed by an underscore #' @slot jackstraw A \code{\link{JackStrawData-class}} object associated with #' this \code{DimReduc} #' @slot misc Utility slot for storing additional data associated with the #' \code{DimReduc} (e.g. the total variance of the PCA) #' #' @name DimReduc-class #' @rdname DimReduc-class #' @exportClass DimReduc #' DimReduc <- setClass( Class = 'DimReduc', slots = c( cell.embeddings = 'matrix', feature.loadings = 'matrix', feature.loadings.projected = 'matrix', assay.used = 'character', global = 'logical', stdev = 'numeric', key = 'character', jackstraw = 'JackStrawData', misc = 'list' ) ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Functions #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Create a DimReduc object #' #' @param embeddings A matrix with the cell embeddings #' @param loadings A matrix with the feature loadings #' @param projected A matrix with the projected feature loadings #' @param assay Assay used to calculate this dimensional reduction #' @param stdev Standard deviation (if applicable) for the dimensional reduction #' @param key A character string to facilitate looking up features from a #' specific DimReduc #' @param global Specify this as a global reduction (useful for visualizations) #' @param jackstraw Results from the JackStraw function #' @param misc list for the user to store any additional information associated #' with the dimensional reduction #' #' @return A \code{\link{DimReduc}} object #' #' @aliases SetDimReduction #' #' @export #' #' @concept dimreduc #' #' @examples #' data <- GetAssayData(pbmc_small[["RNA"]], slot = "scale.data") #' pcs <- prcomp(x = data) #' pca.dr <- CreateDimReducObject( #' embeddings = pcs$rotation, #' loadings = pcs$x, #' stdev = pcs$sdev, #' key = "PC", #' assay = "RNA" #' ) #' CreateDimReducObject <- function( embeddings = new(Class = 'matrix'), loadings = new(Class = 'matrix'), projected = new(Class = 'matrix'), assay = NULL, stdev = numeric(), key = NULL, global = FALSE, jackstraw = NULL, misc = list() ) { if (is.null(x = assay)) { warning( "No assay specified, setting assay as RNA by default.", call. = FALSE, immediate. = TRUE ) assay <- "RNA" } # Try to infer key from column names if (is.null(x = key) && is.null(x = colnames(x = embeddings))) { stop("Please specify a key for the DimReduc object") } else if (is.null(x = key)) { key <- regmatches( x = colnames(x = embeddings), m = regexec(pattern = '^[[:alnum:]]+_', text = colnames(x = embeddings)) ) key <- unique(x = unlist(x = key, use.names = FALSE)) } if (length(x = key) != 1) { stop("Please specify a key for the DimReduc object") } else if (!grepl(pattern = '^[[:alnum:]]+_$', x = key)) { old.key <- key key <- UpdateKey(key = old.key) colnames(x = embeddings) <- gsub( x = colnames(x = embeddings), pattern = old.key, replacement = key ) warning( "All keys should be one or more alphanumeric characters followed by an underscore '_', setting key to ", key, call. = FALSE, immediate. = TRUE ) } # ensure colnames of the embeddings are the key followed by a numeric if (is.null(x = colnames(x = embeddings))) { warning( "No columnames present in cell embeddings, setting to '", key, "1:", ncol(x = embeddings), "'", call. = FALSE, immediate. = TRUE ) colnames(x = embeddings) <- paste0(key, 1:ncol(x = embeddings)) } else if (!all(grepl(pattern = paste0('^', key, "[[:digit:]]+$"), x = colnames(x = embeddings)))) { digits <- unlist(x = regmatches( x = colnames(x = embeddings), m = regexec(pattern = '[[:digit:]]+$', text = colnames(x = embeddings)) )) if (length(x = digits) != ncol(x = embeddings)) { stop("Please ensure all column names in the embeddings matrix are the key plus a digit representing a dimension number") } colnames(x = embeddings) <- paste0(key, digits) } if (!IsMatrixEmpty(x = loadings)) { if (any(rownames(x = loadings) == '')) { stop("Feature names of loadings matrix cannot be empty", call. = FALSE) } colnames(x = loadings) <- colnames(x = embeddings) } if (!IsMatrixEmpty(x = projected)) { if (any(rownames(x = loadings) == '')) { stop("Feature names of projected loadings matrix cannot be empty", call. = FALSE) } colnames(x = projected) <- colnames(x = embeddings) } jackstraw <- jackstraw %||% new(Class = 'JackStrawData') dim.reduc <- new( Class = 'DimReduc', cell.embeddings = embeddings, feature.loadings = loadings, feature.loadings.projected = projected, assay.used = assay, global = global, stdev = stdev, key = key, jackstraw = jackstraw, misc = misc ) return(dim.reduc) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for Seurat-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @rdname Cells #' @export #' @method Cells DimReduc #' Cells.DimReduc <- function(x) { return(rownames(x = x)) } #' @rdname DefaultAssay #' @export #' @method DefaultAssay DimReduc #' DefaultAssay.DimReduc <- function(object, ...) { CheckDots(...) return(slot(object = object, name = 'assay.used')) } #' @rdname DefaultAssay #' @export #' @method DefaultAssay<- DimReduc #' "DefaultAssay<-.DimReduc" <- function(object, ..., value) { CheckDots(...) slot(object = object, name = 'assay.used') <- value return(object) } #' @rdname Embeddings #' @export #' @method Embeddings DimReduc #' #' @examples #' # Get the embeddings directly from a DimReduc object #' Embeddings(object = pbmc_small[["pca"]])[1:5, 1:5] #' Embeddings.DimReduc <- function(object, ...) { CheckDots(...) return(slot(object = object, name = 'cell.embeddings')) } #' @rdname IsGlobal #' @export #' @method IsGlobal DimReduc #' IsGlobal.DimReduc <- function(object, ...) { object <- UpdateSlots(object = object) return(slot(object = object, name = 'global')) } #' @param slot Name of slot to store JackStraw scores to #' Can shorten to 'empirical', 'fake', 'full', or 'overall' #' #' @rdname JS #' @export #' @method JS DimReduc #' JS.DimReduc <- function(object, slot = NULL, ...) { CheckDots(...) jackstraw <- slot(object = object, name = 'jackstraw') if (!is.null(x = slot)) { jackstraw <- JS(object = jackstraw, slot = slot) } return(jackstraw) } #' @rdname JS #' @export #' @method JS<- DimReduc #' "JS<-.DimReduc" <- function(object, slot = NULL, ..., value) { CheckDots(...) if (inherits(x = value, what = 'JackStrawData')) { slot(object = object, name = 'jackstraw') <- value } else if (is.null(x = NULL)) { stop("A slot must be specified") } else { JS(object = JS(object = object), slot = slot) <- value } return(object) } #' @rdname Key #' @export #' @method Key DimReduc #' #' @examples #' # Get a DimReduc key #' Key(object = pbmc_small[["pca"]]) #' Key.DimReduc <- function(object, ...) { CheckDots(...) return(slot(object = object, name = 'key')) } #' @rdname Key #' @export #' @method Key<- DimReduc #' #' @examples #' # Set the key for DimReduc #' Key(object = pbmc_small[["pca"]]) <- "newkey2_" #' Key(object = pbmc_small[["pca"]]) #' "Key<-.DimReduc" <- function(object, ..., value) { CheckDots(...) object <- UpdateSlots(object = object) old.key <- Key(object = object) slots <- Filter( f = function(x) { return(class(x = slot(object = object, name = x)) == 'matrix') }, x = slotNames(x = object) ) for (s in slots) { mat <- slot(object = object, name = s) if (!IsMatrixEmpty(x = mat)) { colnames(x = mat) <- sub( pattern = paste0('^', old.key), replacement = value, x = colnames(x = mat) ) } slot(object = object, name = s) <- mat } slot(object = object, name = 'key') <- value return(object) } #' @param projected Pull the projected feature loadings? #' #' @rdname Loadings #' @export #' @method Loadings DimReduc #' #' @examples #' # Get the feature loadings for a given DimReduc #' Loadings(object = pbmc_small[["pca"]])[1:5,1:5] #' Loadings.DimReduc <- function(object, projected = FALSE, ...) { CheckDots(...) projected <- projected %||% Projected(object = object) slot <- ifelse( test = projected, yes = 'feature.loadings.projected', no = 'feature.loadings' ) return(slot(object = object, name = slot)) } #' @rdname Loadings #' @export #' @method Loadings<- DimReduc #' #' @examples #' # Set the feature loadings for a given DimReduc #' new.loadings <- Loadings(object = pbmc_small[["pca"]]) #' new.loadings <- new.loadings + 0.01 #' Loadings(object = pbmc_small[["pca"]]) <- new.loadings #' "Loadings<-.DimReduc" <- function(object, projected = TRUE, ..., value) { CheckDots(...) slot.use <- ifelse( test = projected, yes = 'feature.loadings.projected', no = 'feature.loadings' ) if (ncol(x = value) != length(x = object)) { stop("New feature loadings must have the dimensions as currently calculated") } slot(object = object, name = slot.use) <- value return(object) } #' @rdname Misc #' @export #' @method Misc DimReduc #' Misc.DimReduc <- .Misc #' @rdname Misc #' @export #' @method Misc<- DimReduc #' "Misc<-.DimReduc" <- `.Misc<-` #' @rdname RenameCells #' @export #' @method RenameCells DimReduc #' #' @examples #' # Rename cells in a DimReduc #' head(x = Cells(x = pbmc_small[["pca"]])) #' renamed.dimreduc <- RenameCells( #' object = pbmc_small[["pca"]], #' new.names = paste0("A_", Cells(x = pbmc_small[["pca"]])) #' ) #' head(x = Cells(x = renamed.dimreduc)) #' RenameCells.DimReduc <- function(object, new.names = NULL, ...) { CheckDots(...) old.data <- Embeddings(object = object) rownames(x = old.data) <- new.names slot(object = object, name = "cell.embeddings") <- old.data return(object) } #' @rdname Stdev #' @export #' @method Stdev DimReduc #' #' @examples #' # Get the standard deviations for each PC from the DimReduc object #' Stdev(object = pbmc_small[["pca"]]) #' Stdev.DimReduc <- function(object, ...) { CheckDots(...) return(slot(object = object, name = 'stdev')) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Methods for R-defined generics #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' \code{DimReduc} Methods #' #' Methods for \code{\link{DimReduc}} objects for generics defined in #' other packages #' #' @inheritParams Assay-methods #' @param x,object A \code{\link{DimReduc}} object #' @param i For \code{[}: feature names or indices; for \code{[[}: cell names #' or indices #' @param j Dimensions to pull for #' @param ... Arguments passed to other methods #' #' @name DimReduc-methods #' @rdname DimReduc-methods #' #' @concept dimreduc #' NULL #' @describeIn DimReduc-methods Pull feature loadings #' #' @return \code{[}: Feature loadings for features \code{i} and dimensions #' \code{j} #' #' @export #' @method [ DimReduc #' "[.DimReduc" <- function(x, i, j, drop = FALSE, ...) { loadings <- Loadings(object = x) if (missing(x = i)) { i <- 1:nrow(x = loadings) } if (missing(x = j)) { j <- names(x = x) } else if (is.numeric(x = j)) { j <- names(x = x)[j] } bad.j <- j[!j %in% colnames(x = loadings)] j <- j[!j %in% bad.j] if (length(x = j) == 0) { stop("None of the requested loadings are present.") } if (length(x = bad.j) > 0) { warning( "The following loadings are not present: ", paste(bad.j, collapse = ", ") ) } return(Loadings(object = x)[i, j, drop = drop, ...]) } #' @describeIn DimReduc-methods Pull cell embeddings #' #' @return \code{[[}: Cell embeddings for cells \code{i} and dimensions \code{j} #' #' @export #' @method [[ DimReduc #' "[[.DimReduc" <- function(x, i, j, drop = FALSE, ...) { if (missing(x = i)) { i <- 1:nrow(x = x) } if (missing(x = j)) { j <- names(x = x) } else if (is.numeric(x = j)) { j <- names(x = x)[j] } embeddings <- Embeddings(object = x) bad.j <- j[!j %in% colnames(x = embeddings)] j <- j[!j %in% bad.j] if (length(x = j) == 0) { stop("None of the requested embeddings are present.") } if (length(x = bad.j) > 0) { warning( "The following embeddings are not present: ", paste(bad.j, collapse = ", ") ) } return(embeddings[i, j, drop = drop, ...]) } #' @describeIn DimReduc-methods The number of cells and dimensions for a #' \code{DimReduc} #' #' @return \code{dim}: The number of cells (\code{nrow}) and dimensions #' (\code{ncol}) #' #' @export #' @method dim DimReduc #' dim.DimReduc <- function(x) { return(dim(x = Embeddings(object = x))) } #' @describeIn DimReduc-methods The cell and dimension names for a #' \code{DimReduc} object #' #' @return \code{dimnames}: The cell (row) and dimension (column) names #' #' @export #' @method dimnames DimReduc #' dimnames.DimReduc <- function(x) { return(dimnames(x = Embeddings(object = x))) } #' @describeIn DimReduc-methods The number of dimensions for a \code{DimReduc} #' object #' #' @return \code{length}: The number of dimensions #' #' @export #' @method length DimReduc #' length.DimReduc <- function(x) { return(ncol(x = Embeddings(object = x))) } #' @describeIn DimReduc-methods Merge two or more \code{DimReduc} objects #' together #' #' @export #' @method merge DimReduc #' merge.DimReduc <- function( x = NULL, y = NULL, add.cell.ids = NULL, ... ) { CheckDots(...) drs <- c(x, y) if (!is.null(x = add.cell.ids)) { for (i in 1:length(x = drs)) { drs[[i]] <- RenameCells(object = drs[[i]], new.names = add.cell.ids[i]) } } embeddings.mat <- list() min.dim <- c() for (i in 1:length(x = drs)) { embeddings.mat[[i]] <- Embeddings(object = drs[[i]]) min.dim <- c(min.dim, ncol(x = embeddings.mat[[i]])) } if (length(x = unique(x = min.dim)) > 1) { min.dim <- min(min.dim) warning( "Reductions contain differing numbers of dimensions, merging first ", min.dim, call. = FALSE, immediate. = TRUE ) embeddings.mat <- lapply( X = embeddings.mat, FUN = function(x) { return(x[, 1:min.dim]) } ) } embeddings.mat <- do.call(what = rbind, args = embeddings.mat) merged.dr <- CreateDimReducObject( embeddings = embeddings.mat, loadings = Loadings(object = drs[[1]], projected = FALSE), projected = Loadings(object = drs[[1]], projected = TRUE), assay = DefaultAssay(object = drs[[1]]), key = Key(object = drs[[1]]), global = IsGlobal(object = drs[[1]]) ) return(merged.dr) } #' @describeIn DimReduc-methods The dimension names for a \code{DimReduc} object #' #' @return \code{names}: The names for the dimensions (eg. \dQuote{PC_1}) #' #' @export #' @method names DimReduc #' names.DimReduc <- function(x) { return(colnames(x = Embeddings(object = x))) } #' @describeIn DimReduc-methods Prints a set of features that most strongly #' define a set of components; \strong{note}: requires feature loadings to be #' present in order to work #' #' @param dims Number of dimensions to display #' @param nfeatures Number of genes to display #' @param projected Use projected slot #' @param ... Arguments passed to other methods #' #' @return \code{print}: Displays set of features defining the components and #' invisibly returns \code{x} #' #' @aliases print #' @seealso \code{\link[base]{cat}} #' #' @export #' @method print DimReduc #' print.DimReduc <- function( x, dims = 1:5, nfeatures = 20, projected = FALSE, ... ) { CheckDots(...) loadings <- Loadings(object = x, projected = projected) if (!IsMatrixEmpty(x = loadings)) { nfeatures <- min(nfeatures, nrow(x = loadings)) if (ncol(x = loadings) == 0) { warning("Dimensions have not been projected. Setting projected = FALSE") projected <- FALSE loadings <- Loadings(object = x, projected = projected) } if (min(dims) > ncol(x = loadings)) { stop("Cannot print dimensions greater than computed") } if (max(dims) > ncol(x = loadings)) { warning("Only ", ncol(x = loadings), " dimensions have been computed.") dims <- intersect(x = dims, y = seq_len(length.out = ncol(x = loadings))) } for (dim in dims) { # features <- TopFeatures( # object = x, # dim = dim, # nfeatures = nfeatures * 2, # projected = projected, # balanced = TRUE # ) features <- Top( data = loadings[, dim, drop = FALSE], num = nfeatures * 2, balanced = TRUE ) cat(Key(object = x), dim, '\n') pos.features <- split( x = features$positive, f = ceiling(x = seq_along(along.with = features$positive) / 10) ) cat("Positive: ", paste(pos.features[[1]], collapse = ", "), '\n') pos.features[[1]] <- NULL if (length(x = pos.features) > 0) { for (i in pos.features) { cat("\t ", paste(i, collapse = ", "), '\n') } } neg.features <- split( x = features$negative, f = ceiling(x = seq_along(along.with = features$negative) / 10) ) cat("Negative: ", paste(neg.features[[1]], collapse = ", "), '\n') neg.features[[1]] <- NULL if (length(x = neg.features) > 0) { for (i in neg.features) { cat("\t ", paste(i, collapse = ", "), '\n') } } } } return(invisible(x = x)) } #' @describeIn DimReduc-methods Subset a \code{DimReduc} object #' #' @param cells,features Cells and features to keep during the subset #' #' @return \code{subset}: \code{x} for cells \code{cells} and features #' \code{features} #' #' @export #' @method subset DimReduc #' subset.DimReduc <- function(x, cells = NULL, features = NULL, ...) { CheckDots(...) cells <- Cells(x = x) %iff% cells %||% Cells(x = x) if (all(is.na(x = cells))) { cells <- Cells(x = x) } else if (any(is.na(x = cells))) { warning("NAs passed in cells vector, removing NAs") cells <- na.omit(object = cells) } # features <- rownames(x = x) %iff% features %||% rownames(x = x) features <- rownames(x = Loadings(object = x)) %iff% features %||% rownames(x = Loadings(object = x)) if (all(sapply(X = list(features, cells), FUN = length) == dim(x = x))) { return(x) } slot(object = x, name = 'cell.embeddings') <- if (is.null(x = cells)) { new(Class = 'matrix') } else { if (is.numeric(x = cells)) { cells <- Cells(x = x)[cells] } cells <- intersect(x = cells, y = Cells(x = x)) if (length(x = cells) == 0) { stop("Cannot find cell provided", call. = FALSE) } x[[cells, , drop = FALSE]] } slot(object = x, name = 'feature.loadings') <- if (is.null(x = features)) { new(Class = 'matrix') } else { if (is.numeric(x = features)) { features <- rownames(x = x)[features] } features.loadings <- intersect( x = rownames(x = Loadings(object = x, projected = FALSE)), y = features ) if (length(x = features.loadings) == 0) { stop("Cannot find features provided", call. = FALSE) } Loadings(object = x, projected = FALSE)[features.loadings, , drop = FALSE] } slot(object = x, name = 'feature.loadings.projected') <- if (is.null(x = features) || !Projected(object = x)) { new(Class = 'matrix') } else { features.projected <- intersect( x = rownames(x = Loadings(object = x, projected = TRUE)), y = features ) if (length(x = features.projected) == 0) { stop("Cannot find features provided", call. = FALSE) } Loadings(object = x, projected = TRUE)[features.projected, , drop = FALSE] } slot(object = x, name = 'jackstraw') <- new(Class = 'JackStrawData') return(x) } #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # S4 methods #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' @describeIn DimReduc-methods Show basic summary of a \code{DimReduc} object #' #' @return \code{show}: Prints summary to \code{\link[base]{stdout}} and #' invisibly returns \code{NULL} #' #' @importFrom methods show #' #' @export #' setMethod( f = 'show', signature = 'DimReduc', definition = function(object) { cat( "A dimensional reduction object with key", Key(object = object), '\n', 'Number of dimensions:', length(x = object), '\n', 'Projected dimensional reduction calculated: ', Projected(object = object), '\n', 'Jackstraw run:', as.logical(x = JS(object = object)), '\n', 'Computed using assay:', DefaultAssay(object = object), '\n' ) return(invisible(x = NULL)) } ) #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% # Internal #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% #' Check to see if projected loadings have been set #' #' @param object a DimReduc object #' #' @return TRUE if projected loadings have been set, else FALSE #' #' @keywords internal #' #' @noRd #' Projected <- function(object) { return(!IsMatrixEmpty(x = Loadings(object = object, projected = TRUE))) } SeuratObject/R/RcppExports.R0000644000175000017500000000066714146005417015626 0ustar nileshnilesh# Generated by using Rcpp::compileAttributes() -> do not edit by hand # Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393 GraphToNeighborHelper <- function(mat) { .Call('_SeuratObject_GraphToNeighborHelper', PACKAGE = 'SeuratObject', mat) } RowMergeMatricesList <- function(mat_list, mat_rownames, all_rownames) { .Call('_SeuratObject_RowMergeMatricesList', PACKAGE = 'SeuratObject', mat_list, mat_rownames, all_rownames) } SeuratObject/LICENSE0000644000175000017500000000006214143043667014011 0ustar nileshnileshYEAR: 2021 COPYRIGHT HOLDER: SeuratObject authors SeuratObject/data/0000755000175000017500000000000014133577537013726 5ustar nileshnileshSeuratObject/data/pbmc_small.rda0000644000175000017500000016720014133577537016535 0ustar nileshnileshBZh91AY&SYN؝ H@h}x=zF5Xj:j[j[`/lR(P)^՛RjEJͥݺͰ;]vaJVi2iT])&(hBB (j{b=۞j׹`Ow 66 s9HP\/Ñ(k %-Sz{ Qn `!ljD5,_wDٸTݍԬVi+튪JT U'fʛ[k:$'}SRcIQrmMb٫L kb6ĩvٍ$[3 KRHi\oqLZVՙU͊(B-dPb@D@144 4<FCM4M4&2hɦ!4aCMFH &2i&FL&h!bi 4A y@L@CL6=izLSS=Qe66jijzbM16ֻLJ\%ʋ0h;5CG"EC`Wַ/V)E ^9d:ȪE [=ـǽ ?.n,9C%k1v)  ʡ(Jv4UQ[LVdĈ Y߶~N[֢3AFZ59te/d ֵAiȡ#XRh2dk[Jq 3V5RcPNA,1aSOZ$b~֍hiO e5'o(>ۈiNcz>NO*'Io.A%_C'#{'!*& x15j lu!f2x8[f\&W9M'%\08FmG6 I᫞j^)8ky*Sh2L*!y'Zi;9m SDhbaPF aPLN/d_]D금4BY9_s%lBR5՜^QHEqlNXA-@ xf:W64fF8$ٺ |2BزuAbARVƔ%fgaiy̖m`|y{SmH )vNn֎ i譺EuN! A{qftqc(7KCy|-9m'6 /IO{<ܝ2TQZT;\g'(szG4<mjg"6[31S_d9Cm(m-GQGhbǞ҄\?QIA랠#mr_-9}[9l{>>pI{Ecy=,I*'I1$L}F[`@u!D?usXĸEܐ@1֖DDƘM+dSTϚjizc^ngU&9B2L^$bb " x)KX*ŨeE<ߙN]"RФbdqb/ɮkl|4*Lq1e+ Neh+D:-TU*'L;XI=ڂ,F}lDlQQLTΓ$.6z]tGz6rvuritixdCb#ʫOq٨% AA^s5P\n@?ǡު=g̟]X$>~}GS P')! vP%id;z{L^ԑ>G<9;o>ۡ7AqŃg=8cЄ{.7iÿؾWuwӿ۟j>(GyƣD#Nzյ-H}gFitwGy[|8uڥy\͜6wNh,+l}{;?B:*:ˣ4XGՊ**cGW,MwgoM}~gֈ}O._V>7l+Wbں;p厞z\N$~!]L}mFM[+#v1=WG?i",{ǃ~`ܝU{ 4={q!ر\>r$1ZWs$ݕdmZ:;N\>sZ[jG1^x\4|$w1:1&޷6:>WWλ>G#;;z\z޾i"8ꭼcV+RHң*xNNy4qFbbƘx:p۷$6m&4mi\<ʻ~E"e"V'ryerҩZuai?#D:/U\*cN1JmE椑[|K vd4JVi&+h<򰕵V+« ;1R@`Q]ib4יHT:,+&UE*WFUbLcOl~T†,HadUm1xNuW*cou¶a^w-G?P!URG{O{)MTw=>rO}XVDGECDÿjAZDɦ?>8CX꾓IUx:p{ZrZyC§^,r8WsLp¸i^-FlLW-UT!8B(>)H9",`v) *lsj4{u#O}Swlϴ妘cmw9pGş쮌yԦlr٧nE}J1էr|vm>(uV,69a}**tiRǝ%y>ētTUUU**w?IJUT]N8pGr!ET*W{\ex4+1JT &*۫h\4Ǚ IʱX Ъ~?UU+l+gɥ*QF;U*laViSMOI1b9w8i[~xrۣp0 S|opT,V:*p)1RZbpۇI,1J[a*ɥ+J4*f Rp'W{8QUU hҕ*SҸJ)_N<..W.z\t|'syݏCDb}zb˜$=ScUUI^* pJG!ڪ˜)Tsq4ڎUcl?Dm )ʱշlLW*=)UULyUɧXƘ6ᦜ4:z[U6V6x6Պ=>1誝Jwmlxғ tWͫj ?iM?iNXmaV&8V9}mR4óOכTUM1 4V#g$RQ0W1ZiʧON=v8iyU&%y?NNIMŦpx?HNXҕTSaU1Uac+ƌT9V6ió:*ѥ~)EU)UOU1~ 1Nl8+ʦ)ƚM41Xژ+txiurM*ITaU:g"b FRiN0SbmucO*JJQ_UcF1Zc_+j&iZmQlmcO9h]o+GZaS" LF)UR1m4a1U1X?fppM6'{LUrW{m۳:9}#jSNWslrls TNZ{QC$+ha$h߀b8~`{OG QZTc]ZrpmN=ma+x+Ji|VX|Wٵw9{/vrѷ{ҝ*i^u1JcUՌ~w4-^7tdmfA4N]N\9*-<3 ̥`*@qs_9}(u_04S$X.tTAP="c='|EhkrK4S @nd{hS 3i$dpC0 `5hQ ܆r>'4,KO. IхU_{<_u8{fCc<!d^;$''# p  q.ҔGbgL zD !?rbE1@T (|{9՚HB )KAE2Х$lh*688NFiw𧧭J"2O-B>@!D85PLTE1SRDLO wJ>tOzq֓wr0 !a,45 njXi !ad,2 aaajB!j 5 C!P,,)'otؾUrյ˝" ( TEHRRaO tp[ JM(DSHyXL"v =L`TI@*žJB(m.pF'T[6@(< wd"$9BQIPRP "<\T} $q` 0 Geg߈'4!HgHL@"X@_|_@}r?@5)L@ ِ4*lH<t0(U+:yᬆ"w_M.{L&R$2fdJ?ZnVxD ~?Ċ?RrntsG`7̤[Py:[r&w(_)yyAS4*3&|u_ğDFa6.JKۜZ;f-b5L gZE |b3ۏ'X, 5?ըES},Wެ;̋2}X 8+ܦ4ONcrj!@`cP g'UvޣG#>| uZD79wO(dbtf:m H kjLT4Fى5-QF¦"ۆkl bR[F&5RAUQAEK0Qݻki6SA5Ii5 TB@8p 5WV5h}\DWJ#^@(Fq|q8>On'>i vSx0C[I \DRm@iьZ3Sk`2u@VU@D K"=\u(Nk>U@a'R 6WTRc !=Ge$IZ-\sy(#v4(Iv_S~Gk tʹKA_:P鲍XWG! JILCݻBj& C {|P0Zet3c[ɦE.mTǩ@K ^G0΋z\ DWbMl@ =-1Rd .J!dO6NC*EiC,||(jBK[mg#7',$#PCR1z |K4bM.s.<{]-{LWU{-P'.omT7`SXv`B}NjL5?>v'm?H{Iσk25ܐ"KɒhlIrWIB{ArowtNh sCV'k\yJry3J|C"$ });~R`}s{ZD~׼LgcccP]jrP u ZW ^7s'@Ck~C <|{* z:)*(ƭ[T0?Ԃx yymHQ<(d@oLu1ɦ Gu lG)8fU ?E#Zj  9ޑ^;y~ R儒mԏ0Xk7l=M1{*8nk2ҋCSPmB: !#¤rQ(OߺGhHH{>o|1^7Kƺd¾_K}[wbTDDyZ*;~.aNµ⌣yi<MAjD&ٕ_qPAHO2"$&usl<A8a8m|/ )g箇Xz|>]yJ-۬W.+/ Psk1r֎veK͒xb[*ʦ(QDvdR@!"G8{ēEF[H.TZ>[zk7C5{ GH }XA5DC1l^VJ 2rskT~ZY\i= $%ȰBYg7 l>r2Q6TYk+y>>1|H{id;8*Xj IWK\,@7n,|E&-f=`=}: @+zo\}v׿enf}FVXG&H_bQE KT9K]CVusVzWe6YʠӢ(@71POE gȣ`_9Ϲ>I#)Cst'[:Jؠ A}=kgwtsr(([Zg\Ө6H@*|fC{[i橒?Mk]m~s࿑\ry$r%?, I3L\aH$2_*>=/ݛdk0k;UA<:;T-P}9+3اH2x{p>JƊ-̽,~= A(x_g?/c~ͭGa!QPG Ϟ PMζG%։K4]z ܵ/Ϸj$$դ't³=M8 ^9mVc=OH bH;S:-@5I=屗֣PAnHO!ieQc Z&C‘ :K'k*!?2%A0<dz;0)%@wߞHFAs6{oiڙ6Dh{8~}HoC o O^?gw;ݫ+FvG+@(| B?hf(>tp|T?1r>;KƮp͎`*~Su^RЀ~3 I^`7+v)c *c.^Ǻ& bd22:r~pK_7@1քo!x~%Yj4`_w pxU[$ݐ"L4KG7W*-Aq ^PqRZOG,$pw[(A ,>$hk\ aa= r^!! !T#=E=J,mP@?((|Dg|\D߮롯L06yjDo=u!@7LI> 7,,؇Ĝ@g6IvA ' 7"S+]0|6n%F+Y-g%ۇdla7!P (a-O5tdhvd{DgqoC$TBal3!0络)?ِ: *Pޡ|@{NPH6iheш\uaj(S&ߓnr}fIx߇]|j)aGE|] 9"QM@$G  -`SH,/.Ned(ఈgfr9ǣ;I-DwPa m:e$L0X(|=?ԏ: (Å˙eۥ(Yӆ( ?nl@D3hH$7Wp<$hfv% ﻤV\m˔ܧ#x`G_Z΋6inIv bZ:z1q $9')u-oyHu*#x䭚7%@G8Xʀ Ë^jb ^a5!w=4阃yzyT뺫Sfy֙x޴=P;>'$aZ#@)S@"Go t0M^Huz [5'j~m|(yO^ >Tl ҫV&]38Ty\t7g̀D hL||o)k{—eܮT D~ObxxU[do$:xV&.P\xH)LnKDI5˦k^O*0$nfog/'K,_ WXѱE]?*TOFdPk3^w@ h2 p8`9`xotN,YHb'sgSuԩ}F0_"p~LuUsa&4<@|6lΗ5z%+"DPaH$c\WwxWI=!T5(4Sr TA%2pcd{5Ϙ+; JJ=2+_>^w3 $^pZUwn'6DŝaƷJ@Gݾ$ >@5 v*(l`"INU1QKߟYw۳Mlo/⹴ZoIBCθNeIxմ@ 0oxNo=v+a`X{">q{߫aj{o_lćHz@${Rdkp19Bq.,VXUBF^oLdu; y?%):>`l-%'Qჳf@L(LGژ<#v`M8/@0i-S Eaw&!F~7߾Ssi DȲTLi:Z{?#ra?MM= OנO_$PI$n: ms1J OʀlzE6<\VAk;`3FȑܧgnX(R7ny5֯+h4C}gAP.TFXdZΏZ[r.|2;k;/…} AI;G`s2uW`Ibx_ ;&:M Oib3ƻ_:jѭ^0*0'=n6V@Oˮh8J.@NP<ǝ:Y]9]uU۟UUAȷnd6w*t$|kAzDeMV;-J?>꽔w6m-?'8[]UhUe΅T[v {}7ewFy?x>#?뇹>Gr5n9:^?A "5Wlujjc~@ XvNl5I&>,5DC@ NY wÙf/Inc')(MJAJE$2'k>{4dYp+%Gݛ:"zr!lCtf{e9?Ik//MI% BnZyxm2H`f'i#"Z)bZ -W/Q!J#*HɅ!5DNr!ru70ǧh|5WZ1L;zdKgorN5Zq,`Y-Bǿ[r@F+RA  !ȁ0c@=HTR&ܥ({o&LHI$W?#^.ε{P=7kWf=mR3'Z_@l[$ywPbDS@d"2ϛDW5X );DO'3!c52/V6n#Jn k߀GGmY1=EPJVH D%MD4QHf:@?Ĥp6/ v H$ ےVA}>/Q܎F@DT?Q~~Ԩr"zl Ùk.9t¬Rxy{> >Ǩ|-+|ʮ3A+on9R 45L)ay7+Aw֣2 uR_+Q xIzB{1y~Z.x=(on2 (6xwxٛu-snM+3Aƕ5cE&kFd4DsDik-uC=iZvg3{szܽ1g +ki x,-Š,kh6aۙ30WҨgVj8NNwְ¯BYPZ9&Fn)yN\`[7Kdo@oHϱHǃi @g7nK nI shdf|~I8M2@=7;33Xr 3hY4]GYryɇdAE`6a*JE#>E$}Ss]?WzmЗck4_~s].[h! ﺌML=b)q_ߕҹeTT>1#rB/ V2FGC{/!}$"urq2fgVeIAC7tL[\E,؞-L[Lϱ >=i.Dpl;!Z\i%MR~J4'I ̌/y]1jeܨkzé2/gXOv+P*xb^0~ qȱ>eN]] rUu}\wK k:Wv*9@y5c/3x,qɗdh?'iot^rLR">8־bZ$&| 2h&,ϿyON$^o#LÇɔ fute~H.I~Sɡk;ےkq0}lm0Y]}m D!)(#DTIeLq.=~24}vSpQ`*v=by0߱ucWo`T\9v\V1J1JU\x ZpoKx]c[k`|'}f ܛ9F?!miVI""}Ky|: YL{f.UJi0}5L,lu1Pߋ6Ixm0Gņtp $G!KBA0j+N]?J8z(\ Dux ~Fה%bA`Z\kq jjܳ$I'3ݛ08'(Z9^)[:y95T\1D^gU}E<Q^T)DPmGAApR0rg; {mBO(f-;)zk|1{DkT5/M[Δ=NGn1rys7¼PmD _[Rμlx۞2r_vgʉsbU*4I)m]n=lvs' Y>:-s @3HW[ gy+׭E<_=-2 epR|ר> \3@r;dϠ~gOpy2#5M60ҝ`jϑfsБ$U)J|䫮ּJx{>]8Q#ZS!ȷ@=uFM5IIa.&l7G딦MHX5*'HeѲSBh*m+ݨ]O`A#q }lnt[?vX Ba3ʛRu[݀@ v??zt\ǿW?x̡2u4[.fۿR$brDzWar[ nɑaFF |K^ӭ BlW\ҡC:ek VA|[tA5}k/MƎc @\ 1<0Z3 M(}.̉\9HF"kV[9ZTOˊ0,4VG;Ww> A}rHYrtQ3*f[@d@ӏrۥ{'L~ MوFwor_>>O,[7uD+.߆X[*\@Oy6| 敺V .\]BB'" ' 5-<"\+cpZ~\q8[ 7A,B [z׽Vam|&&ڿudةڧL9wGvIɇ E׻dw<@֭ T1=9L|Voy]=nOͣ{aR*ȀVpXvum|wPr9|oWl:d%,|VC5>w=0O J^}-ߡZ1X[]5T 74{%1{ڟ5vzYjujK-fPܿTSBvZXWe ?&!79W1PN~DOe]k:~wA7Wd:He8oy^jm+KE-gWT5EKTtMXho>oF;ۅ/\+X̐2%I31'aljTmp݁R)RR*fY-=k]TfT(Ҙ`69CO\de#2B?6w[zZ/.گ`{k]Χ=iyFy_o_gwI.c _?Sag=wAS̈́pfٝc q J4 [*z15~LEw gG?5]C~S^`PJDk\سdD6k6h\\NFT0C; ǀkNV,,'qOY<bXniN@Z8bsgPGlwYj9c,mM 7Ke$k b<;+>uut2q7 =hB"x0y$!ȁp]K!Pd( Ynj2C3"rTV8ҬZNB;ouTN{Sk5dd[ ç&Ttk7;?3M3sl;Ӧ8Iծ"Yóځd@(UEDZ!5X[;pS#pLSqΤHF~d;q0;I[^ba7cnnADoa["(䯍J ]R*^ͪY^y`f{=îvaE{d€gBD'a*j5 DL[sV&㳊&0ț ]|! [IֳdINzq->z)eKnvͫ)t -PX{fRmLMm蛈-Ʌ"j8Q".Ya^'ȿ. aͯ$ī9&+Љ.be!SXԜ6f_+K-5禖0&^2a"x:+IհlF#5y34](2Q!J:! #/fyW*xԼ̽4Gf?N2l%x4|Uy纺`;)IgTaiag*d@Z+RsS kVe!Da1}trvjyrQ# 锅C:N/д \* 8QO"#\39"0O")f\€rNO{ŲNY=5<ʾbM{~{>t/ySo~/1㾧 Sd|E[zCk;ъQ' W{7H]! Ei Ql: BY ٮ Z4|Ĕ2)#kw,26y0_\`UjH0]ˤAywPBwzd1PSZD Nt# bX~W7;<jn<_o Ք*]]3f[)*4c}P'5. j].b`T&8&PɦLiil-NS哋0ժ8yX2 6` tg)CamZҮ.#1ZY/Ddls.Icgye$VK^LFɳeaggK"VC02d;ou ,Mc[Z-k$xŶ-fH֐5 z>D X$JKVQM,B/vJ>lg*~/[}mc-3p:>W (:?^ 0\m\e\|3v89EO&2Y̥ ^ " jH A3WS&4S|((",YfTB!:׫'A1ٻI,\z<=;`d-ִjQ_%V1h[ԌˈUsj؜ ]jCEze|V@,NUα]`<;D5e#q_koc=y,ye^*yjl)^~0XT@VxuwrE[7# N]HźJ [+UU]nj< Bu8La .h \e@L`#EY \a=@C*wI L46vm0n5:~9-% -kM4Xg(RYS\@,*q2E@NVr ɝA gQ~MxU=]uWSFf?ja%=Ցn-{DG<cb'qlϙ,3lRh| `eaVj1/6 28  ̪{&d볹L^BB ,[Ch"q&/VS22 %ژݐՉk NNOysG9Wq:h5rD 4)Eqֆ/#j㨰[N 1^F;b5?;v'.u4N%ya n9 lVbJ ̈́b\Mbm"<`53 SuhgFu .ٌ qFvX$gI!aK8(MCTVfW%b.ј C8MZlEYtBEݱ /frףe=[~.>1\ ĵom>,= MPMɾ>x-]jÎd[_X0>+*)MnkM5Z5y]{&gvBB 1(a۪, D6mi՛t(.hs#&,pkk A}u(p!:Ԥ?w-߯~ߨ{| fޣb""+1x .l{)bptDD Hs0KhՂP^Xk.ET?*,8Xg2yOO6T4NatD63,\dё|92P0 t.qB'DYFr3qo.tbPcۧ_zkWtǧ]ףG]Et(n9hM3ku !ܗ~8ہd=ZonY'r#p,k[2[)fPZEIDKK"Ni0DqVZesc>eUI51U,[fߐ#|A=7.Fq-ǷX*j!#7ry*1'3,]< AA`F9SB5Yf 3аeUK#f:F,Y0@ WHd],3Ӹ2kʖ N/2&3 A3\X<;LR[)5ђ=@RQ 5=WqoPiZCx}d%]]?~~-7W}RzV:9fgz꺞!TUS&T#2ŕ bn + 8]vt^6DS$ŪWPE+C ]X9qh`Hw (̌HrCߑg&D*ik}l&y2, bór'z uR:;/f5e-]M"$hkh.B,^lHUD`Zj*:a+0_" 61g}S>7|W_ퟥ5>"mS@Jm7SN)vU@xu=~.V2 Tq!,3ш/l&p qlXQcJ9a]ܒAF`kMճs=n~;mk'DoH%WCoHf q~y|/Mo7-3;tM_˿}7硷@D1n\yW&l.D<783Ȅv >ˋYqs7 ~a:XjJR()i !(iZ(HBR((( B&(hJ (bZh (h(*:ƕ*Bj )()Bh (+FA5AE$IAOhiuITUPA@-Q 4AJR @U%4ACIPKPRTR@ AIML!^ J(*d"("((J(5d44 SEJA LBPQҔ#Q44dCES@STdCUE APf`PEE9NCdQQ4Ҵ4aME4M!IIH=G&+6 WM+Vt_)>CKm>uKvܣw4r)3hPfQW ZJ>zw>46vUυĨŌ?Vu&28??GvEU`7Cn;ވV٘KNS.0&MjiWRٷie:4Vt? .Fiimul%&` %aecϗN/ V65IOw+#5cm߰"u_\F'K?wEa乴sɺ8ɹM?t8ÓJTU^0ޤ*|hoB7PU PDc7y_WZӟIknz8X\"!(~#sٱz5{ ZIBhJ)*e(hi )J*!F3H bJ)( ZJ` *Xf (j`(j"%&b(h (h*BH!4 =7|K2SfWzqu*KYYnلG}3:%QIrb ^=W)PH1fݜ} (O⹺{ 8' 8(KĘ4&AH(ȺԬRRXMkB4پrSE^i?X0 8ߔJf@ rl}tQ~y/$.["=o߽;޸HP  ݻ+z:6Cw5nI PH׈?n܃3;lj>|sޑ`f]MF->ۏΞ~\!Ax9%$@č MPT9 HD4$Td AAKJM1$M4҅DYR4Y9{Nh=Tp|:ޏuJd9ĸ2nO3YYV ^CR~T#]eo;\y4^:Ky. c9tc ϷWq'_Gè __=?`Oo|nsmsC}ZߨyA/O|;zަ=0vR]ngFs'wො! n_U:E}7XGۘ>cɳd|=}_I5m;﬎zv_mrTa~qfZ2v2OoIz ?B`]{j `~,Ř;~H~n{r]0:_Q_uA:A^><= ա4u mM1`scOW@T]GQk,]|SEk?Fۙ_gcl3m{yfuyOUדּߗxgߙV9|\7Ia،,0Ѷ{_YDD"m59>^K?Iu5r Q31[Os2#9t`y9#uw}4$tׁ~ٞҸ_>A.`fFz쳖 #b1P` {+iǙ/!FYh}V,=aeCVU!-+*64*>|@F B٦4jĒͨ`BkBd>9ky򞏙h?kqh0ɫʊJ+X)j )())(hc3./2G,o.zo!f1t6$pߚc<3 ٓ!Ҩ(RD#MՖ-ɢGo?'??q{fBAj̱#;#S)`aDw NjF5tvySݯqCV:"6櫭kz[]}|P<z,I'_qyN$E9=M̷;^:y/ښ++PU676Y~{YF7K^>9ӀT~g{nӱw~[~eO-[f@~xNCk߶'_ ؼ[]oo좁nL 3a QF=~K^g-IiJ&$Avߧ^'YSjocMz?~t~_kΧ.!.83{l"+Tr?ߩUsQ,ぁDci8qX1PL5Z,Vy lV^c*s'4`uBM=7 P5,~PfFN/TB%/vGc@tCZdϛ$d3='MW2_d+o#xvKq;xyxQ>?3QR4LPAT DI1v !Tfv0cIuXƒu\TG K``kuN bU#< u }r`̾]adO&)E1!@qvZVmfRise[ۮ<,Axb,q7'b5S ]iV|O*qUc8Qݨŵ8^NB69m׏燮3'Lh -ffJʃB@~@TfhIk Cw}-hRl.Fi9ՙ.c')laɝF %C wYp rѮj-eMʁN(.N?hw6ọ 7 -*3)_,lٰ \o&~bݿc30\zy+HUG;my;Ғ&[Eh̀)i)(ZB&hhoVQ}]w&Jiei\a EEoS]|M_ލн-e's0Jho-O䵘LM±/_0Fc ݛ"_b1<|W`Y6K΋\[0XaffOP9c;Y'4^%㴐qY.2\N6dc>Y^uw! $: pR0td6Qy>_ڞmGI?OB~ Yz욗 uydQ8ݽKF=YJтGȬ+[6TOjK^#̽bs8nqZ§3n=ڝ뢤ֽ(41²w}bSjm z&{mmI$ueu{A[dߜn+z ;Gofw;+SsW z Hb!H |]S yw>/6))*(ny;^/52fFEIW}U-QJ߯ }UIMA/__^]Ti8zO}]$%"׳׻))Tqi!1 &<| sƬ+aj-OT!| >Ax.$PǙ8^b6f!!ϳK$2=~H^@9&? {~}pp:?~xUrP`H0^~7<(q̋ BpXn !!p,nCPԉ XXb*C!q"jCp8j Cp2CPXbo>78Hs B!Pɐ܉2 ChXd,aXj PbCp6Cn W71ũP?#DE:Z摧nk3vt홤fgm:SjW`Y=P! T5 pN!d,7 B¡abEd7 pXn5 Pd2CHXj YVf(~1d"09$ v @JGɖ+cx)<Dpd&PL-7ku ;i PWVËd.8&I_y~#ٽC5N/ĒC$#qpuOD#NHa2i$܋Y!k I͜Z8y(#(.%Vpw۔ؽ'!{=IqzG^ x@vI]|DRwƳ"/G*/Öt""błE6Eỏt;C!*K !aXvtuGW<ҍfe8f$=zdٙG4Zbt!hRسr?er!X!: A#r&8!jCR&&!!2Hj37"m!n7 C!ad,an7d,:Cp5 C! Xd?/,8q 8n0ʓ1212d~NyXu0XbhXj !2 B!aaPCXq!,2Cwr յmCWb;tkQJlϦy'ri8C=Xj5 XXXj Cp Xd1 * aYPR2&5 a8BBHL$!y.C{( n-j^jNڤAl/eqfmê&^wF~ntwA`sR7GYo5H빆j-+8v=ܬR~j@r0w-/~ *B"Zf["ص"Z-IlB"!"r_Gܦ@N ]vWڈ鶽ge8'foKy5&gCOh4Z Z*?,) %(hNq: )#eo^5=pL9q6, ᳪ;Ұ'pq9*μrw-hv3^%%SybfNWt㵏q'a_{mE^7D aߐ!!_Є BHI !2{pcػXӍx'ٺ&R{^BMzvpdLaje P1 !b B!aaa7 4i Cԉ!P?LMK8p,5"Xq 5 !aj B!d*"d5 p2!2 C!d5 XXd7 C! B5Ş-*t'RHdu4*|JAGeZUq}pXϞXI2 »z*!p.)=vy /iokY睻 㰭vANC h#hS KZf p P cgH<= p\ۖq8W}ʅ}Ue쵔̃y Aٕ˃KWY:kE-{L&S8]x7s!Xz5Lـw!ږ#RKxvzK|5wFMixa:_)df8.} uI8a2񾓯9[\G7K)[8N0,o2A-s5AD;1/kQۼ,kks &L~m#m%G?ob뫿M\=|sT|1s c'"nZkYMt{ˢq]@R `uP GV .-hxyjbZ1B%QӔ=$.˞z')^%Z;׼Àg yfVOov*Ol7ǖ5;?+ү ^>]3V/dǁ\ Ä FQJ*c2vmuz0L͗ц[dr__}9bs4&uZGNFIhU Թ^S!-Ev :h9bhڠ~G 9~^[sxg) sm (Nfz#\L 2T7K.sROjܳ& •4qlEKPӺĴXHdޞL;XڑۋE;}VcuB8N ZAZ^Pdv/Cg&+K?,MLgZ 0Fi=(nܦɏ1L="v|X~:W C5 !%!$9."Əqr47ʹ513 ;&WYKrsܗ7'AKOI {mM_ϻпCaXd2BPXd*nCPj奇jDq"n0D7 B jChhBR&XjC!ai B,7 Cj!d,:͡n!a,,9Hi >zXd7 BțB1 CPj Cp,5 aa !adLBÙa7 5!nB!Xj ^){L STSjGh 4懞CP&C8XYbC!aCjC Fd$KEw &mG{'_Bu_{ׇw0ڸ -dk`F_4Ll1CyrpMe@!Ʀw+ٗ,5Έ6ihajڈoz;n?VfcG;.}u`o?~NP0B%$DSL4%4UACCKUUD1DEDSP@M4T11444Dđ$E5IEPP cc M.;4==(?6cA㲭\@bW<ЦF^K@R6ݟ\1_]>H :ߏ1dR좌FSvll=[ Mu[^;Zsmd p'%#0m b)&FO]dzzfKx&ɴ[w->Mi{):+Ң%_irv> O+V,s9.Z$wj-zjfCxlcaݶ٩l-U .?޳Zr}"|Orm> Y/g|?ݜz >8NP$~b9Rp^䄐OaJfѶ-(p+i5='L36*Cǧwkmdrv aH#hƇthh yp YJ`@cOrEbzذ63I|rƫ[ Ez rjV.h$@wvO$V^9,MVXNv4z1ZfZ}'9ܘwm[,Ig=.O[cn)'`cOF^[$ )_O>%@"!^曀l{&ckTRp?Dejz b3#ϫW#-75dqE"ׂx%^ޮ ;ŷ-G+ @R6J,?M9XnI9,t;r0D` !N" 0:H~{߯=bU_7ˠpHKo?J]:5w\BG@#>CŦ89Yc.*n} P@7ByAC1Yw&xoQo9nʘdXG$HSU}S=9 YZ9ʦc*)d|wlreqy{ǒ +R_t |oE1P>(kj$e0Z'LvzS4y. ՠX ٠q$U@y48!$:R%1ܘv | <0 [@"ch<9Dt1r;겼SdAײn - =y\UurvdQP 5J,(>p,lxGMR+Ls$@^Xkq.[0óԑSL43ffQoht(,_̀AdNbޘ8Q CB ,.,-[MC,[/jS}e efsˌ2ft_|Hз$"E^qKo"ؼnۮ[b%8<LcjmQlC7|j$ˮx$TnȒ~=S_cS~<³tbi99%(3YͮUf bO윇> a>x0cοo~vGn:/\(p0`%fi<>agT4 w]KI)OeIJ~fH!Ybn/^ۛJ a(q &nL-V2H  rhkHZr 4 q24#g77yzjZn)YfdD"hB6OQwg3 Vߌ3Dhnn[5T_FqN V'#;,'xcZu@A*ie"y%Ա5~.:Vh`>yxѸrܠ ~oRe߻f>m}u"վ*/UMm/F"֥5/&τ-4b%s0kuVI-3bbZ${#FFoH3 p::s*F>%"pP^9`Ѯ 2~Vf*̛wN` -A uq] $37~ ^qyKۏiȁ{PI`p`>5}8b[*!% "1wE0λK|p(Y+zfl渍iC N OϽFC={EO:#-B5MuwSĬYMg+B}~ an€כ\wCl$[˭ p\@$"&a\2΀-BYqy323G 65r{uv5 5-Q> 7i{snӲ+_>fysEވvwH1=񧸻"XV-`!h-P)tA=O/ᢡ~x@,O"^`:szVGqw)>,z`-$!k IwU{Kspn5Oq9]sD_:9 8Oǧ*ʍ#Gȹ5~zVn ] W!naЂY'f 4&2i=mZru1Y^sFYq@q5VVMOE5x1^ *n@F@m{0#zy4E.08%Ϥ[.%/h|@ChTDˊCΞqi9D〄 $o富2_#x邥 MA;#T}3K4?շpK= F&,ZQιnC'7#D@A6_=+Ee(n A@b$PH EňMpn&88l~}oɏD>i.:>aOP0j9O Y\1@E- RD@X+'5~6_3,[@yNkH[ $^v62$)ÐZP#wW0u(rMCFS0j i`9vվJm7=%\sw9Ǵy2翯#g xz?NNu^D8f,Nn@r;ul?FEwýcf}L-At(}t 7]摜>ޜo4,b+"nySv-+R7{GfpzyZo(/wjp\渴1%ԸvCY59@v# xxZT o$w zc ϜZICBc]ak^dptGi #R%BpS !g7ʹ/l|͞X@OBK'UJ ojvzZ){ _ |cM(J%z#vn3|!DK&#Cy>L{}fi;  Cj[3[ >0\ݼAW;ըQ ]~j<=$xm s.tZNJZF\042_+ہ 2Ѐd8 #yK27 j`kS͔Ÿe%y&fY]A6‚wy5~?*7^s;ms:@O & >O fEȆH6ˈgYݸc1 -}5Wvzh|J^++9:YD1/eobxnwLF|c TNhgixD7h_ѧw-Jm0m&[vNDa??t:O 0}9ykd+v}I900Ȁ6ⰻzy$#_QvfH#ۨ [~iOZV,^Eo> I=D{S}łA,)n]@ F|2(6{ dxT e+ sx+wK λ+ UBqn]{+]/k~ߌII GV1Bg6Ή@J#T5=V%$2J{%]OAJru CdRw}Ik?x+7 ǿ-RY!~GԀoLf=:EU>kn[fai}@xmeiHEx^Ehob.m`;,ezmү=yYi1 2ynPAo?+y CzK$Ĥv6YZ<fQoxr&TN_\ʼnÖ*/o;:!/\AEo<l֚}-Tj<  +?juͫswjt/0@/\>R,ڟȻަ;OlGX$jx5Jy-j4zmZRY uH^Cvao 1d@R_8,Iz-j/ jɐDpe?=g]ɝd^7{ϱ 6 \UL=n2*_1V6;lE1ƽ%i9hI&>̇LwY"߽(@$Xh$kof62G|P[dL*׳Ge=d4S6&VCjճ|23`VI_otW^ue @"ILKG? qN'lv6KMܖHp5oTH|4*.wAs1vb vLp~/ތuBf_dz-YEހn)RG=잆o\Ǘ3Jb0Vy{1o*OS8Lj;tk%Է1KP$sIg #W 'k %][٤рJ"?Echj`@CXc:iB}Cf睈jZDa 0/E];{^C @1\YV|%?}I+f ɟ*<>ُjs}$u elQ ( 6כ(p] 5=K}=I pCrrP붩յ^lZ/ NG_])},g/wEDeݥB*AA {d'D 6"ڿa` 0$l2SLX#ktN'\$Ⱦ,I\?I^^&6f,/-RU6aV"7@d a@  @~`y=Ɗ'}ܒlbSO\uN/ H^ݒc> ~Z_Ӂ"3L}מނK=;o[(gخGQ_zNwZ~$hS-qnI%j_H1n^`A?lYr]s3@SM]?ӂԻU]\0 ր" VC]= k\O !&]2OSknc#mU0P4e=5QiW".JC!jhǏ5NWE_{бA!@60\ث,*Z .soV]~#m.gH_w 雈OH\z~v21] M1Re@(3#hBH `q,𠬾AO"?# &g̉Xo.!1/ި"s|_f`ƯHFXhܙlk߅Nc|Ӱ^#%D1^De(Rb H?xr 7'`[*Xaf Wpw@Ag{?;QΛGt9'*Gh1o;@B`^r~ |!cBu֥+88WYXp2Ӽ&Tw_etxmD y~ =!Cmd۝`(?.]F{lVP@Z 65KtG8tl̶G+e*wZ;a~%| D7)(~4ɛ(b6|k9>8b8?[bXb@"i=KkƢia*qIKj8!WɯYd.Ox w4QhBgy0"%UU[W#iۮv]C~\ 1It4kV* `xU>>97!NYe|L7c75 2 3|2I\$߀T߅v6% Rkag -ix|ir{[h,:``: z0:s6{n~ԝm,/ `S?_ۡ-v;騗`@8;?$sSj6wY%E\6ai"¡5D;w4SQ"@W -1.L`nQV4ayQu:*} ?jϟL_5^ [ŲE60(G|K7یlB AyrP~Ǹwnk8_alidԕl:fU=n zMZ)}~wM+DQ1&;~@y*|y"D"?$>[ ~AWo"ju-7h@ IBK;?ך I{?xl֔e>ak"U: ToڠE۹C5 ͟lz(# ?5@WpC(kf#A*Ե43G7 =#eك4$^׵_,5]v _r꒿4q3a9&4?C&xT0([ߊ,6ჩuq ZEΛPe+6z>AR1(ڠ98OO[n%Hp=yFRB֧Ij€ek+u=GqDL"VY ^g:;jQA[_ VD /9?^3`6J^x0%IWQ\/95yUivݔ2hs^ Z-wF_~fw=*/5qY:P̣gp3zAlw*x|gQB:i?g$[4^}CޫmJM5>j]Z̧n.]> m0/ [^<FOeo^MWKAf9e.*$|uP_ l@z.`z9Xf3]yIWAM}Y!^^ݻǓgLH/ =]K1_@];?4}5Ű d-v*".<,S6,WZż5#4%,kM:KF&\9$-اR >.D  #99'E+ӬB+~H2@+Kn\8}2H @w$r: p%sUv\Lx.ь^ڃEumpkȽe#Wڗ2`/{|o/׌ <5}>1iCۣgI-'WF4#:.KeӘXshmUA}xcL̛(?EyMdRAο4[l.v'[{:^emo%`;VrX`Atzl"D-28YVNE)@ &ף߭ybz~ngL@Goy.8v XsWN7/YR}cI@5V~2=B gyήJ2 cZ4"h֍5[Bh }$ ӿ/~{E~Ss>}MvgfHb{twOkc 1,}8e<-Q5\l7aQvH=gNPdlc Ps.m0K_ d9%U\ڜ4Zjtw]pu½El*S1"E6ދ1owyw<F'f ,\nu]Nr>HF!JEe$.}^?9"T紴;b2+RjU^E/vGkv?5wAn5č?8)uJ ScI"b (mq ىL%fQ]]H7Kid1rdkg~1 8,psdGƩcA df|y/6Ny.hQ^s+ |P.Q u |^/l6;:cpE?,9;mc{^ݮɳx- k,- ".#Bnud9̙Vlo4 iġ,ip]Mݏ9D@~Pa ӛp-wJj]{nj5DF?3KZ.ne]==٠غ33Ć-hΪ }  " *NeP >sdMw?Cc/[6|{H[& zd.y-+>$ٵ?_|d؁ 0 @ K14J7Dv0Uwt 0O-PDV{k ·=ap˟ëׇ;-g7T{AXvn20=}+͘jx`ϐv7p]px=t<#,%+m7]{/ܰځ A kǗ홴r/[@{HuIY#c!  |dgcgŔN\+ zTPCNKM@_Ƨk\S}Z{+6}l˻N֬YZ/,u)}8K@:Tfn\0= ek>Km &2dn:1P$89t(uxW*B9jF&J-}<)-RbctY{S\Wf{dAܱyt1HPxu1 eQKTk5H, Pw]VՅz|Cl[y!` 6v>P(Q71`%'e,+F^oOcoׯ|ǵ}o:&+e|yy]З@F:|fŀE/IU% F47WxZUm+m/sz cHT0p~ySvC(Stϓs'"acѣdd3kDR [{jG~  2Ή@ig׭}QLZ&5? ..& BV0ېk}aqO奴@CVWrbiRɌKM(4 "o+13F\'q %XbAš*)JC褐Zg "|42o2ro7{̑kzÞ_r1n lqq wo粙|ߦ7~bIB_cHLn{5ϥgW)6|SV>`*dv7H^>eDv4.ٯ|qkk5ԩܔqzn_ywGqldC{1ro"6_/1ZkMmwa/҃a橓LM]|ohXzj߶Y-_y/vEЗ|nK '÷9@,:4qKsQ_)30_ѝgjRC=0N| }:{fmg!Rm4O- >=ۧͨ-Ma^cI˔72:>,aOMq<͉ќ9;%;uؙduwdv +p=.__znqԭk{_Dq -Ӽf.Oo!뻪.F :k}R?jG&PoY*|Q=NoM]yiUa {\5#TE_|5A~uyܒz* -_L%ڜ f\?kJ_RQ 7̉ϤsW*zR75$= 9 .MyH}m}5$.h_GϳTy8D͐|SUwM9#W`ހ;$#hPؼ8vZz !B(olU?)^'4`:ԶWv) BBC3"eÄch+4 쌂Et!6QT > IJsh];zMP teLRIpF]ћCi{vԢ(R<ػyx]/a GW~8:_3+sKk1- Œ JEH[2DM+6M ӥ^407굊t5SK r +{^m*-iCۓb, O{)B_)@w<ҵ"C2@zʚ$RǶrV/xpzkAI>z$'sjȤϯO:w㉣D"HGt$@Yv _I=l{ |^6<bSngݶyy~[%Iun~(aXvJ~[H0Ihg-uGrc_nsjHޤR=-U  dO'~vE~H&= ~}StaVe*W*H6X4ui)^;c _9i5YN+Ҁ $O $O=[ަlTy51:GʛcIPÙ~@(; Sy z]zht$%$>&JE{t_S*,\+OdlVBl<~6kdN+όI0N}O'Ʋ{e`GEWͨw+BmΗ6a\?E7?_.3rs$ ?B$@fQg] #I"HJb? OklZ+ZEO-VchMv,lЎ BuJEϝm8$gOV`G[OMqb_4Gxy[30rmnc& *1Vk ~䀹` @Js,yg`hاFq"V4Z*tyJڣ0, j=3 WG`"p=-GU/Ǭ[VS,RWClq<o6#5`z {o >5̂]i@PBXql CGP٦{ok>K#Y;Uտ@xy(:@U<־; z dk sDᾴ;.Jnz{ެGգe$a>7#`  %a]= 2e]OqG7ճ|NVLg@T&h\l;W63gpJJqL@ ל 8DϹ=uiwb໢ $/RVz}-jj/2UDzN _+[Igo 𾇿`S_Tq@%-qWYprE/Ӝ#rh~Q;\D=/:N}QGO=BP"v}p+@:4:)39{jRI3~'fVQ - njqtXkn]Im$wUgTH %؋~{VPHxE*u\=Ʊ/nwtNuC̻ SPZrEx>>#Sg55ڷGYcf]=ǿA"4X;KTUMj@G%HL8eBMx+,U)X-<B& EW x|{4@g|H|(Nm`s`+_*HRg%A|n@k'ݠl+jv;SPA0b-5rMdIJ(#c/-OtIT=O^ tSX(״cq/+)G (̓Ξ]dx\nB09{Z=D"$s1J;G譇>:$ g!Ix jU[ 1vYk,#m w{mX6ֶhְX6vneCdɾRdK$g+%)>^/V~FD`VF%/};'p3)>h31"9PPQS@DpWSˀ &yl !|K"H LI鏝Э軥Tʮ?"0zkDx1T>$>cT20ϵ1M6ڎEIQ l^\SKGsczP E w0/t@~Pmg`.p|IPP8G?l3BK eP:c\3wG[F tP pv!" c1U ve;GTDް00?o %,"qf ^ZuOo3Plxc0,iPC, %; lOH.B%7A^}t$K˻L mr,c#zD =c8ZSP*eJpt^@ uQxWc}H7_1زRod ڇ0k9xaX`A"r>R>m Q`7_:U~`T ,hT9Oy^.V:"聯k8m wY~Vj7n[98e@t벚4A!'O$cYIU8_U@oUn$y ҠI7ta< sܢ@ {yV MWÑ ٰΘ\Э;z,c_M6mx4a,unN9#?8`Dd{}#o.^U .tĞDT xєs5n(isCS:!ߌ樧bQi^{]aGٴe)l:njjPn!Q F"oX-JعaL@7Ƅ@w>Epj=zvc$Z8$? K<=co Z,G]ʑUly' Z> vDϫwqzQ:L Zӑy؅L%}處4LrBUyހmϰk /zً覎ת}UklT4a&l?aC?gሰQrPyqhhe`jޥyӤdS#;LnD@}"0ⲨVs'~ LA0>$"Mtŭ| 9?RY Ȁtu\㝬Ps(NuӻL[5#H>nmJW5gfYiI ># {?(L!if=;rl@G*?;\I%qрhM)T/$ F1[K &յ]}j>@A|J@)LI_f:SW< N?{$.[zcj\ތ@9J=tRw v ur.WMu:U׀۰G#Dߺ&LX 3:LW]j@p:`-)}QCa[CȌ U )(ҁ͍ק-3 Vm8 _x NUR# ctDp~VdlLr0PqxO ]0X%+Fڛt 3DT g$Uxŋ-Wpkjfnu/rǃ~AX.-8AZ1D0fI=4:AamMgLUOT wdN i$HJi/~}PLJ5]uHf$+P( S%+:w<7؊YAWȈFEzk-\ -Q4]]vK1B1r2huf)|| O@/gઞ9$'DǢ{ Oƕ-sje?yt*NrӶuIi5erai: ͨ2>wEXpu:ť:f)b$d8QHMo{^C$S6Q<0ڶ&AHr3[ݿB0,g?y}%BeãkFhҌ * T+sGs&ωْ*Pmӵx#m8vZ硓D]xP^8ɔMoc%A@'4̉*.Z6?^u8|N4Cq6O9EIjڂ ShouOF'bw%7|.R]s{Y{6Q!;F9-үQnZj/+@@SֵdzщCKIAUdqzv_t"X nt&wMeKMG\A LW8&X  {h;ޢHe#${BS f!Hc9 DMlUmsEƠTW{z3f.HRGkHp ʎWͲ6vQ/^:?x7)X?O>.d%T\uU c8m}xLZŮ Zr68[X {Ye_ǨKD!7dctea J0[4@s*pqʵh8}m˙wzPnFMqceMjf7ɗ﷟C H\-o:ǩZܳR]P萒a!D!}r vE'C͗NL,.\sH} n"Q[1 iPI>@E9X4ZtQK)n?vD^Ȼ "$v[Q?G~6I!PpZ`vmEg'8B0N5}޻,gŵ`0.fXMׁ]>ol^'hZ;d=:yuIp<#=UHaR4~&PP5LUosn+0o"ĝ%da6z n=gC}:ߒ9`zp}CcB }"APjq" <&;.p#voPs/i $-쩗|; tELx''T3;(SP p YUTxUroR4t I;-yd;O 9c7`wM:N(?HOۀ>4?IxzTiA ""M"OjϑP" UяJŐ$!R+C6ב`3g6fhJmfċXB>Gc0 ^'L}^}Rh:fXƸATR5}|rm4?դEk׳$  57[dWFC6S㫜to9۪gߧ%ʜi=g Sm s9>#{ҙ&$; gLG.er=X|fI0M{U g~ڞW]G//{*!2ɲHb`.CR h+)A!t=Hh7=mOV}ѱj6z4k,sBALP\S4{;A4]`5"Ma0 LÏ}i:ܰIF4ɀx, ZгbZ/:,g!ȐcU [xj-Lt1>1G*=_@q3Y-]-#=\|ض|mtVy$7@)1!}<>>ҼUY'S:kHl#!i)}9H{J1)!`(Ns>/'6IF'*zCmWe%ڮ?ҍ;P~϶j3^wZ SmD(H ټʦ@f.舘18 yɰybK˖[UʪZ>njƫ:4^{',mcvלT4N~, ߑƭ6eEL!BN c梊VX8У:H$/#`q >0 FoE(M}5}%GĐilwLbJh =j(6:d2A#PzX h QCQQ0 [C47`^7/hV}@:.QM{[mf9DQ?_bm&_2qO!PK4]6z,EUc$~9$2NF՝QɍB,ف 93_-I uyU,퐝]g57IUN( %f7 7-}kB֎7 h[$6;\M-F3zCns>/ G* tj>.}s&eE𧃏ji%Lg[Y,Gi+Dq(M} ]#m 8DhȐaQ'nY/įnkX$ܬRjѐkU3~}=*ϒ)fs_OHAwIS\ ÑT3z9zsOX~NaDiL $Sv盫ҶLh1Nl<~$2|HGf(pͫ0,x<$'b!e@gSHD!DdލQow8xƐ%.  OyO_IlOfMFo"*2*jbE'duiَ\