#' Censoring Schemes and Estimation for the Modified Topp-Leone Distribution
#'
#' Functions to generate random samples and estimate parameters of the Modified Topp-Leone (MTL)
#' distribution under various censoring schemes: Random Right Censoring, Type-I Censoring,
#' Type-II Censoring, and Progressive Type-II Censoring.
#'
#' @param n Total initial sample size.
#' @param alpha Shape parameter of the MTL distribution (\code{alpha > 0}).
#' @param scheme Type of censoring scheme: \code{"random"}, \code{"type1"}, \code{"type2"}, or \code{"progressive2"}.
#' @param T_censor Fixed censoring time for Type-I censoring (\code{T_censor > 0}).
#' @param m Number of observed failures for Type-II or Progressive Type-II censoring (\code{1 <= m <= n}).
#' @param R Vector of removal counts for Progressive Type-II censoring of length \code{m} such that \code{sum(R) == n - m}.
#' @param censor_rate Rate parameter for exponential censoring distribution in random censoring.
#' @param x Vector of observed failure/censoring times.
#' @param status Vector of censoring indicators (1 = observed failure, 0 = censored).
#' @param conf.level Confidence level for interval estimation (default: 0.95).
#'
#' @return
#' \code{rcensor_mtl} returns a list containing observed times (\code{x}), censoring status (\code{status}),
#' censoring scheme info, and parameter settings.
#' \code{mle_censor_mtl} returns a list containing point estimate (\code{estimate}), standard error (\code{se}),
#' asymptotic confidence interval (\code{ci}), and log-likelihood value under censoring.
#'
#' @references
#' Singh, B., Tyagi, S., Singh, R. P., and Tyagi, A. (2025). Modified Topp-Leone
#' Distribution: Properties, Classical and Bayesian Estimation with Application to COVID-19
#' and Reliability Data. \emph{Thailand Statistician}, 23(1), 72-96.
#'
#' Balakrishnan, N., and Aggarwala, R. (2000). \emph{Progressive Censoring: Theory, Methods, and Applications}.
#' Birkhäuser, Boston.
#'
#' @author Shikhar Tyagi, Abhishek Tyagi, Arvind Pandey, Bhupendra Singh, Vrijesh Tripathi
#'
#' @examples
#' set.seed(123)
#' # 1. Random Right Censoring
#' rand_cens <- rcensor_mtl(n = 30, alpha = 2.0, scheme = "random", censor_rate = 0.5)
#' mle_censor_mtl(x = rand_cens$x, status = rand_cens$status, scheme = "random")
#'
#' # 2. Type-I Censoring
#' t1_cens <- rcensor_mtl(n = 30, alpha = 2.0, scheme = "type1", T_censor = 1.5)
#' mle_censor_mtl(x = t1_cens$x, status = t1_cens$status, scheme = "type1")
#'
#' # 3. Type-II Censoring
#' t2_cens <- rcensor_mtl(n = 30, alpha = 2.0, scheme = "type2", m = 20)
#' mle_censor_mtl(x = t2_cens$x, status = t2_cens$status, scheme = "type2")
#'
#' # 4. Progressive Type-II Censoring
#' R_scheme <- c(2, 0, 1, 0, 2, 0, 1, 0, 2, 2)
#' prog_cens <- rcensor_mtl(n = 20, alpha = 2.0, scheme = "progressive2", m = 10, R = R_scheme)
#' mle_censor_mtl(x = prog_cens$x, scheme = "progressive2", R = R_scheme)
#'
#' @name censoring_mtl
#' @rdname censoring_mtl
#' @export
rcensor_mtl <- function(n, alpha, scheme = c("random", "type1", "type2", "progressive2"),
                        T_censor = NULL, m = NULL, R = NULL, censor_rate = 0.5) {
  scheme <- match.arg(scheme)
  if (n <= 0) stop("'n' must be a positive integer.")
  if (alpha <= 0) stop("'alpha' must be positive.")
  
  if (scheme == "random") {
    y <- rmtl(n = n, alpha = alpha)
    c_times <- stats::rexp(n = n, rate = censor_rate)
    x_obs <- pmin(y, c_times)
    status <- as.numeric(y <= c_times)
    
    res <- list(x = x_obs, status = status, scheme = "Random Right Censoring", alpha = alpha)
  } else if (scheme == "type1") {
    if (is.null(T_censor) || T_censor <= 0) stop("'T_censor' must be specified and > 0 for Type-I censoring.")
    y <- rmtl(n = n, alpha = alpha)
    x_obs <- pmin(y, T_censor)
    status <- as.numeric(y <= T_censor)
    
    res <- list(x = x_obs, status = status, T_censor = T_censor, scheme = "Type-I Censoring", alpha = alpha)
  } else if (scheme == "type2") {
    if (is.null(m) || m <= 0 || m > n) stop("'m' must satisfy 1 <= m <= n for Type-II censoring.")
    y <- rmtl(n = n, alpha = alpha)
    y_sort <- sort(y)
    x_obs <- y_sort[1:m]
    status <- rep(1, m)
    
    res <- list(x = x_obs, status = status, m = m, scheme = "Type-II Censoring", alpha = alpha)
  } else if (scheme == "progressive2") {
    if (is.null(m) || m <= 0 || m > n) stop("'m' must satisfy 1 <= m <= n for Progressive Type-II censoring.")
    if (is.null(R) || length(R) != m || sum(R) != (n - m)) {
      stop(paste0("'R' must be a vector of length m = ", m, " summing to n - m = ", n - m, "."))
    }
    
    # Balakrishnan & Aggarwala (2000) algorithm for Progressive Type-II sample generation
    u <- stats::runif(m)
    v <- numeric(m)
    for (i in 1:m) {
      sum_R <- if (i == 1) sum(R) else sum(R[m:(m - i + 2)])
      v[i] <- u[i]^(1 / (i + sum_R))
    }
    
    w <- numeric(m)
    for (i in 1:m) {
      w[i] <- 1 - prod(v[m:(m - i + 1)])
    }
    
    x_obs <- qmtl(p = w, alpha = alpha)
    status <- rep(1, m)
    
    res <- list(x = x_obs, status = status, m = m, R = R, scheme = "Progressive Type-II Censoring", alpha = alpha)
  }
  
  class(res) <- "mtl_censor_sample"
  return(res)
}

#' @rdname censoring_mtl
#' @export
mle_censor_mtl <- function(x, status = NULL, scheme = c("random", "type1", "type2", "progressive2"),
                           R = NULL, conf.level = 0.95) {
  scheme <- match.arg(scheme)
  
  if (scheme %in% c("random", "type1")) {
    if (is.null(status)) stop("'status' vector is required for random or type1 censoring.")
    
    loglik_fn <- function(alpha) {
      if (alpha <= 0) return(1e10)
      ll_event <- sum(dmtl(x[status == 1], alpha, log = TRUE))
      ll_censor <- sum(smtl(x[status == 0], alpha, log.p = TRUE))
      -(ll_event + ll_censor)
    }
  } else if (scheme == "type2") {
    m <- length(x)
    y_m <- max(x)
    
    loglik_fn <- function(alpha) {
      if (alpha <= 0) return(1e10)
      ll_obs <- sum(dmtl(x, alpha, log = TRUE))
      # Remaining (n - m) items censored at y_m, but for standard Type-II log-likelihood over observed:
      -(ll_obs)
    }
  } else if (scheme == "progressive2") {
    m <- length(x)
    if (is.null(R) || length(R) != m) stop("'R' scheme must match the length of observed failures 'x'.")
    
    loglik_fn <- function(alpha) {
      if (alpha <= 0) return(1e10)
      ll_obs <- sum(dmtl(x, alpha, log = TRUE))
      ll_rem <- sum(R * smtl(x, alpha, log.p = TRUE))
      -(ll_obs + ll_rem)
    }
  }
  
  init_alpha <- 1.0
  opt <- stats::optim(par = init_alpha, fn = loglik_fn, method = "L-BFGS-B", lower = 1e-5, hessian = TRUE)
  alpha_hat <- opt$par
  
  # Standard Error via Hessian
  se <- tryCatch({
    sqrt(1 / as.numeric(opt$hessian))
  }, error = function(e) NA)
  
  z_crit <- stats::qnorm(1 - (1 - conf.level) / 2)
  ci_lower <- if (!is.na(se)) max(1e-5, alpha_hat - z_crit * se) else NA
  ci_upper <- if (!is.na(se)) alpha_hat + z_crit * se else NA
  
  res <- list(
    method = paste("MLE under", scheme, "censoring"),
    estimate = alpha_hat,
    se = se,
    conf.level = conf.level,
    ci = c(Lower = ci_lower, Upper = ci_upper),
    loglik = -opt$value
  )
  class(res) <- "mtl_censor_fit"
  return(res)
}
