Capacity to use arbitrary differential expression functions

R/differential_expression.R

@@ -593,74 +593,71 @@ FindMarkers.default <- function(
   if (!test.use %in% c('wilcox', 'MAST', 'DESeq2')) {
     CheckDots(...)
   }
+
+  std.arguments <- list(
+    data.use = object[features, c(cells.1, cells.2), drop = FALSE],
+    cells.1 = cells.1,  cells.2 = cells.2,  verbose = verbose)
+
   de.results <- switch(
     EXPR = test.use,
-    'wilcox' = WilcoxDETest(
-      data.use = object[features, c(cells.1, cells.2), drop = FALSE],
-      cells.1 = cells.1,
-      cells.2 = cells.2,
-      verbose = verbose,
-      ...
-    ),
-    'bimod' = DiffExpTest(
-      data.use = object[features, c(cells.1, cells.2), drop = FALSE],
-      cells.1 = cells.1,
-      cells.2 = cells.2,
-      verbose = verbose
-    ),
-    'roc' = MarkerTest(
-      data.use = object[features, c(cells.1, cells.2), drop = FALSE],
-      cells.1 = cells.1,
-      cells.2 = cells.2,
-      verbose = verbose
-    ),
-    't' = DiffTTest(
-      data.use = object[features, c(cells.1, cells.2), drop = FALSE],
-      cells.1 = cells.1,
-      cells.2 = cells.2,
-      verbose = verbose
-    ),
-    'negbinom' = GLMDETest(
-      data.use = object[features, c(cells.1, cells.2), drop = FALSE],
-      cells.1 = cells.1,
-      cells.2 = cells.2,
-      min.cells = min.cells.feature,
-      latent.vars = latent.vars,
-      test.use = test.use,
-      verbose = verbose
-    ),
-    'poisson' = GLMDETest(
-      data.use = object[features, c(cells.1, cells.2), drop = FALSE],
-      cells.1 = cells.1,
-      cells.2 = cells.2,
-      min.cells = min.cells.feature,
-      latent.vars = latent.vars,
-      test.use = test.use,
-      verbose = verbose
+    'wilcox' = do.call(what = "WilcoxDETest", args = c(std.arguments, ...)),
+    'bimod' = do.call(what = "DiffExpTest", args = c(std.arguments, ...)),
+    'roc' = do.call(what = "MarkerTest", args = std.arguments),
+    't' = do.call(what = "DiffTTest", args = std.arguments),
+    'negbinom' = do.call(
+      what = "GLMDETest",
+      args = c(
+        std.arguments,
+        min.cells = min.cells.feature,
+        latent.vars = latent.vars,
+        test.use = test.use
+      )
     ),
-    'MAST' = MASTDETest(
-      data.use = object[features, c(cells.1, cells.2), drop = FALSE],
-      cells.1 = cells.1,
-      cells.2 = cells.2,
-      latent.vars = latent.vars,
-      verbose = verbose,
-      ...
+    'poisson' = do.call(
+      what = "GLMDETest",
+      args = c(
+        std.arguments,
+        min.cells = min.cells.feature,
+        latent.vars = latent.vars,
+        test.use = test.use
+      )
     ),
-    "DESeq2" = DESeq2DETest(
-      data.use = object[features, c(cells.1, cells.2), drop = FALSE],
-      cells.1 = cells.1,
-      cells.2 = cells.2,
-      verbose = verbose,
-      ...
+    'MAST' = do.call(
+      what = "MASTDETest",
+      args = c(
+        std.arguments,
+        min.cells = min.cells.feature,
+        latent.vars = latent.vars,
+        test.use = test.use
+      )
     ),
-    "LR" = LRDETest(
-      data.use = object[features, c(cells.1, cells.2), drop = FALSE],
-      cells.1 = cells.1,
-      cells.2 = cells.2,
-      latent.vars = latent.vars,
-      verbose = verbose
+    "DESeq2" = do.call(what = "DESeq2DETest", args = std.arguments),
+    "LR" = do.call(
+      what = "LRDETest",
+      args = c(std.arguments, latent.vars = latent.vars)
     ),
-    stop("Unknown test: ", test.use)
+    {
+      de.results <- try(
+        expr = {
+          do.call(
+            what = test.use,
+            args = c(std.arguments, ...),
+            envir = parent.frame(2)
+          )
+         },
+        silent = TRUE
+      )
+      # This section makes sure that the correct error is raised, the
+      if (class(de.results) == "try-error") {
+        if (grepl(paste0("could not find function.*", test.use), de.results)) {
+          stop("Unknown test: ", test.use)
+        } else {
+          stop(de.results)
+        }
+      }
+
+      de.results
+    }
   )
   if (is.null(x = reduction)) {
     diff.col <- ifelse(

tests/testthat/test_differential_expression.R

@@ -13,6 +13,7 @@ test_that("Default settings work as expected", {
   expect_error(FindMarkers(object = pbmc_small))
   expect_error(FindMarkers(object = pbmc_small, ident.1 = "test"))
   expect_error(FindMarkers(object = pbmc_small, ident.1 = 0, ident.2 = "test"))
+  expect_error(FindMarkers(object = pbmc_small, ident.1 = 0, test.use = "areallyfaketest"), regexp = "Unknown test: ")
   expect_equal(colnames(x = markers.0), c("p_val", "avg_logFC", "pct.1", "pct.2", "p_val_adj"))
   expect_equal(markers.0[1, "p_val"], 9.572778e-13)
   expect_equal(markers.0[1, "avg_logFC"], -4.034691, tolerance = 1e-6)
@@ -221,7 +222,30 @@ test_that("LR test works", {
   expect_equal(rownames(x = results)[1], "LYZ")
 })
 
-# Tests for FindConservedMarkers 
+test_that("Arbitrary marker function calling works", {
+  return_fakedata <- function(data.use, ...) data.frame(p_val = rep(1, nrow(data.use)), row.names = rownames(data.use))
+
+  results <- suppressWarnings(FindMarkers(object = pbmc_small, ident.1 = 0, ident.2 = 1, test.use = "return_fakedata", verbose = FALSE))
+
+  expect_equal(nrow(x = results), 201)
+  expect_equal(results["CST3", "p_val"], 1)
+  expect_equal(results["CST3", "avg_logFC"], -2.552769, tolerance = 1e-6)
+  expect_equal(results["CST3", "pct.1"], 0.306)
+  expect_equal(results["CST3", "pct.2"], 1.00)
+  expect_equal(results["CST3", "p_val_adj"], 1)
+  expect_equal(rownames(x = results)[1], "PF4")
+
+})
+
+test_that("Arbitrary marker function propagates the right error", {
+  buggyfunction <- function(...) stop("I dont work")
+
+  expect_error(FindMarkers(object = pbmc_small, ident.1 = 0, ident.2 = 1, test.use = "buggyfunction", verbose = FALSE), "I dont work")
+  expect_error(FindMarkers(object = pbmc_small, ident.1 = 0, ident.2 = 1, test.use = "nonexistent", verbose = FALSE), "Unknown test: nonexistent")
+})
+
+
+# Tests for FindConservedMarkers
 # --------------------------------------------------------------------------------
 context("FindConservedMarkers")
 pbmc_small$groups