tests/testthat/test-moonboot.R

In moonboot: m-Out-of-n Bootstrap Functions

test_that("mboot parameter", {
  set.seed(100)
  n <- 1000
  data <- runif(n)
  max.tau <- function(x) { return(x) }
  max.statistic <- function(data, indices) { return(max(data[indices])) }
  # empty data
  expect_error(mboot(c(), statistic, 0), "no data.*")
  # negative R
  expect_error(mboot(data, statistic, R = -1), ".*>0.*")
  # call to mboot which should work
  boot.out <- mboot(data, max.statistic, R = 1000, m = sqrt(n), replace = FALSE)

  # mboot.ci
  # confidence level out of bounds
  expect_error(mboot.ci(boot.out, conf = 1.01, max.tau), "conf.*")

  # user provides tau_n directly instead of a function
  expect_error(mboot.ci(boot.out, conf = 0.95, tau = max.tau(n)), ".*function")

  # mboot.ci call expected to work
  cis <- mboot.ci(boot.out, conf = 0.95, tau = max.tau)
})

test_that("estimate m", {
  set.seed(100)
  n <- 1000
  data <- runif(n)
  max.tau <- function(x) { return(x) }
  max.statistic <- function(data, indices) { return(max(data[indices])) }

  # unknown method
  expect_error(estimate.m(data, max.statistic, tau = max.tau, R = 1000, method = "unknown"),
               "unsupported.*")

  # bickel
  # choosing a bad q value
  expect_error(estimate.m(data, max.statistic,
                          tau = max.tau, R = 1000, method = "bickel", params = list(q = 0.9999)), ".*q value.*")
  set.seed(99)
  n <- 100
  data <- runif(n)
  m.bickel <- estimate.m(data, max.statistic, tau = max.tau, R = 1000, method = "bickel")
  expect_lte(m.bickel, n)
  expect_gte(m.bickel, 2, n)
  expect(m.bickel == 4, "m.bickel not 4")

  # goetze
  m.goetze <- estimate.m(data, max.statistic, tau = max.tau, R = 1000, method = "goetze")
  expect_lte(m.goetze, n)
  expect_gte(m.goetze, 2, n)

  # politis
  m.politis <- estimate.m(data, max.statistic, tau = max.tau, R = 1000, method = "politis")
  expect_lte(m.politis, n)
  expect_gte(m.politis, 2, n)

  # sherman will be tested in its own test file
})

test_that("estimate tau", {
  set.seed(100)
  # using mean
  data <- runif(10000)
  mean.statistic <- function(data, indices) { return(mean(data[indices])) }
  mean.tau <- log(estimate.tau(data, mean.statistic, R = 1000, replace = FALSE)(length(data)), length(data))
  expect_lt(mean.tau, 0.6)
  expect_gt(mean.tau, 0.4)
  mean.tau.quantile <- log(estimate.tau(data, mean.statistic, R = 1000, replace = FALSE, method = "quantile")(length(data)), length(data))
  expect_equal(mean.tau, mean.tau.quantile, tolerance = 0.05)
})