# Internal utilities for UniCensor -------------------------------------------

#' @keywords internal
.validate_dist <- function(dist) {
  if (!inherits(dist, "dist_spec")) {
    stop("'dist' must be a dist_spec object; use dist_spec() to create one.",
         call. = FALSE)
  }
  invisible(dist)
}

#' @keywords internal
.apply_seed <- function(seed) {
  if (!is.null(seed)) {
    if (!is.numeric(seed) || length(seed) != 1L || is.na(seed)) {
      stop("'seed' must be a single numeric value or NULL.", call. = FALSE)
    }
    set.seed(as.integer(seed))
  }
  invisible(seed)
}

#' @keywords internal
.as_censored_sample <- function(scheme, dist, n, seed, t_true, x, status,
                                time2 = rep(NA_real_, length(x)),
                                extra = list()) {
  out <- list(
    scheme  = scheme,
    dist    = dist,
    n       = as.integer(n),
    seed    = seed,
    t_true  = as.numeric(t_true),
    x       = as.numeric(x),
    status  = as.integer(status),
    time2   = as.numeric(time2)
  )
  if (length(extra)) out <- c(out, extra)
  class(out) <- "censored_sample"
  out
}

#' @keywords internal
.rng_stream <- function(n, dist) {
  if (!is.null(dist$q)) {
    u <- stats::runif(n)
    return(vapply(u, function(ui) dist$q(ui, dist$param), numeric(1)))
  }
  u <- stats::runif(n)
  vapply(seq_len(n), function(i) {
    .invert_survival(u[i], dist)
  }, numeric(1))
}

#' @keywords internal
.invert_survival <- function(u, dist, interval = NULL) {
  if (is.null(interval)) {
    interval <- c(dist$lower, dist$upper)
    if (!is.finite(interval[2])) interval[2] <- dist$lower + 1e4
  }
  target <- 1 - u
  if (!is.null(dist$surv)) {
    f <- function(t) dist$surv(t, dist$param) - target
  } else if (!is.null(dist$p)) {
    f <- function(t) dist$p(t, dist$param) - u
  } else if (!is.null(dist$d)) {
    ll <- dist$lower
    dens <- function(x) dist$d(x, dist$param)
    cdf_at <- function(t) {
      if (!is.finite(t) || t <= ll) return(0)
      if (is.finite(dist$upper) && t >= dist$upper) return(1)
      stats::integrate(dens, ll, t, rel.tol = 1e-8, subdivisions = 200L)$value
    }
    f <- function(t) cdf_at(t) - u
  } else {
    stop("dist_spec must provide at least one of q, surv, p, or d.",
         call. = FALSE)
  }
  res <- suppressWarnings(tryCatch(
    stats::uniroot(f, interval = interval, tol = 1e-8, extendInt = "upX"),
    error = function(e) NULL
  ))
  if (is.null(res)) {
    stop("Could not invert the distribution on support [",
         interval[1], ", ", interval[2], "].", call. = FALSE)
  }
  res$root
}

#' @keywords internal
.rng_truncated <- function(n, dist, left = dist$lower, right = dist$upper) {
  if (!is.null(dist$q) && !is.null(dist$p)) {
    pl <- dist$p(left, dist$param)
    pr <- dist$p(right, dist$param)
    u  <- stats::runif(n, min = pl, max = pr)
    return(vapply(u, function(ui) dist$q(ui, dist$param), numeric(1)))
  }
  vapply(seq_len(n), function(i) {
    u <- stats::runif(1)
    if (!is.null(dist$surv)) {
      sl <- dist$surv(left, dist$param)
      sr <- dist$surv(right, dist$param)
      target <- sr + u * (sl - sr)
      f <- function(t) dist$surv(t, dist$param) - target
    } else {
      pl <- dist$p(left, dist$param)
      pr <- dist$p(right, dist$param)
      target <- pl + u * (pr - pl)
      f <- function(t) dist$p(t, dist$param) - target
    }
    stats::uniroot(f, interval = c(left, right), tol = 1e-8)$root
  }, numeric(1))
}

#' @keywords internal
.check_n <- function(n) {
  n <- as.integer(n)
  if (length(n) != 1L || is.na(n) || n <= 0L) {
    stop("'n' must be a positive integer.", call. = FALSE)
  }
  n
}

#' @keywords internal
.default_cen_time <- function(t_true, prob = 0.7) {
  unname(stats::quantile(t_true, prob, names = FALSE))
}

#' @keywords internal
.default_r_failures <- function(n, prop = 0.7) {
  max(1L, floor(prop * n))
}

#' @keywords internal
.type2_stop <- function(t_true, r_failures) {
  r_failures <- min(as.integer(r_failures), length(t_true))
  ord  <- order(t_true)
  r_th <- t_true[ord[r_failures]]
  event <- t_true <= r_th
  list(
    x = ifelse(event, t_true, r_th),
    status = ifelse(event, 1L, 0L),
    r_th_time = r_th
  )
}

#' @keywords internal
.progressive_type2_removals <- function(t_true, scheme) {
  n <- length(t_true)
  scheme <- as.integer(scheme)
  ord <- order(t_true)
  removed <- logical(n)
  censor_at <- rep(NA_real_, n)
  m <- min(length(scheme), n - 1L)

  for (j in seq_len(m)) {
    fail_pos <- ord[j]
    if (removed[fail_pos]) next          # already removed; skip
    t_j <- t_true[fail_pos]
    # Candidates: not yet removed AND with failure time > t_j
    candidates <- which(!removed & t_true > t_j)
    n_rem <- min(scheme[j], 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
    }
  }

  list(removed = removed, censor_at = censor_at)
}
