tests/testthat/test-AdMitIS.R

In AdMit: Adaptive Mixture of Student-t Distributions

test_that("AdMitIS estimates the mean of a bivariate target", {
  set.seed(1234)
  fit <- AdMit(KERNEL = GelmanMeng, mu0 = c(0.0, 0.1),
               control = list(Ns = 1e4, Np = 1e3, Hmax = 4))
  out <- AdMitIS(N = 2e4, KERNEL = GelmanMeng, mit = fit$mit)

  expect_length(out$ghat, 2)
  ## target mean, Ardia, Hoogerheide and van Dijk (2009, JSS 29(3))
  expect_equal(out$ghat, c(1.459, 1.459), tolerance = 0.05)
  expect_true(all(out$NSE > 0))
  expect_true(all(out$RNE > 0 & out$RNE < 1.5))
})

test_that("AdMitIS works for a univariate target", {
  ## regression: rMit returns a vector when k = 1, and AdMitIS used to fail
  ## with "dim(X) must have a positive length"
  set.seed(301)
  fit <- AdMit(KERNEL = Gauss1d, mu0 = 0.5,
               control = list(Ns = 5e3, Np = 5e2, Hmax = 3))
  out <- AdMitIS(N = 1e4, KERNEL = Gauss1d, mit = fit$mit)

  expect_length(out$ghat, 1)
  expect_equal(out$ghat, 2, tolerance = 0.05) ## Gauss1d is centred at m = 2
  expect_true(is.finite(out$NSE))
})

test_that("AdMitIS accepts a scalar-valued function of interest", {
  ## regression: any G returning a vector used to fail the same way
  set.seed(302)
  fit <- AdMit(KERNEL = GelmanMeng, mu0 = c(0.0, 0.1),
               control = list(Ns = 5e3, Np = 5e2, Hmax = 3))

  set.seed(999)
  out1 <- AdMitIS(N = 2e4, KERNEL = GelmanMeng, mit = fit$mit,
                  G = function(theta) theta[,1]^2)
  expect_length(out1$ghat, 1)
  expect_true(is.finite(out1$ghat) && out1$ghat > 0)

  ## the same quantity obtained from a matrix-valued G must agree
  set.seed(999)
  out2 <- AdMitIS(N = 2e4, KERNEL = GelmanMeng, mit = fit$mit,
                  G = function(theta) cbind(theta[,1]^2, theta[,2]^2))
  expect_equal(out1$ghat, out2$ghat[1])
  expect_equal(out1$NSE, out2$NSE[1])
})

test_that("AdMitIS passes extra arguments to KERNEL and to G", {
  set.seed(303)
  fit <- AdMit(KERNEL = GelmanMeng, mu0 = c(0.0, 0.1),
               control = list(Ns = 5e3, Np = 5e2, Hmax = 3))

  G.shift <- function(theta, shift) theta - matrix(shift, nrow(theta), 2, byrow = TRUE)
  set.seed(304)
  base  <- AdMitIS(N = 1e4, KERNEL = GelmanMeng, mit = fit$mit)
  set.seed(304)
  moved <- AdMitIS(N = 1e4, KERNEL = GelmanMeng, mit = fit$mit,
                   G = G.shift, shift = c(1, 1))

  expect_equal(moved$ghat, base$ghat - 1)
})

test_that("AdMitIS validates its arguments", {
  expect_error(AdMitIS(N = 1e3), "'KERNEL' is missing")
  expect_error(AdMitIS(N = 0, KERNEL = GelmanMeng), "'N' should be larger")
  expect_error(AdMitIS(N = 1e3, KERNEL = function(x) x), "MUST have the logical argument")
})