introduce testthat framework

DESCRIPTION

@@ -45,3 +45,4 @@ Collate:
     'tSNE_project.R'
     'zfRenderSeurat.R'
 RoxygenNote: 5.0.1
+Suggests: testthat

R/seurat.R

@@ -288,8 +288,8 @@ setMethod("setup","seurat",
             genes.use=rownames(object@data)
             if (min.cells>0) {
               if (!large.object) num.cells=apply(object@data,1,humpCt,min=object@is.expr)
-              if (large.object) num.cells=colSums(t.data)
-              genes.use=names(num.cells[which(num.cells>min.cells)])
+              if (large.object) num.cells=colSums(t.data > is.expr)
+              genes.use=names(num.cells[which(num.cells>=min.cells)])
               object@data=object@data[genes.use,]
               t.data=t.data[,genes.use]
             }

tests/testthat.R

@@ -0,0 +1,4 @@
+library(testthat)
+library(Seurat)
+
+test_check("Seurat")

tests/testthat/test_clique.R

@@ -0,0 +1,94 @@
+# Unit testing for functions in clique.cpp
+
+# --------------------------------------------------------------------------------
+
+context("SNN-clique Rcpp testing")
+# Tests for removeRedundantClique(IntegerVector x, IntegerVector y)
+# --------------------------------------------------------------------------------
+test_that("removeRedundantClique works correctly",{
+  x1 <- c(2, 4)
+  x2 <- c(1, 2, 3, 4)
+
+  expect_that(removeRedundantClique(x1,x2), is_a("logical"))
+  expect_that(removeRedundantClique(x1,x2), is_true())
+  expect_that(removeRedundantClique(c(5),x2), is_false())
+  expect_that(removeRedundantClique(x1,x2), is_true())
+})
+
+# Tests for sizeCliqueIntersection(IntegerVector x, IntegerVector y)
+# --------------------------------------------------------------------------------
+test_that("sizeCliqueIntersection works correctly",{
+  x1 <- c(1, 2, 3)
+  x2 <- c(1, 4, 5)
+
+  expect_that(sizeCliqueIntersection(x1,x1), is_a("integer"))
+  expect_that(sizeCliqueIntersection(x1,x1), equals(length(x1)))
+  expect_that(sizeCliqueIntersection(x1,x2), equals(1))
+  expect_that(sizeCliqueIntersection(x1,c(0)), equals(0))
+})
+
+# Tests for IntegerVector removeNode(IntegerVector x, int y)
+# --------------------------------------------------------------------------------
+test_that("removeNode works correctly",{
+  # remember that C++ indexes from 0
+  x <- c(1, 2, 3)
+  y <- 2
+
+  expect_that(removeNode(x,y), is_a("integer"))
+  expect_that(length(removeNode(x,y)), equals(length(x) - 1))
+  expect_that(removeNode(x,y), equals(c(1, 2)))
+})
+
+# Tests for whichNotZero(NumericVector X)
+# --------------------------------------------------------------------------------
+test_that("whichNotZero works correctly",{
+  v1 <- c(0, 1, 0, 1)
+  non_zero <- c(1, 3) # c++ indexes from 0
+  v2 <- c(0, 0, 0)
+
+  expect_that(whichNotZero(v1), is_a("integer"))
+  expect_that(whichNotZero(v1), equals(non_zero))
+  expect_that(whichNotZero(v1), equals(c(1, 3)))
+  expect_that(length(whichNotZero(v2)), equals(0))
+})
+
+# Tests for subsetMatrix(NumericMatrix m, NumericVector rows, Numeric vector cols)
+# --------------------------------------------------------------------------------
+test_that("subsetMatrix works correctly",{
+  m <- matrix(1:16, 4, 4)
+
+  expect_that(subsetMatrix(m, c(1, 2), c(1, 2)), is_a("matrix"))
+  expect_that(subsetMatrix(m, c(0:3), c(0:3)), equals(m))
+  expect_that(subsetMatrix(m, c(0, 1), c(0, 1)), equals(matrix(c(1, 2, 5, 6), 2, 2)))
+  expect_that(subsetMatrix(m, c(0), c(0, 1)), equals(matrix(c(1, 5), 1, 2)))
+  expect_that(subsetMatrix(m, c(0, 1), c(0)), equals(matrix(c(1, 2), 2, 1)))
+  expect_that(subsetMatrix(m, c(0, 1), c(2, 3)), equals(matrix(c(9, 10, 13, 14), 2, 2)))
+})
+
+# Tests for NumericMatrix setRow(NumericMatrix m, int r, int n)
+# --------------------------------------------------------------------------------
+test_that("setRow works correctly",{
+  m <- matrix(1:16, 4, 4)
+  m2 <- matrix(1:16, 4, 4)
+  m2[1, ] <- 0
+  m3 <- matrix(1:16, 4, 4)
+  m3[2, ] <- 1
+
+  expect_that(setRow(m, 0, 0), is_a("matrix"))
+  expect_that(setRow(m, 0, 0), equals(m2))
+  expect_that(setRow(m, 1, 1), equals(m3))
+})
+
+# Tests for NumericMatrix setCol(NumericMatrix m, int c, int n)
+# --------------------------------------------------------------------------------
+test_that("setCol works correctly",{
+  m <- matrix(1:16, 4, 4)
+  m2 <- matrix(1:16, 4, 4)
+  m2[ ,1] <- 0
+  m3 <- matrix(1:16, 4, 4)
+  m3[ ,2] <- 1
+
+  expect_that(setCol(m, 0, 0), is_a("matrix"))
+  expect_that(setCol(m, 0, 0), equals(m2))
+  expect_that(setCol(m, 1, 1), equals(m3))
+})

tests/testthat/test_seurat_object.R

@@ -0,0 +1,71 @@
+# Tests for functions dependent on a seurat object
+
+# load a minimal example data set (subset of nbt dataset)
+load("../testdata/nbt_small.Rdata")
+
+
+# Tests for object creation (via setup)
+# --------------------------------------------------------------------------------
+context("Object creation")
+
+# Generate Seurat object
+min_cells <- 3
+project_name <- "NBT_TEST"
+names_field <- 2
+names_delim <- "_"
+min_genes <- 1000
+expression_thresh <- 1
+
+nbt_test <- new("seurat", raw.data = nbt_small)
+
+test_that("object initialization creates seurat object", {
+  expect_is(nbt_test, "seurat")
+})
+
+nbt_test <- setup(nbt_test, project = project_name, min.cells = min_cells, names.field = names_field,  
+                  names.delim = names_delim, min.genes = min_genes, is.expr = expression_thresh, 
+                  large.object = T ) 
+
+test_that("entered parameters set correctly", {
+  expect_match(project_name, nbt_test@project.name)
+  expect_equal(expression_thresh, nbt_test@is.expr)
+
+
+})
+
+test_that("correct cells are used",{
+  gene_count <- unname(findNGene(nbt_test@raw.data, nbt_test@is.expr))
+  expect_equal(min(gene_count), 2814)
+  expect_true(all(gene_count >= min_genes))
+})
+
+test_that("correct genes are used", {
+  usuable_genes <- rowSums(nbt_test@raw.data > expression_thresh)
+  usuable_genes <- usuable_genes[usuable_genes >= min_cells]
+  used_genes <- rownames(nbt_test@data)
+
+  expect_true(length(usuable_genes) > 0)
+  expect_equal(length(usuable_genes), length(used_genes))
+})
+
+test_that("names and IDs set correctly", {
+  expect_true(length(colnames(nbt_test@raw.data)) > 0)
+  expect_equal(nbt_test@cell.names, colnames(nbt_test@raw.data))
+
+  expected_cluster_ids = c("GW21.2", "GW16", "GW21")
+  expect_equal(as.vector(unique(nbt_test@ident)), expected_cluster_ids)
+  expect_equal(as.vector(unique(nbt_test@ident)), as.vector(unique(nbt_test@data.info$orig.ident)))
+
+})
+
+test_that("scaling done correctly", {
+  expect_equal(nbt_test@scale.data["AAAS", "Hi_GW21.2_3"], 3.28266251317083)
+  expect_equal(nbt_test@scale.data["ZYX", "Hi_GW16_1"], -0.380777117739444)
+})
+
+test_that("nGene calculations are consistent" , {
+  gene_count <- unname(findNGene(nbt_test@raw.data, nbt_test@is.expr))
+  expect_equal(nbt_test@mix.probs[, 1], gene_count)
+  expect_equal(nbt_test@gene.scores[, 1], gene_count)
+
+})