Merge pull request #68 from c-mertes/fix_tests

Fix tests

R/AllGenerics.R

@@ -1111,6 +1111,9 @@ aberrant.FRASER <- function(object, type=fitMetrics(object),
             aberrantEvents <- aberrantEvents & as.matrix(rho <= rhoCutoff)
         }
         aberrantEvents[is.na(aberrantEvents)] <- FALSE
+        if(is.null(colnames(aberrantEvents))){
+            colnames(aberrantEvents) <- colnames(object)
+        }
     }
 
     if(isTRUE(aggregate)){

R/example_functions.R

@@ -10,6 +10,8 @@
 #'                \code{FRASER_output} in the current working directory.
 #' @param rerun Defaults to \code{FALSE}. If set to \code{TRUE} it reruns the
 #'                full fit of the model.
+#' @param metrics The splice metrics that should be included in the test fds. 
+#'              One or several of 'jaccard', 'psi5', 'psi3' or 'theta'.
 #' @return A FraserDataSet object that contains a test case 
 #' 
 #' @examples
@@ -54,7 +56,10 @@ createTestFraserSettings <- function(workingDir="FRASER_output"){
 
 #' @rdname createTestFraserDataSet
 #' @export
-createTestFraserDataSet <- function(workingDir="FRASER_output", rerun=FALSE){
+createTestFraserDataSet <- function(workingDir="FRASER_output", rerun=FALSE,
+                                    metrics="jaccard"){
+    metrics <- match.arg(metrics, several.ok=TRUE, 
+                            choices=c("jaccard", "psi5", "psi3", "theta"))
     # check if file exists already
     hdf5Files <- file.path(workingDir, "savedObjects", "Data_Analysis", 
             "fds-object.RDS")
@@ -84,6 +89,7 @@ createTestFraserDataSet <- function(workingDir="FRASER_output", rerun=FALSE){
     suppressMessages({ fds <- annotateRangesWithTxDb(fds) })
 
     # run FRASER pipeline
+    fitMetrics(fds) <- metrics
     fds <- FRASER(fds, q=c(jaccard=2, psi5=2, psi3=2, theta=2), iterations=2)
 
     # save data for later 

R/getNSetterFuns.R

@@ -10,6 +10,9 @@
 #' @param level Indicates if the retrieved p values should be adjusted on the 
 #'          donor/acceptor site-level (default) or if unadjusted junction-level 
 #'          p values should be returned.
+#' @param subsetName The name of a subset of genes of interest for which FDR 
+#'          corrected pvalues were previously computed. 
+#'          Default is NULL (using transcriptome-wide FDR corrected pvalues).
 #' @param filters A named list giving the filters that were applied for masking 
 #'          during p value correction. Used for storing and retrieving the 
 #'          correct set of requested p values.

tests/testthat/helper.R

@@ -2,6 +2,6 @@
 # helper scripts for the testing step
 #
 getFraser <- function(clean=FALSE){
-    fds <- createTestFraserDataSet(rerun=clean)
+    fds <- createTestFraserDataSet(rerun=clean, metrics=psiTypes)
     fds
 }

tests/testthat/test_fraser_pipeline.R

@@ -5,7 +5,7 @@ test_that("FRASER function", {
     expect_is(fds, "FraserDataSet")
     anames <- c(psiTypes, paste0(c("delta", "predictedMeans", 
             "pvaluesBetaBinomial", "padjBetaBinomial"), "_", 
-            rep(fitMetrics(fds), 5)))
+            rep(psiTypes, 5)))
     expect_equal(anames %in% assayNames(fds), !logical(length(anames)))
 })
 

tests/testthat/test_getter_setter.R

@@ -5,12 +5,15 @@ test_that("counts", {
     expect_equal(counts(fds, type="psi5"),    K(fds, "psi5"))
     expect_equal(counts(fds, type="psi3"),    K(fds, "psi3"))
     expect_equal(counts(fds, type="theta"), K(fds, "theta"))
+    expect_equal(counts(fds, type="jaccard"),    K(fds, "jaccard"))
     expect_equal(counts(fds, type="psi5", side='other'), 
             N(fds, "psi5") - K(fds, "psi5"))
     expect_equal(counts(fds, type="psi3", side='other'),
             N(fds, "psi3") - K(fds, "psi3"))
     expect_equal(counts(fds, type="theta", side='other'),
             N(fds, "theta") - K(fds, "theta"))
+    expect_equal(counts(fds, type="jaccard", side='other'),
+                 N(fds, "jaccard") - K(fds, "jaccard"))
 })
 
 test_that("generic functions", {

tests/testthat/test_plotSampleResults.R

@@ -7,18 +7,33 @@ test_that("Results function", {
 
     # intron-level results
     res <- results(fds, aggregate=FALSE, all=TRUE)
-    expect_equal(length(res), prod(dim(fds)))
+    res <- as.data.table(res)
+    for(psiType in psiTypes){
+        expect_equal(res[type == psiType, .N], 
+                    prod(dim(pVals(fds, level="junction", type=psiType))))
+    }
     res_signif <- results(fds, aggregate=FALSE, all=FALSE,
-                            padjCutoff=NA, deltaPsiCutoff=0.2)
-    expect_equal(length(res_signif), 1)
+                            padjCutoff=NA, deltaPsiCutoff=0.01)
+    res_signif <- as.data.table(res_signif)
+    expect_equal(res_signif[type == "jaccard", .N], 1)
+    expect_equal(res_signif[type == "psi5", .N], 8)
+    expect_equal(res_signif[type == "psi3", .N], 3)
+    expect_equal(res_signif[type == "theta", .N], 6)
 
     # gene-level results
     res_gene <- results(fds, aggregate=TRUE, all=TRUE)
-    expect_equal(length(res_gene), 
-                    prod(dim(pVals(fds, level="gene", type="jaccard"))))
+    res_gene <- as.data.table(res_gene)
+    for(psiType in psiTypes){
+        expect_equal(res_gene[type == psiType, .N], 
+                    prod(dim(pVals(fds, level="gene", type=psiType))))
+    }
     res_gene_signif <- results(fds, aggregate=TRUE, all=FALSE,
-                          padjCutoff=NA, deltaPsiCutoff=0.2)
-    expect_equal(length(res_gene_signif), 1)
+                          padjCutoff=NA, deltaPsiCutoff=0.01)
+    res_gene_signif <- as.data.table(res_gene_signif)
+    expect_equal(res_gene_signif[type == "jaccard", .N], 1)
+    expect_equal(res_gene_signif[type == "psi5", .N], 4)
+    expect_equal(res_gene_signif[type == "psi3", .N], 2)
+    expect_equal(res_gene_signif[type == "theta", .N], 3)
 
 })