Convert functions to S4 methods for SCE dispatch, closes #23.

Minor variable renaming to avoid confusion.

DESCRIPTION

@@ -1,6 +1,7 @@
 Package: velociraptor
 Title: Toolkit for Single-Cell Velocity
-Version: 0.99.8
+Version: 0.99.9
+Date: 2020-10-10
 Authors@R: c(person("Kevin", "Rue-Albrecht", role = c("aut", "cre"), email = "[email protected]", comment = c(ORCID = "0000-0003-3899-3872")),
     person("Aaron", "Lun", role="aut", email="[email protected]", comment = c(ORCID = '0000-0002-3564-4813')),
     person("Charlotte", "Soneson", role="aut", email="[email protected]", comment = c(ORCID = '0000-0003-3833-2169')))

NAMESPACE

@@ -1,8 +1,11 @@
 # Generated by roxygen2: do not edit by hand
 
+export(.grid_vectors)
 export(embedVelocity)
 export(gridVectors)
 export(scvelo)
+exportMethods(embedVelocity)
+exportMethods(gridVectors)
 exportMethods(scvelo)
 import(SummarizedExperiment)
 import(basilisk)

NEWS.md

@@ -1,3 +1,7 @@
+# velociraptor 0.99.9
+
+* Converted various functions to S4 generics for easier use with `SingleCellExperiment` objects.
+
 # velociraptor 0.99.8
 
 * Trigger new build to repeat `ExperimentHub` download.

R/embedVelocity.R

@@ -3,9 +3,15 @@
 #' Project the velocity vector for each cell onto an existing low-dimensional embedding.
 #'
 #' @param x A numeric matrix of low-dimensional coordinates, e.g., after t-SNE.
-#' @param v A \linkS4class{SingleCellExperiment} containing the output of the velocity calculations,
+#' Alternatively, a \linkS4class{SingleCellExperiment} containing such coordinates in its \code{\link{reducedDims}}.
+#' @param vobj A \linkS4class{SingleCellExperiment} containing the output of the velocity calculations,
 #' typically after running \code{\link{scvelo}}.
-#' @param ... Further arguments to pass to the \code{velocity_embedding} Python function from \pkg{scVelo}.
+#' @param ... For the generic, further arguments to pass to specific methods.
+#'
+#' For the ANY method, further arguments to pass to the \code{velocity_embedding} Python function from \pkg{scVelo}.
+#'
+#' For the SingleCellExperiment method, further arguments to pass to the ANY method.
+#' @param use.dimred String or integer scalar specifying the reduced dimensions to retrieve from \code{x}.
 #'
 #' @details
 #' This is a simple wrapper around the \code{scvelo.tools.velocity_embedding} function.
@@ -28,21 +34,38 @@
 #' projected <- embedVelocity(tsne.results, out)
 #'
 #' @export
+#' @name embedVelocity
+NULL
+
 #' @importFrom SingleCellExperiment reducedDim<-
-embedVelocity <- function(x, v, ...) {
-    reducedDim(v, "X_target") <- as.matrix(x)
-    basiliskRun(env=velo.env, fun=.run_embedder, v=v, ...)
+.embed_velocity <- function(x, vobj, ...) {
+    reducedDim(vobj, "X_target") <- as.matrix(x)
+    basiliskRun(env=velo.env, fun=.run_embedder, vobj=vobj, ...)
 }
 
 #' @importFrom reticulate import
 #' @importFrom zellkonverter SCE2AnnData
-.run_embedder <- function(v, ...) {
+.run_embedder <- function(vobj, ...) {
     scv <- import("scvelo")
 
     args <- list(..., basis="target", autoscale=FALSE)
-    adata <- SCE2AnnData(v)
+    adata <- SCE2AnnData(vobj)
 
     do.call(scv$tl$velocity_embedding, c(list(data=adata), args))
 
     adata$obsm["velocity_target"]
 }
+
+#' @export
+#' @rdname embedVelocity
+setGeneric("embedVelocity", function(x, vobj, ...) standardGeneric("embedVelocity"))
+
+#' @export
+#' @rdname embedVelocity
+setMethod("embedVelocity", "ANY", .embed_velocity)
+
+#' @export
+#' @rdname embedVelocity
+setMethod("embedVelocity", "SingleCellExperiment", function(x, vobj, ..., use.dimred=1) {
+    .embed_velocity(reducedDim(x, use.dimred), vobj, ...)
+})

R/gridVectors.R

@@ -2,21 +2,27 @@
 #'
 #' Summarize the velocity vectors into a grid, usually for easy plotting.
 #'
-#' @param x A low-dimensional embedding of the dataset where each cell is a row.
-#' @param v A low-dimensional projection of the velocity vectors, of the same dimensions as \code{x}.
+#' @param x A numeric matrix of low-dimensional coordinates, e.g., after t-SNE.
+#' Alternatively, a \linkS4class{SingleCellExperiment} containing such coordinates in its \code{\link{reducedDims}}.
+#' @param embedded A low-dimensional projection of the velocity vectors into the embedding of \code{x}.
+#' This should be of the same dimensions as \code{x} and is typically produced by \code{\link{embedVelocity}}.
 #' @param resolution Integer scalar specifying the resolution of the grid,
 #' in terms of the number of grid intervals along each axis.
 #' @param scale Logical scalar indicating whether the averaged vectors should be scaled by the grid resolution.
 #' @param as.data.frame Logical scalar indicating whether the output should be a data.frame.
 #' If \code{FALSE}, a list of two matrices is returned.
+#' @param ... For the generic, further arguments to pass to specific methods.
+#'
+#' For the SingleCellExperiment method, further arguments to pass to the ANY method.
+#' @param use.dimred String or integer scalar specifying the reduced dimensions to retrieve from \code{x}.
 #'
 #' @details
 #' This partitions the bounding box of \code{x} into a grid with \code{resolution} units in each dimension.
 #' The locations and vectors of all cells in each block are averaged to obtain a representative of that block.
 #' This is most obviously useful for visualization to avoid overplotting of velocity vectors.
 #'
 #' If \code{scale=TRUE}, per-block vectors are scaled so that the median vector length is comparable to the spacing between blocks.
-#' This improves visualization when the scales of \code{x} and \code{v} are not immediately comparable.
+#' This improves visualization when the scales of \code{x} and \code{embedded} are not immediately comparable.
 #'
 #' @return
 #' If \code{as.data.frame=FALSE}, a list is returned containing \code{start} and \code{end},
@@ -38,10 +44,15 @@
 #' plot(tsne.results[,1], tsne.results[,2], col='grey')
 #' arrows(out$start.1, out$start.2, out$end.1, out$end.2, length=0.05)
 #'
+#' @seealso 
+#' \code{\link{embedVelocity}}, to generate \code{embedded}.
+#' @name gridVectors
+NULL
+
 #' @export
 #' @importFrom S4Vectors selfmatch DataFrame
 #' @importFrom stats median
-gridVectors <- function(x, v, resolution=40, scale=TRUE, as.data.frame=TRUE) {
+.grid_vectors <- function(x, embedded, resolution=40, scale=TRUE, as.data.frame=TRUE) {
     limits <- apply(x, 2, range)
     intercept <- limits[1,]
     delta <- (limits[2,] - intercept)/resolution
@@ -53,7 +64,7 @@ gridVectors <- function(x, v, resolution=40, scale=TRUE, as.data.frame=TRUE) {
 
     tab <- as.integer(table(grp))
     pos <- rowsum(x, grp)/tab
-    vec <- rowsum(v, grp)/tab
+    vec <- rowsum(embedded, grp)/tab
 
     if (scale) {
         d <- sqrt(rowSums(vec^2))
@@ -64,3 +75,17 @@ gridVectors <- function(x, v, resolution=40, scale=TRUE, as.data.frame=TRUE) {
     FUN <- if (as.data.frame) data.frame else list
     FUN(start=pos, end=pos + vec)
 }
+
+#' @export
+#' @rdname gridVectors
+setGeneric("gridVectors", function(x, embedded, ...) standardGeneric("gridVectors"))
+
+#' @export
+#' @rdname gridVectors
+setMethod("gridVectors", "ANY", .grid_vectors) 
+
+#' @export
+#' @rdname gridVectors
+setMethod("gridVectors", "SingleCellExperiment", function(x, embedded, ..., use.dimred=1) {
+    .grid_vectors(reducedDim(x, use.dimred), embedded, ...)
+})

tests/testthat/test-embed.R

@@ -15,6 +15,11 @@ test_that("embedVelocity works correctly", {
     tsne.results <- matrix(rnorm(2*ncol(out)), ncol=2)
     projected <- embedVelocity(tsne.results, out)
     expect_identical(dim(tsne.results), dim(projected))
+
+    # Same results inside an SCE.
+    reducedDim(sce1, "TSNE") <- tsne.results
+    projected2 <- embedVelocity(sce1, out, use.dimred="TSNE")
+    expect_identical(projected, projected2)
 })
 
 test_that("gridVectors works correctly", {
@@ -26,4 +31,9 @@ test_that("gridVectors works correctly", {
 
     out <- gridVectors(tsne.results, projected, as.data.frame=FALSE)
     expect_type(out, "list")
+
+    # Same results inside an SCE.
+    reducedDim(sce1, "TSNE") <- tsne.results
+    out2 <- gridVectors(sce1, projected, use.dimred="TSNE", as.data.frame=FALSE)
+    expect_identical(out, out2)
 })