Add test-params

Fix some bugs along the way

R/params.R

@@ -260,6 +260,8 @@ getParams <- function(params, names) {
 
     if (!keep.list) {
         output <- unlist(output)
+    } else if (length(output) == 1) {
+        output <- output[[1]]
     }
 
     return(output)
@@ -314,12 +316,12 @@ checkParams <- function(params) {
 
     # Define which parameters are allowed to be vectors
     vectors <- c("groupCells", "path.from", "path.length", "path.skew")
-    n.groups <- length(params$groupCells)
+    n.groups <- length(getParams(params, "groupCells"))
 
     for (idx in seq_along(types)) {
         name <- names(types)[idx]
         type <- types[idx]
-        value <- getParams(name)
+        value <- getParams(params, name)
 
         # Check vector properties first so we can exclude vectors with an NA
         # before the next section
@@ -336,7 +338,7 @@ checkParams <- function(params) {
             }
         }
 
-        # Missing values are allowed so we skip anything that is not NA
+        # Missing values are allowed so we skip anything that is NA
         if (!all(is.na(value))) {
 
             if (type %in% c("NUM", "INT", "POS", "PROB") &&
@@ -390,7 +392,7 @@ mergeParams <- function(params1, params2) {
         }
     }
 
-    checkParams()
+    checkParams(params1)
 
     return(params1)
 }
@@ -420,7 +422,5 @@ defaultParams <- function() {
                         path.skew = 0.5, path.nonlinearProb = 0.1,
                         path.sigmaFac = 0.8)
 
-    checkParams()
-
     return(params)
 }
\ No newline at end of file

tests/testthat/test-params.R

+library(splatter)
+context("splatParams object")
+
+test_that("checkParams checks class", {
+    expect_error(checkParams("a"),
+                 "params does not belong to the splatParams class")
+    expect_error(checkParams(1),
+                 "params does not belong to the splatParams class")
+    expect_error(checkParams(list()),
+                 "params does not belong to the splatParams class")
+})
+
+test_that("checkParams checks numeric", {
+    params <- splatParams()
+    params$nGenes <- "A"
+    expect_error(checkParams(params), "nGenes must be numeric")
+    params$nGenes <- TRUE
+    expect_error(checkParams(params), "nGenes must be numeric")
+    params$nGenes <- 100
+    expect_silent(checkParams(params))
+})
+
+test_that("checkParams checks integer", {
+    params <- splatParams()
+    params$nGenes <- 1.5
+    expect_error(checkParams(params), "nGenes must be an integer")
+    params$nGenes <- NA
+    params$path$length <- 1.5
+    expect_error(checkParams(params), "path.length must be an integer")
+    params$path$length <- NA
+    params$nGenes <- 100
+    expect_silent(checkParams(params))
+})
+
+test_that("checkParams checks positive", {
+    params <- splatParams()
+    params$nGenes <- -1
+    expect_error(checkParams(params), "nGenes must be positive")
+    params$nGenes <- NA
+    params$mean$rate <- -1
+    expect_error(checkParams(params), "mean.rate must be positive")
+    params$mean$rate <- 1
+    expect_silent(checkParams(params))
+})
+
+test_that("checkParams checks prob", {
+    params <- splatParams()
+    params$out$prob <- 1.2
+    expect_error(checkParams(params), "out.prob must be in the range 0-1")
+    params$out$prob <- 0.5
+    expect_silent(checkParams(params))
+})
+
+test_that("checkParams checks logical", {
+    params <- splatParams()
+    params$dropout$present <- "A"
+    #expect_error(checkParams(params),
+    #             "dropout.present must be logical (TRUE/FALSE)")
+    params$dropout$present <- TRUE
+    expect_silent(checkParams(params))
+    params$dropout$present <- FALSE
+    expect_silent(checkParams(params))
+})
+
+test_that("checkParams checks vectors allowed", {
+    params <- splatParams()
+    params$nGenes <- c(1, 2)
+    expect_error(checkParams(params), "nGenes should be a single value")
+    params$nGenes <- NA
+    params$groupCells <- c(100, 200)
+})
+
+test_that("checkParams checks vector length", {
+    params <- splatParams()
+    params$groupCells <- c(100, 200)
+    params$path$length <- 100
+    expect_silent(checkParams(params))
+    params$path$length <- c(100, 200, 300)
+    expect_error(checkParams(params),
+                 paste("length of path.length must be 1 or the length of the",
+                       "groupCells parameter"))
+    params$path$length <- c(100, 200)
+    expect_silent(checkParams(params))
+    params$groupCells <- NA
+    expect_error(checkParams(params),
+                 paste("length of path.length must be 1 or the length of the",
+                       "groupCells parameter"))
+})
+
+test_that("checkParams checks vector is not NA", {
+    params <- splatParams()
+    params$groupCells <- c(100, 200)
+    expect_silent(checkParams(params))
+    params$groupCells <- c(100, NA)
+    expect_error(checkParams(params),
+                 "groupCells is a vector and contains NA values")
+})
+
+test_that("setParams sets correctly", {
+    params <- splatParams()
+    params <- setParams(params, nGenes = 100)
+    expect_equal(params$nGenes, 100)
+    params <- setParams(params, mean.rate = 0.5)
+    expect_equal(params$mean$rate, 0.5)
+    params <- setParams(params, groupCells = c(100, 200))
+    expect_equal(params$groupCells, c(100, 200))
+    params <- setParams(params, dropout.present = TRUE)
+    expect_equal(params$dropout$present, TRUE)
+})
+
+test_that("getParams gets correctly", {
+    params <- defaultParams()
+    expect_equal(getParams(params, "nGenes"), c(nGenes = 10000))
+    expect_equal(getParams(params, "mean.rate"), c(mean.rate = 0.3))
+    expect_equal(getParams(params, c("nGenes", "mean.rate")),
+                 c(nGenes = 10000, mean.rate = 0.3))
+    params <- setParams(params, groupCells = c(100, 200))
+    expect_equal(getParams(params, "groupCells"), c(100, 200))
+    expect_equal(getParams(params, c("nGenes", "mean.rate", "groupCells")),
+                 list(nGenes = 10000, mean.rate = 0.3,
+                      groupCells = c(100, 200)))
+})
+
+test_that("mergeParams merges correctly", {
+    params1 <- splatParams(nGenes = 100, mean.rate = 0.5,
+                           groupCells = c(100, 200))
+    params2 <- defaultParams()
+    params <- mergeParams(params1, params2)
+    expect_equal(params$nGenes, params1$nGenes)
+    expect_equal(params$mean$rate, params1$mean$rate)
+    expect_equal(params$groupCells, params1$groupCells)
+    expect_equal(params$nCells, params2$nCells)
+    expect_equal(params$dropout$present, params2$dropout$present)
+})
+
+test_that("constructor is valid", {
+    expect_silent(checkParams(splatParams()))
+})
+
+test_that("defaultParams is valid", {
+    expect_silent(checkParams(defaultParams()))
+})
\ No newline at end of file