diff --git a/NAMESPACE b/NAMESPACE index ec21adb0a..18c5919a8 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -142,6 +142,7 @@ export(Read10X_h5) export(RefinedMapping) export(RegressOut) export(RemoveFromTable) +export(RenameCells) export(RenameIdent) export(ReorderIdent) export(RidgePlot) diff --git a/R/dimensional_reduction.R b/R/dimensional_reduction.R index d2ebf938e..18f63efe2 100644 --- a/R/dimensional_reduction.R +++ b/R/dimensional_reduction.R @@ -759,6 +759,8 @@ RunCCA <- function( #' #' @param object.list List of Seurat objects #' @param genes.use Genes to use in mCCA. +#' @param add.cell.ids Vector of strings to pass to \code{\link{RenameCells}} to +#' give unique cell names #' @param niter Number of iterations to perform. Set by default to 25. #' @param num.ccs Number of canonical vectors to calculate #' @param standardize standardize scale.data matrices to be centered (mean zero) @@ -781,7 +783,8 @@ RunCCA <- function( #' # Print results #' PrintDim(pbmc_cca,reduction.type = 'cca') #' -RunMultiCCA <- function(object.list, genes.use, niter = 25, num.ccs = 1, standardize = TRUE){ +RunMultiCCA <- function(object.list, genes.use, add.cell.ids = NULL, + niter = 25, num.ccs = 1, standardize = TRUE){ set.seed(42) if(length(object.list) < 3){ stop("Must give at least 3 objects/matrices for MultiCCA") @@ -808,6 +811,21 @@ RunMultiCCA <- function(object.list, genes.use, niter = 25, num.ccs = 1, standar else{ stop("input data not Seurat objects") } + + if (!missing(add.cell.ids)) { + if (length(add.cell.ids) != length(object.list)) { + stop("add.cell.ids must have the same length as object.list") + } + object.list <- lapply(seq_along(object.list), function(i) { + RenameCells(object = object.list[[i]], add.cell.id = add.cell.ids[i]) + }) + } + names.list <- lapply(object.list, slot, name = "cell.names") + names.intersect <- Reduce(intersect, names.list) + if(length(names.intersect) > 0) { + stop("duplicate cell names detected, please set 'add.cell.ids'") + } + num.sets <- length(mat.list) if(standardize){ for (i in 1:num.sets){ diff --git a/R/interaction.R b/R/interaction.R index f5d53ce15..fd60467ad 100644 --- a/R/interaction.R +++ b/R/interaction.R @@ -24,8 +24,8 @@ globalVariables(names = 'cell.name', package = 'Seurat', add = TRUE) #' field from the cell's column name #' @param names.delim For the initial identity class for each cell, choose this #' delimiter from the cell's column name -#' @param add.cell.id1 String to be appended to the names of all cells in object1 -#' @param add.cell.id2 String to be appended to the names of all cells in object2 +#' @param add.cell.id1 String passed to \code{\link{RenameCells}} for object1 +#' @param add.cell.id2 String passed to \code{\link{RenameCells}} for object1 #' #' @return Merged Seurat object #' @@ -67,30 +67,10 @@ MergeSeurat <- function( stop("Second object provided has an empty raw.data slot. Adding/Merging performed on raw count data.") } if (!missing(x = add.cell.id1)) { - object1@cell.names <- paste(add.cell.id1,object1@cell.names, sep = "_") - colnames(x = object1@raw.data) <- paste( - add.cell.id1, - colnames(x = object1@raw.data), - sep = "_" - ) - rownames(x = object1@meta.data) <- paste( - add.cell.id1, - rownames(x = object1@meta.data), - sep = "_" - ) + object1 <- RenameCells(object1, add.cell.id = add.cell.id1) } if (!missing(x = add.cell.id2)) { - object2@cell.names <- paste(add.cell.id2,object2@cell.names, sep = "_") - colnames(x = object2@raw.data) <- paste( - add.cell.id2, - colnames(x = object2@raw.data), - sep = "_" - ) - rownames(x = object2@meta.data) <- paste( - add.cell.id2, - rownames(x = object2@meta.data), - sep = "_" - ) + object2 <- RenameCells(object2, add.cell.id = add.cell.id2) } if (any(object1@cell.names %in% object2@cell.names)) { stop("Duplicate cell names, please provide 'add.cell.id1' and/or 'add.cell.id2' for unique names") @@ -313,21 +293,21 @@ AddSamples <- function( #' Creates a Seurat object containing only a subset of the cells in the #' original object. Forms a dataframe by fetching the variables in \code{vars.use}, then #' subsets it using \code{base::subset} with \code{predicate} as the filter. -#' Returns the corresponding subset of the Seurat object. +#' Returns the corresponding subset of the Seurat object. #' #' @param object Seurat object #' @param vars.use Variables to fetch for use in base::subset. Character vector. #' @param predicate String to be parsed into an R expression and evaluated as an input to base::subset. -#' +#' #' @export #' #' @examples -#' pbmc1 <- SubsetByPredicate(object = pbmc_small, -#' vars.use = c("nUMI", "res.1"), +#' pbmc1 <- SubsetByPredicate(object = pbmc_small, +#' vars.use = c("nUMI", "res.1"), #' predicate = "nUMI < 200 & res.1=='3'") #' pbmc1 #' -SubsetByPredicate = function( +SubsetByPredicate = function( object, vars.use, predicate @@ -1144,3 +1124,82 @@ AddMetaData <- function(object, metadata, col.name = NULL) { object@meta.data[, cols.add] <- meta.add return(object) } + + +#' Rename cells +#' +#' Change the cell names in all the different parts of a Seurat object. Can +#' be useful before combining multiple objects. +#' +#' @param object Seurat object +#' @param add.cell.id prefix to add cell names +#' @param new.names vector of new 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. +#' +#' @return Seurat object with new cell names +#' +#' @export +#' +#' @examples +#' head(pbmc_small@cell.names) +#' pbmc_small <- RenameCells(pbmc_small, add.cell.id = "Test") +#' head(pbmc_small@cell.names) +#' +RenameCells <- function(object, add.cell.id = NULL, new.names = NULL) { + + if (missing(add.cell.id) && missing(new.names)) { + stop("One of 'add.cell.id' and 'new.names' must be set") + } + + if (!missing(add.cell.id) && !missing(new.names)) { + stop("Only one of 'add.cell.id' and 'new.names' must be set") + } + + if (!missing(add.cell.id)) { + new.cell.names <- paste(add.cell.id, object@cell.names, sep = "_") + } else { + if (length(new.names) == length(object@cell.names)) { + new.cell.names <- new.names + } else { + stop("the length of 'new.names' (", length(new.names), ") must be the ", + "same as the length of 'object@cell.names' (", + length(object@cell.names), ")") + } + } + + object@cell.names <- new.cell.names + colnames(object@raw.data) <- new.cell.names + colnames(object@data) <- new.cell.names + + if (!is.null(object@scale.data)) { + colnames(object@scale.data) <- new.cell.names + } + rownames(object@meta.data) <- new.cell.names + names(object@ident) <- new.cell.names + + if (length(object@dr) > 0) { + for (dr in names(object@dr)) { + rownames(object@dr[[dr]]@cell.embeddings) <- new.cell.names + } + } + if (nrow(object@snn) == length(new.cell.names)) { + colnames(object@snn) <- new.cell.names + rownames(object@snn) <- new.cell.names + } + + if (!is.null(object@kmeans)) { + if (!is.null(object@kmeans@gene.kmeans.obj)) { + colnames(object@kmeans@gene.kmeans.obj$centers) <- new.cell.names + } + if (!is.null(object@kmeans@cell.kmeans.obj)) { + names(object@kmeans@cell.kmeans.obj$cluster) <- new.cell.names + } + } + + rownames(object@spatial@mix.probs) <- new.cell.names + + return(object) +} diff --git a/man/MergeSeurat.Rd b/man/MergeSeurat.Rd index 577d1a6d8..238e2d228 100644 --- a/man/MergeSeurat.Rd +++ b/man/MergeSeurat.Rd @@ -40,9 +40,9 @@ field from the cell's column name} \item{names.delim}{For the initial identity class for each cell, choose this delimiter from the cell's column name} -\item{add.cell.id1}{String to be appended to the names of all cells in object1} +\item{add.cell.id1}{String passed to \code{\link{RenameCells}} for object1} -\item{add.cell.id2}{String to be appended to the names of all cells in object2} +\item{add.cell.id2}{String passed to \code{\link{RenameCells}} for object1} } \value{ Merged Seurat object diff --git a/man/RenameCells.Rd b/man/RenameCells.Rd new file mode 100644 index 000000000..5008618ec --- /dev/null +++ b/man/RenameCells.Rd @@ -0,0 +1,32 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/interaction.R +\name{RenameCells} +\alias{RenameCells} +\title{Rename cells} +\usage{ +RenameCells(object, add.cell.id = NULL, new.names = NULL) +} +\arguments{ +\item{object}{Seurat object} + +\item{add.cell.id}{prefix to add cell names} + +\item{new.names}{vector of new cell names} +} +\value{ +Seurat object with new cell names +} +\description{ +Change the cell names in all the different parts of a Seurat 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{ +head(pbmc_small@cell.names) +pbmc_small <- RenameCells(pbmc_small, add.cell.id = "Test") +head(pbmc_small@cell.names) + +} diff --git a/man/RunMultiCCA.Rd b/man/RunMultiCCA.Rd index 762068ce1..2a5fbe108 100644 --- a/man/RunMultiCCA.Rd +++ b/man/RunMultiCCA.Rd @@ -4,14 +4,17 @@ \alias{RunMultiCCA} \title{Perform Canonical Correlation Analysis with more than two groups} \usage{ -RunMultiCCA(object.list, genes.use, niter = 25, num.ccs = 1, - standardize = TRUE) +RunMultiCCA(object.list, genes.use, add.cell.ids = NULL, niter = 25, + num.ccs = 1, standardize = TRUE) } \arguments{ \item{object.list}{List of Seurat objects} \item{genes.use}{Genes to use in mCCA.} +\item{add.cell.ids}{Vector of strings to pass to \code{\link{RenameCells}} to +give unique cell names} + \item{niter}{Number of iterations to perform. Set by default to 25.} \item{num.ccs}{Number of canonical vectors to calculate} diff --git a/tests/testthat/test_alignment.R b/tests/testthat/test_alignment.R index 106358345..b78a1049a 100644 --- a/tests/testthat/test_alignment.R +++ b/tests/testthat/test_alignment.R @@ -31,3 +31,9 @@ test_that("CalcVarExpRatio performs as expectd", { expect_equal(pbmc_cca@meta.data$var.ratio.pca[40], 0.5198426, tolerance = 1e-6) expect_equal(pbmc_cca@meta.data$var.ratio.pca[80], 0.9824946, tolerance = 1e-6) }) + +test_that("RunMultiCCA works with add.cell.ids", { + pbmc_multi_cca <- RunMultiCCA(list(pbmc_small, pbmc_small, pbmc_small), + add.cell.ids = c("A", "B", "C")) + expect_s4_class(pbmc_multi_cca, "seurat") +}) diff --git a/tests/testthat/test_interaction.R b/tests/testthat/test_interaction.R index 60e097722..702e0f9c2 100644 --- a/tests/testthat/test_interaction.R +++ b/tests/testthat/test_interaction.R @@ -101,3 +101,41 @@ test_that("do.clean and do.raw work", { expect_equal(length(x@dr), 2) }) +# Tests for RenameCells +# -------------------------------------------------------------------------------- +context("RenameCells") + +test_that("argument checks work", { + expect_error(RenameCells(pbmc_small), + "One of 'add.cell.id' and 'new.names' must be set") + expect_error(RenameCells(pbmc_small, add.cell.id = "A", new.names = "A"), + "Only one of 'add.cell.id' and 'new.names' must be set") +}) + +test_that("add.cell.id works", { + test.names <- paste("Test", pbmc_small@cell.names, sep = "_") + x <- RenameCells(pbmc_small, add.cell.id = "Test") + expect_equal(x@cell.names, test.names) + expect_equal(colnames(x@raw.data), test.names) + expect_equal(colnames(x@data), test.names) + expect_equal(colnames(x@scale.data), test.names) + expect_equal(rownames(x@meta.data), test.names) + expect_equal(names(x@ident), test.names) + expect_equal(rownames(x@dr$pca@cell.embeddings), test.names) + expect_equal(rownames(x@dr$tsne@cell.embeddings), test.names) + expect_equal(rownames(x@spatial@mix.probs), test.names) +}) + +test_that("new.names works", { + test.names <- paste0("A", 1:80) + x <- RenameCells(pbmc_small, new.names = paste0("A", 1:80)) + expect_equal(x@cell.names, test.names) + expect_equal(colnames(x@raw.data), test.names) + expect_equal(colnames(x@data), test.names) + expect_equal(colnames(x@scale.data), test.names) + expect_equal(rownames(x@meta.data), test.names) + expect_equal(names(x@ident), test.names) + expect_equal(rownames(x@dr$pca@cell.embeddings), test.names) + expect_equal(rownames(x@dr$tsne@cell.embeddings), test.names) + expect_equal(rownames(x@spatial@mix.probs), test.names) +})