From a5f3e5bd458afecca4d91c9dac263ac8ca2ad401 Mon Sep 17 00:00:00 2001 From: Luke Zappia Date: Wed, 30 May 2018 11:54:48 +1000 Subject: [PATCH 1/7] Add RenameCells function Update cell names in all the different parts of a Seurat object --- NAMESPACE | 1 + R/interaction.R | 66 ++++++++++++++++++++++++++++++++++++++++++---- man/RenameCells.Rd | 26 ++++++++++++++++++ 3 files changed, 88 insertions(+), 5 deletions(-) create mode 100644 man/RenameCells.Rd 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/interaction.R b/R/interaction.R index f5d53ce15..a83fbf20c 100644 --- a/R/interaction.R +++ b/R/interaction.R @@ -313,21 +313,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 +1144,59 @@ 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 object. +#' +#' @param object Seurat object +#' @param add.cell.id prefix to add cell 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) { + new.cell.names <- paste(add.cell.id, object@cell.names, sep = "_") + + 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) > 0) { + 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/RenameCells.Rd b/man/RenameCells.Rd new file mode 100644 index 000000000..5b6f56418 --- /dev/null +++ b/man/RenameCells.Rd @@ -0,0 +1,26 @@ +% 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) +} +\arguments{ +\item{object}{Seurat object} + +\item{add.cell.id}{prefix to add 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 object. +} +\examples{ +head(pbmc_small@cell.names) +pbmc_small <- RenameCells(pbmc_small, add.cell.id = "Test") +head(pbmc_small@cell.names) + +} From 933cc589c258f95b07b2b9ebd7433613c4934879 Mon Sep 17 00:00:00 2001 From: Luke Zappia Date: Wed, 30 May 2018 12:06:01 +1000 Subject: [PATCH 2/7] Add RenameCells tests Only tests the fields that are set in pbmc_small so misse a couple of less common ones (kmeans and snn) --- tests/testthat/test_interaction.R | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/tests/testthat/test_interaction.R b/tests/testthat/test_interaction.R index 60e097722..3573455d2 100644 --- a/tests/testthat/test_interaction.R +++ b/tests/testthat/test_interaction.R @@ -101,3 +101,20 @@ test_that("do.clean and do.raw work", { expect_equal(length(x@dr), 2) }) +# Tests for RenameCells +# -------------------------------------------------------------------------------- +context("RenameCells") + +test_that("RenameCells 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) +}) From 2f65ed102cde91968c54a41a9284ece2dbf7d2eb Mon Sep 17 00:00:00 2001 From: Luke Zappia Date: Wed, 30 May 2018 12:12:32 +1000 Subject: [PATCH 3/7] Modify MergeSeurat to use RenameCells Also fix tabbing in RenameCells --- R/interaction.R | 52 ++++++++++++++-------------------------------- man/MergeSeurat.Rd | 4 ++-- 2 files changed, 18 insertions(+), 38 deletions(-) diff --git a/R/interaction.R b/R/interaction.R index a83fbf20c..119b1b291 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") @@ -1171,29 +1151,29 @@ RenameCells <- function(object, add.cell.id) { colnames(object@data) <- new.cell.names if (!is.null(object@scale.data)) { - colnames(object@scale.data) <- new.cell.names + 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 - } + for (dr in names(object@dr)) { + rownames(object@dr[[dr]]@cell.embeddings) <- new.cell.names + } } if (nrow(object@snn) > 0) { - colnames(object@snn) <- new.cell.names - rownames(object@snn) <- 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 - } + 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 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 From b1042f6239dacf3bdf271ce01ea55f5e97c00edf Mon Sep 17 00:00:00 2001 From: Luke Zappia Date: Wed, 30 May 2018 14:34:49 +1000 Subject: [PATCH 4/7] Add add.cell.ids parameter to RunMultiCCA --- R/dimensional_reduction.R | 18 +++++++++++++++++- man/RunMultiCCA.Rd | 7 +++++-- tests/testthat/test_alignment.R | 6 ++++++ 3 files changed, 28 insertions(+), 3 deletions(-) diff --git a/R/dimensional_reduction.R b/R/dimensional_reduction.R index 719191e77..bb59ebefc 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,19 @@ RunMultiCCA <- function(object.list, genes.use, niter = 25, num.ccs = 1, standar else{ stop("input data not Seurat objects") } + 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'") + } + 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.list[[i]], add.cell.id = add.cell.ids[i]) + }) + } num.sets <- length(mat.list) if(standardize){ for (i in 1:num.sets){ 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") +}) From 3838fd406cfa1f07a0139cf92cba7d052d11ce43 Mon Sep 17 00:00:00 2001 From: Luke Zappia Date: Wed, 30 May 2018 15:02:27 +1000 Subject: [PATCH 5/7] Add new.names argument to RenameCells --- R/interaction.R | 78 ++++++++++++++++++++----------- man/RenameCells.Rd | 10 +++- tests/testthat/test_interaction.R | 23 ++++++++- 3 files changed, 81 insertions(+), 30 deletions(-) diff --git a/R/interaction.R b/R/interaction.R index 119b1b291..f26956c73 100644 --- a/R/interaction.R +++ b/R/interaction.R @@ -1129,10 +1129,15 @@ AddMetaData <- function(object, metadata, col.name = NULL) { #' Rename cells #' #' Change the cell names in all the different parts of a Seurat object. Can -#' be useful before combining multiple object. +#' 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 #' @@ -1143,40 +1148,59 @@ AddMetaData <- function(object, metadata, col.name = NULL) { #' pbmc_small <- RenameCells(pbmc_small, add.cell.id = "Test") #' head(pbmc_small@cell.names) #' -RenameCells <- function(object, add.cell.id) { - new.cell.names <- paste(add.cell.id, object@cell.names, sep = "_") +RenameCells <- function(object, add.cell.id = NULL, new.names = NULL) { - object@cell.names <- new.cell.names - colnames(object@raw.data) <- new.cell.names - colnames(object@data) <- new.cell.names + if (missing(add.cell.id) && missing(new.names)) { + stop("One of 'add.cell.id' and 'new.names' must be set") + } - 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 (!missing(add.cell.id) && !missing(new.names)) { + stop("Only one of 'add.cell.id' and 'new.names' must be set") + } - if (length(object@dr) > 0) { - for (dr in names(object@dr)) { - rownames(object@dr[[dr]]@cell.embeddings) <- new.cell.names - } + 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 (nrow(object@snn) > 0) { - colnames(object@snn) <- new.cell.names - rownames(object@snn) <- 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 (!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 - } + if (nrow(object@snn) > 0) { + 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 + rownames(object@spatial@mix.probs) <- new.cell.names - return(object) + return(object) } diff --git a/man/RenameCells.Rd b/man/RenameCells.Rd index 5b6f56418..5008618ec 100644 --- a/man/RenameCells.Rd +++ b/man/RenameCells.Rd @@ -4,19 +4,25 @@ \alias{RenameCells} \title{Rename cells} \usage{ -RenameCells(object, add.cell.id) +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 object. +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) diff --git a/tests/testthat/test_interaction.R b/tests/testthat/test_interaction.R index 3573455d2..702e0f9c2 100644 --- a/tests/testthat/test_interaction.R +++ b/tests/testthat/test_interaction.R @@ -105,7 +105,14 @@ test_that("do.clean and do.raw work", { # -------------------------------------------------------------------------------- context("RenameCells") -test_that("RenameCells works", { +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) @@ -118,3 +125,17 @@ test_that("RenameCells works", { 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) +}) From f30e5f3a6963520798eb9b067474bb5706e284e7 Mon Sep 17 00:00:00 2001 From: Andrew Butler Date: Fri, 1 Jun 2018 07:33:46 -0400 Subject: [PATCH 6/7] fix snn slot checking --- R/interaction.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/R/interaction.R b/R/interaction.R index f26956c73..fd60467ad 100644 --- a/R/interaction.R +++ b/R/interaction.R @@ -1185,8 +1185,7 @@ RenameCells <- function(object, add.cell.id = NULL, new.names = NULL) { rownames(object@dr[[dr]]@cell.embeddings) <- new.cell.names } } - - if (nrow(object@snn) > 0) { + if (nrow(object@snn) == length(new.cell.names)) { colnames(object@snn) <- new.cell.names rownames(object@snn) <- new.cell.names } From be7d9868f213eaabe7d25d13f283605bea5a8a68 Mon Sep 17 00:00:00 2001 From: Andrew Butler Date: Fri, 1 Jun 2018 08:04:12 -0400 Subject: [PATCH 7/7] rename before checking for duplicates --- R/dimensional_reduction.R | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/R/dimensional_reduction.R b/R/dimensional_reduction.R index ade1211b8..18f63efe2 100644 --- a/R/dimensional_reduction.R +++ b/R/dimensional_reduction.R @@ -811,19 +811,21 @@ RunMultiCCA <- function(object.list, genes.use, add.cell.ids = NULL, else{ stop("input data not Seurat objects") } - 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'") - } + 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.list[[i]], add.cell.id = add.cell.ids[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){