tests/testthat/test-robustness_score.R

test_that("robustness_score returns value between 0 and 1", {
  pred_fn <- function(X) X %*% c(1, 2)
  set.seed(123)
  X <- matrix(rnorm(100), ncol = 2)
  result <- robustness_score(pred_fn, X, noise_level = 0.05, n_rep = 5)
  expect_true(result >= 0 && result <= 1)
})

test_that("robustness_score returns 1 for constant predictions", {
  pred_fn <- function(X) rep(5, nrow(X))
  set.seed(42)
  X <- matrix(rnorm(100), ncol = 2)
  result <- robustness_score(pred_fn, X)
  expect_equal(result, 1)
})

test_that("lower noise yields higher robustness", {
  pred_fn <- function(X) X %*% c(1, 2, 3)
  set.seed(42)
  X <- matrix(rnorm(300), ncol = 3)
  high_robust <- robustness_score(pred_fn, X, noise_level = 0.01, n_rep = 20)
  low_robust <- robustness_score(pred_fn, X, noise_level = 0.50, n_rep = 20)
  expect_true(high_robust > low_robust)
})

test_that("robustness_score errors on non-function predict_fn", {
  X <- matrix(rnorm(100), ncol = 2)
  expect_error(robustness_score("not_a_function", X), "must be a function")
})

test_that("robustness_score errors on invalid noise_level", {
  pred_fn <- function(X) rowSums(X)
  X <- matrix(rnorm(100), ncol = 2)
  expect_error(
    robustness_score(pred_fn, X, noise_level = -1),
    "positive number"
  )
})

test_that("robustness_score errors on non-matrix X", {
  pred_fn <- function(X) rowSums(X)
  expect_error(robustness_score(pred_fn, c(1, 2, 3)), "must be a matrix")
})

test_that("robustness_score errors on X with NA values", {
  pred_fn <- function(X) rowSums(X)
  X <- matrix(c(1, NA, 3, 4), ncol = 2)
  expect_error(robustness_score(pred_fn, X), "must not contain NA")
})

test_that("robustness_score errors on single-row X", {
  pred_fn <- function(X) rowSums(X)
  X <- matrix(c(1, 2, 3), nrow = 1)
  expect_error(robustness_score(pred_fn, X), "at least 2 rows")
})

Try the TrustworthyMLR package in your browser

Any scripts or data that you put into this service are public.

TrustworthyMLR documentation built on Feb. 20, 2026, 5:09 p.m.