Merge pull request #1692 from satijalab/develop

Seurat v3.0.2

.gitignore

@@ -4,6 +4,7 @@
 .RDataTmp
 src/*.o
 src/*.so
+src/*.dll
 .DS_Store
 *.pdf
 *.Rproj

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Seurat
-Version: 3.0.1
-Date: 2019-05-16
+Version: 3.0.2
+Date: 2019-06-14
 Title: Tools for Single Cell Genomics
 Description: A toolkit for quality control, analysis, and exploration of single cell RNA sequencing data. 'Seurat' aims to enable users to identify and interpret sources of heterogeneity from single cell transcriptomic measurements, and to integrate diverse types of single cell data. See Satija R, Farrell J, Gennert D, et al (2015) <doi:10.1038/nbt.3192>, Macosko E, Basu A, Satija R, et al (2015) <doi:10.1016/j.cell.2015.05.002>, and Butler A and Satija R (2017) <doi:10.1101/164889> for more details.
 Authors@R: c(
@@ -90,4 +90,7 @@ Suggests:
     GenomicRanges,
     GenomeInfoDb,
     IRanges,
-    rtracklayer
+    rtracklayer,
+    monocle,
+    Biobase,
+    VGAM

NAMESPACE

@@ -117,12 +117,15 @@ S3method(VariableFeatures,Seurat)
 S3method(WhichCells,Assay)
 S3method(WhichCells,Seurat)
 S3method(WriteH5AD,Seurat)
+S3method(as.CellDataSet,Seurat)
 S3method(as.Graph,Matrix)
 S3method(as.Graph,matrix)
+S3method(as.Seurat,CellDataSet)
 S3method(as.Seurat,SingleCellExperiment)
 S3method(as.Seurat,loom)
 S3method(as.SingleCellExperiment,Seurat)
 S3method(as.data.frame,Matrix)
+S3method(as.list,SeuratCommand)
 S3method(as.logical,JackStrawData)
 S3method(as.loom,Seurat)
 S3method(as.sparse,H5Group)
@@ -209,6 +212,7 @@ export(FontSize)
 export(GetAssay)
 export(GetAssayData)
 export(GetIntegrationData)
+export(GetResidual)
 export(HTODemux)
 export(HTOHeatmap)
 export(HVFInfo)
@@ -298,6 +302,7 @@ export(VizDimLoadings)
 export(VlnPlot)
 export(WhichCells)
 export(WhiteBackground)
+export(as.CellDataSet)
 export(as.Graph)
 export(as.Seurat)
 export(as.SingleCellExperiment)
@@ -340,8 +345,7 @@ importFrom(cowplot,get_legend)
 importFrom(cowplot,plot_grid)
 importFrom(cowplot,theme_cowplot)
 importFrom(fitdistrplus,fitdist)
-importFrom(future,plan)
-importFrom(future.apply,future_apply)
+importFrom(future,nbrOfWorkers)
 importFrom(future.apply,future_lapply)
 importFrom(future.apply,future_sapply)
 importFrom(ggplot2,GeomPolygon)
@@ -414,6 +418,7 @@ importFrom(ggrepel,geom_text_repel)
 importFrom(ggridges,geom_density_ridges)
 importFrom(ggridges,theme_ridges)
 importFrom(grDevices,col2rgb)
+importFrom(grDevices,colorRamp)
 importFrom(grDevices,colorRampPalette)
 importFrom(grDevices,rgb)
 importFrom(graphics,axis)

NEWS.md

@@ -2,6 +2,26 @@
 All notable changes to Seurat will be documented in this file.
 The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/)
 
+## [3.0.2] - 2019-06-07
+### Added
+- Flag to skip singleton grouping in `FindClusters`
+- New custom colors for blended `FeaturePlot`s
+- New `GetResidual` function
+- New Seurat/Monocle converters
+
+### Changed
+- Fix issue where certain assays weren't being shown in the `Seurat` object
+- Fix issue where we weren't updating `DimReduc` object column names
+- Fix line spacers in `DoHeatmap`
+- Fix uninformative labels in `FeaturePlot`
+- Fix unset identities when converting from SCE to Seurat
+- Fix single colors being interpreted as palettes in `SingleDimPlot`
+- Ensure factor levels are always numerically increasing after `FindClusters`
+- Better cell highlighting colors for `DimPlot`
+- Fix to `levels<-.Seurat`
+- Add ability to use counts/scaled data in `BuildClusterTree`
+- Minor fix to split `ScaleData`
+
 ## [3.0.1] - 2019-05-16
 ### Added
 - Add global option (Seurat.memsafe) to skip gc() calls

R/clustering.R

@@ -12,6 +12,7 @@ NULL
 
 #' @importFrom pbapply pblapply
 #' @importFrom future.apply future_lapply
+#' @importFrom future nbrOfWorkers
 #'
 #' @param modularity.fxn Modularity function (1 = standard; 2 = alternative).
 #' @param initial.membership,weights,node.sizes Parameters to pass to the Python leidenalg function.
@@ -23,6 +24,8 @@ NULL
 #' @param n.start Number of random starts.
 #' @param n.iter Maximal number of iterations per random start.
 #' @param random.seed Seed of the random number generator.
+#' @param group.singletons Group singletons into nearest cluster. If FALSE, assign all singletons to
+#' a "singleton" group
 #' @param temp.file.location Directory where intermediate files will be written.
 #' Specify the ABSOLUTE path.
 #' @param edge.file.name Edge file to use as input for modularity optimizer jar.
@@ -42,6 +45,7 @@ FindClusters.default <- function(
   n.start = 10,
   n.iter = 10,
   random.seed = 0,
+  group.singletons = TRUE,
   temp.file.location = NULL,
   edge.file.name = NULL,
   verbose = TRUE,
@@ -56,7 +60,7 @@ FindClusters.default <- function(
   if (tolower(x = algorithm) == "leiden") {
     algorithm <- 4
   }
-  if (PlanThreads() > 1) {
+  if (nbrOfWorkers() > 1) {
     clustering.results <- future_lapply(
       X = resolution,
       FUN = function(r) {
@@ -121,7 +125,7 @@ FindClusters.default <- function(
         stop("algorithm not recognised, please specify as an integer or string")
       }
       names(x = ids) <- colnames(x = object)
-      ids <- GroupSingletons(ids = ids, SNN = object, verbose = verbose)
+      ids <- GroupSingletons(ids = ids, SNN = object, group.singletons = group.singletons, verbose = verbose)
       clustering.results[, paste0("res.", r)] <- factor(x = ids)
     }
   }
@@ -148,6 +152,7 @@ FindClusters.Seurat <- function(
   n.start = 10,
   n.iter = 10,
   random.seed = 0,
+  group.singletons = TRUE,
   temp.file.location = NULL,
   edge.file.name = NULL,
   verbose = TRUE,
@@ -171,13 +176,25 @@ FindClusters.Seurat <- function(
     n.start = n.start,
     n.iter = n.iter,
     random.seed = random.seed,
+    group.singletons = group.singletons,
     temp.file.location = temp.file.location,
     edge.file.name = edge.file.name,
     verbose = verbose
   )
   colnames(x = clustering.results) <- paste0(graph.name, "_", colnames(x = clustering.results))
   object <- AddMetaData(object = object, metadata = clustering.results)
   Idents(object = object) <- colnames(x = clustering.results)[ncol(x = clustering.results)]
+  levels <- levels(x = object)
+  levels <- tryCatch(
+    expr = as.numeric(x = levels),
+    warning = function(...) {
+      return(levels)
+    },
+    error = function(...) {
+      return(levels)
+    }
+  )
+  Idents(object = object) <- factor(x = Idents(object = object), levels = sort(x = levels))
   object[['seurat_clusters']] <- Idents(object = object)
   object <- LogSeuratCommand(object)
   return(object)
@@ -260,7 +277,7 @@ FindNeighbors.default <- function(
   # convert nn.ranked into a Graph
   j <- as.numeric(x = t(x = nn.ranked))
   i <- ((1:length(x = j)) - 1) %/% k.param + 1
-  nn.matrix <- as(object = sparseMatrix(i = i, j = j, x = 1), Class = "Graph")
+  nn.matrix <- as(object = sparseMatrix(i = i, j = j, x = 1, dims = c(nrow(x = object), nrow(x = object))), Class = "Graph")
   rownames(x = nn.matrix) <- rownames(x = object)
   colnames(x = nn.matrix) <- rownames(x = object)
   neighbor.graphs <- list(nn = nn.matrix)
@@ -436,17 +453,23 @@ FindNeighbors.Seurat <- function(
 #
 # @param ids Named vector of cluster ids
 # @param SNN SNN graph used in clustering
+# @param group.singletons Group singletons into nearest cluster. If FALSE, assign all singletons to
+# a "singleton" group
 #
 # @return Returns Seurat object with all singletons merged with most connected cluster
 #
-GroupSingletons <- function(ids, SNN, verbose) {
+GroupSingletons <- function(ids, SNN, group.singletons = TRUE, verbose = TRUE) {
   # identify singletons
   singletons <- c()
-  singletons <- names(which(table(ids) == 1))
-  singletons <- intersect(unique(ids), singletons)
+  singletons <- names(x = which(x = table(ids) == 1))
+  singletons <- intersect(x = unique(x = ids), singletons)
+  if (!group.singletons) {
+    ids[which(ids %in% singletons)] <- "singleton"
+    return(ids)
+  }
   # calculate connectivity of singletons to other clusters, add singleton
   # to cluster it is most connected to
-  cluster_names <- as.character(unique(x = ids))
+  cluster_names <- as.character(x = unique(x = ids))
   cluster_names <- setdiff(x = cluster_names, y = singletons)
   connectivity <- vector(mode = "numeric", length = length(x = cluster_names))
   names(x = connectivity) <- cluster_names

R/differential_expression.R

@@ -154,7 +154,7 @@ FindAllMarkers <- function(
           subset = (myAUC > return.thresh | myAUC < (1 - return.thresh))
         )
       } else if (is.null(x = node) || test.use %in% c('bimod', 't')) {
-        gde <- gde[order(gde$p_val, -gde$avg_logFC), ]
+        gde <- gde[order(gde$p_val, -gde[, 2]), ]
         gde <- subset(x = gde, subset = p_val < return.thresh)
       }
       if (nrow(x = gde) > 0) {
@@ -167,7 +167,7 @@ FindAllMarkers <- function(
     }
   }
   if ((only.pos) && nrow(x = gde.all) > 0) {
-    return(subset(x = gde.all, subset = avg_logFC > 0))
+    return(subset(x = gde.all, subset = gde.all[, 2] > 0))
   }
   rownames(x = gde.all) <- make.unique(names = as.character(x = gde.all$gene))
   if (nrow(x = gde.all) == 0) {
@@ -391,7 +391,7 @@ FindConservedMarkers <- function(
 #'  each of the cells in cells.2). An AUC value of 0 also means there is perfect
 #'  classification, but in the other direction. A value of 0.5 implies that
 #'  the gene has no predictive power to classify the two groups. Returns a
-#'  'predictive power' (abs(AUC-0.5)) ranked matrix of putative differentially
+#'  'predictive power' (abs(AUC-0.5) * 2) ranked matrix of putative differentially
 #'  expressed genes.
 #'  \item{"t"} : Identify differentially expressed genes between two groups of
 #'  cells using the Student's t-test.
@@ -666,7 +666,7 @@ FindMarkers.default <- function(
     de.results[, diff.col] <- total.diff[rownames(x = de.results)]
   }
   if (only.pos) {
-    de.results <- subset(x = de.results, subset = diff.col > 0)
+    de.results <- de.results[de.results[, diff.col] > 0, , drop = FALSE]
   }
   if (test.use == "roc") {
     de.results <- de.results[order(-de.results$power, -de.results[, diff.col]), ]
@@ -990,6 +990,7 @@ DifferentialLRT <- function(x, y, xmin = 0) {
 #
 #' @importFrom pbapply pbsapply
 #' @importFrom future.apply future_sapply
+#' @importFrom future nbrOfWorkers
 #
 # @export
 # @examples
@@ -1004,7 +1005,7 @@ DiffExpTest <- function(
   verbose = TRUE
 ) {
   my.sapply <- ifelse(
-    test = verbose && PlanThreads() == 1,
+    test = verbose && nbrOfWorkers() == 1,
     yes = pbsapply,
     no = future_sapply
   )
@@ -1034,6 +1035,7 @@ DiffExpTest <- function(
 #' @importFrom stats t.test
 #' @importFrom pbapply pbsapply
 #' @importFrom future.apply future_sapply
+#' @importFrom future nbrOfWorkers
 #
 # @export
 #
@@ -1048,7 +1050,7 @@ DiffTTest <- function(
   verbose = TRUE
 ) {
   my.sapply <- ifelse(
-    test = verbose && PlanThreads() == 1,
+    test = verbose && nbrOfWorkers() == 1,
     yes = pbsapply,
     no = future_sapply
   )
@@ -1084,7 +1086,8 @@ DiffTTest <- function(
 #' @importFrom pbapply pbsapply
 #' @importFrom stats var as.formula
 #' @importFrom future.apply future_sapply
-#
+#' @importFrom future nbrOfWorkers
+#' 
 # @export
 #
 # @examples
@@ -1117,7 +1120,7 @@ GLMDETest <- function(
   }
   latent.var.names <- colnames(x = latent.vars)
   my.sapply <- ifelse(
-    test = verbose && PlanThreads() == 1,
+    test = verbose && nbrOfWorkers() == 1,
     yes = pbsapply,
     no = future_sapply
   )
@@ -1194,6 +1197,7 @@ GLMDETest <- function(
 #' @importFrom pbapply pbsapply
 #' @importFrom stats as.formula glm
 #' @importFrom future.apply future_sapply
+#' @importFrom future nbrOfWorkers
 #
 LRDETest <- function(
   data.use,
@@ -1210,7 +1214,7 @@ LRDETest <- function(
   data.use <- data.use[, rownames(group.info), drop = FALSE]
   latent.vars <- latent.vars[rownames(group.info), , drop = FALSE]
   my.sapply <- ifelse(
-    test = verbose && PlanThreads() == 1,
+    test = verbose && nbrOfWorkers() == 1,
     yes = pbsapply,
     no = future_sapply
   )
@@ -1255,7 +1259,7 @@ LRDETest <- function(
 # value of 0.5 implies that the gene has no predictive power to classify the
 # two groups.
 #
-# @return Returns a 'predictive power' (abs(AUC-0.5)) ranked matrix of
+# @return Returns a 'predictive power' (abs(AUC-0.5) * 2) ranked matrix of
 # putative differentially expressed genes.
 #
 # @export
@@ -1511,6 +1515,7 @@ RegularizedTheta <- function(cm, latent.data, min.theta = 0.01, bin.size = 128)
 #' @importFrom pbapply pbsapply
 #' @importFrom stats wilcox.test
 #' @importFrom future.apply future_sapply
+#' @importFrom future nbrOfWorkers
 #
 # @export
 #
@@ -1532,7 +1537,7 @@ WilcoxDETest <- function(
   group.info[, "group"] <- factor(x = group.info[, "group"])
   data.use <- data.use[, rownames(x = group.info), drop = FALSE]
   my.sapply <- ifelse(
-    test = verbose && PlanThreads() == 1,
+    test = verbose && nbrOfWorkers() == 1,
     yes = pbsapply,
     no = future_sapply
   )

R/dimensional_reduction.R

@@ -32,6 +32,7 @@ NULL
 #' @importFrom methods new
 #' @importFrom pbapply pblapply pbsapply
 #' @importFrom future.apply future_lapply future_sapply
+#' @importFrom future nbrOfWorkers
 #'
 #' @references Inspired by Chung et al, Bioinformatics (2014)
 #'
@@ -56,7 +57,7 @@ JackStraw <- function(
   if (reduction != "pca") {
     stop("Only pca for reduction is currently supported")
   }
-  if (verbose && PlanThreads() == 1) {
+  if (verbose && nbrOfWorkers() == 1) {
     my.lapply <- pblapply
     my.sapply <- pbsapply
   } else {

R/generics.R

@@ -33,8 +33,20 @@ AddMetaData <- function(object, metadata, col.name = NULL) {
   UseMethod(generic = 'AddMetaData', object = object)
 }
 
-#' Convert a matrix (or Matrix) to the Graph class.
+#' Convert objects to CellDataSet objects
+#'
+#' @param x An object to convert to class \code{CellDataSet}
+#' @param ... Arguments passed to other methods
+#'
+#' @rdname as.CellDataSet
+#' @export as.CellDataSet
+#'
+as.CellDataSet <- function(x, ...) {
+  UseMethod(generic = 'as.CellDataSet', object = x)
+}
 
+#' Convert a matrix (or Matrix) to the Graph class.
+#'
 #' @param x The matrix to convert
 #' @param ... Arguments passed to other methods (ignored for now)
 #'