Fix merge conflicts

DESCRIPTION

@@ -47,12 +47,14 @@ Imports:
     RColorBrewer,
     Rcpp,
     reticulate,
+    rlang,
     ROCR,
     rsvd,
     Rtsne,
     scales,
     SDMTools,
     stats,
+    tools,
     tsne,
     utils
 LinkingTo: Rcpp (>= 0.11.0), RcppEigen, RcppProgress

NAMESPACE

@@ -381,7 +381,9 @@ importFrom(ggplot2,scale_y_discrete)
 importFrom(ggplot2,scale_y_log10)
 importFrom(ggplot2,stat_density2d)
 importFrom(ggplot2,stat_qq)
+importFrom(ggplot2,sym)
 importFrom(ggplot2,theme)
+importFrom(ggplot2,vars)
 importFrom(ggplot2,waiver)
 importFrom(ggplot2,xlim)
 importFrom(ggplot2,ylim)
@@ -434,6 +436,7 @@ importFrom(reticulate,py_module_available)
 importFrom(reticulate,py_set_seed)
 importFrom(reticulate,r_to_py)
 importFrom(reticulate,tuple)
+importFrom(rlang,"!!")
 importFrom(rsvd,rsvd)
 importFrom(scales,hue_pal)
 importFrom(scales,zero_range)

R/differential_expression.R

@@ -93,6 +93,7 @@ FindAllMarkers <- function(
     idents.all <- (tree$Nnode + 2):max(tree$edge)
   }
   genes.de <- list()
+  messages <- list()
   for (i in 1:length(x = idents.all)) {
     if (verbose) {
       message("Calculating cluster ", idents.all[i])
@@ -129,9 +130,13 @@ FindAllMarkers <- function(
         )
       },
       error = function(cond) {
-        return(NULL)
+        return(cond$message)
       }
     )
+    if (class(x = genes.de[[i]]) == "character") {
+      messages[[i]] <- genes.de[[i]]
+      genes.de[[i]] <- NULL
+    }
   }
   gde.all <- data.frame()
   for (i in 1:length(x = idents.all)) {
@@ -163,7 +168,15 @@ FindAllMarkers <- function(
   }
   rownames(x = gde.all) <- make.unique(names = as.character(x = gde.all$gene))
   if (nrow(x = gde.all) == 0) {
-    warning("No DE genes identified", call. = FALSE)
+    warning("No DE genes identified", call. = FALSE, immediate. = TRUE)
+  }
+  if (length(x = messages) > 0) {
+    warning("The following tests were not performed: ", call. = FALSE, immediate. = TRUE)
+    for (i in 1:length(x = messages)) {
+      if (!is.null(x = messages[[i]])) {
+        warning("When testing ", idents.all[i], " versus all:\n\t", messages[[i]], call. = FALSE, immediate. = TRUE)
+      }
+    }
   }
   if (!is.null(x = node)) {
     gde.all$cluster <- MapVals(
@@ -590,6 +603,9 @@ FindMarkers.default <- function(
 #' use all other cells for comparison; if an object of class \code{phylo} or
 #' 'clustertree' is passed to \code{ident.1}, must pass a node to find markers for
 #' @param assay Assay to use in differential expression testing
+#' @param reduction Reduction to use in differential expression testing - will test for DE on cell embeddings
+#' @param group.by Regroup cells into a different identity class prior to performing differential expression (see example)
+#' @param subset.ident Subset a particular identity class prior to regrouping. Only relevant if group.by is set (see example)
 #'
 #' @importFrom methods is
 #'
@@ -601,7 +617,10 @@ FindMarkers.Seurat <- function(
   object,
   ident.1 = NULL,
   ident.2 = NULL,
+  group.by = NULL,
+  subset.ident = NULL,
   assay = NULL,
+  reduction = NULL, 
   features = NULL,
   logfc.threshold = 0.25,
   test.use = "wilcox",
@@ -617,13 +636,29 @@ FindMarkers.Seurat <- function(
   pseudocount.use = 1,
   ...
 ) {
-  assay <- assay %||% DefaultAssay(object = object)
+  if (!is.null(x = group.by)) {
+    if (!is.null(x = subset.ident)) {
+      object <- subset(x = object, idents = subset.ident)
+    }
+    Idents(object = object) <- group.by
+  }
+  if (!is.null(x = assay) & !is.null(x = reduction)) {
+    stop("Please only specify either assay or reduction.")
+  }
   data.slot <- ifelse(
     test = test.use %in% c("negbinom", "poisson", "DESeq2"),
     yes = 'counts',
     no = 'data'
   )
-  data.use <- GetAssayData(object = object[[assay]], slot = data.slot)
+  if (is.null(x = reduction)) {
+    assay <- assay %||% DefaultAssay(object = object)
+    data.use <-  GetAssayData(object = object[[assay]], slot = data.slot)
+  } else {
+    if (data.slot == "counts") {
+      stop("The following tests cannot be used when specifying a reduction as they assume a count model: negbinom, poisson, DESeq2")
+    }
+    data.use <- t(x = Embeddings(object = object, reduction = reduction))
+  }
   if (is.null(x = ident.1)) {
     stop("Please provide ident.1")
   } else if (ident.1 == 'clustertree' || is(object = ident.1, class2 = 'phylo')) {

R/dimensional_reduction.R

@@ -1285,7 +1285,7 @@ RunUMAP.Graph <- function(
 #' used to combine local fuzzy simplicial sets to obtain a global fuzzy simplicial sets. Both fuzzy
 #' set operations use the product t-norm. The value of this parameter should be between 0.0 and
 #' 1.0; a value of 1.0 will use a pure fuzzy union, while 0.0 will use a pure fuzzy intersection.
-#' @param local.connectivity The local connectivity required – i.e. the number of nearest neighbors
+#' @param local.connectivity The local connectivity required - i.e. the number of nearest neighbors
 #' that should be assumed to be connected at a local level. The higher this value the more connected
 #' the manifold becomes locally. In practice this should be not more than the local intrinsic
 #' dimension of the manifold.
@@ -1703,9 +1703,9 @@ fftRtsne <- function(X,
   if (version_number == "1.0") {
     flag <- system2(
      command = fast_tsne_path,
-     args = c( data_path, result_path, nthreads)
+     args = c(data_path, result_path, nthreads)
     )
-  }else{
+  } else {
     flag <- system2(
       command = fast_tsne_path,
       args = c(version_number, data_path, result_path, nthreads)

R/generics.R

@@ -180,9 +180,9 @@ Embeddings <- function(object, ...) {
 #' van Eck (2013) \emph{The European Physical Journal B}. Thanks to Nigel
 #' Delaney (evolvedmicrobe@github) for the rewrite of the Java modularity
 #' optimizer code in Rcpp!
-#' 
+#'
 #' To run Leiden algorithm, you must first install the leidenalg python
-#' package (e.g. via pip install leidenalg), see Traag et al (2018). 
+#' package (e.g. via pip install leidenalg), see Traag et al (2018).
 #'
 #' @param object An object
 #' @param ... Arguments passed to other methods
@@ -221,7 +221,7 @@ FindClusters <- function(object, ...) {
 #' Bioinformatics. 2013;29(4):461-467. doi:10.1093/bioinformatics/bts714
 #' @references Trapnell C, et al. The dynamics and regulators of cell fate
 #' decisions are revealed by pseudotemporal ordering of single cells. Nature
-#' Biotechnology volume 32, pages 381–386 (2014)
+#' Biotechnology volume 32, pages 381-386 (2014)
 #' @references Andrew McDavid, Greg Finak and Masanao Yajima (2017). MAST: Model-based
 #' Analysis of Single Cell Transcriptomics. R package version 1.2.1.
 #' https://github.com/RGLab/MAST/
@@ -236,6 +236,10 @@ FindClusters <- function(object, ...) {
 #' markers <- FindMarkers(object = pbmc_small, ident.1 = 2)
 #' head(x = markers)
 #'
+#' # Take all cells in cluster 2, and find markers that separate cells in the 'g1' group (metadata variable 'group')
+#' markers <- FindMarkers(pbmc_small, ident.1 = "g1", group.by = 'groups', subset.ident = "2")
+#' head(x = markers)
+#' 
 #' # Pass 'clustertree' or an object of class phylo to ident.1 and
 #' # a node to ident.2 as a replacement for FindMarkersNode
 #' pbmc_small <- BuildClusterTree(object = pbmc_small)
@@ -321,7 +325,7 @@ GetAssay <- function(object, ...) {
 
 #' General accessor function for the Assay class
 #'
-#' This function can be used to pull information from any of the slots in the Assay class. For 
+#' This function can be used to pull information from any of the slots in the Assay class. For
 #' example, pull one of the data matrices("counts", "data", or "scale.data").
 #'
 #' @param object An object
@@ -679,7 +683,7 @@ RunICA <- function(object, ...) {
 #'
 #' @param object Seurat object
 #' @param ... Arguments passed to other methods
-#' 
+#'
 #' @rdname RunLSI
 #' @export RunLSI
 #'

R/preprocessing.R

@@ -294,7 +294,7 @@ HTODemux <- function(
     slot = 'counts'
   )[, colnames(x = object)]
   counts <- as.matrix(x = counts)
-  ncenters <- init %||% nrow(x = data) + 1
+  ncenters <- init %||% (nrow(x = data) + 1)
   switch(
     EXPR = kfunc,
     'kmeans' = {