add tests

dfrankow · Aug 5, 2018 · f8f348a · f8f348a
1 parent 0168c9e
commit f8f348a
Showing 1 changed file with 50 additions and 7 deletions.
diff --git a/tests/testthat/tests-core.R b/tests/testthat/tests-core.R
@@ -18,6 +18,7 @@ test_that("Test prediction()", {
     expect_true(all.equal(prediction(mod2, data = mtcars)$fitted, predict(mod2, type = "response"), check.attributes = FALSE),
                 label = "prediction() matches predict() (GLM)")
 })
+
 test_that("Test prediction(at = )", {
     m <- lm(mpg ~ cyl, data = mtcars)
     p1 <- prediction(m, at = list(cyl = 4))
@@ -49,17 +50,59 @@ test_that("Test print()", {
     expect_true(inherits(print(prediction(lm(mpg ~ cyl, data = mtcars), data = mtcars, at = list(cyl = c(4,6,8)))), "data.frame"), 
                 label = "print() works with numeric outcome and at()")
 })
-test_that("Test summary()", {
-    expect_true(inherits(summary(prediction(lm(mpg ~ cyl, data = mtcars), data = mtcars)), "data.frame"), 
+
+test_that("Test summary() w/o at()", {
+    m1 <- lm(mpg ~ cyl, data = mtcars)
+
+    # prediction w/o at()
+    p1 <- prediction(m1)
+    s1 <- summary(p1)
+    expect_true(inherits(summary(p1), "data.frame"), 
                 label = "summary() works with numeric outcome")
-    expect_true(inherits(summary(prediction(lm(mpg ~ cyl, data = mtcars), data = mtcars, at = list(cyl = c(4,6,8)))), "data.frame"), 
+    expect_true(all(c("Prediction", "SE", "z", "p", "lower", "upper") %in% names(s1)),
+                label = "summary() has correct columns w/o at()")
+    expect_true(nrow(s1) == 1L, label = "summary() has correct rows w/o at()")
+
+    ## numerical correctness
+    expect_true(all.equal(s1[["Prediction"]][1L], mean(predict(m1)), tolerance = tol),
+                label = "summary() returns numerically correct mean prediction")
+    test_se <- sqrt(colMeans(cbind(1, mtcars$cyl)) %*% vcov(m1) %*% colMeans(cbind(1, mtcars$cyl)))[1,1,drop=TRUE]
+    expect_true(all.equal(s1[["SE"]][1L], test_se, tolerance = tol),
+                label = "summary() returns numerically correct SE of mean prediction")
+})
+
+test_that("Test summary() w at()", {
+    # prediction w/ at()
+    m1 <- lm(mpg ~ cyl, data = mtcars)
+    p2 <- prediction(m1, data = mtcars, at = list(cyl = c(4,6,8)))
+    s2 <- summary(p2)
+    expect_true(inherits(s2, "data.frame"),
                 label = "summary() works with numeric outcome and at()")
+    expect_true(all(c("at(cyl)", "Prediction", "SE", "z", "p", "lower", "upper") %in% names(s2)),
+                label = "summary() has correct columns with at()")
+    expect_true(nrow(s2) == 3L, label = "summary() has correct rows w/o at()")
+
+    ## numerical correctness
+    expect_true(all.equal(s2[["Prediction"]][1L], mean(predict(m1, newdata = within(mtcars, cyl <- 4))), tolerance = tol),
+                label = "summary() returns numerically correct mean prediction with at()")
+    test_se <- sqrt(colMeans(cbind(1, 4)) %*% vcov(m1) %*% colMeans(cbind(1, 4)))[1,1,drop=TRUE]
+    expect_true(all.equal(s2[["SE"]][1L], test_se, tolerance = tol),
+                label = "summary() returns numerically correct SE of mean prediction with at()")
 })
+
+test_that("Test prediction_summary()", {
+    m1 <- lm(mpg ~ cyl, data = mtcars), data = mtcars)
+    p1 <- prediction(m1)
+    s1 <- summary(p1)
+    expect_true(identical(s1, prediction_summary(m1)), label = "prediction_summary() is correct")
+})
+
 test_that("Test head() and tail()", {
-    expect_true(inherits(head(prediction(lm(mpg ~ cyl, data = mtcars), data = mtcars)), "data.frame"), 
-                label = "head() works")
-    expect_true(inherits(tail(prediction(lm(mpg ~ cyl, data = mtcars), data = mtcars)), "data.frame"), 
-                label = "tail() works")
+    p1 <- prediction(lm(mpg ~ cyl, data = mtcars), data = mtcars)
+    expect_true(inherits(head(p1), "data.frame"), label = "head() works")
+    expect_true(nrow(head(p1, 5L)) == 5L, label = "head() has correct rows")
+    expect_true(inherits(tail(p1), "data.frame"), label = "tail() works")
+    expect_true(nrow(tail(p1, 5L)) == 5L, label = "tail() has correct rows")
 })
 
 context("Test utilities")