Update sim_failures() to add optional sim window

Author: paulgovan

.Rproj.user/CB2BA49E/pcs/files-pane.pper

@@ -5,5 +5,5 @@
             "ascending": true
         }
     ],
-    "path": "~/Documents/ReliaGrowR"
+    "path": "~/Documents/ReliaGrowR/R"
 }

R/sim_failures.R

@@ -3,6 +3,8 @@
 #' Simulates which units in a non-failed population fail next using probability
 #' proportional to size (PPS) sampling based on unit runtimes. Units with
 #' longer runtimes have a proportionally higher probability of being selected.
+#' The full fleet is returned: selected units are labelled `"Failure"` and the
+#' remaining units are labelled `"Suspension"`.
 #'
 #' @srrstats {G1.0} This function implements probability proportional to size
 #' (PPS) sampling, a standard statistical technique.
@@ -21,17 +23,30 @@
 #'   runtime of each unit in the non-failed population.
 #' @param replace Logical scalar. If `TRUE`, sampling is done with replacement
 #'   (a unit may be selected more than once). Default is `FALSE`.
-#' @return A data frame with `n` rows sorted by `runtime`, containing:
-#'   \item{index}{Integer index of the selected unit in `runtimes`.}
-#'   \item{runtime}{Runtime of the selected unit (reported failure time).}
+#' @param window `NULL` or a single positive numeric. The width of the
+#'   observation window. When `NULL` (default), event times equal current
+#'   runtimes. When provided, failure times are
+#'   `runtime + Uniform(0, window)` and suspension times are
+#'   `runtime + window`.
+#' @return A data frame with `length(runtimes)` rows sorted ascending by
+#'   `runtime`, containing:
+#'   \item{index}{Integer index of the unit in `runtimes`.}
+#'   \item{runtime}{Simulated event time.}
+#'   \item{type}{Character; `"Failure"` for selected units, `"Suspension"` for
+#'     the rest.}
 #' @family data preparation
 #' @examples
 #' set.seed(42)
 #' runtimes <- c(100, 500, 200, 800, 300)
 #' result <- sim_failures(2, runtimes)
 #' print(result)
+#'
+#' # With an observation window
+#' set.seed(42)
+#' result_w <- sim_failures(2, runtimes, window = 50)
+#' print(result_w)
 #' @export
-sim_failures <- function(n, runtimes, replace = FALSE) {
+sim_failures <- function(n, runtimes, replace = FALSE, window = NULL) {
   # Validate n
   if (!is.numeric(n) || length(n) != 1) {
     stop("'n' must be a single numeric value.")
@@ -67,11 +82,41 @@ sim_failures <- function(n, runtimes, replace = FALSE) {
     stop("'n' cannot exceed the number of units in 'runtimes' when replace = FALSE.")
   }
 
+  # Validate window
+  if (!is.null(window)) {
+    if (!is.numeric(window) || length(window) != 1) {
+      stop("'window' must be a single positive numeric value.")
+    }
+    if (is.na(window) || is.nan(window) || !is.finite(window)) {
+      stop("'window' must be a finite positive numeric value.")
+    }
+    if (window <= 0) {
+      stop("'window' must be a positive numeric value.")
+    }
+  }
+
   # PPS sampling
   prob <- runtimes / sum(runtimes)
-  idx <- sample(seq_along(runtimes), size = n, replace = replace, prob = prob)
+  idx  <- sample(seq_along(runtimes), size = n, replace = replace, prob = prob)
+
+  fail_idx <- unique(idx)
+  susp_idx <- setdiff(seq_along(runtimes), fail_idx)
+
+  # Compute event times
+  if (is.null(window)) {
+    fail_times <- runtimes[fail_idx]
+    susp_times <- runtimes[susp_idx]
+  } else {
+    fail_times <- runtimes[fail_idx] + runif(length(fail_idx), 0, window)
+    susp_times <- runtimes[susp_idx] + window
+  }
 
-  result <- data.frame(index = idx, runtime = runtimes[idx])
+  result <- data.frame(
+    index   = c(fail_idx,       susp_idx),
+    runtime = c(fail_times,     susp_times),
+    type    = c(rep("Failure",    length(fail_idx)),
+                rep("Suspension", length(susp_idx)))
+  )
   result <- result[order(result$runtime), ]
   rownames(result) <- NULL
 

man/sim_failures.Rd

@@ -4,10 +4,12 @@ test_that("sim_failures returns correct output structure", {
   result <- sim_failures(2, runtimes)
 
   expect_s3_class(result, "data.frame")
-  expect_named(result, c("index", "runtime"))
-  expect_equal(nrow(result), 2)
+  expect_named(result, c("index", "runtime", "type"))
+  expect_equal(nrow(result), 5)
   expect_type(result$index, "integer")
   expect_type(result$runtime, "double")
+  expect_type(result$type, "character")
+  expect_true(all(result$type %in% c("Failure", "Suspension")))
   # sorted ascending by runtime
   expect_true(all(diff(result$runtime) >= 0))
 })
@@ -17,7 +19,8 @@ test_that("sim_failures PPS bias: higher-runtime units selected more often", {
   runtimes <- c(10, 1000)
   N <- 10000
   draws <- replicate(N, {
-    sim_failures(1, runtimes, replace = FALSE)$index
+    res <- sim_failures(1, runtimes, replace = FALSE)
+    res$index[res$type == "Failure"]
   })
   # unit 2 has 100x the runtime of unit 1, so it should be chosen ~99% of the time
   prop_unit2 <- mean(draws == 2)
@@ -72,10 +75,10 @@ test_that("sim_failures errors: n > length(runtimes) without replacement", {
     sim_failures(4, c(100, 200, 300), replace = FALSE),
     "'n' cannot exceed the number of units in 'runtimes' when replace = FALSE."
   )
-  # Same call with replace = TRUE should succeed
+  # Same call with replace = TRUE should succeed (returns full fleet of 3 rows)
   set.seed(1)
   result <- sim_failures(4, c(100, 200, 300), replace = TRUE)
-  expect_equal(nrow(result), 4)
+  expect_equal(nrow(result), 3)
 })
 
 test_that("sim_failures is reproducible with the same seed", {
@@ -90,12 +93,12 @@ test_that("sim_failures is reproducible with the same seed", {
   expect_equal(r1, r2)
 })
 
-test_that("sim_failures edge case: n = 1 returns a 1-row data frame", {
+test_that("sim_failures edge case: n = 1 returns full fleet (3 rows)", {
   set.seed(7)
   runtimes <- c(100, 500, 200)
   result <- sim_failures(1, runtimes)
-  expect_equal(nrow(result), 1)
-  expect_named(result, c("index", "runtime"))
+  expect_equal(nrow(result), 3)
+  expect_named(result, c("index", "runtime", "type"))
 })
 
 test_that("sim_failures edge case: n = length(runtimes) returns all units without replacement", {
@@ -105,3 +108,96 @@ test_that("sim_failures edge case: n = length(runtimes) returns all units withou
   expect_equal(nrow(result), length(runtimes))
   expect_equal(sort(result$index), seq_along(runtimes))
 })
+
+test_that("sim_failures type labels: correct counts of Failure and Suspension", {
+  set.seed(42)
+  runtimes <- c(100, 500, 200, 800, 300)
+  n <- 2
+  result <- sim_failures(n, runtimes, replace = FALSE)
+
+  n_failures    <- sum(result$type == "Failure")
+  n_suspensions <- sum(result$type == "Suspension")
+
+  # With replace = FALSE and n unique draws, exactly n failures and rest suspensions
+  expect_equal(n_failures, n)
+  expect_equal(n_suspensions, length(runtimes) - n)
+})
+
+test_that("sim_failures window: failure times are in (runtime, runtime + window]", {
+  set.seed(42)
+  runtimes <- c(100, 500, 200, 800, 300)
+  w <- 50
+  result <- sim_failures(2, runtimes, window = w)
+
+  failures <- result[result$type == "Failure", ]
+  for (i in seq_len(nrow(failures))) {
+    orig <- runtimes[failures$index[i]]
+    expect_gt(failures$runtime[i], orig)
+    expect_lte(failures$runtime[i], orig + w)
+  }
+})
+
+test_that("sim_failures window: suspension times equal runtime + window exactly", {
+  set.seed(42)
+  runtimes <- c(100, 500, 200, 800, 300)
+  w <- 50
+  result <- sim_failures(2, runtimes, window = w)
+
+  suspensions <- result[result$type == "Suspension", ]
+  for (i in seq_len(nrow(suspensions))) {
+    orig <- runtimes[suspensions$index[i]]
+    expect_equal(suspensions$runtime[i], orig + w)
+  }
+})
+
+test_that("sim_failures window = NULL: runtimes unchanged", {
+  set.seed(42)
+  runtimes <- c(100, 500, 200, 800, 300)
+  result <- sim_failures(2, runtimes, window = NULL)
+
+  for (i in seq_len(nrow(result))) {
+    expect_equal(result$runtime[i], runtimes[result$index[i]])
+  }
+})
+
+test_that("sim_failures window validation errors", {
+  runtimes <- c(100, 500, 200)
+
+  expect_error(
+    sim_failures(1, runtimes, window = "50"),
+    "'window' must be a single positive numeric value."
+  )
+  expect_error(
+    sim_failures(1, runtimes, window = c(10, 20)),
+    "'window' must be a single positive numeric value."
+  )
+  expect_error(
+    sim_failures(1, runtimes, window = NA_real_),
+    "'window' must be a finite positive numeric value."
+  )
+  expect_error(
+    sim_failures(1, runtimes, window = Inf),
+    "'window' must be a finite positive numeric value."
+  )
+  expect_error(
+    sim_failures(1, runtimes, window = 0),
+    "'window' must be a positive numeric value."
+  )
+  expect_error(
+    sim_failures(1, runtimes, window = -5),
+    "'window' must be a positive numeric value."
+  )
+})
+
+test_that("sim_failures reproducibility with window", {
+  runtimes <- c(100, 500, 200, 800, 300)
+  w <- 50
+
+  set.seed(42)
+  r1 <- sim_failures(2, runtimes, window = w)
+
+  set.seed(42)
+  r2 <- sim_failures(2, runtimes, window = w)
+
+  expect_equal(r1, r2)
+})