update test suite

leeper · Apr 19, 2017 · e763e55 · e763e55
1 parent 2218a4a
commit e763e55
Show file tree

Hide file tree

Showing 4 changed files with 45 additions and 39 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -3,8 +3,8 @@ Type: Package
 Title: Tidy, Type-Safe 'prediction()' Methods
 Description: A one-function package containing 'prediction()', a type-safe alternative to 'predict()' that always returns a data frame. The package currently supports common model types (e.g., "lm", "glm") from the 'stats' package, as well as numerous other model classes from other add-on packages. See the README or main package documentation page for a complete listing.
 License: MIT + file LICENSE
-Version: 0.1.17
-Date: 2017-04-18
+Version: 0.2.0
+Date: 2017-04-19
 Authors@R: c(person("Thomas J.", "Leeper",
                     role = c("aut", "cre"),
                     email = "[email protected]"),

diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,8 @@
+# CHANGES TO prediction 0.2.0
+
+* CRAN Release.
+* Added `mean_or_mode.data.frame()` and `median_or_mode.data.frame()` methods.
+
 # CHANGES TO prediction 0.1.17
 
 * Added `prediction.zeroinfl()` method for "zeroinfl" objects from **pscl**. (#1)

diff --git a/tests/testthat/tests-build_datalist.R b/tests/testthat/tests-build_datalist.R
@@ -7,6 +7,8 @@ test_that("Test build_datalist()", {
     expect_true(length(build_datalist(mtcars, at = list(cyl = c(4, 6), wt = 2:3))) == 4, label = "build_datalist() length")
 
     expect_error(build_datalist(mtcars, at = list(foo = 1)), label = "build_datalist(at = foo) errors")
+    expect_error(build_datalist(mtcars, at = list(1)), label = "build_datalist() unnamed list errors")
+    expect_warning(build_datalist(mtcars, at = list(cyl = 2)), label = "build_datalist() range warning")
 })
 
 test_that("Factors in build_datalist()", {

diff --git a/tests/testthat/tests-methods.R b/tests/testthat/tests-methods.R
@@ -5,7 +5,7 @@ library("datasets")
 
 context("Test `prediction()` methods, conditional on package availability")
 
-if (requireNamespace("AER")) {
+if (require("AER", quietly = TRUE)) {
     test_that("Test prediction() for 'ivreg'", {
         data("CigarettesSW", package = "AER")
         CigarettesSW$rprice <- with(CigarettesSW, price/cpi)
@@ -17,15 +17,15 @@ if (requireNamespace("AER")) {
     })
 }
 
-if (requireNamespace("betareg")) {
+if (require("betareg", quietly = TRUE)) {
     test_that("Test prediction() for 'betareg'", {
         data("GasolineYield", package = "betareg")
         m <- betareg::betareg(yield ~ batch + temp, data = GasolineYield)
         expect_true(inherits(prediction(m), "prediction"))
     })
 }
 
-if (requireNamespace("brglm")) {
+if (require("brglm", quietly = TRUE)) {
     test_that("Test prediction() for 'brglm'", {
         data("lizards", package = "brglm")
         m <- brglm::brglm(cbind(grahami, opalinus) ~ height + diameter +
@@ -35,29 +35,28 @@ if (requireNamespace("brglm")) {
     })
 }
 
-if (requireNamespace("crch")) {
+if (require("crch", quietly = TRUE)) {
     test_that("Test prediction() for 'crch'", {
         e <- new.env()
         data("RainIbk", package = "crch", envir = e)
         RainIbk <- e$RainIbk
         RainIbk$sqrtensmean <- apply(sqrt(RainIbk[,grep('^rainfc',names(RainIbk))]), 1, mean)
-        m <- crch::crch(sqrt(rain) ~ sqrtensmean, data = RainIbk, 
-                        dist = "gaussian", left = 0)
-        expect_true(inherits(prediction(m, data = RainIbk), "prediction"))
-    })
-    test_that("Test prediction() for 'hxlr'", {
-        e <- new.env()
-        data("RainIbk", package = "crch", envir = e)
-        RainIbk <- e$RainIbk
-        RainIbk$sqrtensmean <- 
-          apply(sqrt(RainIbk[,grep('^rainfc',names(RainIbk))]), 1, mean)
-        q <- unique(quantile(RainIbk$rain, seq(0.1, 0.9, 0.1)))
-        m <- crch::hxlr(sqrt(rain) ~ sqrtensmean, data = RainIbk, thresholds = sqrt(q))
+        m <- crch::crch(sqrt(rain) ~ sqrtensmean, data = RainIbk, dist = "gaussian", left = 0)
         expect_true(inherits(prediction(m, data = RainIbk), "prediction"))
     })
+#    test_that("Test prediction() for 'hxlr'", {
+#        e <- new.env()
+#        data("RainIbk", package = "crch", envir = e)
+#        RainIbk <- e$RainIbk
+#        RainIbk$sqrtensmean <- 
+#          apply(sqrt(RainIbk[,grep('^rainfc',names(RainIbk))]), 1, mean)
+#        q <- unique(quantile(RainIbk$rain, seq(0.1, 0.9, 0.1)))
+#        m <- crch::hxlr(sqrt(rain) ~ sqrtensmean, data = RainIbk, thresholds = sqrt(q))
+#        expect_true(inherits(prediction(m, data = RainIbk), "prediction"))
+#    })
 }
 
-if (requireNamespace("e1071")) {
+if (require("e1071", quietly = TRUE)) {
     test_that("Test prediction() for 'naiveBayes'", {
         data("Titanic")
         m <- e1071::naiveBayes(Survived ~ ., data = Titanic)
@@ -69,23 +68,23 @@ if (requireNamespace("e1071")) {
     })
 }
 
-if (requireNamespace("gam")) {
+if (require("gam", quietly = TRUE)) {
     test_that("Test prediction() for 'gam'", {
         data("gam.data", package = "gam")
         m <- gam::gam(y ~ gam::s(x,6) + z,data=gam.data)
         expect_true(inherits(prediction(m), "prediction"))
     })
 }
 
-if (requireNamespace("gee")) {
+if (require("gee", quietly = TRUE)) {
     test_that("Test prediction() for 'gee'", {
         data("warpbreaks")
         m <- gee::gee(breaks ~ tension, id=wool, data=warpbreaks, corstr="exchangeable")
         expect_true(inherits(prediction(m), "prediction"))
     })
 }
 
-if (requireNamespace("glmx") ) {
+if (require("glmx", quietly = TRUE) ) {
     test_that("Test prediction() for 'glmx()'", {
         d <- data.frame(x = runif(200, -1, 1))
         d$y <- rnbinom(200, mu = exp(0 + 3 * d$x), size = 1)
@@ -102,15 +101,15 @@ if (requireNamespace("glmx") ) {
     })
 }
 
-if (requireNamespace("lme4")) {
+if (require("lme4", quietly = TRUE)) {
     test_that("Test prediction() for 'merMod'", {
         data("cbpp", package = "lme4")
         m <- lme4::glmer(cbind(incidence, size - incidence) ~ period + (1 |herd), cbpp, binomial)
         expect_true(inherits(prediction(m), "prediction"))
     })
 }
 
-if (requireNamespace("MASS")) {
+if (require("MASS", quietly = TRUE)) {
     test_that("Test prediction() for 'glm.nb'", {
         data("quine", package = "MASS")
         m <- MASS::glm.nb(Days ~ Sex/(Age + Eth*Lrn), data = quine)
@@ -154,31 +153,31 @@ if (requireNamespace("MASS")) {
     })
 }
 
-if (requireNamespace("mclogit")) {
+if (require("mclogit", quietly = TRUE)) {
     test_that("Test prediction() for 'mclogit'", {
         data("Transport", package = "mclogit")
         m <- mclogit::mclogit(cbind(resp,suburb)~distance+cost, data = Transport, trace = FALSE)
         expect_true(inherits(prediction(m), "prediction"))
     })
 }
 
-if (requireNamespace("mnlogit")) {
+if (require("mnlogit", quietly = TRUE)) {
     test_that("Test prediction() for 'mnlogit'", {
         data("Fish", package = "mnlogit")
         m <- mnlogit::mnlogit(mode ~ price | income | catch, Fish, ncores = 1)
         expect_true(inherits(prediction(m), "prediction"))
     })
 }
 
-if (requireNamespace("MNP")) {
+if (require("MNP", quietly = TRUE)) {
     test_that("Test prediction() for 'mnp'", {
         data("japan", package = "MNP")
         m <- MNP::mnp(cbind(LDP, NFP, SKG, JCP) ~ gender + education + age, data = head(japan, 100), verbose = FALSE)
         expect_true(inherits(prediction(m), "prediction"))
     })
 }
 
-if (requireNamespace("nlme")) {
+if (require("nlme", quietly = TRUE)) {
     test_that("Test prediction() for 'gls'", {
         data("Ovary", package = "nlme")
         m <- nlme::gls(follicles ~ sin(2*pi*Time) + cos(2*pi*Time), Ovary,
@@ -192,7 +191,7 @@ if (requireNamespace("nlme")) {
     })
 }
 
-if (requireNamespace("nnet")) {
+if (require("nnet", quietly = TRUE)) {
     #test_that("Test prediction() for 'multinom'", { })
     test_that("Test prediction() for 'nnet'", {
         data("iris3", package = "datasets")
@@ -205,23 +204,23 @@ if (requireNamespace("nnet")) {
     })
 }
 
-if (requireNamespace("ordinal")) {
+if (require("ordinal", quietly = TRUE)) {
     test_that("Test prediction() for 'clm'", {
         data("wine", package = "ordinal")
         m <- ordinal::clm(rating ~ temp * contact, data = wine)
         expect_true(inherits(prediction(m), "prediction"))
     })
 }
 
-if (requireNamespace("plm")) {
+if (require("plm", quietly = TRUE)) {
     test_that("Test prediction() for 'plm'", {
         data("Grunfeld", package = "plm")
         m <- plm::plm(inv ~ value + capital, data = Grunfeld, model = "pooling")
         expect_true(inherits(prediction(m), "prediction"))
     })
 }
 
-if (requireNamespace("pscl")) {
+if (require("pscl", quietly = TRUE)) {
     test_that("Test prediction() for 'hurdle'", {
         data("bioChemists", package = "pscl")
         m <- pscl::hurdle(art ~ ., data = bioChemists)
@@ -237,11 +236,11 @@ if (requireNamespace("pscl")) {
     #})
 }
 
-if (requireNamespace("quantreg")) {
-    #test_that("Test prediction() for 'rq'", {})
-}
+#if (require("quantreg", quietly = TRUE)) {
+#    test_that("Test prediction() for 'rq'", {})
+#}
 
-if (requireNamespace("sampleSelection")) {
+if (require("sampleSelection", quietly = TRUE)) {
     test_that("Test prediction() for 'selection'", {
         data("Mroz87", package = "sampleSelection")
         Mroz87$kids  <- (Mroz87$kids5 + Mroz87$kids618 > 0)
@@ -251,7 +250,7 @@ if (requireNamespace("sampleSelection")) {
     })
 }
 
-if (requireNamespace("stats")) {
+if (require("stats", quietly = TRUE)) {
     test_that("Test prediction() for 'ar'", {
         data("sunspot.year", package = "datasets")
         m <- stats::ar(sunspot.year)
@@ -287,7 +286,7 @@ if (requireNamespace("stats")) {
     })
 }
 
-if (requireNamespace("survey")) {
+if (require("survey", quietly = TRUE)) {
     test_that("Test prediction() for 'svyglm'", {
         data("api", package = "survey")
         dstrat <- survey::svydesign(id=~1,strata=~stype, weights=~pw, data=apistrat, fpc=~fpc)
@@ -296,7 +295,7 @@ if (requireNamespace("survey")) {
     })
 }
 
-if (requireNamespace("survival")) {
+if (require("survival", quietly = TRUE)) {
     test_that("Test prediction() for 'coxph'", {
         test1 <- list(time=c(4,3,1,1,2,2,3), 
               status=c(1,1,1,0,1,1,0),