## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  echo = TRUE,
  comment = "#>"
)
library(kofn)
library(flexhaz)
set.seed(42)
old_opts <- options(digits = 4)

## ----functor-demo-------------------------------------------------------------
# Exact: the trivial case -- no information loss
observe_exact()(3.7)

# Right-censoring: systems surviving past tau are censored
obs_rc <- observe_right_censor(tau = 5)
obs_rc(3.7)   # fails before tau -> exact
obs_rc(8.2)   # survives past tau -> right-censored at 5

# Left-censoring: systems failing before tau are censored
obs_lc <- observe_left_censor(tau = 2)
obs_lc(1.5)   # fails before tau -> left-censored at 2
obs_lc(3.7)   # fails after tau  -> exact

# Interval-censoring: failures in [a, b) are binned
obs_ic <- observe_interval_censor(a = 2, b = 6)
obs_ic(4.0)   # inside window  -> interval [2, 6)
obs_ic(1.0)   # outside window -> exact

# Periodic inspection: regular grid with right-censoring at tau
obs_per <- observe_periodic(delta = 3, tau = 15)
obs_per(7.3)  # falls in [6, 9) -> interval
obs_per(20)   # past tau        -> right-censored at 15

## ----rdata-compose------------------------------------------------------------
model <- kofn(k = 2, m = 2, component = dfr_exponential())
theta <- c(1.0, 0.5)
gen <- rdata(model)

# Exact observation (default)
df_exact <- gen(theta, n = 6)
head(df_exact)

# Right-censoring at tau = 2
df_right <- gen(theta, n = 6, observe = observe_right_censor(tau = 2))
head(df_right)

# Periodic inspection every delta = 1 time unit
df_per <- gen(theta, n = 6, observe = observe_periodic(delta = 1, tau = 10))
head(df_per)

## ----scheme-comparison--------------------------------------------------------
set.seed(2026)
R <- 3; n <- 60
theta <- c(1.0, 0.5)
theta_sorted <- sort(theta)
model <- kofn(k = 2, m = 2, component = dfr_exponential())
gen <- rdata(model)
fit_fn <- fit(model)

schemes <- list(
  exact       = NULL,
  right_tau3  = observe_right_censor(tau = 3),
  right_tau1  = observe_right_censor(tau = 1),
  periodic_d1 = observe_periodic(delta = 1, tau = 20),
  left_tau1   = observe_left_censor(tau = 1)
)

results <- lapply(names(schemes), function(nm) {
  ests <- matrix(NA, nrow = R, ncol = 2)
  for (r in seq_len(R)) {
    df <- gen(theta, n, observe = schemes[[nm]])
    res <- tryCatch(fit_fn(df, n_starts = 1L), error = function(e) NULL)
    if (!is.null(res) && !any(is.na(coef(res))))
      ests[r, ] <- sort(coef(res))
  }
  ok <- complete.cases(ests)
  errs <- sweep(ests[ok, , drop = FALSE], 2, theta_sorted)
  data.frame(
    scheme    = nm,
    rmse_1    = round(sqrt(mean(errs[, 1]^2)), 3),
    rmse_2    = round(sqrt(mean(errs[, 2]^2)), 3),
    converged = sum(ok),
    stringsAsFactors = FALSE
  )
})
scheme_rmse <- do.call(rbind, results)
scheme_rmse

## ----mixture-demo-------------------------------------------------------------
obs_mix <- observe_mixture(
  observe_exact(),
  observe_periodic(delta = 2, tau = 20),
  weights = c(0.7, 0.3)
)

set.seed(99)
model <- kofn(k = 2, m = 2, component = dfr_exponential())
gen <- rdata(model)
df_mix <- gen(c(1.0, 0.5), n = 60, observe = obs_mix)
table(df_mix$omega)

## ----mixture-fit--------------------------------------------------------------
fit_fn <- fit(model)
res_mix <- fit_fn(df_mix, n_starts = 1L)
sort(coef(res_mix))

## ----cleanup, include = FALSE-------------------------------------------------
options(old_opts)