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