tests/testthat/test-resampling.R

In bayesSSM: Bayesian Methods for State Space Models

##################### Tests for cpp code #####################
test_that("Validation of weights work", {
  expect_error(resample_multinomial_cpp(3, c(-1, 1, 2)),
               "Weights must be non-negative")
  expect_error(resample_stratified_cpp(3, c(-1, 1, 2)),
               "Weights must be non-negative")
  expect_error(resample_stratified_cpp(3, c(-1, 1, 2)),
               "Weights must be non-negative")

  expect_error(resample_multinomial_cpp(3, c(0, 0, 0)),
               "Sum of weights must be greater than 0")
  expect_error(resample_stratified_cpp(3, c(0, 0, 0)),
               "Sum of weights must be greater than 0")
  expect_error(resample_systematic_cpp(3, c(0, 0, 0)),
               "Sum of weights must be greater than 0")
})
test_that("Resampling functions return correct proportions", {
  set.seed(1405)
  weights <- c(0.1, 0.2, 0.3, 0.2, 0.2)

  # Repeat many times
  n <- 10000
  indices_multinomial <- replicate(n, resample_multinomial_cpp(5, weights))
  indices_stratified <- replicate(n, resample_stratified_cpp(5, weights))
  indices_systematic <- replicate(n, resample_systematic_cpp(5, weights))
  # Calculate proportions
  prop_multinomial <- as.numeric(table(indices_multinomial)) / (n * 5)
  prop_stratified <- as.numeric(table(indices_stratified)) / (n * 5)
  prop_systematic <- as.numeric(table(indices_systematic)) / (n * 5)

  # Check proportions
  expect_equal(prop_multinomial, weights, tolerance = 0.05)
  expect_equal(prop_stratified, weights, tolerance = 0.05)
  expect_equal(prop_systematic, weights, tolerance = 0.05)
})
test_that("Check stratified and systematic correctly uses cumulative weights", {
  weights <- c(0.1, 0.5, 0.1, 0.15, 0.15)
  # For stratified resampling index 2 should always be for
  # 2nd and 3rd sample
  indices_stratified <- replicate(100, resample_stratified_cpp(5, weights))
  expect_true(all(indices_stratified[2, ] == 2))
  expect_true(all(indices_stratified[3, ] == 2))
  # For systematic resampling index 2 should always be for
  # 2nd and 3rd sample. If index 1 was selected for sample 1 then index 3 should
  # be selected for sample 4. If index 2 was selected for sample 1 then
  # index 4 should be selected for sample 4.
  indices_systematic <- replicate(100, resample_systematic_cpp(5, weights))
  expect_true(all(indices_systematic[2, ] == 2))
  expect_true(all(indices_systematic[3, ] == 2))

  first <- indices_systematic[1, ]
  fourth <- indices_systematic[4, ]

  expect_true(all(fourth[first == 1] == 3))
  expect_true(all(fourth[first == 2] == 4))
})



test_that("Throws error if particles dim doesn't match weight", {
  particles <- 1:3
  weights <- c(0.1, 0.2, 0.3, 0.2)
  expect_error(
    .resample_multinomial(particles, weights),
    "Number of particles must match the length of weights"
  )
  expect_error(
    .resample_stratified(particles, weights),
    "Number of particles must match the length of weights"
  )
  expect_error(
    .resample_systematic(particles, weights),
    "Number of particles must match the length of weights"
  )

  # Matrix case
  particles <- matrix(1:6, nrow = 3)
  weights <- c(0.1, 0.2, 0.3, 0.2)
  expect_error(
    .resample_multinomial(particles, weights),
    "Number of particles must match the length of weights"
  )
  expect_error(
    .resample_stratified(particles, weights),
    "Number of particles must match the length of weights"
  )
  expect_error(
    .resample_systematic(particles, weights),
    "Number of particles must match the length of weights"
  )
})


test_that("Throws error for non-valid weights", {
  particles <- 1:3
  weights <- rep(0, 3)
  expect_error(
    .resample_multinomial(particles, weights),
    "Sum of weights must be greater than 0"
  )
  expect_error(
    .resample_stratified(particles, weights),
    "Sum of weights must be greater than 0"
  )
  expect_error(
    .resample_systematic(particles, weights),
    "Sum of weights must be greater than 0"
  )

  weights <- c(-0.1, 0.5, 0.4)
  expect_error(
    .resample_multinomial(particles, weights),
    "Weights must be non-negative"
  )
  expect_error(
    .resample_stratified(particles, weights),
    "Weights must be non-negative"
  )
  expect_error(
    .resample_systematic(particles, weights),
    "Weights must be non-negative"
  )
})

test_that("Multinomial resampling produces valid output", {
  set.seed(123)
  particles <- 1:5
  weights <- c(0.1, 0.2, 0.3, 0.2, 0.2)

  resampled <- .resample_multinomial(particles, weights)

  # Check that all resampled values are from the original set
  expect_true(all(resampled %in% particles))

  # Check that the length is preserved
  expect_equal(length(resampled), length(particles))
})

test_that("Stratified resampling produces valid output", {
  set.seed(123)
  particles <- 1:5
  weights <- c(0.1, 0.2, 0.3, 0.2, 0.2)

  resampled <- .resample_stratified(particles, weights)

  expect_true(all(resampled %in% particles))
  expect_equal(length(resampled), length(particles))
})

test_that("Systematic resampling produces valid output", {
  set.seed(123)
  particles <- 1:5
  weights <- c(0.1, 0.2, 0.3, 0.2, 0.2)

  resampled <- .resample_systematic(particles, weights)

  expect_true(all(resampled %in% particles))
  expect_equal(length(resampled), length(particles))
})

test_that("Resampling handles uniform weights correctly", {
  set.seed(123)
  particles <- 1:10
  weights <- rep(1 / 10, 10)

  resampled_multinomial <- .resample_multinomial(particles, weights)
  resampled_stratified <- .resample_stratified(particles, weights)
  resampled_systematic <- .resample_systematic(particles, weights)

  expect_true(all(resampled_multinomial %in% particles))
  expect_true(all(resampled_stratified %in% particles))
  expect_true(all(resampled_systematic %in% particles))

  expect_equal(length(resampled_multinomial), length(particles))
  expect_equal(length(resampled_stratified), length(particles))
  expect_equal(length(resampled_systematic), length(particles))
})

test_that("Resampling handles extreme weights correctly", {
  set.seed(123)
  particles <- 1:5
  weights <- c(0, 0, 1, 0, 0) # All weight on one particle

  resampled_multinomial <- .resample_multinomial(particles, weights)
  resampled_stratified <- .resample_stratified(particles, weights)
  resampled_systematic <- .resample_systematic(particles, weights)

  expect_true(all(resampled_multinomial == 3))
  expect_true(all(resampled_stratified == 3))
  expect_true(all(resampled_systematic == 3))
})

test_that("Works with matrix particles", {
  set.seed(123)
  particles <- matrix(1:6, nrow = 3)
  weights <- rep(1 / 3, 3)

  resampled_multinomial <- .resample_multinomial(particles, weights)
  resampled_stratified <- .resample_stratified(particles, weights)
  resampled_systematic <- .resample_systematic(particles, weights)

  expect_true(all(resampled_multinomial %in% particles))
  expect_true(all(resampled_stratified %in% particles))
  expect_true(all(resampled_systematic %in% particles))

  expect_equal(nrow(resampled_multinomial), nrow(particles))
  expect_equal(nrow(resampled_stratified), nrow(particles))
  expect_equal(nrow(resampled_systematic), nrow(particles))
})