Diff of /tests/testthat/setup.R [000000] .. [ede2d4]

Switch to side-by-side view

--- a
+++ b/tests/testthat/setup.R
@@ -0,0 +1,50 @@
+## silence output and warnings
+SW <- function(expr) suppressMessages(suppressWarnings(expr))
+
+## dataset
+set.seed(1)
+N <- 50
+P <- 10
+U <- 3
+x <- matrix(rnorm(N * P), nrow=N, ncol=P)
+b <- runif(P) - 0.5
+y.gauss <- rnorm(N, mean=x %*% b, sd=runif(1, 1, 2))
+y.binom <- factor(rbinom(N, 1, binomial()$linkinv(x %*% b)))
+df <- data.frame(x, y.gauss=y.gauss, y.binom=y.binom)
+df[, 1] <- factor(letters[rbinom(N, 2, 0.5) + 1])
+df$X1b_X3 <- df$X3 * (df$X1 == "b")
+df$X1c_X3 <- df$X3 * (df$X1 == "c")
+df$X3_X2 <- df$X3 * df$X2
+
+## model options
+unp <- paste0("X", 1:U)
+pen <- setdiff(paste0("X", 1:P), unp)
+mod.gauss <- reformulate(unp, "y.gauss")
+mod.binom <- reformulate(unp, "y.binom")
+folds <- c(rep(1, N / 2), rep(2, N / 2))
+iters <- 500
+chains <- 2
+
+## numerical tolerance
+tol <- 0.000001
+
+## wrapper to set commonly used options
+hs <- function(model, family, ...)
+    hsstan(df, model, pen, iter=iters, chains=chains, family=family,
+           refresh=0, ...)
+
+message("Running hsstan models...")
+SW({
+    hs.base <- hsstan(df, mod.gauss, iter=iters, chains=chains, refresh=0)
+    hs.gauss <- hs(mod.gauss, gaussian)
+    hs.binom <- hs(mod.binom, binomial)
+    hs.inter <- hs(y.gauss ~ X1 * X3 + X2 * X3, gaussian)
+})
+
+message("Running cross-validated hsstan models...")
+SW({
+    cv.gauss <- kfold(hs.gauss, folds=folds, chains=2)
+    cv.binom <- kfold(hs.binom, folds=folds)
+    cv.nofit <- cv.gauss
+    cv.nofit$fits <- cv.nofit$data <- NULL
+})