test_that("log_lik",
{
out <- log_lik(hs.gauss)
expect_equal(nrow(out), iters)
expect_equal(ncol(out), N)
expect_equal(log_lik(hs.binom),
log_lik(hs.binom, newdata=df))
expect_equal(log_lik(cv.gauss$fits[[1]]),
log_lik(cv.gauss$fits[[1]], newdata=df[folds == 2, ]))
expect_equal(log_lik(cv.binom$fits[[2]]),
log_lik(cv.binom$fits[[2]], newdata=df[folds == 1, ]))
})
test_that("posterior_interval",
{
expect_error(posterior_interval(hs.gauss, pars=1:3),
"'pars' must be a character vector")
expect_error(posterior_interval(hs.gauss, pars="zzz"),
"No pattern in 'pars' matches parameter names")
expect_error(posterior_interval(hs.gauss, prob=0),
"'prob' must be a single value between 0 and 1")
out <- posterior_interval(hs.gauss)
expect_is(out, "matrix")
expect_equal(nrow(out),
P + 1 + 1) # intercept and extra factor level for X1
expect_equal(colnames(out), c("2.5%", "97.5%"))
out <- posterior_interval(hs.gauss, pars="X1", prob=0.5)
expect_equal(nrow(out),
3) # X1b, X1c, X10
expect_equal(colnames(out), c("25%", "75%"))
})
test_that("posterior_linpred",
{
expect_equal(posterior_linpred(hs.gauss),
posterior_linpred(hs.gauss, newdata=df))
expect_equal(posterior_linpred(hs.binom, transform=TRUE),
posterior_linpred(hs.binom, transform=TRUE, newdata=df))
})
test_that("posterior_predict",
{
expect_error(posterior_predict(hs.gauss, nsamples=0),
"'nsamples' must be a positive integer")
expect_error(posterior_predict(hs.gauss, nsamples=-1),
"'nsamples' must be a positive integer")
expect_error(posterior_predict(hs.gauss, nsamples=1.5),
"'nsamples' must be a positive integer")
expect_equal(posterior_predict(hs.gauss, seed=1),
posterior_predict(hs.gauss, seed=1, newdata=df))
expect_equal(posterior_predict(hs.binom, seed=1),
posterior_predict(hs.binom, seed=1, newdata=df))
})
test_that("posterior_performance",
{
expect_error(posterior_performance(x),
"Not an 'hsstan' or 'kfold' object")
expect_error(posterior_performance(cv.nofit),
"No fitted models found, run 'kfold' with store.fits=TRUE")
expect_error(posterior_performance(cv.gauss, sub.idx=letters),
"'sub.idx' must be an integer vector")
expect_error(posterior_performance(cv.gauss, sub.idx=c(1, 2, 3.2)),
"'sub.idx' must be an integer vector")
expect_error(posterior_performance(cv.gauss, sub.idx=matrix(1:9, 3, 3)),
"'sub.idx' must be an integer vector")
expect_error(posterior_performance(cv.gauss, sub.idx=1),
"'sub.idx' must contain at least two elements")
expect_error(posterior_performance(cv.gauss, sub.idx=c(0, 10)),
"'sub.idx' contains out of bounds indices")
expect_error(posterior_performance(cv.gauss, sub.idx=c(1, 5, 1000)),
"'sub.idx' contains out of bounds indices")
expect_error(posterior_performance(cv.gauss, sub.idx=c(1, 2, 1, 4)),
"'sub.idx' contains duplicate indices")
expect_error(posterior_performance(cv.binom, sub.idx=1:2),
"'sub.idx' must contain both outcome classes")
out <- posterior_performance(cv.gauss)
expect_is(out,
"matrix")
expect_equal(rownames(out),
c("r2", "llk"))
expect_equal(colnames(out),
c("mean", "sd", "2.5%", "97.5%"))
expect_named(attributes(out),
c("dim", "dimnames", "type"))
expect_equal(attributes(out)$type,
"cross-validated")
expect_equivalent(out["r2", ],
c(0.00573753, 0.01640424, 0.00000000, 0.04763979),
tolerance=tol)
expect_equivalent(out["llk", ],
c(-141.8687757, 20.2069346, -194.7961530, -119.0098033),
tolerance=tol)
expect_equal(out,
posterior_performance(cv.gauss, sub.idx=1:N))
out <- posterior_performance(cv.gauss, sub.idx=sample(which(df$X1 == "b")))
expect_named(attributes(out),
c("dim", "dimnames", "type", "subset"))
expect_equal(attributes(out)$subset,
which(df$X1 == "b"))
out <- posterior_performance(hs.binom, prob=0.89)
expect_equal(rownames(out),
c("auc", "llk"))
expect_equal(colnames(out),
c("mean", "sd", "5.5%", "94.5%"))
expect_equal(attributes(out)$type,
"non cross-validated")
expect_equivalent(out["auc", ],
c(0.64088960, 0.07803343, 0.52711200, 0.77760000),
tolerance=tol)
expect_equivalent(out["llk", ],
c(-33.987399, 2.847330, -38.134992, -28.816855),
tolerance=tol)
out <- posterior_performance(cv.binom, summary=FALSE)
expect_equal(nrow(out),
nsamples(cv.binom$fits[[1]]))
expect_equal(ncol(out), 2)
expect_equal(attributes(out)$type,
"cross-validated")
expect_equivalent(posterior_summary(out),
posterior_performance(cv.binom))
})
test_that("loo",
{
out <- loo(hs.gauss)
expect_s3_class(out, "loo")
expect_equivalent(out$estimates[1:2, "Estimate"],
c(-113.489222, 6.700909),
tolerance=tol)
out <- loo(hs.binom)
expect_equivalent(out$estimates[1:2, "Estimate"],
c(-38.891008, 8.315188),
tolerance=tol)
})
test_that("waic",
{
out <- waic(hs.gauss)
expect_s3_class(out, c("waic", "loo"))
expect_equivalent(out$estimates[1:2, "Estimate"],
c(-113.336708, 6.548394),
tolerance=tol)
out <- waic(hs.binom)
expect_equivalent(out$estimates[1:2, "Estimate"],
c(-38.561844, 7.986024),
tolerance=tol)
})
test_that("bayes_R2",
{
expect_error(bayes_R2(hs.gauss, prob=1),
"'prob' must be a single value between 0 and 1")
expect_error(bayes_R2(hs.gauss, prob=c(0.2, 0.5)),
"'prob' must be a single value between 0 and 1")
out <- bayes_R2(hs.gauss)
expect_is(out, "numeric")
expect_named(out,
c("mean", "sd", "2.5%", "97.5%"))
out <- bayes_R2(hs.binom, summary=FALSE)
expect_is(out, "numeric")
expect_length(out, iters * chains / 2)
})
test_that("loo_R2",
{
out <- loo_R2(hs.gauss, summary=FALSE)
expect_is(out, "numeric")
expect_length(out, iters * chains / 2)
out <- loo_R2(hs.binom)
expect_is(out, "numeric")
expect_named(out,
c("mean", "sd", "2.5%", "97.5%"))
})
Datasets
Models
