test-srr_rdt.R
In ReliaGrowR: Reliability Growth Analysis

#' @srrstats {G5.2} Unit tests demonstrate error messages and compare results with expected values.
#' @srrstats {G5.2a} Every message produced by `stop()` is unique.
#' @srrstats {G5.2b} Unit tests demonstrate error messages and compare results with expected values.
#' @srrstats {G5.4} Unit tests include correctness tests to test that statistical
#' algorithms produce expected results to some fixed test data sets.
#' @srrstats {G5.5} Correctness tests are run with a fixed random seed.
#' @srrstats {G5.8} See sub-tags for responses.
#' @srrstats {G5.8a} Unit tests include checks for zero-length data.
#' @srrstats {G5.8b} Unit tests include checks for unsupported data types.
#' @srrstats {G5.8c} Unit tests include checks for data with 'NA' fields.
#' @srrstats {G5.8d} Unit tests include checks for data outside the scope of the algorithm.
#' @srrstats {G5.9} Unit tests include noise susceptibility tests for expected stochastic behavior.
#' @srrstats {G5.9a} Unit tests check that adding trivial noise to data does not meaningfully change results.
#' @srrstats {G5.10} All unit tests run as part of continuous integration.

test_that("rdt() input validation errors", {
  # target
  expect_error(
    rdt("a", 100, 0.9, n = 10),
    "'target' must be a single finite numeric value."
  )
  expect_error(
    rdt(c(0.9, 0.8), 100, 0.9, n = 10),
    "'target' must be a single finite numeric value."
  )
  expect_error(
    rdt(Inf, 100, 0.9, n = 10),
    "'target' must be a single finite numeric value."
  )
  # expect_error(rdt(0, 100, 0.9, n = 10),
  #              "'target' must be between 0 and 1 (exclusive).")
  # expect_error(rdt(1, 100, 0.9, n = 10),
  #              "'target' must be between 0 and 1 (exclusive).")

  # mission_time
  expect_error(
    rdt(0.9, "a", 0.9, n = 10),
    "'mission_time' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, c(100, 200), 0.9, n = 10),
    "'mission_time' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, Inf, 0.9, n = 10),
    "'mission_time' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, 0, 0.9, n = 10),
    "'mission_time' must be greater than 0."
  )

  # conf_level
  expect_error(
    rdt(0.9, 100, "a", n = 10),
    "'conf_level' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, 100, c(0.9, 0.8), n = 10),
    "'conf_level' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, 100, Inf, n = 10),
    "'conf_level' must be a single finite numeric value."
  )
  # expect_error(rdt(0.9, 100, 0, n = 10),
  #              "'conf_level' must be between 0 and 1 (exclusive).")
  # expect_error(rdt(0.9, 100, 1, n = 10),
  #              "'conf_level' must be between 0 and 1 (exclusive).")

  # beta
  expect_error(
    rdt(0.9, 100, 0.9, beta = "a", n = 10),
    "'beta' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, 100, 0.9, beta = c(1, 2), n = 10),
    "'beta' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, 100, 0.9, beta = Inf, n = 10),
    "'beta' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, 100, 0.9, beta = 0, n = 10),
    "'beta' must be greater than 0."
  )

  # n vs test_time mutual exclusivity
  expect_error(
    rdt(0.9, 100, 0.9, n = 10, test_time = 200),
    "Provide only one of 'n' \\(sample size\\) or 'test_time', not both."
  )
  expect_error(
    rdt(0.9, 100, 0.9),
    "Provide exactly one of 'n' \\(sample size\\) or 'test_time'."
  )

  # n validation
  expect_error(
    rdt(0.9, 100, 0.9, n = "a"),
    "'n' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, 100, 0.9, n = c(1, 2)),
    "'n' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, 100, 0.9, n = Inf),
    "'n' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, 100, 0.9, n = 0),
    "'n' must be a positive integer."
  )
  expect_error(
    rdt(0.9, 100, 0.9, n = 3.5),
    "'n' must be a positive integer."
  )

  # test_time validation
  expect_error(
    rdt(0.9, 100, 0.9, test_time = "a"),
    "'test_time' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, 100, 0.9, test_time = c(1, 2)),
    "'test_time' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, 100, 0.9, test_time = Inf),
    "'test_time' must be a single finite numeric value."
  )
  expect_error(
    rdt(0.9, 100, 0.9, test_time = 0),
    "'test_time' must be greater than 0."
  )
})

test_that("print.rdt() input validation errors", {
  expect_error(
    print.rdt(list()),
    "'x' must be an object of class 'rdt'."
  )
})

test_that("RDT with sample size input is stable to trivial noise", {
  set.seed(123)

  # Base parameters
  target <- 0.9
  mission_time <- 1000
  conf_level <- 0.9
  beta <- 1
  n <- 10

  base_result <- rdt(target, mission_time, conf_level, beta, n = n)

  # Apply very small noise to continuous parameters
  noise <- function(x) x + rnorm(1, 0, 1e-8)
  noisy_result <- rdt(noise(target), noise(mission_time), noise(conf_level),
    noise(beta),
    n = n
  )

  # Sample size input stays exact
  expect_equal(base_result$Input_Sample_Size, noisy_result$Input_Sample_Size)

  # Required test time should be nearly identical
  expect_equal(base_result$Required_Test_Time,
    noisy_result$Required_Test_Time,
    tolerance = 1e-6
  )
})

test_that("RDT with test time input is stable to trivial noise", {
  set.seed(456)

  # Base parameters
  target <- 0.9
  mission_time <- 1000
  conf_level <- 0.9
  beta <- 1
  test_time <- 2000

  base_result <- rdt(target, mission_time, conf_level, beta, test_time = test_time)

  # Apply very small noise
  noise <- function(x) x + rnorm(1, 0, 1e-8)
  noisy_result <- rdt(noise(target), noise(mission_time), noise(conf_level),
    noise(beta),
    test_time = noise(test_time)
  )

  # Input test time should remain close
  expect_equal(base_result$Input_Test_Time,
    noisy_result$Input_Test_Time,
    tolerance = 1e-6
  )

  # Required sample size is integer-valued; expect identical result
  expect_equal(base_result$Required_Sample_Size, noisy_result$Required_Sample_Size)
})

test_that("print.rdt works for required test time", {
  plan <- rdt(
    target = 0.9, mission_time = 1000,
    conf_level = 0.9, beta = 1, n = 10
  )

  # Ensure output contains expected lines
  expect_output(print(plan), "Reliability Demonstration Test \\(RDT\\) Plan")
  expect_output(print(plan), "Distribution:")
  expect_output(print(plan), "Weibull Shape Parameter")
  expect_output(print(plan), "Target Reliability")
  expect_output(print(plan), "Mission Time")
  expect_output(print(plan), "Input Sample Size")
  expect_output(print(plan), "Required Test Time")

  # Invisibly returns the input object
  expect_invisible(print(plan))
})

test_that("print.rdt works for required sample size", {
  plan <- rdt(
    target = 0.9, mission_time = 1000,
    conf_level = 0.9, beta = 1, test_time = 2000
  )

  expect_output(print(plan), "Reliability Demonstration Test \\(RDT\\) Plan")
  expect_output(print(plan), "Distribution:")
  expect_output(print(plan), "Weibull Shape Parameter")
  expect_output(print(plan), "Target Reliability")
  expect_output(print(plan), "Mission Time")
  expect_output(print(plan), "Input Test Time")
  expect_output(print(plan), "Required Sample Size")

  expect_invisible(print(plan))
})

test_that("print.rdt errors on wrong input", {
  expect_error(print.rdt(123), "'x' must be an object of class 'rdt'")
  expect_error(print.rdt(list()), "'x' must be an object of class 'rdt'")
})