tests/testthat/test-sps_repweights.R

In sps: Sequential Poisson Sampling

set.seed(1234)

test_that("corner cases work as expected", {
  w <- rep(1, 10)

  # all TA units gives a matrix of 1s
  expect_equal(
    sps_repweights(w, 5, tau = 3),
    structure(matrix(1, 10, 5), tau = 3)
  )
  expect_equal(
    sps_repweights(w, 5, dist = rnorm),
    structure(matrix(1, 10, 5), tau = 1)
  )

  # asking for 0 repweights gives a matrix with no columns
  expect_equal(
    sps_repweights(w, 0),
    structure(matrix(numeric(0), 10, 0), tau = 1)
  )
  expect_equal(
    sps_repweights(w, 0, dist = rnorm),
    structure(matrix(numeric(0), 10, 0), tau = 1)
  )

  # supplying no weights gives a matrix with no rows
  expect_equal(
    sps_repweights(integer(0), 5),
    structure(matrix(numeric(0), 0, 5), tau = 1)
  )
  expect_equal(
    sps_repweights(integer(0), 5, dist = rnorm),
    structure(matrix(numeric(0), 0, 5), tau = 1)
  )

  # intersection of both cases
  expect_equal(
    sps_repweights(integer(0), 0),
    structure(matrix(numeric(0), 0, 0), tau = 1)
  )
  expect_equal(
    sps_repweights(integer(0), 0, dist = rnorm),
    structure(matrix(numeric(0), 0, 0), tau = 1)
  )
})

test_that("argument checking works", {
  expect_error(sps_repweights(0:5, 5))
  expect_error(sps_repweights(c(NA, 1:5), 5))
  expect_error(sps_repweights(1:5, -5))
  expect_error(sps_repweights(1:5, NA))
  expect_error(sps_repweights(1:5, integer(0)))
  expect_error(sps_repweights(1:5, 5, -1))
  expect_error(sps_repweights(1:5, 5, NA))
  expect_error(sps_repweights(1:5, 5, numeric(0)))
})

test_that("rep weights works for TA units", {
  expect_true(all(sps_repweights(1:5, tau = 2) > 0))
  expect_true(all(sps_repweights(1:5, tau = 2)[1, ] == 1))
})

test_that("results agree with bootstrapFP:::generalised()", {
  # fixed a bug with the exponential case by replacing exp() with rexp()
  bootstrap_fp <- function(ys, pks, replicates) {
    n <- length(ys)
    ht <- vector("numeric", length = replicates)
    w <- 1 / pks
    for (b in seq_len(replicates)) {
      a <- 1 + (rexp(n) - 1) * sqrt(1 - pks)
      ws <- a * w
      ht[b] <- sum(ys * ws)
    }
    ht_total <- sum(w * ys)
    (sum((ht - ht_total))^2) / replicates
  }

  w <- 1 / c(1, runif(98), 1)
  y <- rlnorm(100)

  set.seed(51423)
  rw <- sps_repweights(w, 100, dist = function(x) rexp(x) - 1)
  var1 <- sum(colSums(rw * y) - sum(w * y))^2 / 100

  set.seed(51423)
  var2 <- bootstrap_fp(y, 1 / w, 100)

  expect_equal(var1, var2)
})