## check that predictive distributions hold what they promise, ## i.e. that they describe the sum of n new data points. set.seed(42343) ## precision at which reference and tested must match eps <- 1e-2 ## percentiles to test for p_quants <- seq(0.1, 0.9, by = 0.1) ## number of samples used for sampling method Nsamp <- 1e5 ## define the different test cases beta <- mixbeta(c(1, 11, 4)) betaMix <- mixbeta(c(0.8, 11, 4), c(0.2, 1, 1)) gamma <- mixgamma(c(1, 65, 50)) gammaMix <- mixgamma(rob = c(0.5, 8, 0.5), inf = c(0.5, 9, 2), param = "ms") norm <- mixnorm(c(1, 0, 0.5), sigma = 1) normMix <- mixnorm(c(0.2, 0, 2), c(0.8, 2, 1), sigma = 1) n <- 25 preddist_cmp <- function(mix, n, n_rng, N = Nsamp, qntls = p_quants, stat = c("sum", "mean"), Teps = eps) { skip_on_cran() ## sample for each draw a single hyper-parameter which is then ## used n times in the rng function to return n samples from the ## sampling distribution stat <- match.arg(stat) test <- replicate(N, n_rng(rmix(mix, 1))) if (stat == "sum") test_stat <- colSums(test) if (stat == "mean") test_stat <- colMeans(test) quants_stest <- quantile(test_stat, qntls) ## note: in particular for the discrete/counting distributions, ## sampling gives better estimates quants_sref <- qmix(preddist(mix, n = n), qntls) res_sum <- abs(quants_sref - quants_stest) ## note: errors are accumulating with n, hence to check the mean, ## we scale eps with n if (stat == "sum") expect_true(all(res_sum < n * Teps)) if (stat == "mean") expect_true(all(res_sum < Teps)) quants_test <- quantile(test[1, ], qntls) quants_ref <- qmix(preddist(mix, n = 1), qntls) res <- abs(quants_ref - quants_test) expect_true(all(res < Teps)) if (inherits(mix, "betaMix")) { ## specifically test BetaBinomial (which is from Stan) predmix <- preddist(mix, n = 30) dens <- dmix(predmix, 0:30) cdens <- cumsum(dens) pc <- pmix(predmix, 0:30) upc <- pmix(predmix, 0:30, FALSE) expect_true(all(abs(cdens - pc) < Teps)) expect_true(all(abs(1 - cdens - upc) < Teps)) } ## test that output length of the predictive is the same as the ## input data vector, even for negative values for values outside ## the valid support of the postive only distribtions cprob_ltest <- pmix(preddist(mix, n = 1), c(-1, quants_ref)) expect_true(length(cprob_ltest) == length(c(-1, quants_ref))) } test_that("Predictive for a beta evaluates correctly (binary)", { preddist_cmp(beta, n, Curry(rbinom, n = n, size = 1)) }) test_that("Predictive for a beta mixture evaluates correctly (binary)", { preddist_cmp(betaMix, n, Curry(rbinom, n = n, size = 1)) }) test_that("Predictive for a gamma evaluates correctly (poisson)", { preddist_cmp(gamma, n, Curry(rpois, n = n)) }) test_that("Predictive for a gamma mixture evaluates correctly (poisson)", { preddist_cmp(gammaMix, n, Curry(rpois, n = n), Teps = 1E-1) }) test_that("Predictive for a normal evaluates correctly (normal)", { preddist_cmp(norm, n, Curry(rnorm, n = n, sd = sigma(norm)), stat = "mean") }) test_that("Predictive for a normal mixture evaluates correctly (normal)", { preddist_cmp(normMix, n, Curry(rnorm, n = n, sd = sigma(normMix)), stat = "mean", Teps = 1E-1) })