## test the analytical OC function via brute force simulation set.seed(12354) ## expect results to be 1% exact eps <- 1e-2 prior1 <- mixnorm(c(0.3, -0.2, 2), c(0.7, 0, 50), sigma=1) prior2 <- mixnorm(c(1.0, 0, 50), sigma=1) ##prior1 <- mixnorm(c(0.3, -0.2, 20), c(0.7, 0, 50), sigma=1) ##prior2 <- mixnorm(c(1.0, 0, 50), sigma=1) N1 <- 30 N2 <- 40 ## we test here that the PoS indeed averages over the predictive of an ## informative prior weighting the conditional power respectively. s <- 1 pcrit <- 0.80 qcrit <- 0 N_samp <- 1E4 dec <- decision2S(pcrit, qcrit) decU <- decision2S(pcrit, qcrit, lower.tail=FALSE) test_pos2S <- function(prior1, prior2, ia_dist1, ia_dist2, n1, n2, dec, decU) { skip_on_cran() ## the PoS is the expected value of the condition power integrated ## over the interim density which is what we check here cpo_analytic <- oc2S(prior1, prior2, n1, n2, dec) pos_analytic <- pos2S(prior1, prior2, n1, n2, dec) samp1 <- rmix(ia_dist1, N_samp) samp2 <- rmix(ia_dist2, N_samp) pos_mc <- mean(cpo_analytic(samp1, samp2)) ##print(pos_mc) ##print(pos_analytic(ia_dist1, ia_dist2)) expect_true(all(abs(pos_mc - pos_analytic(ia_dist1, ia_dist2)) < eps)) lower.tail <- attr(dec,"lower.tail") if(lower.tail) { ##cat("Also testing lower.tail=FALSE\n") test_pos2S(prior1, prior2, ia_dist1, ia_dist2, n1, n2, 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) }) ## also run a MC comparison pos2S_normal_MC <- function(prior1, prior2, N1, N2, dtheta1, dtheta2, pcrit=0.975, qcrit=0) { skip_on_cran() mean_sd1 <- sigma(prior1) / sqrt(N1) mean_sd2 <- sigma(prior2) / sqrt(N2) mean_prior1 <- prior1 sigma(mean_prior1) <- mean_sd1 mean_prior2 <- prior2 sigma(mean_prior2) <- mean_sd2 pred_dtheta1 <- preddist(dtheta1, n=N1)##, sigma=mean_sd1) pred_dtheta2 <- preddist(dtheta2, n=N2)##, sigma=mean_sd1) ##mean_samp1 <- rnorm(Nsim, theta1, mean_sd1) ##mean_samp2 <- rnorm(Nsim, theta2, mean_sd2) mean_samp1 <- rmix(pred_dtheta1, N_samp) mean_samp2 <- rmix(pred_dtheta2, N_samp) dec <- rep(NA, N_samp) for(i in 1:N_samp) { post1 <- postmix(mean_prior1, m=mean_samp1[i], se=mean_sd1) post2 <- postmix(mean_prior2, m=mean_samp2[i], se=mean_sd2) dec[i] <- as.numeric(pmix(RBesT:::mixnormdiff(post1, post2), qcrit) > pcrit) } mean(dec) } test_that("Normal PoS 2 sample function matches MC integration", { pos_mc <- pos2S_normal_MC(prior1, prior2, N1, N2, ia1, ia2, pcrit=0.8, qcrit=0) pos_analytic <- pos2S(prior1, prior2, N1, N2, dec) expect_true(all(abs(pos_mc - pos_analytic(ia1, ia2)) < eps)) }) 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_pos2S(beta_prior, beta_prior, beta_ia1, beta_ia2, N1, N2, dec, decU) }) gamma_prior <- mixgamma(c(1, 1, 1), param="mn") alpha <- 0.05 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_pos2S(gamma_prior, gamma_prior, gamma_ia1, gamma_ia2, N1, N2, dec_count, dec_countU) }) test_that("Binomial PoS 2 with IA returns results", { ## reported by user successCrit <- decision2S(c(0.9), c(0), lower.tail=FALSE) n0 <- 50 n <- 100 n_alt <- 140 neutr_prior <- mixbeta(c(1,1/3,1/3)) post_placeboIA <- postmix(neutr_prior, r=13, n=n0) post_treatIA <- postmix(neutr_prior, r=3, n=n0) # Criterion for PPoS at IA pos_final <- pos2S(post_treatIA, post_placeboIA, n-n0, n-n0, successCrit) pos_final_alt <- pos2S(post_treatIA, post_placeboIA, n_alt-n0, n_alt-n0, successCrit) #Predictive proba of success at the end expect_number(pos_final_alt(post_treatIA, post_placeboIA), na.ok=FALSE, lower=0, upper=1, finite=TRUE, null.ok=FALSE) expect_number(pos_final(post_treatIA, post_placeboIA), na.ok=FALSE, lower=0, upper=1, finite=TRUE, null.ok=FALSE) })