tests/testthat/tests-methods.R

In leeper/prediction: Tidy, Type-Safe 'prediction()' Methods

# test all prediction() methods, conditional on availability of package
# this file is organized alphabetically by package name

library("datasets")

context("Test `prediction()` methods, conditional on package availability")

if (require("AER", quietly = TRUE)) {
    test_that("Test prediction() for 'ivreg'", {
        data("CigarettesSW", package = "AER")
        CigarettesSW$rprice <- with(CigarettesSW, price/cpi)
        CigarettesSW$rincome <- with(CigarettesSW, income/population/cpi)
        CigarettesSW$tdiff <- with(CigarettesSW, (taxs - tax)/cpi)
        m <- AER::ivreg(log(packs) ~ log(rprice) + log(rincome) | log(rincome) + tdiff + I(tax/cpi),
                        data = CigarettesSW, subset = year == "1995")
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'tobit'", {
        data("Affairs", package = "AER")
        m <- tobit(affairs ~ age + yearsmarried + religiousness + occupation + rating, data = Affairs)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("aod", quietly = TRUE)) {
    test_that("Test prediction() for 'glimML'", {
        data("orob2", package = "aod")
        m <- aod::betabin(cbind(y, n - y) ~ seed, ~ 1, data = orob2)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'glimQL'", {
        data("orob2", package = "aod")
        m <- aod::quasibin(cbind(y, n - y) ~ seed * root, data = orob2, phi = 0)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("betareg", quietly = TRUE)) {
    test_that("Test prediction() for 'betareg'", {
        data("GasolineYield", package = "betareg")
        m <- betareg::betareg(yield ~ batch + temp, data = GasolineYield)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("biglm", quietly = TRUE)) {
    test_that("Test prediction() for 'biglm'", {
        data("trees", package = "datasets")
        m <- biglm::biglm(log(Volume) ~ log(Girth) + log(Height), data=trees)
        p <- prediction(m, calculate_se = FALSE) # temporary, while bug fixed upstream
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    #test_that("Test prediction() for 'bigglm'", {
    #    data("trees", package = "datasets")
    #    m <- biglm::bigglm(log(Volume) ~ log(Girth) + log(Height), data=trees, chunksize=10)
    #    p <- prediction(m, calculate_se = FALSE) # temporary, while bug fixed upstream
    #    expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
    #    expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    #})
}

if (require("brglm", quietly = TRUE)) {
    test_that("Test prediction() for 'brglm'", {
        data("lizards", package = "brglm")
        m <- brglm::brglm(cbind(grahami, opalinus) ~ height + diameter +
                          light + time, family = binomial(logit), data=lizards,
                          method = "brglm.fit")
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("caret", quietly = TRUE)) {
    test_that("Test prediction() for 'knnreg'", {
        data("BloodBrain", package = "caret")
        inTrain <- createDataPartition(logBBB, p = .8)[[1]]
        trainX <- bbbDescr[inTrain,]
        trainY <- logBBB[inTrain]
        testX <- bbbDescr[-inTrain,]
        m <- knnreg(trainX, trainY, k = 3)
        p <- prediction(m, data = testX)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'train'", {
        data("iris", package = "datasets")
        m <- train(Sepal.Length ~ ., data = iris, method = "lm")
        p <- prediction(m, data = iris)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

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)
        p <- prediction(m, data = RainIbk)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'hxlr'", {
        data("RainIbk", package = "crch")
        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 (require("e1071", quietly = TRUE)) {
    test_that("Test prediction() for 'naiveBayes'", {
        data("Titanic")
        m <- e1071::naiveBayes(Survived ~ ., data = Titanic)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'svm'", {
        m <- e1071::svm(Species ~ ., data = iris)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("earth", quietly = TRUE)) {
    test_that("Test prediction() for 'earth'", {
        data("trees", package = "datasets")
        m <- earth::earth(Volume ~ ., data = trees)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("ffbase", quietly = TRUE)) {
    test_that("Test prediction() for 'biglm' w/ 'ffbase' backend", {
        stopifnot(require("ff"))
        stopifnot(require("biglm"))
        data("trees", package = "datasets")
        x <- ff::as.ffdf(trees)
        m <- biglm::biglm(log(Volume)~log(Girth)+log(Height), data=x)
        p <- prediction(m, calculate_se = FALSE) # temporary, while bug fixed upstream
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

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)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("gee", quietly = TRUE)) {
    test_that("Test prediction() for 'gee'", {
        data("warpbreaks")
        m <- gee::gee(breaks ~ tension, id=wool, data=warpbreaks, corstr="exchangeable")
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("glmnet", quietly = TRUE)) {
    test_that("Test prediction() for 'glmnet'", {
        x <- matrix(rnorm(100*20),100,20)
        y <- rnorm(100)
        m <- glmnet::glmnet(x,y)
        p <- prediction(m, data = x)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

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)
        m <- glmx::glmx(y ~ x, data = d, family = MASS::negative.binomial, xlink = "log", xstart = 0)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'hetglm()'", {
        n <- 200
        x <- rnorm(n)
        ystar <- 1 + x +  rnorm(n, sd = exp(x))
        y  <- factor(ystar > 0)
        m <- glmx::hetglm(y ~ x | 1)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("kernlab", quietly = TRUE)) {
    require("methods", quietly = TRUE)
    test_that("Test prediction() for 'gausspr'", {
        data("promotergene", package = "kernlab")
        ind <- sample(1:dim(promotergene)[1],20)
        genetrain <- promotergene[-ind, ]
        genetest <- promotergene[ind, ]
        m <- kernlab::gausspr(Class~., data = genetrain, kernel = "rbfdot",
                              kpar = list(sigma = 0.015))
        p <- prediction(m, data = genetrain)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'kqr'", {
        x <- sort(runif(300))
        y <- sin(pi*x) + rnorm(300,0,sd=exp(sin(2*pi*x)))
        m <- kernlab::kqr(x, y, tau = 0.5, C=0.15, kpar = list(sigma = 10))
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'ksvm'", {
        data("promotergene", package = "kernlab")
        ind <- sample(1:dim(promotergene)[1],20)
        genetrain <- promotergene[-ind, ]
        genetest <- promotergene[ind, ]
        m <- kernlab::ksvm(Class~., data = genetrain, kernel = "rbfdot",
                           kpar = list(sigma = 0.015), C = 70, cross = 4, prob.model = TRUE)
        p <- prediction(m, data = genetrain)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

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)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

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)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'lda'", {
        data("iris3", package = "datasets")
        tr <- sample(1:50, 25)
        train <- rbind(iris3[tr,,1], iris3[tr,,2], iris3[tr,,3])
        cl <- factor(c(rep("s",25), rep("c",25), rep("v",25)))
        m <- MASS::lda(train, cl)
        p <- prediction(m, data = train)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'lqs'", {
        data("stackloss", package = "datasets")
        m <- MASS::lqs(stack.loss ~ ., data = stackloss, method = "S", nsamp = "exact")
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'mca'", {
        data("farms", package = "MASS")
        m <- MASS::mca(farms, abbrev=TRUE)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'polr'", {
        data("housing", package = "MASS")
        m <- MASS::polr(Sat ~ Infl + Type + Cont, weights = Freq, data = housing)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'qda'", {
        data("iris3", package = "datasets")
        tr <- sample(1:50, 25)
        train <- rbind(iris3[tr,,1], iris3[tr,,2], iris3[tr,,3])
        cl <- factor(c(rep("s",25), rep("c",25), rep("v",25)))
        m <- MASS::qda(train, cl)
        p <- prediction(m, data = train)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'rlm'", {
        data("stackloss", package = "datasets")
        m <- MASS::rlm(stack.loss ~ ., stackloss)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

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)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("mda", quietly = TRUE)) {
    test_that("Test prediction() for 'bruto'", {
        data("trees", package = "datasets")
        m <- bruto(trees[,-3], trees[3])
        p <- prediction(m, data = NULL)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'fda'", {
        data("iris", package = "datasets")
        m <- fda(Species ~ ., data = iris)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted", "fitted.class") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'mars'", {
        data("trees", package = "datasets")
        m <- mars(trees[,-3], trees[3])
        p <- prediction(m, data = NULL)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'mda'", {
        data("glass", package = "mda")
        m <- mda(Type ~ ., data = glass)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'polyreg'", {
        data("iris", package = "datasets")
        m <- polyreg(iris[,2:3], iris$Sepal.Length)
        p <- prediction(m, data = NULL)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

#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)
#        p <- prediction(m)
#        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
#        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
#    })
#}

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)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

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,
                         correlation = nlme::corAR1(form = ~ 1 | Mare), verbose = FALSE)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'lme'", {
        data("Orthodont", package = "nlme")
        m <- nlme::lme(distance ~ age, Orthodont, random = ~ age | Subject)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("nnet", quietly = TRUE)) {
    #test_that("Test prediction() for 'multinom'", { })
    test_that("Test prediction() for 'nnet'", {
        data("iris3", package = "datasets")
        ird <- data.frame(rbind(iris3[,,1], iris3[,,2], iris3[,,3]),
                          species = factor(c(rep("s",50), rep("c", 50), rep("v", 50))))
        samp <- c(sample(1:50,25), sample(51:100,25), sample(101:150,25))
        m <- nnet::nnet(species ~ ., data = ird, subset = samp, size = 2, rang = 0.1,
                        decay = 5e-4, maxit = 200, trace = FALSE)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("ordinal", quietly = TRUE)) {
    test_that("Test prediction() for 'clm'", {
        data("wine", package = "ordinal")
        m <- ordinal::clm(rating ~ temp * contact, data = wine)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

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")
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("pscl", quietly = TRUE)) {
    test_that("Test prediction() for 'hurdle'", {
        data("bioChemists", package = "pscl")
        m <- pscl::hurdle(art ~ ., data = bioChemists)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'zeroinfl'", {
        data("bioChemists", package = "pscl")
        m <- pscl::zeroinfl(art ~ ., data = bioChemists)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    #test_that("Test prediction() for 'ideal'", {
    #    expect_true(inherits(prediction(m), "prediction"))
    #})
}

if (require("quantreg", quietly = TRUE)) {
    test_that("Test prediction() for 'rq'", {
        data("stackloss", package = "datasets")
        m <- quantreg::rq(stack.loss ~ stack.x, tau = .5, data = stackloss)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("rpart", quietly = TRUE)) {
    test_that("Test prediction() for 'rpart'", {
        data("kyphosis", package = "rpart")
        m <- rpart::rpart(Kyphosis ~ Age + Number + Start, data = kyphosis)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("sampleSelection", quietly = TRUE)) {
    test_that("Test prediction() for 'selection'", {
        data("Mroz87", package = "sampleSelection")
        Mroz87$kids  <- (Mroz87$kids5 + Mroz87$kids618 > 0)
        m <- sampleSelection::heckit(lfp ~ age + I( age^2 ) + faminc + kids + educ, 
                                     wage ~ exper + I( exper^2 ) + educ + city, Mroz87)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("speedglm", quietly = TRUE) ) {
    test_that("Test prediction() for 'speedglm()'", {
        n <- 1000
        k <- 3
        y <- rnorm(n)
        x <- round(matrix(rnorm(n * k), n, k), digits = 3)
        colnames(x) <- c("s1", "s2", "s3")
        da <- data.frame(y, x)
        m <- speedglm(y ~ s1 + s2 + s3, data = da)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'speedlm()'", {
        n <- 1000
        k <- 3
        y <- rnorm(n)
        x <- round(matrix(rnorm(n * k), n, k), digits = 3)
        colnames(x) <- c("s1", "s2", "s3")
        da <- data.frame(y, x)
        m <- speedlm(y ~ s1 + s2 + s3, data = da)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("stats", quietly = TRUE)) {
    test_that("Test prediction() for 'ar'", {
        data("sunspot.year", package = "datasets")
        m <- stats::ar(sunspot.year)
        p <- prediction(m, data = sunspot.year)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'Arima'", {
        expect_true(inherits(prediction(stats::arima(lh, order = c(3,0,0)), n.ahead = 12), "prediction"))
    })
    test_that("Test prediction() for 'arima0'", {
        m <- stats::arima0(lh, order = c(1,0,1))
        expect_true(inherits(prediction(m, data = lh, n.ahead = 12), "prediction"))
    })
    test_that("Test prediction() for 'loess'", {
        m <- stats::loess(dist ~ speed, cars)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'nls'", {
        m <- stats::nls(demand ~ SSasympOrig(Time, A, lrc), data = BOD)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'ppr'", {
        data("rock", package = "datasets")
        rock$area1 <- rock$area/10000
        rock$peri1 <- rock$peri/10000
        m <- stats::ppr(log(perm) ~ area1 + peri1 + shape,
                        data = rock, nterms = 2, max.terms = 5)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'princomp'", {
        data("USArrests", package = "datasets")
        m <- stats::princomp(~ ., data = USArrests, cor = TRUE)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

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)
        m <- survey::svyglm(api.stu~enroll, design=dstrat)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

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), 
              x=c(0,2,1,1,1,0,0), 
              sex=c(0,0,0,0,1,1,1)) 
        m <- survival::coxph(survival::Surv(time, status) ~ x + survival::strata(sex), test1) 
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
    test_that("Test prediction() for 'survreg'", {
        data("ovarian", package = "survival")
        m <- survival::survreg(survival::Surv(futime, fustat) ~ ecog.ps + rx, ovarian, dist='weibull', scale=1)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}

if (require("truncreg", quietly = TRUE)) {
    test_that("Test prediction() for 'truncreg'", {
        data("tobin", package = "survival")
        m <- truncreg::truncreg(durable ~ age + quant, data = tobin, subset = durable > 0)
        p <- prediction(m)
        expect_true(inherits(p, "prediction"), label = "'prediction' class is correct")
        expect_true(all(c("fitted", "se.fitted") %in% names(p)), label = "'fitted' and 'se.fitted' columns returned")
    })
}