Skip to content

Commit

Permalink
silence expected warnings in tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@weberse2
weberse2 committed Nov 21, 2024
1 parent 6d7eb25 commit 69bc5f3
Show file tree
Hide file tree
Showing 3 changed files with 37 additions and 33 deletions.
46 changes: 24 additions & 22 deletions tests/testthat/test-gMAP.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -105,14 +105,14 @@ rate <- round(-log(0.05)/2, 1)
test_that("gMAP matches RStanArm binomial family", {
skip("RStanArm has issues loading since 2024-01-02 on CI/CD systems.")
skip_on_cran()
best_run <- gMAP(cbind(r, n-r) ~ 1 | study,
suppressWarnings( best_run <- gMAP(cbind(r, n-r) ~ 1 | study,
data=AS,
family=binomial,
tau.dist="Exp",
tau.prior=c(rate),
beta.prior=cbind(0, 2)
)
out <- capture.output(rstanarm_run <- make_rstanarm_ref(
) )
suppressWarnings( out <- capture.output(rstanarm_run <- make_rstanarm_ref(
stan_glmer(cbind(r, n-r) ~ 1 + (1|study),
data=AS,
family=binomial,
Expand All @@ -126,6 +126,7 @@ test_that("gMAP matches RStanArm binomial family", {
prior_intercept=normal(0,2,autoscale=FALSE),
prior_covariance=decov(1, 1, 1, 1/rate)
)))
)
cmp_reference(best_gmap=best_run, OB_ref=rstanarm_run)
})

Expand All @@ -147,9 +148,10 @@ test_that("gMAP processes single trial case", {
)

test_that("gMAP processes not continuously labeled studies", {
out <- capture.output(map1 <- gMAP(cbind(r, n-r) ~ 1 | study, data=AS[-1,],
suppressWarnings( out <- capture.output(map1 <- gMAP(cbind(r, n-r) ~ 1 | study, data=AS[-1,],
family=binomial, tau.dist="HalfNormal", tau.prior=0.5,
iter=100, warmup=50, chains=1, thin=1))
)
expect_true(nrow(fitted(map1)) == nrow(AS) - 1)
})

Expand All @@ -162,7 +164,7 @@ test_that("gMAP reports divergences", {
tau.dist="Uniform", tau.prior=cbind(0, 1000),
beta.prior=cbind(0,1E5),
iter=1000, warmup=0, chains=1, thin=1, init=10)))
sp <- rstan::get_sampler_params(mcmc_div$fit)[[1]]
sp <- rstan::get_sampler_params(mcmc_div$fit, inc_warmup=FALSE)[[1]]
expect_true(sum(sp[,"divergent__"]) > 0)
})

Expand All @@ -172,31 +174,31 @@ do.call(options, std_sampling)
test_that("gMAP handles extreme response rates", {
n <- 5
data1 <- data.frame(n=c(n,n,n,n),r=c(5,5,5,5), study=1)
map1 <- gMAP(cbind(r, n-r) ~ 1 | study, family=binomial,
data=data1, tau.dist="HalfNormal",
tau.prior=2.0, beta.prior=2,
warmup=100, iter=200, chains=1, thin=1)
suppressWarnings( map1 <- gMAP(cbind(r, n-r) ~ 1 | study, family=binomial,
data=data1, tau.dist="HalfNormal",
tau.prior=2.0, beta.prior=2,
warmup=100, iter=200, chains=1, thin=1) )
expect_true(nrow(fitted(map1)) == 4)
data2 <- data.frame(n=c(n,n,n,n),r=c(0,0,0,0), study=1)
map2 <- gMAP(cbind(r, n-r) ~ 1 | study, family=binomial,
data=data2, tau.dist="HalfNormal",
tau.prior=2.0, beta.prior=2,
warmup=100, iter=200, chains=1, thin=1)
suppressWarnings( map2 <- gMAP(cbind(r, n-r) ~ 1 | study, family=binomial,
data=data2, tau.dist="HalfNormal",
tau.prior=2.0, beta.prior=2,
warmup=100, iter=200, chains=1, thin=1) )
expect_true(nrow(fitted(map2)) == 4)
data3 <- data.frame(n=c(n,n,n,n),r=c(5,5,5,5), study=c(1,1,2,2))
map3 <- gMAP(cbind(r, n-r) ~ 1 | study, family=binomial,
data=data3, tau.dist="HalfNormal",
tau.prior=2.0, beta.prior=2,
warmup=100, iter=200, chains=1, thin=1)
suppressWarnings( map3 <- gMAP(cbind(r, n-r) ~ 1 | study, family=binomial,
data=data3, tau.dist="HalfNormal",
tau.prior=2.0, beta.prior=2,
warmup=100, iter=200, chains=1, thin=1) )
expect_true(nrow(fitted(map3)) == 4)
})

test_that("gMAP handles fixed tau case", {
map1 <- gMAP(cbind(r, n-r) ~ 1 | study, family=binomial,
data=AS, tau.dist="Fixed",
tau.prior=0.5, beta.prior=2,
warmup=100, iter=200, chains=1, thin=1)
expect_true(map1$Rhat.max >= 1)
suppressWarnings( map1 <- gMAP(cbind(r, n-r) ~ 1 | study, family=binomial,
data=AS, tau.dist="Fixed",
tau.prior=0.5, beta.prior=2,
warmup=100, iter=200, chains=1, thin=1) )
expect_true(map1$Rhat.max >= 1)
})

test_that("gMAP labels data rows correctly when using covariates", {
Expand Down
22 changes: 12 additions & 10 deletions tests/testthat/test-pos2S.R
View file
Original file line number Diff line number Diff line change
@@ -1,4 +1,3 @@
context("pos2S: 2-Sample Probability of Success")

## test the analytical OC function via brute force simulation
set.seed(12354)
Expand Down Expand Up @@ -51,11 +50,12 @@ test_pos2S <- function(prior1, prior2, ia_dist1, ia_dist2, n1, n2, dec, decU) {
ia1 <- postmix(prior1, m=0.2, se=s/sqrt(15))
ia2 <- postmix(prior2, m=0, se=s/sqrt(15))

test_that("Normal PoS 2 sample function matches MC integration of CPO",
test_pos2S(prior1, prior2,
ia1, ia2,
N1, N2,
dec, decU))
test_that("Normal PoS 2 sample function matches MC integration of CPO",{
test_pos2S(prior1, prior2,
ia1, ia2,
N1, N2,
dec, decU)
})

## also run a MC comparison
pos2S_normal_MC <- function(prior1, prior2, N1, N2, dtheta1, dtheta2, pcrit=0.975, qcrit=0) {
Expand Down Expand Up @@ -98,11 +98,12 @@ test_that("Normal PoS 2 sample function matches MC integration",
beta_prior <- mixbeta(c(1, 1, 1))
beta_ia1 <- postmix(beta_prior, r=20, n=50)
beta_ia2 <- postmix(beta_prior, r=30, n=50)
test_that("Binomial PoS 2 sample function matches MC integration of CPO",
test_that("Binomial PoS 2 sample function matches MC integration of CPO", {
test_pos2S(beta_prior, beta_prior,
beta_ia1, beta_ia2,
N1, N2,
dec, decU))
dec, decU)
})


gamma_prior <- mixgamma(c(1, 1, 1), param="mn")
Expand All @@ -111,11 +112,12 @@ dec_count <- decision2S(1-alpha, 0, lower.tail=TRUE)
dec_countU <- decision2S(1-alpha, 0, lower.tail=FALSE)
gamma_ia1 <- postmix(gamma_prior, m=0.7, n=60)
gamma_ia2 <- postmix(gamma_prior, m=1.2, n=60)
test_that("Poisson PoS 2 sample function matches MC integration of CPO",
test_that("Poisson PoS 2 sample function matches MC integration of CPO", {
test_pos2S(gamma_prior, gamma_prior,
gamma_ia1, gamma_ia2,
N1, N2,
dec_count, dec_countU))
dec_count, dec_countU)
})

test_that("Binomial PoS 2 with IA returns results", {
## reported by user
Expand Down
2 changes: 1 addition & 1 deletion tools/make-ds.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -43,7 +43,7 @@ make_internal_ds <- function() {
calibration_meta["MD5"] <- vals["MD5"]

pkg_create_date <- Sys.time()
pkg_sha <- "ff4fcab"
pkg_sha <- "bd767e7"

if (gsub("\\$", "", pkg_sha) == "Format:%h") {
pkg_sha <- system("git rev-parse --short HEAD", intern=TRUE)
Expand Down

0 comments on commit 69bc5f3

Please sign in to comment.