merge

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: Seurat
-Version: 3.1.4.9021
-Date: 2020-04-06
+Version: 3.1.4.9023
+Date: 2020-04-08
 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 Stuart T, Butler A, et al (2019) <doi:10.1016/j.cell.2019.05.031> for more details. Please note:  SDMTools is available is available from the CRAN archives with install.packages("https://cran.rstudio.com//src/contrib/Archive/SDMTools/SDMTools_1.1-221.2.tar.gz", repos = NULL); it is not in the standard repositories.
 Authors@R: c(

NAMESPACE

@@ -15,6 +15,7 @@ S3method("Key<-",Assay)
 S3method("Key<-",DimReduc)
 S3method("Loadings<-",DimReduc)
 S3method("Misc<-",Assay)
+S3method("Misc<-",DimReduc)
 S3method("Misc<-",Seurat)
 S3method("Project<-",Seurat)
 S3method("Tool<-",Seurat)
@@ -70,6 +71,7 @@ S3method(Key,Seurat)
 S3method(Loadings,DimReduc)
 S3method(Loadings,Seurat)
 S3method(Misc,Assay)
+S3method(Misc,DimReduc)
 S3method(Misc,Seurat)
 S3method(NormalizeData,Assay)
 S3method(NormalizeData,Seurat)
@@ -560,4 +562,5 @@ importFrom(utils,setTxtProgressBar)
 importFrom(utils,txtProgressBar)
 importFrom(utils,write.table)
 importFrom(uwot,umap)
+importFrom(uwot,umap_transform)
 useDynLib(Seurat)

R/dimensional_reduction.R

@@ -1141,7 +1141,7 @@ RunTSNE.Seurat <- function(
 }
 
 #' @importFrom reticulate py_module_available py_set_seed import
-#' @importFrom uwot umap
+#' @importFrom uwot umap umap_transform
 #' @importFrom future nbrOfWorkers
 #'
 #' @rdname RunUMAP
@@ -1150,7 +1150,7 @@ RunTSNE.Seurat <- function(
 #'
 RunUMAP.default <- function(
   object,
-  model.object = NULL,
+  reduction.model = NULL,
   assay = NULL,
   umap.method = 'uwot',
   n.neighbors = 30L,
@@ -1289,51 +1289,51 @@ RunUMAP.default <- function(
         )
         metric <- 'cosine'
       }
-      #if (model.object == NULL) {
-      #  stop("UWOT predict needs a model, try umot-learn on the object first")
-      #}
-      uwot::umap_transform(
+      if (is.null(x = reduction.model) || !inherits(x = reduction.model, what = 'DimReduc')) {
+        stop(
+          "If using uwot-predict, please pass a DimReduc object with the model stored to reduction.model.",
+          call. = FALSE
+        )
+      }
+      model <- reduction.model %||% Misc(
+        object = reduction.model,
+        slot = "model"
+      )
+      if (length(x = model) == 0) {
+        stop(
+          "The provided reduction.model does not have a model stored. Please try running umot-learn on the object first",
+          call. = FALSE
+        )
+      }
+      umap_transform(
         X = object,
-        model = model.object@reductions$umap@misc,
+        model = model,
         n_threads = nbrOfWorkers(),
         n_epochs = n.epochs,
         verbose = verbose
       )
     },
     stop("Unknown umap method: ", umap.method, call. = FALSE)
   )
-
   if (umap.method == 'uwot-learn') {
     umap.model <- umap.output
     umap.output <- umap.output$embedding
   }
-
   colnames(x = umap.output) <- paste0(reduction.key, 1:ncol(x = umap.output))
   if (inherits(x = object, what = 'dist')) {
     rownames(x = umap.output) <- attr(x = object, "Labels")
   } else {
     rownames(x = umap.output) <- rownames(x = object)
   }
-
-  if (umap.method == 'umap-learn' || umap.method == 'uwot' || umap.method == 'uwot-predict') {
-    umap.reduction <- CreateDimReducObject(
-      embeddings = umap.output,
-      key = reduction.key,
-      assay = assay,
-      global = TRUE
-    )
-  } else if (umap.method == 'uwot-learn') {
-    umap.reduction <- CreateDimReducObject(
-      embeddings = umap.output,
-      key = reduction.key,
-      assay = assay,
-      global = TRUE,
-      misc = umap.model
-    )
-  } else {
-    stop("Unknown umap method: ", umap.method, call. = FALSE)
+  umap.reduction <- CreateDimReducObject(
+    embeddings = umap.output,
+    key = reduction.key,
+    assay = assay,
+    global = TRUE
+  )
+  if (umap.method == 'uwot-learn') {
+    Misc(umap.reduction, slot = "model") <- umap.model
   }
-
   return(umap.reduction)
 }
 
@@ -1425,6 +1425,7 @@ RunUMAP.Graph <- function(
   return(umap)
 }
 
+#' @param reduction.model \code{DimReduc} object that contains the umap model
 #' @param dims Which dimensions to use as input features, used only if
 #' \code{features} is NULL
 #' @param reduction Which dimensional reduction (PCA or ICA) to use for the
@@ -1438,6 +1439,7 @@ RunUMAP.Graph <- function(
 #' @param umap.method UMAP implementation to run. Can be
 #' \describe{
 #'   \item{\code{uwot}:}{Runs umap via the uwot R package}
+#'   \item{\code{uwot-learn}:}{Runs umap via the uwot R package and return the learned umap model}
 #'   \item{\code{umap-learn}:}{Run the Seurat wrapper of the python umap-learn package}
 #' }
 #' @param n.neighbors This determines the number of neighboring points used in
@@ -1498,7 +1500,7 @@ RunUMAP.Graph <- function(
 #'
 RunUMAP.Seurat <- function(
   object,
-  model.object = NULL,
+  reduction.model = NULL,
   dims = NULL,
   reduction = 'pca',
   features = NULL,
@@ -1563,7 +1565,7 @@ RunUMAP.Seurat <- function(
   }
   object[[reduction.name]] <- RunUMAP(
     object = data.use,
-    model.object = model.object,
+    reduction.model = reduction.model,
     assay = assay,
     umap.method = umap.method,
     n.neighbors = n.neighbors,

R/objects.R

@@ -3333,6 +3333,18 @@ Misc.Assay <- function(object, slot = NULL, ...) {
   return(slot(object = object, name = 'misc')[[slot]])
 }
 
+#' @rdname Misc
+#' @export
+#' @method Misc DimReduc
+#'
+Misc.DimReduc <- function(object, slot = NULL, ...) {
+  CheckDots(...)
+  if (is.null(x = slot)) {
+    return(slot(object = object, name = 'misc'))
+  }
+  return(slot(object = object, name = 'misc')[[slot]])
+}
+
 #' @rdname Misc
 #' @export
 #' @method Misc Seurat
@@ -3366,6 +3378,23 @@ Misc.Seurat <- function(object, slot = NULL, ...) {
   return(object)
 }
 
+#' @rdname Misc
+#' @export
+#' @method Misc<- DimReduc
+#'
+"Misc<-.DimReduc" <- function(object, slot, ..., value) {
+  CheckDots(...)
+  if (slot %in% names(x = Misc(object = object))) {
+    warning("Overwriting miscellanous data for ", slot)
+  }
+  if (is.list(x = value)) {
+    slot(object = object, name = 'misc')[[slot]] <- c(value)
+  } else {
+    slot(object = object, name = 'misc')[[slot]] <- value
+  }
+  return(object)
+}
+
 #' @rdname Misc
 #' @export
 #' @method Misc<- Seurat

R/visualization.R

@@ -526,8 +526,8 @@ RidgePlot <- function(
 #' @inheritParams RidgePlot
 #' @param pt.size Point size for geom_violin
 #' @param split.by A variable to split the violin plots by,
-#' @param multi.group  plot each group of the split violin plots by multiple or single violin shapes
-#' see \code{\link{FetchData}} for more details
+#' @param split.plot  plot each group of the split violin plots by multiple or
+#' single violin shapes.
 #' @param adjust Adjust parameter for geom_violin
 #'
 #' @return A \code{\link[patchwork]{patchwork}ed} ggplot object if
@@ -557,12 +557,25 @@ VlnPlot <- function(
   log = FALSE,
   ncol = NULL,
   slot = 'data',
-  multi.group = FALSE,
+  split.plot = FALSE,
   combine = TRUE
 ) {
+  if (
+    !is.null(x = split.by) &
+    getOption(x = 'Seurat.warn.vlnplot.split', default = TRUE)
+  ) {
+    message(
+      "The default behaviour of split.by has changed.\n",
+      "Separate violin plots are now plotted side-by-side.\n",
+      "To restore the old behaviour of a single split violin,\n",
+      "set split.plot = TRUE.
+      \nThis message will be shown once per session."
+    )
+    options(Seurat.warn.vlnplot.split = FALSE)
+  }
   return(ExIPlot(
     object = object,
-    type = ifelse(test = multi.group, yes = 'multiViolin', no = 'violin'),
+    type = ifelse(test = split.plot, yes = 'splitViolin', no = 'violin'),
     features = features,
     idents = idents,
     ncol = ncol,
@@ -3640,7 +3653,7 @@ DefaultDimReduc <- function(object, assay = NULL) {
 # Basically combines the codebase for VlnPlot and RidgePlot
 #
 # @param object Seurat object
-# @param type Plot type, choose from 'ridge', 'violin', or 'multiViolin'
+# @param type Plot type, choose from 'ridge', 'violin', or 'splitViolin'
 # @param features Features to plot (gene expression, metrics, PC scores,
 # anything that can be retreived by FetchData)
 # @param idents Which classes to include in the plot (default is all)
@@ -3728,6 +3741,10 @@ ExIPlot <- function(
     }
     cols <- rep_len(x = cols, length.out = length(x = levels(x = split)))
     names(x = cols) <- sort(x = levels(x = split))
+    if ((length(x = cols) > 2) & (type == "splitViolin")) {
+      warning("Split violin is only supported for <3 groups, using multi-violin.")
+      type <- "violin"
+    }
   }
   if (same.y.lims && is.null(x = y.max)) {
     y.max <- max(data)
@@ -3752,7 +3769,7 @@ ExIPlot <- function(
   label.fxn <- switch(
     EXPR = type,
     'violin' = ylab,
-    "multiViolin" = ylab,
+    "splitViolin" = ylab,
     'ridge' = xlab,
     stop("Unknown ExIPlot type ", type, call. = FALSE)
   )
@@ -4645,11 +4662,11 @@ SingleExIPlot <- function(
   y.max <- y.max %||% max(data[, feature][is.finite(x = data[, feature])])
   if (type == 'violin' && !is.null(x = split)) {
     data$split <- split
-    vln.geom <- geom_split_violin
+    vln.geom <- geom_violin
     fill <- 'split'
-  } else if (type == 'multiViolin' && !is.null(x = split )) {
+  } else if (type == 'splitViolin' && !is.null(x = split )) {
     data$split <- split
-    vln.geom <- geom_violin
+    vln.geom <- geom_split_violin
     fill <- 'split'
     type <- 'violin'
   } else {

R/zzz.R

@@ -1,3 +1,5 @@
+#' Seurat package
+#'
 #' Tools for single-cell genomics
 #'
 #' Tools for single-cell genomics
@@ -17,8 +19,10 @@
 #'   \item{\code{Seurat.checkdots}}{For functions that have ... as a parameter,
 #'   this controls the behavior when an item isn't used. Can be one of warn,
 #'   stop, or silent.}
-#'   \item{\code{Seurat.limma.wilcox.msg}}{{Show message about more efficient 
-#'   Wilcoxon Rank Sum test available via the limma package}}
+#'   \item{\code{Seurat.limma.wilcox.msg}}{Show message about more efficient 
+#'   Wilcoxon Rank Sum test available via the limma package}
+#'   \item{\code{Seurat.warn.vlnplot.split}}{Show message about changes to 
+#'   default behavior of split/multi violin plots}
 #' }
 #'
 #' @docType package
@@ -31,7 +35,8 @@ seurat_default_options <- list(
   Seurat.memsafe = FALSE,
   Seurat.warn.umap.uwot = TRUE,
   Seurat.checkdots = "warn",
-  Seurat.limma.wilcox.msg = TRUE
+  Seurat.limma.wilcox.msg = TRUE,
+  Seurat.warn.vlnplot.split = TRUE
 )
 
 .onLoad <- function(libname, pkgname) {