Nothing
# 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")
})
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.