test_that("AdMit fits a well-formed mixture and lowers the coefficient of variation", { set.seed(1234) out <- AdMit(KERNEL = GelmanMeng, mu0 = c(0.0, 0.1), control = list(Ns = 1e4, Np = 1e3, Hmax = 4)) H <- length(out$mit$p) expect_gt(H, 1) ## the target is bimodal expect_equal(sum(out$mit$p), 1) expect_true(all(out$mit$p >= 0)) expect_identical(dim(out$mit$mu), c(H, 2L)) expect_identical(dim(out$mit$Sigma), c(H, 4L)) expect_identical(colnames(out$mit$Sigma), c("k1k1", "k1k2", "k2k1", "k2k2")) expect_length(out$CV, H) expect_lt(out$CV[H], out$CV[1]) ## the mixture improves on one component expect_true(all(is.finite(out$CV))) expect_s3_class(out$summary, "data.frame") }) test_that("AdMit fits a univariate target", { set.seed(401) out <- AdMit(KERNEL = Gauss1d, mu0 = 0.5, control = list(Ns = 5e3, Np = 5e2, Hmax = 3)) expect_identical(ncol(out$mit$mu), 1L) expect_equal(out$mit$mu[1, 1], 2, tolerance = 1e-3) ## mode of Gauss1d expect_equal(out$mit$Sigma[1, 1], 1, tolerance = 1e-3) ## and its curvature }) test_that("AdMit accepts a user-supplied Sigma0 and skips the optimisation", { set.seed(402) out <- AdMit(KERNEL = GelmanMeng, mu0 = c(0.0, 0.1), Sigma0 = diag(2), control = list(Ns = 5e3, Np = 5e2, Hmax = 3)) expect_identical(as.character(out$summary$METHOD.mu[1]), "USER") expect_equal(out$mit$mu[1, ], c(0.0, 0.1), ignore_attr = TRUE) expect_equal(out$mit$Sigma[1, ], c(1, 0, 0, 1), ignore_attr = TRUE) }) test_that("AdMit runs the importance sampling variant", { set.seed(403) out <- AdMit(KERNEL = GelmanMeng, mu0 = c(0.0, 0.1), control = list(Ns = 5e3, Np = 5e2, Hmax = 3, IS = TRUE)) expect_gt(length(out$mit$p), 1) expect_true(all(grepl("^IS ", out$summary$METHOD.mu[-1]))) }) test_that("AdMit validates its arguments", { expect_error(AdMit(mu0 = c(0, 0)), "'KERNEL' is missing") expect_error(AdMit(KERNEL = GelmanMeng), "'mu0' is missing") expect_error(AdMit(KERNEL = GelmanMeng, mu0 = matrix(0, 2, 1)), "must be a vector") expect_error(AdMit(KERNEL = GelmanMeng, mu0 = c(0, 0), Sigma0 = c(1, 1)), "must be a matrix") expect_error(AdMit(KERNEL = GelmanMeng, mu0 = c(0, 0), Sigma0 = matrix(c(1, 2, 3, 1), 2)), "not symmetric") expect_error(AdMit(KERNEL = GelmanMeng, mu0 = c(0, 0), Sigma0 = -diag(2)), "not positive definite") expect_error(AdMit(KERNEL = GelmanMeng, mu0 = c(0, 0), control = list(Np = 10)), "'Np' far too small") expect_error(AdMit(KERNEL = GelmanMeng, mu0 = c(0, 0), control = list(Ns = 1e3, Np = 2e3)), "lower or equal") expect_error(AdMit(KERNEL = GelmanMeng, mu0 = c(0, 0), control = list(CVtol = 2)), "must belong to") }) test_that("AdMitMH samples from the target", { set.seed(1234) fit <- AdMit(KERNEL = GelmanMeng, mu0 = c(0.0, 0.1), control = list(Ns = 1e4, Np = 1e3, Hmax = 4)) out <- AdMitMH(N = 2e4, KERNEL = GelmanMeng, mit = fit$mit) expect_identical(dim(out$draws), c(2e4L, 2L)) expect_identical(colnames(out$draws), c("k1", "k2")) expect_gt(out$accept, 0.3) expect_lte(out$accept, 1) ## burn-in discarded, as in the package documentation draws <- out$draws[-(1:1000), ] expect_equal(colMeans(draws), c(1.459, 1.459), tolerance = 0.1, ignore_attr = TRUE) }) test_that("AdMitMH validates its arguments", { expect_error(AdMitMH(N = 1e3), "'KERNEL' is missing") expect_error(AdMitMH(N = 1, KERNEL = GelmanMeng), "at least larger than 2") expect_error(AdMitMH(N = 1e3, KERNEL = function(x) x), "MUST have the logical argument") })