Increase coverage of unit tests.

AEBilgrau · Nov 30, 2018 · 599b620 · 599b620
1 parent 88e1382
commit 599b620
Show file tree

Hide file tree

Showing 3 changed files with 38 additions and 7 deletions.
diff --git a/tests/testthat/test-PseudoEMAlgorithm.R b/tests/testthat/test-PseudoEMAlgorithm.R
@@ -29,3 +29,11 @@ test_that("PseudoEMAlgorithm returns proper format", {
   expect_that(is.matrix(res$kappa), is_true())
   expect_that(dim(res$kappa), equals(c(n, m)))
 })
+
+
+test_that("PseudoEMAlgorithm expected errors & warnigns", {
+  expect_error(GMCM:::PseudoEMAlgorithm(uhat, meta2full(c(0.5, 15, 0.1, 0.8), d = d)))
+  expect_warning(GMCM:::PseudoEMAlgorithm(uhat, meta2full(c(0.5, 2,  0.1, 0.8), d = d),
+                                          max.ite = 2))
+})
+
diff --git a/tests/testthat/test-pgmm.marginal.R b/tests/testthat/test-pgmm.marginal.R
@@ -20,9 +20,17 @@ for (d in seq_len(3) + 1) {
     })
 
     test_that("pgmm.marginal fails when intended", {
-      expect_error(GMCM:::pgmm.marginal(z = sim$z, theta = c(0.5, 1, 1, 0.5)))
-      expect_error(GMCM:::pgmm.marginal(z = sim$z[1, ], theta = rtheta(d = d)))
-      expect_error(GMCM:::pgmm.marginal(z = sim$z, theta = rtheta(d = 1)))
+
+      sim <- SimulateGMMData(n = n,
+                             theta = rtheta(d = d, method = "EqualEllipsoidal"))
+      suppressWarnings({
+        expect_error(GMCM:::pgmm.marginal(z = sim$z, theta = c(0.5, 1, 1, 0.5)),
+                     "theta is formatted incorrectly")
+        expect_error(GMCM:::pgmm.marginal(z = sim$z[1, ], theta = rtheta(d = d)),
+                     "not a matrix")
+        expect_error(GMCM:::pgmm.marginal(z = sim$z, theta = rtheta(d = 1)),
+                     "Number of columns")
+      })
     })
 
 

diff --git a/tests/testthat/test-qgmm.marginal.R b/tests/testthat/test-qgmm.marginal.R
@@ -1,18 +1,33 @@
 context("Check qgmm.marginal")
+set.seed(543485621)
 
 for (d in seq_len(3) + 1) {
   for (n in trunc(seq(50, 50000, length.out = 20))) {
 
     sim <- SimulateGMCMData(n = n, theta = rtheta(d = d))
     dimnames(sim$z) <- list(paste0("f", 1:n), paste0("d", 1:d))
+    theta <- rtheta(d = d)
 
-    ans <- GMCM:::qgmm.marginal(u = sim$u, theta = rtheta(d = d))
+    ans <- GMCM:::qgmm.marginal(u = sim$u, theta = theta)
 
     test_that("qgmm.marginal returns proper format", {
-      expect_that(is.numeric(ans), is_true())
-      expect_that(dim(ans), equals(c(n, d)))
-      expect_that(any(is.na(ans)), is_false())
+      expect_true(is.numeric(ans))
+      expect_equal(dim(ans), c(n, d))
+      expect_false(any(is.na(ans)))
     })
 
+    test_that("qgmm.marginal handling of extrapolation", {
+      u <- sim$u
+      u[1, ] <- rep(1e-50, theta$d)
+      u[2, ] <- rep(1 - 1e-50, theta$d)
+      ans <- GMCM:::qgmm.marginal(u = u, theta = theta, rule = 1)
+      expect_true(is.numeric(ans))
+      expect_equal(dim(ans), c(n, d))
+      expect_false(any(is.na(ans)))
+      expect_equal(ans[1, ], rep(-Inf, d))
+      expect_equal(ans[2, ], rep(Inf, d))
+    })
+
+
   }
 }