tests/testthat/test-AdMit.R

In AdMit: Adaptive Mixture of Student-t Distributions

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")
})