# Complete (uncensored) sample ------------------------------------------------

#' Generate a complete (uncensored) random sample
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param seed optional integer seed for reproducibility.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 1 = event for all observations in a complete
#'   sample), and \code{time2} (\code{NA} for all).
#' @export
#' @examples
#' exp_dist <- dist_spec(
#'   q = function(u, p) -log(1 - u) / p$rate,
#'   surv = function(x, p) exp(-p$rate * x),
#'   param = list(rate = 1), name = "Exp(1)"
#' )
#' samp <- r_complete(50, exp_dist, seed = 42)
#' table(samp$status)
r_complete <- function(n, dist, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true <- .rng_stream(n, dist)
  .as_censored_sample("complete", dist, n, seed, t_true, t_true,
                      rep(1L, n))
}

# Truncation -------------------------------------------------------------------

#' Right-truncated random sample
#'
#' Observations are drawn from \eqn{X \mid X \le \code{right}}.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param right upper truncation point.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(p = function(x, p) 1 - exp(-p$rate * x),
#'                q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_right_truncation(20, d, right = 3, seed = 1)
r_right_truncation <- function(n, dist, right, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true <- .rng_truncated(n, dist, left = dist$lower, right = right)
  .as_censored_sample("right_truncation", dist, n, seed, t_true, t_true,
                      rep(1L, n), extra = list(right = right))
}

#' Left-truncated random sample
#'
#' Observations are drawn from \eqn{X \mid X \ge \code{left}}.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param left lower truncation point.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(p = function(x, p) 1 - exp(-p$rate * x),
#'                q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_left_truncation(20, d, left = 0.5, seed = 1)
r_left_truncation <- function(n, dist, left, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  upper <- if (is.finite(dist$upper)) dist$upper else left + 1e4
  t_true <- .rng_truncated(n, dist, left = left, right = upper)
  .as_censored_sample("left_truncation", dist, n, seed, t_true, t_true,
                      rep(1L, n), extra = list(left = left))
}

# Simple censoring -------------------------------------------------------------

#' Random censoring
#'
#' Each subject is observed until \eqn{\min(X, C)} where \eqn{C} follows an
#' exponential distribution with rate \code{cen_rate}.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param cen_rate exponential censoring rate (default \code{0.2}).
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_random_censor(30, d, seed = 1)
r_random_censor <- function(n, dist, cen_rate = 0.2, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true <- .rng_stream(n, dist)
  c_time <- stats::rexp(n, rate = cen_rate)
  cens   <- t_true > c_time
  x      <- ifelse(cens, c_time, t_true)
  status <- ifelse(cens, 0L, 1L)
  .as_censored_sample("random", dist, n, seed, t_true, x, status,
                      extra = list(cen_rate = cen_rate))
}

#' Right censoring at a fixed time
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param cen_time fixed right-censoring time.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_right_censor(30, d, cen_time = 2, seed = 1)
r_right_censor <- function(n, dist, cen_time, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true <- .rng_stream(n, dist)
  cens   <- t_true > cen_time
  x      <- pmin(t_true, cen_time)
  status <- ifelse(cens, 0L, 1L)
  .as_censored_sample("right", dist, n, seed, t_true, x, status,
                      extra = list(cen_time = cen_time))
}

#' Left censoring at a fixed threshold
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param threshold left-censoring threshold.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_left_censor(30, d, threshold = 0.5, seed = 1)
r_left_censor <- function(n, dist, threshold, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true <- .rng_stream(n, dist)
  cens   <- t_true < threshold
  x      <- ifelse(cens, threshold, t_true)
  status <- ifelse(cens, 2L, 1L)
  .as_censored_sample("left", dist, n, seed, t_true, x, status,
                      extra = list(threshold = threshold))
}

#' Interval censoring
#'
#' A proportion \code{prop_interval} of subjects are interval-censored into
#' windows of width \code{width}; optional random right censoring applies to
#' the remainder at rate \code{cen_rate}.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param width interval window width.
#' @param prop_interval fraction interval-censored (default \code{0.3}).
#' @param cen_rate exponential rate for additional right censoring
#'   (default \code{0.2}).
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_interval_censor(30, d, width = 0.5, seed = 1)
r_interval_censor <- function(n, dist, width, prop_interval = 0.3,
                              cen_rate = 0.2, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true  <- .rng_stream(n, dist)
  x       <- t_true
  time2   <- rep(NA_real_, n)
  status  <- rep(1L, n)

  n_int <- floor(prop_interval * n)
  if (n_int > 0L) {
    int_idx <- sample(n, n_int)
    t1 <- floor(t_true[int_idx] / width) * width
    t2 <- t1 + width
    x[int_idx]      <- pmax(t1, dist$lower)
    time2[int_idx]  <- t2
    status[int_idx] <- 3L
  }

  rem <- setdiff(seq_len(n), which(status == 3L))
  rc_frac <- 1 - prop_interval            # remaining subjects exposed to RC
  n_rc <- floor(rc_frac * length(rem))
  if (n_rc > 0L && length(rem) > 0L) {
    rc_idx <- sample(rem, min(n_rc, length(rem)))
    c_time <- stats::rexp(length(rc_idx), rate = cen_rate)
    x[rc_idx] <- pmin(t_true[rc_idx], c_time)
    status[rc_idx] <- ifelse(t_true[rc_idx] <= c_time, 1L, 0L)
  }

  .as_censored_sample("interval", dist, n, seed, t_true, x, status,
                      time2 = time2,
                      extra = list(width = width,
                                   prop_interval = prop_interval,
                                   cen_rate = cen_rate))
}

#' Middle censoring
#'
#' Observations that fall within the interval \code{[lower, upper]} are
#' middle-censored; observations outside this interval are observed exactly.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param lower lower bound of the middle censoring interval.
#' @param upper upper bound of the middle censoring interval.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_middle_censor(30, d, lower = 0.5, upper = 1.5, seed = 1)
r_middle_censor <- function(n, dist, lower, upper, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  if (lower >= upper) {
    stop("'lower' must be strictly less than 'upper'.", call. = FALSE)
  }
  .apply_seed(seed)
  t_true <- .rng_stream(n, dist)
  x      <- t_true
  status <- rep(1L, n)
  time2  <- rep(NA_real_, n)

  # Middle censoring: observations in [lower, upper] are censored
  middle <- t_true >= lower & t_true <= upper
  if (any(middle)) {
    # For middle-censored observations, report the interval boundaries
    # x stores the lower bound, time2 stores the upper bound
    x[middle]      <- lower
    time2[middle]  <- upper
    status[middle] <- 4L  # Status 4 = middle-censored
  }

  .as_censored_sample("middle", dist, n, seed, t_true, x, status,
                      time2 = time2,
                      extra = list(lower = lower, upper = upper))
}

#' Block random censoring
#'
#' Subjects are partitioned into blocks of size \code{block_size}; entire
#' blocks are randomly selected for right censoring at the block maximum
#' observed failure time or at an exponential censoring time, whichever is
#' smaller.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param block_size block length (default \code{5}).
#' @param prop_blocks fraction of blocks censored (default \code{0.4}).
#' @param cen_rate exponential censoring rate within censored blocks.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_block_random_censor(30, d, seed = 1)
r_block_random_censor <- function(n, dist, block_size = 5L,
                                  prop_blocks = 0.4, cen_rate = 0.2,
                                  seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true <- .rng_stream(n, dist)
  x      <- t_true
  status <- rep(1L, n)

  n_blocks <- ceiling(n / block_size)
  blocks   <- split(seq_len(n), rep(seq_len(n_blocks),
                                    each = block_size, length.out = n))
  n_cen_blocks <- floor(prop_blocks * n_blocks)
  if (n_cen_blocks > 0L) {
    cen_block_ids <- sample(n_blocks, n_cen_blocks)
    for (b in cen_block_ids) {
      idx <- blocks[[b]]
      c_time <- stats::rexp(1, rate = cen_rate)
      block_cen <- pmin(max(t_true[idx]), c_time)
      cens <- t_true[idx] > block_cen
      x[idx]      <- ifelse(cens, block_cen, t_true[idx])
      status[idx] <- ifelse(cens, 0L, 1L)
    }
  }

  .as_censored_sample("block_random", dist, n, seed, t_true, x, status,
                      extra = list(block_size = block_size,
                                   prop_blocks = prop_blocks,
                                   cen_rate = cen_rate))
}

# Type-I / Type-II -------------------------------------------------------------

#' Type-I (time-terminated) censoring
#'
#' All units are observed until fixed time \code{cen_time}; failures after
#' that time are right-censored.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param cen_time fixed censoring time (default: 70th percentile of latent
#'   failure times from a pilot draw).
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_type1_censor(30, d, cen_time = 2, seed = 1)
r_type1_censor <- function(n, dist, cen_time = NULL, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true <- .rng_stream(n, dist)
  if (is.null(cen_time)) cen_time <- .default_cen_time(t_true)
  cens   <- t_true > cen_time
  x      <- pmin(t_true, cen_time)
  status <- ifelse(cens, 0L, 1L)
  .as_censored_sample("type1", dist, n, seed, t_true, x, status,
                      extra = list(cen_time = cen_time))
}

#' Type-II (failure-terminated) censoring
#'
#' Experiment stops at the \code{r_failures}-th observed failure; remaining
#' units are right-censored at that time.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param r_failures number of failures before termination (default
#'   \eqn{\lfloor 0.7n \rfloor}).
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_type2_censor(30, d, r_failures = 20, seed = 1)
r_type2_censor <- function(n, dist, r_failures = NULL, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true <- .rng_stream(n, dist)
  if (is.null(r_failures)) r_failures <- .default_r_failures(n)
  stop <- .type2_stop(t_true, r_failures)
  .as_censored_sample("type2", dist, n, seed, t_true, stop$x, stop$status,
                      extra = list(r_failures = min(as.integer(r_failures), n),
                                   r_th_time = stop$r_th_time))
}

#' Progressive Type-II censoring
#'
#' At the \code{j}-th failure time, \code{scheme[j]} surviving units are
#' randomly removed from the risk set.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param scheme integer vector of removals at successive failure times.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_progressive_type2_censor(30, d, seed = 1)
r_progressive_type2_censor <- function(n, dist, scheme = NULL, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true <- .rng_stream(n, dist)
  if (is.null(scheme)) scheme <- rep(1L, min(10L, max(1L, n %/% 5L)))
  pr <- .progressive_type2_removals(t_true, scheme)
  x <- t_true
  status <- ifelse(pr$removed, 0L, 1L)
  x[pr$removed] <- pr$censor_at[pr$removed]
  .as_censored_sample("progressive_type2", dist, n, seed, t_true, x, status,
                      extra = list(scheme = as.integer(scheme)))
}

#' Progressive first-failure censoring
#'
#' At each failure one surviving unit is randomly removed until only one unit
#' remains under observation.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_progressive_first_failure(15, d, seed = 1)
r_progressive_first_failure <- function(n, dist, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true  <- .rng_stream(n, dist)
  ord     <- order(t_true)
  removed <- logical(n)
  n_remove <- max(0L, n - 1L)

  censor_at <- rep(NA_real_, n)
  for (j in seq_len(n_remove)) {
    fail_pos  <- ord[j]
    t_j       <- t_true[fail_pos]
    remaining <- ord[which(!removed[ord] & ord > fail_pos)]
    if (length(remaining) == 0L) break
    pick <- sample(remaining, 1L)
    removed[pick] <- TRUE
    censor_at[pick] <- t_j
  }

  x      <- t_true
  status <- ifelse(removed, 0L, 1L)
  x[removed] <- censor_at[removed]
  .as_censored_sample("progressive_first_failure", dist, n, seed,
                      t_true, x, status)
}

# Joint and hybrid schemes -----------------------------------------------------

#' Joint Type-I censoring across multiple samples
#'
#' Generates \code{k} independent samples of size \code{n} each, all
#' censored at a common fixed time \code{cen_time}.
#'
#' @param n sample size per group.
#' @param k number of independent samples (default \code{2}).
#' @param dist a \code{\link{dist_spec}} object.
#' @param cen_time fixed censoring time.
#' @param seed optional integer seed.
#' @return A list of \code{censored_sample} objects (class
#'   \code{"censored_sample_list"}), one per group.  Each element contains
#'   \code{scheme}, \code{dist}, \code{n}, \code{seed}, \code{t_true},
#'   \code{x}, \code{status} (0 = right-censored, 1 = event), \code{time2},
#'   and extra fields \code{group} and \code{k}.
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_joint_type1_censor(20, d, cen_time = 2, seed = 1)
r_joint_type1_censor <- function(n, dist, cen_time, k = 2L, seed = NULL) {
  n <- .check_n(n)
  k <- as.integer(k)
  .validate_dist(dist)
  .apply_seed(seed)
  groups <- vector("list", k)
  for (g in seq_len(k)) {
    t_true <- .rng_stream(n, dist)
    cens   <- t_true > cen_time
    x      <- pmin(t_true, cen_time)
    status <- ifelse(cens, 0L, 1L)
    groups[[g]] <- .as_censored_sample(
      "joint_type1", dist, n, seed, t_true, x, status,
      extra = list(cen_time = cen_time, group = g, k = k)
    )
  }
  class(groups) <- "censored_sample_list"
  groups
}

#' Joint Type-II censoring across multiple samples
#'
#' All \code{k} samples share the same termination rule: stop when a total of
#' \code{r_failures} events have been observed across all groups combined.
#'
#' @param n sample size per group.
#' @param k number of groups (default \code{2}).
#' @param dist a \code{\link{dist_spec}} object.
#' @param r_failures total failure count across all groups.
#' @param seed optional integer seed.
#' @return A list of \code{censored_sample} objects (class
#'   \code{"censored_sample_list"}), one per group.  Each element contains
#'   \code{scheme}, \code{dist}, \code{n}, \code{seed}, \code{t_true},
#'   \code{x}, \code{status} (0 = right-censored, 1 = event), \code{time2},
#'   and extra fields \code{group} and \code{k}.
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_joint_type2_censor(20, d, r_failures = 15, seed = 1)
r_joint_type2_censor <- function(n, dist, r_failures, k = 2L, seed = NULL) {
  n <- .check_n(n)
  k <- as.integer(k)
  .validate_dist(dist)
  .apply_seed(seed)
  t_all <- matrix(.rng_stream(n * k, dist), nrow = n, ncol = k)
  flat  <- as.vector(t_all)
  ord   <- order(flat)
  r_failures <- min(as.integer(r_failures), n * k)
  r_th <- flat[ord[r_failures]]
  event <- t_all <= r_th
  groups <- vector("list", k)
  for (g in seq_len(k)) {
    t_true <- t_all[, g]
    x      <- ifelse(event[, g], t_true, r_th)
    status <- ifelse(event[, g], 1L, 0L)
    groups[[g]] <- .as_censored_sample(
      "joint_type2", dist, n, seed, t_true, x, status,
      extra = list(r_failures = r_failures, r_th_time = r_th,
                   group = g, k = k)
    )
  }
  class(groups) <- "censored_sample_list"
  groups
}

#' Balanced joint progressive Type-II (BJPT-II) censoring
#'
#' \code{k} samples of size \code{n} are progressively Type-II censored with
#' a balanced removal scheme \code{scheme} applied jointly at each failure
#' time across all groups.
#'
#' @param n sample size per group.
#' @param k number of groups (default \code{2}).
#' @param dist a \code{\link{dist_spec}} object.
#' @param scheme integer vector of total removals at each failure (split
#'   evenly across groups).
#' @param seed optional integer seed.
#' @return A list of \code{censored_sample} objects (class
#'   \code{"censored_sample_list"}), one per group.  Each element contains
#'   \code{scheme}, \code{dist}, \code{n}, \code{seed}, \code{t_true},
#'   \code{x}, \code{status} (0 = right-censored, 1 = event), \code{time2},
#'   and extra fields \code{group} and \code{k}.
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_bjpt2_censor(20, d, k = 2, seed = 1)
r_bjpt2_censor <- function(n, dist, scheme = NULL, k = 2L, seed = NULL) {
  n <- .check_n(n)
  k <- as.integer(k)
  .validate_dist(dist)
  .apply_seed(seed)
  if (is.null(scheme)) scheme <- rep(1L, min(10L, max(1L, n %/% 5L)))
  scheme <- as.integer(scheme)

  t_mat <- matrix(.rng_stream(n * k, dist), nrow = n, ncol = k)
  removed <- matrix(FALSE, nrow = n, ncol = k)
  x_mat <- t_mat
  ids <- expand.grid(row = seq_len(n), col = seq_len(k))
  flat_time <- t_mat[cbind(ids$row, ids$col)]
  ord <- order(flat_time)

  m <- min(length(scheme), n * k - 1L)
  for (j in seq_len(m)) {
    pos <- ord[j]
    r <- ids$row[pos]
    c <- ids$col[pos]
    t_j <- t_mat[r, c]
    at_risk <- which(!removed & t_mat > t_j, arr.ind = TRUE)
    if (nrow(at_risk) == 0L) next
    n_remove <- min(scheme[j], nrow(at_risk))
    pick <- at_risk[sample(nrow(at_risk), n_remove), , drop = FALSE]
    removed[cbind(pick[, "row"], pick[, "col"])] <- TRUE
    x_mat[cbind(pick[, "row"], pick[, "col"])] <- t_j
  }

  groups <- vector("list", k)
  for (g in seq_len(k)) {
    t_true <- t_mat[, g]
    rem_g  <- removed[, g]
    x      <- x_mat[, g]
    status <- ifelse(rem_g, 0L, 1L)
    groups[[g]] <- .as_censored_sample(
      "bjpt2", dist, n, seed, t_true, x, status,
      extra = list(scheme = scheme, group = g, k = k)
    )
  }
  class(groups) <- "censored_sample_list"
  groups
}

#' Hybrid censoring (Type-I and Type-II constraints)
#'
#' Stops at \code{cen_time} or when \code{r_failures} events occur, whichever
#' comes first.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param cen_time fixed time limit.
#' @param r_failures failure count limit.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_hybrid_censor(30, d, cen_time = 2, r_failures = 15, seed = 1)
r_hybrid_censor <- function(n, dist, cen_time, r_failures, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true <- .rng_stream(n, dist)
  stop <- .type2_stop(t_true, r_failures)
  stop_time <- min(cen_time, stop$r_th_time)
  event <- t_true <= stop_time
  x <- ifelse(event, t_true, stop_time)
  status <- ifelse(event, 1L, 0L)
  .as_censored_sample("hybrid", dist, n, seed, t_true, x, status,
                      extra = list(cen_time = cen_time,
                                   r_failures = min(as.integer(r_failures), n),
                                   stop_time = stop_time))
}

#' Hybrid Type-I censoring with progressive withdrawal
#'
#' At each time in \code{prog_times}, \code{scheme[j]} units are withdrawn;
#' remaining units are Type-I censored at \code{cen_time}.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param cen_time final Type-I censoring time.
#' @param prog_times vector of progressive withdrawal times.
#' @param scheme removals at each progressive time.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_hybrid_type1_censor(30, d, cen_time = 3,
#'                       prog_times = c(1, 2), scheme = c(2, 2), seed = 1)
r_hybrid_type1_censor <- function(n, dist, cen_time, prog_times, scheme,
                                  seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true <- .rng_stream(n, dist)
  prog_times <- sort(prog_times)
  scheme     <- as.integer(scheme)
  m          <- min(length(prog_times), length(scheme))
  x          <- t_true
  status     <- rep(1L, n)
  at_risk    <- rep(TRUE, n)

  for (j in seq_len(m)) {
    tau <- prog_times[j]
    at_risk[t_true <= tau & status == 1L] <- FALSE
    eligible <- which(at_risk & t_true > tau)
    n_rem <- min(scheme[j], length(eligible))
    if (n_rem > 0L) {
      rem <- sample(eligible, n_rem)
      x[rem] <- tau
      status[rem] <- 0L
      at_risk[rem] <- FALSE
    }
  }

  still <- which(at_risk)
  cens  <- t_true[still] > cen_time
  x[still[cens]] <- cen_time
  status[still[cens]] <- 0L

  .as_censored_sample("hybrid_type1", dist, n, seed, t_true, x, status,
                      extra = list(cen_time = cen_time,
                                   prog_times = prog_times,
                                   scheme = scheme))
}

#' Doubly Type-II censoring
#'
#' Classical doubly Type-II censoring: the \code{r1} smallest and \code{r2}
#' largest latent failure times are censored; the middle order statistics are
#' observed exactly.  Requires \code{r1 + r2 < n}.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param r1 number of smallest order statistics left-censored.
#' @param r2 number of largest order statistics right-censored.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_doubly_type2_censor(50, d, r1 = 5, r2 = 5, seed = 1)
r_doubly_type2_censor <- function(n, dist, r1, r2, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  r1 <- as.integer(r1)
  r2 <- as.integer(r2)
  if (r1 < 0L || r2 < 0L) {
    stop("'r1' and 'r2' must be non-negative.", call. = FALSE)
  }
  if (r1 + r2 >= n) {
    stop("'r1' + 'r2' must be less than 'n'.", call. = FALSE)
  }
  t_true <- .rng_stream(n, dist)
  ord <- order(t_true)
  r1 <- min(r1, n - 1L)
  r2 <- min(r2, n - r1 - 1L)

  x <- t_true
  status <- rep(1L, n)
  if (r1 > 0L) {
    left_c <- ord[seq_len(r1)]
    x[left_c] <- t_true[ord[r1 + 1L]]
    status[left_c] <- 2L
  }
  if (r2 > 0L) {
    right_c <- ord[seq(n - r2 + 1L, n)]
    x[right_c] <- t_true[ord[n - r2]]
    status[right_c] <- 0L
  }

  .as_censored_sample("doubly_type2", dist, n, seed, t_true, x, status,
                      extra = list(r1 = r1, r2 = r2))
}

#' Type-I hybrid censoring
#'
#' Experiment terminates at \code{cen_time} or when \code{r_failures} events
#' occur; if \code{r_failures} is reached first, a final Type-I censoring time
#' \code{cen_time} still applies to remaining units.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param cen_time fixed censoring time.
#' @param r_failures failure count target.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_type1_hybrid_censor(30, d, cen_time = 2, r_failures = 15, seed = 1)
r_type1_hybrid_censor <- function(n, dist, cen_time, r_failures,
                                  seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true <- .rng_stream(n, dist)
  r_failures <- min(as.integer(r_failures), n)
  ord  <- order(t_true)
  r_th <- t_true[ord[r_failures]]
  stop_time <- if (r_th <= cen_time) r_th else cen_time
  cens <- t_true > stop_time
  x    <- ifelse(cens, stop_time, t_true)
  status <- ifelse(cens, 0L, 1L)
  .as_censored_sample("type1_hybrid", dist, n, seed, t_true, x, status,
                      extra = list(cen_time = cen_time,
                                   r_failures = r_failures,
                                   stop_time = stop_time))
}

#' Hybrid Type-II censoring
#'
#' Progressive Type-II removals are applied, then the experiment terminates
#' at the \code{r_failures}-th remaining failure.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param scheme progressive removal scheme before Type-II stop.
#' @param r_failures failure count for final Type-II termination.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), and \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_hybrid_type2_censor(30, d, scheme = c(1, 1), r_failures = 10, seed = 1)
r_hybrid_type2_censor <- function(n, dist, scheme, r_failures,
                                  seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true  <- .rng_stream(n, dist)
  scheme  <- as.integer(scheme)
  pr <- .progressive_type2_removals(t_true, scheme)

  still <- which(!pr$removed)
  t_still <- t_true[still]
  r_failures <- min(as.integer(r_failures), length(still))
  stop <- .type2_stop(t_still, r_failures)
  r_th <- stop$r_th_time

  x      <- t_true
  status <- rep(1L, n)
  status[pr$removed] <- 0L
  x[pr$removed] <- pr$censor_at[pr$removed]
  cens <- !pr$removed & t_true > r_th
  x[cens] <- r_th
  status[cens] <- 0L

  .as_censored_sample("hybrid_type2", dist, n, seed, t_true, x, status,
                      extra = list(scheme = scheme,
                                   r_failures = r_failures,
                                   r_th_time = r_th))
}

# Type-II progressively hybrid censoring ---------------------------------------

#' Type-II progressively hybrid censoring
#'
#' Combines progressive Type-II censoring with a pre-set time limit
#' \code{cen_time}.  Progressive removals according to \code{scheme} are
#' applied at each failure.  The experiment terminates at
#' \eqn{\min(X_{m:m:n}, T)}, where \eqn{X_{m:m:n}} is the \code{m}-th
#' (i.e., \code{r_failures}-th) failure among the remaining units and
#' \eqn{T} is \code{cen_time}.  If fewer than \code{r_failures} events
#' occur before \code{cen_time}, all surviving units are censored at
#' \code{cen_time}.  See Kundu and Joarder (2006)
#' \doi{10.1016/j.csda.2005.05.002}.
#'
#' @param n sample size.
#' @param dist a \code{\link{dist_spec}} object.
#' @param scheme integer vector of removals at successive failure times.
#' @param r_failures target number of failures (default
#'   \eqn{\lfloor 0.7 n \rfloor}).
#' @param cen_time pre-set maximum experiment time.
#' @param seed optional integer seed.
#' @return A \code{censored_sample} object (S3 class) containing:
#'   \code{scheme} (character "progressive_hybrid_type2"), \code{dist} (the \code{dist_spec}),
#'   \code{n} (integer sample size), \code{seed}, \code{t_true} (numeric
#'   vector of latent failure times), \code{x} (observed/censored values),
#'   \code{status} (integer: 0 = right-censored, 1 = event, 2 = left-censored,
#'   3 = interval-censored, 4 = middle-censored), \code{time2}
#'   (upper interval bound where applicable, \code{NA} otherwise), and
#'   \code{extra} (list containing \code{scheme}, \code{r_failures}, \code{cen_time},
#'   and \code{stop_time}).
#' @export
#' @examples
#' d <- dist_spec(q = function(u, p) -log(1 - u) / p$rate,
#'                param = list(rate = 1), name = "Exp(1)")
#' r_progressive_hybrid_type2_censor(30, d, scheme = c(1, 1, 1),
#'                                   r_failures = 10, cen_time = 3, seed = 1)
r_progressive_hybrid_type2_censor <- function(n, dist, scheme, r_failures = NULL,
                                              cen_time, seed = NULL) {
  n <- .check_n(n)
  .validate_dist(dist)
  .apply_seed(seed)
  t_true  <- .rng_stream(n, dist)
  scheme  <- as.integer(scheme)
  if (is.null(r_failures)) r_failures <- .default_r_failures(n)
  r_failures <- min(as.integer(r_failures), n)

  # Progressive removals at ordered failure times
  ord     <- order(t_true)
  removed <- logical(n)
  censor_at <- rep(NA_real_, n)
  m <- min(length(scheme), n - 1L)

  n_observed <- 0L
  for (j in seq_len(n)) {
    fail_pos <- ord[j]
    if (removed[fail_pos]) next
    t_j <- t_true[fail_pos]

    # If this failure time exceeds cen_time, stop
    if (t_j > cen_time) break

    n_observed <- n_observed + 1L

    # Apply progressive removals if scheme still has entries
    if (n_observed <= m) {
      candidates <- which(!removed & t_true > t_j)
      # Exclude the current failure from candidates
      candidates <- setdiff(candidates, fail_pos)
      n_rem <- min(scheme[n_observed], length(candidates))
      if (n_rem > 0L) {
        to_remove <- if (n_rem == 1L) {
          candidates[sample.int(length(candidates), 1L)]
        } else {
          sample(candidates, n_rem)
        }
        removed[to_remove] <- TRUE
        censor_at[to_remove] <- t_j
      }
    }

    # Check if we reached the target number of failures
    if (n_observed >= r_failures) break
  }

  # Determine effective stop time
  # If r_failures observed, stop_time is the r-th failure time
  # Otherwise stop_time is cen_time
  if (n_observed >= r_failures) {
    # Find the r_failures-th observed failure time
    obs_failures <- ord[!removed[ord]]
    obs_times <- t_true[obs_failures]
    stop_time <- sort(obs_times[obs_times <= cen_time])[r_failures]
  } else {
    stop_time <- cen_time
  }

  # Build output
  x      <- t_true
  status <- rep(1L, n)

  # Units already removed progressively
  status[removed] <- 0L
  x[removed] <- censor_at[removed]

  # Units still at risk but failing after stop_time
  late <- !removed & t_true > stop_time
  x[late] <- stop_time
  status[late] <- 0L

  .as_censored_sample("progressive_hybrid_type2", dist, n, seed,
                      t_true, x, status,
                      extra = list(scheme = scheme,
                                   r_failures = r_failures,
                                   cen_time = cen_time,
                                   stop_time = stop_time))
}
