Merge branch 'develop' into feat/MultiModal

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: Seurat
-Version: 2.3.2
+Version: 2.3.3.9000
 Date: 2018-06-11
 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.
@@ -24,18 +24,15 @@ SystemRequirements: Java (>= 6)
 Imports:
     methods,
     ROCR,
-    stringr,
     mixtools,
     lars,
     ica,
     tsne,
     Rtsne,
     fpc,
     ape,
-    VGAM,
     pbapply,
     igraph,
-    FNN,
     RANN,
     caret,
     dplyr,
@@ -44,9 +41,7 @@ Imports:
     irlba,
     reshape2,
     gplots,
-    gdata,
-    Rcpp,
-    tclust,
+    Rcpp (>= 0.11.0),
     ranger,
     dtw,
     SDMTools,
@@ -64,7 +59,7 @@ Imports:
     reticulate,
     foreach,
     hdf5r
-LinkingTo: Rcpp, RcppEigen, RcppProgress
+LinkingTo: Rcpp (>= 0.11.0), RcppEigen, RcppProgress
 License: GPL-3 | file LICENSE
 LazyData: true
 Collate:
@@ -103,6 +98,9 @@ Collate:
     'zfRenderSeurat.R'
 RoxygenNote: 6.0.1
 Suggests:
+    gdata,
+    VGAM,
+    tclust,
     testthat,
     loomR,
     phateR,

NAMESPACE

@@ -285,8 +285,6 @@ import(lars)
 import(metap)
 import(parallel)
 import(pbapply)
-import(stringr)
-importFrom(FNN,get.knn)
 importFrom(Hmisc,cut2)
 importFrom(MASS,glm.nb)
 importFrom(MASS,kde2d)
@@ -304,14 +302,10 @@ importFrom(ROCR,performance)
 importFrom(ROCR,prediction)
 importFrom(Rcpp,evalCpp)
 importFrom(Rtsne,Rtsne)
-importFrom(VGAM,tobit)
-importFrom(VGAM,vgam)
 importFrom(ape,as.phylo)
 importFrom(ape,drop.tip)
 importFrom(ape,nodelabels)
 importFrom(ape,plot.phylo)
-importFrom(caret,train)
-importFrom(caret,trainControl)
 importFrom(cluster,clara)
 importFrom(cowplot,get_legend)
 importFrom(cowplot,plot_grid)
@@ -331,8 +325,6 @@ importFrom(dtw,dtw)
 importFrom(fitdistrplus,fitdist)
 importFrom(foreach,"%dopar%")
 importFrom(foreach,foreach)
-importFrom(gdata,drop.levels)
-importFrom(gdata,interleave)
 importFrom(ggplot2,annotation_raster)
 importFrom(ggridges,geom_density_ridges)
 importFrom(ggridges,theme_ridges)
@@ -380,7 +372,6 @@ importFrom(pbapply,pbapply)
 importFrom(pbapply,pblapply)
 importFrom(pbapply,pbsapply)
 importFrom(png,readPNG)
-importFrom(ranger,ranger)
 importFrom(reshape2,melt)
 importFrom(reticulate,dict)
 importFrom(reticulate,import)
@@ -430,7 +421,6 @@ importFrom(stats,smooth.spline)
 importFrom(stats,t.test)
 importFrom(stats,var)
 importFrom(stats,wilcox.test)
-importFrom(tclust,tkmeans)
 importFrom(tidyr,gather)
 importFrom(tidyr,separate)
 importFrom(tidyr,unite)

R/alignment.R

@@ -275,8 +275,10 @@ AlignSubspace <- function(
 #' @param dims.use Dimensions to use in building the NN graph
 #' @param grouping.var Grouping variable used in the alignment.
 #' @param nn Number of neighbors to calculate in the NN graph construction
+#' @param nn.eps Error bound when performing nearest neighbor seach using RANN;
+#' default of 0.0 implies exact nearest neighbor search
 #'
-#' @importFrom FNN get.knn
+#' @importFrom RANN nn2
 #' @export
 #'
 #' @examples
@@ -294,22 +296,41 @@ AlignSubspace <- function(
 #'                     dims.use = 1:5, grouping.var =  "group")
 #' }
 #'
-CalcAlignmentMetric <- function(object, reduction.use = "cca.aligned", dims.use,
-                                grouping.var, nn){
-  object <- SetAllIdent(object, grouping.var)
-  object <- SubsetData(object, max.cells.per.ident = min(table(object@ident)))
-  num.groups <- length(unique(object@ident))
-  if(missing(nn)){
-    nn <- ceiling(table(object@ident)[1] * 0.01 * num.groups)
+CalcAlignmentMetric <- function(
+  object,
+  reduction.use = "cca.aligned",
+  dims.use,
+  grouping.var,
+  nn,
+  nn.eps = 0
+) {
+  object <- SetAllIdent(object = object, id = grouping.var)
+  object <- SubsetData(object = object, max.cells.per.ident = min(table(object@ident)))
+  num.groups <- length(x = unique(x = object@ident))
+  if (missing(x = nn)) {
+    nn <- ceiling(x = table(object@ident)[1] * 0.01 * num.groups)
   }
-  dist.mat <- GetCellEmbeddings(object, reduction.type = reduction.use, dims.use = dims.use)
-  object.fnn <- get.knn(dist.mat, k = nn)
-  alignment.score <- sapply(1:length(object@cell.names), function(x) {
-    cell.id <- object@ident[x]
-    num.same.id <- length(which(object@ident[object.fnn$nn.index[x, ]] == cell.id))
-  })
-  alignment.score <- 1 - ((mean(alignment.score) - nn /num.groups) / (nn - nn/num.groups))
-  return(unname(alignment.score))
+  dist.mat <- GetCellEmbeddings(
+    object = object,
+    reduction.type = reduction.use,
+    dims.use = dims.use
+  )
+  # object.fnn <- get.knn(dist.mat, k = nn)
+  object.fnn <- nn2(
+    data = dist.mat,
+    k = nn,
+    searchtype = 'standard',
+    eps = nn.eps
+  )
+  alignment.score <- sapply(
+    X = 1:length(x = object@cell.names),
+    FUN = function(x) {
+      cell.id <- object@ident[x]
+      num.same.id <- length(x = which(x = object@ident[object.fnn$nn.idx[x, ]] == cell.id))
+    }
+  )
+  alignment.score <- 1 - ((mean(x = alignment.score) - nn / num.groups) / (nn - nn / num.groups))
+  return(unname(obj = alignment.score))
 }
 
 #' Calculate the ratio of variance explained by ICA or PCA to CCA

R/cluster_determination.R

@@ -1,5 +1,6 @@
 #' @include seurat.R
 NULL
+
 #' Cluster Determination
 #'
 #' Identify clusters of cells by a shared nearest neighbor (SNN) modularity
@@ -333,7 +334,6 @@ NumberClusters <- function(object) {
 #'
 #' @import Matrix
 #' @importFrom stats predict
-#' @importFrom ranger ranger
 #'
 #' @export
 #'
@@ -356,6 +356,7 @@ ClassifyCells <- function(
   new.data = NULL,
   ...
 ) {
+  PackageCheck('ranger')
   # build the classifier
   if (missing(classifier)){
     classifier <- BuildRFClassifier(
@@ -397,7 +398,6 @@ ClassifyCells <- function(
 #' @return Returns the random forest classifier
 #'
 #' @import Matrix
-#' @importFrom ranger ranger
 #'
 #' @export
 #'
@@ -414,6 +414,7 @@ BuildRFClassifier <- function(
   verbose = TRUE,
   ...
 ) {
+  PackageCheck('ranger')
   training.classes <- as.vector(x = training.classes)
   training.genes <- SetIfNull(
     x = training.genes,
@@ -430,7 +431,7 @@ BuildRFClassifier <- function(
   if (verbose) {
     message("Training Classifier ...")
   }
-  classifier <- ranger(
+  classifier <- ranger::ranger(
     data = training.data,
     dependent.variable.name = "class",
     classification = TRUE,
@@ -442,7 +443,7 @@ BuildRFClassifier <- function(
 
 #' K-Means Clustering
 #'
-#' Perform k=means clustering on both genes and single cells
+#' Perform k-means clustering on both genes and single cells
 #'
 #' K-means and heatmap are calculated on object@@scale.data
 #'
@@ -464,7 +465,6 @@ BuildRFClassifier <- function(
 #'
 #' @importFrom methods new
 #' @importFrom stats kmeans
-#' @importFrom tclust tkmeans
 #'
 #' @return Seurat object where the k-means results for genes is stored in
 #' object@@kmeans.obj[[1]], and the k-means results for cells is stored in
@@ -506,7 +506,8 @@ DoKMeans <- function(
   kmeans.data <- data.use[genes.use, cells.use]
   if (do.constrained) {
     set.seed(seed = k.seed)
-    kmeans.obj <- tkmeans(x = kmeans.data, k = k.genes, ...)
+    PackageCheck('tclust')
+    kmeans.obj <- tclust::tkmeans(x = kmeans.data, k = k.genes, ...)
   } else {
     set.seed(seed = k.seed)
     kmeans.obj <- kmeans(x = kmeans.data, centers = k.genes, ...)

R/cluster_validation.R

@@ -13,7 +13,6 @@ NULL
 #' clusters
 #' @param acc.cutoff Accuracy cutoff for classifier
 #' @param verbose Controls whether to display progress and merging results
-#' @importFrom caret trainControl train
 #' @return Returns a Seurat object, object@@ident has been updated with new
 #' cluster info
 #' @export
@@ -35,6 +34,7 @@ ValidateClusters <- function(
   acc.cutoff = 0.9,
   verbose = TRUE
 ) {
+  PackageCheck('caret')
   # probably should refactor to make cleaner
   if (length(x = object@snn) > 1) {
     SNN.use <- object@snn
@@ -133,7 +133,6 @@ ValidateClusters <- function(
 #' @param pc.use Which PCs to use for model construction
 #' @param top.genes Use the top X genes for model construction
 #' @param acc.cutoff Accuracy cutoff for classifier
-#' @importFrom caret trainControl train
 #' @return Returns a Seurat object, object@@ident has been updated with
 #' new cluster info
 #' @export
@@ -155,6 +154,7 @@ ValidateSpecificClusters <- function(
   top.genes = 30,
   acc.cutoff = 0.9
 ) {
+  PackageCheck('caret')
   acc <- RunClassifier(
     object = object,
     group1 = cluster1,
@@ -203,9 +203,9 @@ RunClassifier <- function(object, group1, group2, pcs, num.genes) {
   xv <- apply(X = x, MARGIN = 2, FUN = var)
   x  <- x[, names(x = which(xv > 0))]
   # run k-fold cross validation
-  ctrl <- trainControl(method = "repeatedcv", repeats = 5)
+  ctrl <- caret::trainControl(method = "repeatedcv", repeats = 5)
   set.seed(seed = 1500)
-  model <- train(
+  model <- caret::train(
     x = x,
     y = as.factor(x = y),
     formula = as.factor(x = y) ~ .,

R/conversion.R

@@ -157,9 +157,9 @@ Convert.seurat <- function(
         from@data <- as.matrix(from@data)
       }
       sce <- if (class(from@raw.data) %in% c("matrix", "dgTMatrix")) {
-        SingleCellExperiment::SingleCellExperiment(assays = list(counts = as(from@raw.data[, from@cell.names], "dgCMatrix")))
+        SingleCellExperiment::SingleCellExperiment(assays = list(counts = as(from@raw.data[rownames(from@data), from@cell.names], "dgCMatrix")))
       } else if (inherits(x = from@raw.data, what = "dgCMatrix")) {
-        SingleCellExperiment::SingleCellExperiment(assays = list(counts = from@raw.data[, from@cell.names]))
+        SingleCellExperiment::SingleCellExperiment(assays = list(counts = from@raw.data[rownames(from@data), from@cell.names]))
       } else {
         stop("Invalid class stored in seurat object's raw.data slot")
       }

R/differential_expression_internal.R

@@ -94,14 +94,14 @@ DifferentialTobit <- function(x1, x2, lower = 1, upper = Inf) {
 #internal function to run Tobit DE test
 #credit to Cole Trapnell for this
 #
-#' @importFrom VGAM vgam tobit
 #' @importFrom stats as.formula
 #
-TobitFitter <- function(x, modelFormulaStr, lower = 1, upper = Inf){
+TobitFitter <- function(x, modelFormulaStr, lower = 1, upper = Inf) {
+  PackageCheck('VGAM')
   tryCatch(
-    expr = return(suppressWarnings(expr = vgam(
+    expr = return(suppressWarnings(expr = VGAM::vgam(
       formula = as.formula(object = modelFormulaStr),
-      family = tobit(Lower = lower, Upper = upper),
+      family = VGAM::tobit(Lower = lower, Upper = upper),
       data = x
     ))),
     #warning = function(w) { FM_fit },

R/interaction.R

@@ -416,7 +416,7 @@ SubsetData <- function(
     )
     gc(verbose = FALSE)
   }
-  object@ident <- drop.levels(x = object@ident[cells.use])
+  object@ident <- droplevels(x = object@ident[cells.use])
   if (length(x = object@dr) > 0) {
     for (i in 1:length(object@dr)) {
       if (length(object@dr[[i]]@cell.embeddings) > 0) {
@@ -921,7 +921,7 @@ StashIdent <- function(object, save.name = "oldIdent") {
 #'
 #' @return A Seurat object where object@@ident has been appropriately modified
 #'
-#' @importFrom gdata drop.levels
+#' @importFrom stats reorder
 #'
 #' @export
 #'
@@ -954,7 +954,7 @@ SetIdent <- function(object, cells.use = NULL, ident.use = NULL) {
     )
   )
   object@ident[cells.use] <- ident.use
-  object@ident <- drop.levels(x = object@ident)
+  object@ident <- reorder(x = droplevels(x = object@ident))
   return(object)
 }
 
@@ -1194,7 +1194,7 @@ RenameCells <- function(object, add.cell.id = NULL, new.names = NULL,
   colnames(object@raw.data) <- new.rawdata.names
   rownames(object@meta.data) <- new.cell.names
   object@cell.names <- new.cell.names
-  
+
   if (for.merge) {
     return(object)
   }

R/plotting.R

@@ -1038,7 +1038,9 @@ FeaturePlot <- function(
   coord.fixed = FALSE,
   dark.theme = FALSE,
   do.return = FALSE,
-  vector.friendly=FALSE
+  vector.friendly=FALSE,
+  png.file = NULL,
+  png.arguments = c(10,10, 100)
 ) {
   cells.use <- SetIfNull(x = cells.use, default = colnames(x = object@data))
   if (is.null(x = nCol)) {
@@ -1151,7 +1153,9 @@ FeaturePlot <- function(
         no.axes = no.axes,
         no.legend = no.legend,
         dark.theme = dark.theme,
-        vector.friendly = vector.friendly
+        vector.friendly = vector.friendly,
+        png.file = png.file,
+        png.arguments = png.arguments
       ),
       SIMPLIFY = FALSE # Get list, not matrix
     )

R/preprocessing.R

@@ -31,8 +31,6 @@
 #' @return Returns a Seurat object with the raw data stored in object@@raw.data.
 #' object@@data, object@@meta.data, object@@ident, also initialized.
 #'
-#' @import stringr
-#' @import pbapply
 #' @importFrom methods new
 #' @importFrom utils packageVersion
 #' @importFrom Matrix colSums rowSums