tests/testthat/test-srr-mcf.R

In ReliaGrowR: Reliability Growth Analysis and Repairable Systems Modeling

#' @srrstats {G5.0} Tests use standard recurrent event data.
#' @srrstats {G5.2} Unit tests demonstrate error messages and compare results.
#' @srrstats {G5.2a} Every message produced by stop() is unique.
#' @srrstats {G5.4} Correctness tests with known MCF values.
#' @srrstats {G5.8a} Checks for zero-length data.
#' @srrstats {G5.8b} Checks for unsupported data types.
#' @srrstats {G5.8c} Checks for data with NA fields.

# --- Input validation tests ---

test_that("mcf errors on missing id", {
  expect_error(mcf(time = c(1, 2)), "'id' must be provided.", fixed = TRUE)
})

test_that("mcf errors on missing time", {
  expect_error(mcf(id = c(1, 1)), "'time' must be provided.", fixed = TRUE)
})

test_that("mcf errors on empty id", {
  expect_error(mcf(id = c(), time = c()), "'id' must be provided.", fixed = TRUE)
})

test_that("mcf errors on empty time", {
  expect_error(mcf(id = c(1), time = c()), "'time' must be provided.", fixed = TRUE)
})

test_that("mcf errors on non-numeric time", {
  expect_error(
    mcf(id = c(1, 1), time = c("a", "b")),
    "'time' must be a numeric vector.", fixed = TRUE
  )
})

test_that("mcf errors on NA in time", {
  expect_error(
    mcf(id = c(1, 1), time = c(100, NA)),
    "'time' contains missing (NA) or NaN values.", fixed = TRUE
  )
})

test_that("mcf errors on NaN in time", {
  expect_error(
    mcf(id = c(1, 1), time = c(100, NaN)),
    "'time' contains missing (NA) or NaN values.", fixed = TRUE
  )
})

test_that("mcf errors on non-positive time", {
  expect_error(
    mcf(id = c(1, 1), time = c(0, 100)),
    "All values in 'time' must be finite and > 0.", fixed = TRUE
  )
})

test_that("mcf errors on infinite time", {
  expect_error(
    mcf(id = c(1, 1), time = c(100, Inf)),
    "All values in 'time' must be finite and > 0.", fixed = TRUE
  )
})

test_that("mcf errors on mismatched id and time lengths", {
  expect_error(
    mcf(id = c(1, 2, 3), time = c(100, 200)),
    "'id' and 'time' must have the same length.", fixed = TRUE
  )
})

test_that("mcf errors on non-numeric event", {
  expect_error(
    mcf(id = c(1, 1), time = c(100, 200), event = c("a", "b")),
    "'event' must be a numeric vector.", fixed = TRUE
  )
})

test_that("mcf errors on mismatched event length", {
  expect_error(
    mcf(id = c(1, 1), time = c(100, 200), event = c(1)),
    "'event' and 'time' must have the same length.", fixed = TRUE
  )
})

test_that("mcf errors on NA in event", {
  expect_error(
    mcf(id = c(1, 1), time = c(100, 200), event = c(1, NA)),
    "'event' contains missing (NA) or NaN values.", fixed = TRUE
  )
})

test_that("mcf errors on invalid event values", {
  expect_error(
    mcf(id = c(1, 1), time = c(100, 200), event = c(1, 2)),
    "'event' must contain only 0 (censored) or 1 (event).", fixed = TRUE
  )
})

test_that("mcf errors on invalid conf_level", {
  expect_error(
    mcf(id = c(1), time = c(100), conf_level = "a"),
    "'conf_level' must be a single numeric value.", fixed = TRUE
  )
  expect_error(
    mcf(id = c(1), time = c(100), conf_level = 0),
    "'conf_level' must be between 0 and 1 (exclusive).", fixed = TRUE
  )
  expect_error(
    mcf(id = c(1), time = c(100), conf_level = 1),
    "'conf_level' must be between 0 and 1 (exclusive).", fixed = TRUE
  )
})

# --- Data frame input tests ---

test_that("mcf works with data frame input", {
  df <- data.frame(id = c(1, 1, 2, 2), time = c(100, 200, 150, 300))
  result <- mcf(data = df)
  expect_s3_class(result, "mcf")
  expect_equal(result$n_systems, 2)
  expect_equal(result$n_events, 4)
})

test_that("mcf data frame errors on missing columns", {
  expect_error(
    mcf(data = data.frame(x = 1:3)),
    "'data' must contain a column named 'id'.", fixed = TRUE
  )
  expect_error(
    mcf(data = data.frame(id = 1:3)),
    "'data' must contain a column named 'time'.", fixed = TRUE
  )
})

test_that("mcf errors on non-data-frame data", {
  expect_error(
    mcf(data = list(id = 1, time = 1)),
    "'data' must be a data frame.", fixed = TRUE
  )
})

test_that("mcf data frame with event column works", {
  df <- data.frame(
    id = c(1, 1, 2, 2),
    time = c(100, 200, 150, 300),
    event = c(1, 0, 1, 1)
  )
  result <- mcf(data = df)
  expect_s3_class(result, "mcf")
  expect_equal(result$n_events, 3)
})

# --- Correctness tests ---

test_that("mcf computes correct values for simple single-system case", {
  # Single system with events at 100, 200, 300
  id <- c(1, 1, 1)
  time <- c(100, 200, 300)
  result <- mcf(id, time)

  # For single system, MCF = cumulative count: 1, 2, 3
  expect_equal(result$mcf, c(1, 2, 3))
  expect_equal(result$time, c(100, 200, 300))
  expect_equal(result$n_systems, 1)
  expect_equal(result$n_events, 3)
})

test_that("mcf computes correct values for multi-system case", {
  # System 1: events at 100, 300; max_time = 300

# System 2: events at 100, 200; max_time = 200
  # At t=100: d=2, n=2, increment = 1.0
  # At t=200: d=1, n=2, increment = 0.5
  # At t=300: d=1, n=1, increment = 1.0
  id <- c(1, 1, 2, 2)
  time <- c(100, 300, 100, 200)
  result <- mcf(id, time)

  expect_equal(result$time, c(100, 200, 300))
  expect_equal(result$mcf, c(1.0, 1.5, 2.5))
  expect_equal(result$n_systems, 2)
  expect_equal(result$n_events, 4)
})

test_that("mcf with censoring excludes censored observations from events", {
  id <- c(1, 1, 2, 2)
  time <- c(100, 300, 100, 200)
  event <- c(1, 0, 1, 1)  # System 1's second obs is censoring

  result <- mcf(id, time, event)
  # Events at: t=100 (sys 1 + sys 2), t=200 (sys 2)
  # At t=100: d=2, n=2, increment = 1.0
  # At t=200: d=1, n=2, increment = 0.5
  expect_equal(result$time, c(100, 200))
  expect_equal(result$mcf, c(1.0, 1.5))
  expect_equal(result$n_events, 3)
})

test_that("mcf confidence bounds are wider at higher confidence level", {
  id <- c(1, 1, 1, 2, 2, 3, 3, 3)
  time <- c(100, 200, 300, 100, 250, 50, 150, 400)

  result_90 <- mcf(id, time, conf_level = 0.90)
  result_99 <- mcf(id, time, conf_level = 0.99)

  width_90 <- result_90$upper_bounds - result_90$lower_bounds
  width_99 <- result_99$upper_bounds - result_99$lower_bounds

  expect_true(all(width_99 >= width_90))
})

test_that("mcf lower bounds are non-negative", {
  id <- c(1, 1, 2, 2, 3)
  time <- c(100, 200, 150, 300, 50)
  result <- mcf(id, time)
  expect_true(all(result$lower_bounds >= 0))
})

# --- end_time (exposure) tests ---

test_that("mcf with end_time keeps systems in risk set longer", {
  # System 1: event at 100; last event = 100
  # System 2: event at 200; last event = 200
  # Without end_time: at t=200, n=1 (sys1 dropped out at 100)
  # With end_time = 500 for both: at t=200, n=2
  id <- c(1, 2)
  time <- c(100, 200)

  result_no_et <- mcf(id, time)
  result_et <- mcf(id, time, end_time = c("1" = 500, "2" = 500))

  # Without end_time: at t=200, n_j=1 so increment = 1/1 = 1
  # With end_time: at t=200, n_j=2 so increment = 1/2 = 0.5
  # MCF at t=200 should be lower with end_time
  expect_true(result_et$mcf[length(result_et$mcf)] <
                result_no_et$mcf[length(result_no_et$mcf)])
})

test_that("mcf with end_time produces correct values", {
  # System 1: event at 100, observed until 400
  # System 2: event at 100, event at 300, observed until 300
  # At t=100: d=2, n=2, increment = 1.0

  # At t=300: d=1, n=2 (sys1 still at risk until 400), increment = 0.5
  id <- c(1, 2, 2)
  time <- c(100, 100, 300)
  end_time <- c("1" = 400, "2" = 300)

  result <- mcf(id, time, end_time = end_time)

  expect_equal(result$time, c(100, 300))
  expect_equal(result$mcf, c(1.0, 1.5))
})

test_that("mcf with unnamed end_time works", {
  id <- c(1, 2)
  time <- c(100, 200)
  # Unnamed: assumed to be in order of unique(id) = c(1, 2)
  result <- mcf(id, time, end_time = c(500, 500))
  expect_s3_class(result, "mcf")
})

test_that("mcf errors on unnamed end_time with wrong length", {
  id <- c(1, 2)
  time <- c(100, 200)
  expect_error(
    mcf(id, time, end_time = c(500, 500, 500)),
    "Unnamed 'end_time' must have one value per system"
  )
})

test_that("mcf errors on non-numeric end_time", {
  id <- c(1, 2)
  time <- c(100, 200)
  expect_error(
    mcf(id, time, end_time = c("a", "b")),
    "'end_time' must be a numeric vector.", fixed = TRUE
  )
})

test_that("mcf errors on NA in end_time", {
  id <- c(1, 2)
  time <- c(100, 200)
  expect_error(
    mcf(id, time, end_time = c(500, NA)),
    "'end_time' contains missing (NA) or NaN values.", fixed = TRUE
  )
})

test_that("mcf errors on non-positive end_time", {
  id <- c(1, 2)
  time <- c(100, 200)
  expect_error(
    mcf(id, time, end_time = c(500, 0)),
    "All values in 'end_time' must be finite and > 0.", fixed = TRUE
  )
})

test_that("mcf output includes end_times", {
  id <- c(1, 1, 2, 2)
  time <- c(100, 200, 150, 300)
  result <- mcf(id, time)
  expect_true("end_times" %in% names(result))
})

test_that("mcf end_times from data frame works", {
  df <- data.frame(
    id = c(1, 1, 2, 2),
    time = c(100, 200, 150, 300),
    end_time = c(500, 500, 500, 500)
  )
  result <- mcf(data = df)
  expect_s3_class(result, "mcf")
  # end_time should be 500 for both systems
  expect_equal(unname(result$end_times), c(500, 500))
})

test_that("mcf with exposure end_times interoperates", {
  # Compute exposure, then use its end_times in MCF
  id <- c(1, 1, 1, 2, 2, 2)
  time <- c(100, 300, 500, 80, 300, 600)
  event <- c(1, 1, 0, 1, 1, 0)

  exp_result <- exposure(id, time, event)
  mcf_result <- mcf(id, time, event, end_time = exp_result$end_times)

  expect_s3_class(mcf_result, "mcf")
  # With censoring at 500 and 600, both systems should be at risk
  # longer than if we only considered event times
  expect_true(all(mcf_result$end_times >= 0))
})

# --- Print and plot tests ---

test_that("print.mcf produces output", {
  id <- c(1, 1, 2, 2)
  time <- c(100, 200, 150, 300)
  result <- mcf(id, time)
  expect_output(print(result), "Mean Cumulative Function")
})

test_that("print.mcf returns invisible", {
  id <- c(1, 1, 2, 2)
  time <- c(100, 200, 150, 300)
  result <- mcf(id, time)
  expect_invisible(print(result))
})

test_that("print.mcf errors on wrong class", {
  expect_error(
    print.mcf(list(a = 1)),
    "'x' must be an object of class 'mcf'.", fixed = TRUE
  )
})

test_that("plot.mcf produces a plot without error", {
  id <- c(1, 1, 2, 2)
  time <- c(100, 200, 150, 300)
  result <- mcf(id, time)
  expect_silent(plot(result, main = "Test MCF"))
})

test_that("plot.mcf validates inputs", {
  id <- c(1, 1, 2, 2)
  time <- c(100, 200, 150, 300)
  result <- mcf(id, time)

  expect_error(plot.mcf(list(a = 1)), "'x' must be an object of class 'mcf'.")
  expect_error(plot(result, conf_bounds = "yes"), "'conf_bounds' must be a single logical value.")
  expect_error(plot(result, legend = "yes"), "'legend' must be a single logical value.")
  expect_error(plot(result, legend_pos = 123), "'legend_pos' must be a single character string.")
})

test_that("plot.mcf works without confidence bounds and legend", {
  id <- c(1, 1, 2, 2)
  time <- c(100, 200, 150, 300)
  result <- mcf(id, time)
  expect_silent(plot(result, conf_bounds = FALSE, legend = FALSE))
})