Masked Series Systems

Competing Risks with Masked Failure Causes

A series system of \(m\) components fails when any component fails. We observe the system failure time \(t\), but we may not know which component caused the failure. Instead, we observe a candidate set \(C \subseteq \{1, \ldots, m\}\) of components that could have been responsible.

Under standard masking conditions (C1: the true cause is always in the candidate set; C2: masking is symmetric across candidates; C3: masking is independent of system parameters), the log-likelihood contribution for an exact observation with candidate set \(C_i\) under independent exponential components with rates \(\lambda_1, \ldots, \lambda_m\) is:

\[ \ell_i = \log\!\Bigl(\sum_{j \in C_i} \lambda_j\Bigr) - \Bigl(\sum_{j=1}^{m} \lambda_j\Bigr) \, t_i \]

Right-censored observations (system survived past \(t\)) contribute only the survival term:

\[ \ell_i = -\Bigl(\sum_{j=1}^{m} \lambda_j\Bigr) \, t_i \]

These are just two different log-likelihood functions sharing the same parameters, which is exactly what likelihood.contr composes.

Building the Model

library(likelihood.contr)
library(likelihood.model)

# m = 3 components. Candidate set columns: x1, x2, x3 (logical).
m <- 3

masked_exact <- contr_fn(
  loglik = function(df, par, ...) {
    C <- as.matrix(df[, paste0("x", seq_len(m))])
    lambda_c <- rowSums(sweep(C, 2, par, `*`))
    lambda_sys <- sum(par)
    sum(log(lambda_c) - lambda_sys * df$t)
  },
  score = function(df, par, ...) {
    C <- as.matrix(df[, paste0("x", seq_len(m))])
    lambda_c <- rowSums(sweep(C, 2, par, `*`))
    # d/d(lambda_j): sum(C[i,j] / lambda_c[i]) - n * t_bar
    colSums(C / lambda_c) - sum(df$t)
  }
)

masked_right <- contr_fn(
  loglik = function(df, par, ...) {
    -sum(par) * sum(df$t)
  },
  score = function(df, par, ...) {
    rep(-sum(df$t), m)
  }
)

model <- likelihood_contr(
  obs_type = "omega",
  exact = masked_exact,
  right = masked_right,
  assumptions = c(
    "independent exponential components",
    "series system",
    "C1: true cause always in candidate set",
    "C2: symmetric masking",
    "C3: masking independent of parameters"
  )
)
model
#> Likelihood Contribution Model
#> -----------------------------
#> Observation types: exact, right 
#> Dispatch method: column 'omega'
#> Assumptions:
#>  - iid 
#>  - independent exponential components 
#>  - series system 
#>  - C1: true cause always in candidate set 
#>  - C2: symmetric masking 
#>  - C3: masking independent of parameters

Simulating Masked Data

set.seed(42)
n <- 300
true_rates <- c(1.0, 0.5, 0.3)
censor_time <- 2.0
mask_prob <- 0.4  # probability a non-failed component enters candidate set

# Generate component lifetimes and system lifetime
comp_times <- matrix(rexp(n * m, rate = rep(true_rates, each = n)), n, m)
sys_times <- apply(comp_times, 1, min)
failed_comp <- apply(comp_times, 1, which.min)

# Apply right-censoring
obs_times <- pmin(sys_times, censor_time)
omega <- ifelse(sys_times <= censor_time, "exact", "right")

# Generate candidate sets satisfying C1/C2/C3
C <- matrix(FALSE, n, m)
for (i in seq_len(n)) {
  if (omega[i] == "exact") {
    C[i, failed_comp[i]] <- TRUE                        # C1
    others <- setdiff(seq_len(m), failed_comp[i])
    C[i, others] <- runif(length(others)) < mask_prob   # C2/C3
  }
  # right-censored: candidate set stays empty
}

df <- data.frame(t = obs_times, omega = omega, C)
colnames(df)[3:(m + 2)] <- paste0("x", seq_len(m))

cat("Exact:", sum(omega == "exact"),
    " Right-censored:", sum(omega == "right"), "\n")
#> Exact: 291  Right-censored: 9
head(df)
#>           t omega    x1    x2    x3
#> 1 0.1983368 exact  TRUE  TRUE FALSE
#> 2 0.0782418 exact FALSE  TRUE FALSE
#> 3 0.2834910 exact  TRUE FALSE FALSE
#> 4 0.0381919 exact  TRUE FALSE FALSE
#> 5 0.4731766 exact  TRUE  TRUE FALSE
#> 6 0.2087726 exact FALSE  TRUE FALSE

Fitting

result <- fit(model)(df, par = c(0.5, 0.5, 0.5))
summary(result)
#> Maximum Likelihood Estimate (Fisherian)
#> ----------------------------------------
#> 
#> Coefficients:
#>      Estimate Std. Error   2.5% 97.5%
#> [1,]   0.9124     0.0861 0.7436 1.081
#> [2,]   0.5130     0.0718 0.3722 0.654
#> [3,]   0.2470     0.0545 0.1402 0.354
#> 
#> Log-likelihood: -293.8 
#> AIC: 593.6 
#> Number of observations: 300

cat("True rates: ", paste(true_rates, collapse = ", "), "\n")
#> True rates:  1, 0.5, 0.3
cat("Estimated:  ", paste(round(coef(result), 3), collapse = ", "), "\n")
#> Estimated:   0.912, 0.513, 0.247

Why This Works

The key insight is that likelihood.contr does not care what the log-likelihood means, only that each observation type contributes a function f(df, par) -> scalar. The masked series system model is just two contributions (exact with candidate sets, right-censored without) sharing the same rate parameters. The candidate set information lives in the data frame columns, and each contribution function reads what it needs.

This same pattern extends to left-censored and interval-censored masked data, Weibull components, or any parametric family where you can write the log-likelihood contribution as a function of the data and parameters.