# =============================================================================
# Internal helpers (not exported)
# =============================================================================

#' Turnbull EM algorithm for NPMLE of interval-censored data
#'
#' @param l Numeric vector of lower bounds.
#' @param r Numeric vector of upper bounds (Inf for right-censored).
#' @param supp Numeric vector of support points.
#' @param max_iter Maximum number of EM iterations.
#' @param tol Convergence tolerance.
#' @return Numeric vector of probability masses on \code{supp}.
#' @keywords internal
turnbull_em <- function(l, r, supp, max_iter = 1000, tol = 1e-10) {
  n <- length(l)
  J <- length(supp)

  ## Build the indicator matrix alpha[i,j] = 1 iff supp[j] in observed interval of i
  alpha <- matrix(0.0, n, J)
  for (i in seq_len(n)) {
    li <- l[i]; ri <- r[i]
    if      ( is.finite(li) &&  is.finite(ri)) alpha[i, supp >  li & supp <= ri] <- 1.0
    else if ( is.finite(li) && !is.finite(ri)) alpha[i, supp >  li              ] <- 1.0
    else if (!is.finite(li) &&  is.finite(ri)) alpha[i,               supp <= ri] <- 1.0
  }

  covered <- colSums(alpha) > 0
  if (!any(covered)) return(rep(0.0, J))

  alpha_c <- alpha[, covered, drop = FALSE]
  Jc      <- sum(covered)
  p       <- rep(1.0 / Jc, Jc)

  for (iter in seq_len(max_iter)) {
    p_old <- p
    denom <- as.vector(alpha_c %*% p)
    denom[denom < 1e-14] <- 1e-14
    w     <- sweep(alpha_c * matrix(p, n, Jc, byrow = TRUE), 1, denom, "/")
    p     <- colMeans(w)
    if (max(abs(p - p_old)) < tol) break
  }

  p_full          <- numeric(J)
  p_full[covered] <- p
  p_full
}


#' Precompute global log-rank quantities shared across all p features
#'
#' Fits a single pooled NPMLE under the null (no covariate effect) and
#' computes posterior weights \eqn{w_{ij}}, pooled pseudo-failure counts
#' \eqn{\hat{d}_j}, and pooled pseudo-risk-set sizes \eqn{\hat{n}_j}.
#' These are reused for every feature at negligible additional cost.
#'
#' @param l Numeric vector of lower bounds.
#' @param r Numeric vector of upper bounds.
#' @return A list with components \code{w}, \code{d_j}, \code{n_j}, \code{n}.
#' @keywords internal
logrank_globals <- function(l, r) {
  n    <- length(l)
  supp <- sort(unique(c(l[is.finite(l)], r[is.finite(r)])))

  p_hat   <- turnbull_em(l, r, supp)
  active  <- p_hat > 1e-14
  supp_a  <- supp[active]
  p_hat_a <- p_hat[active] / sum(p_hat[active])
  Ja      <- length(supp_a)

  ## Re-build alpha on the active support only
  alpha <- matrix(0L, n, Ja)
  for (i in seq_len(n)) {
    li <- l[i]; ri <- r[i]
    if      ( is.finite(li) &&  is.finite(ri)) alpha[i, supp_a >  li & supp_a <= ri] <- 1L
    else if ( is.finite(li) && !is.finite(ri)) alpha[i, supp_a >  li               ] <- 1L
    else if (!is.finite(li) &&  is.finite(ri)) alpha[i,                supp_a <= ri] <- 1L
  }

  denom <- as.vector(alpha %*% p_hat_a)
  denom[denom < 1e-14] <- 1e-14
  w   <- sweep(alpha * matrix(p_hat_a, n, Ja, byrow = TRUE), 1, denom, "/")
  d_j <- colSums(w)
  n_j <- rev(cumsum(rev(d_j)))

  list(w = w, d_j = d_j, n_j = n_j, n = n)
}


#' Variance-adjusted generalized log-rank utility for one binary feature
#'
#' Computes \eqn{\hat\omega_k = |\hat U_k| / [n \hat\pi_k (1 - \hat\pi_k)]}
#' using precomputed global quantities from \code{logrank_globals()}.
#'
#' @param x_k Integer vector of length n with values in \{0, 1\}.
#' @param g List returned by \code{logrank_globals()}.
#' @return A single non-negative numeric value.
#' @keywords internal
logrank_score <- function(x_k, g) {
  ## Skip features with fewer than 2 observations in either group
  if (sum(x_k) < 2L || sum(1L - x_k) < 2L) return(0.0)

  d_jk <- colSums(x_k * g$w)
  n_jk <- rev(cumsum(rev(d_jk)))
  ok   <- g$n_j > 1e-9
  if (!any(ok)) return(0.0)

  ## Generalized log-rank score U_k / n  (Eq. 1 / n in the paper)
  U_n  <- sum(d_jk[ok] - g$d_j[ok] * (n_jk[ok] / g$n_j[ok])) / g$n

  ## Variance adjustment by marginal prevalence (Eq. 2 in the paper)
  pi_k <- mean(x_k)
  abs(U_n) / (pi_k * (1.0 - pi_k) + 1e-8)
}


# =============================================================================
# Exported function
# =============================================================================

#' Generalized Log-rank Sure Independence Screening for Ultrahigh-Dimensional
#' Interval-Censored Response
#'
#' @description
#' A computationally efficient and statistically robust feature screening
#' procedure for ultrahigh-dimensional Case II interval-censored responses
#' with binary predictors (e.g., SNP indicators or text-derived skill words).
#'
#' The marginal utility is the \emph{variance-adjusted generalized log-rank
#' statistic}
#' \deqn{\hat\omega_k = \frac{|\hat U_k|}{n\,\hat\pi_k(1-\hat\pi_k)},}
#' where \eqn{\hat U_k} is the generalized log-rank score of Sun (1996)
#' evaluated at the pooled NPMLE \eqn{\hat{\mathbf p}} fitted once to the
#' full sample under the null hypothesis of no covariate effect.  Because
#' \eqn{\hat{\mathbf p}} and the resulting posterior weights \eqn{w_{ij}} are
#' shared across all \eqn{p} features, evaluating each feature reduces to
#' simple vector operations, achieving dramatic speed-ups over ADD-SIS
#' (Zhong et al., 2023), which requires \eqn{2p} stratified NPMLE fits.
#'
#' @param X The design matrix of dimensions \eqn{n \times p}.  Each row is an
#'   observation vector.  Predictors should be binary (0/1), as commonly
#'   arising from SNP minor-allele encoding or word-segmentation of job
#'   postings.
#' @param L A numeric vector of length \eqn{n} giving the \strong{lower}
#'   endpoints of the observed intervals \eqn{(L_i, R_i]}.  For left-censored
#'   observations (event known to have occurred no later than \eqn{R_i}), set
#'   \code{L[i] = 0} or \code{L[i] = -Inf} as appropriate for the application.
#' @param R A numeric vector of length \eqn{n} giving the \strong{upper}
#'   endpoints of the observed intervals.  Set \code{R[i] = Inf} for
#'   right-censored observations (event not yet observed by the end of
#'   follow-up).
#' @param nsis Number of predictors recruited by \code{LogrankSIS}.  The
#'   default is \code{floor(n / log(n))}.
#'
#' @return An integer vector of length \code{nsis} containing the
#'   \strong{column indices} of the top-ranked predictors in \code{X},
#'   ordered by decreasing marginal utility \eqn{\hat\omega_k}.
#'
#' @references
#'
#' Sun, J. (1996). A non-parametric test for interval-censored failure time
#' data with application to AIDS studies.
#' \emph{Statistics in Medicine}, \strong{15}, 1387--1395.
#'
#' Zhao, Q. and Sun, J. (2004). Generalized log-rank test for mixed
#' interval-censored failure time data.
#' \emph{Statistics in Medicine}, \strong{23}(10), 1621--1629.
#'
#' Zhong, W., Qian, C., Liu, W., Zhu, L., and Li, R. (2023). Feature
#' screening for interval-valued response with application to study
#' association between posted salary and required skills.
#' \emph{Journal of the American Statistical Association},
#' \strong{118}, 805--817.
#'
#' Fan, J. and Lv, J. (2008). Sure independence screening for ultrahigh
#' dimensional feature space.
#' \emph{Journal of the Royal Statistical Society: Series B},
#' \strong{70}(5), 849--911.
#'
#' @examples
#' ## ---- Example 1: Balanced binary predictors, linear model ----
#' set.seed(2025)
#' n   <- 200
#' p   <- 1000
#' rho <- 0.5
#'
#' ## Toeplitz covariance for latent continuous predictors
#' data <- GendataIC(n, p, rho, model = "linear", balanced = TRUE)
#' X <- data[[1]]   # n x p binary design matrix
#' L <- data[[2]]   # lower bounds
#' R <- data[[3]]   # upper bounds (Inf = right-censored)
#'
#' ## Run LogrankSIS (active predictors are indices 1, 2, 3, 19, 20)
#' result <- LogrankSIS(X, L, R, nsis = floor(n / log(n)))
#' cat("Active predictors recovered:", intersect(result, c(1, 2, 3, 19, 20)), "\n")
#'
#' ## ---- Example 2: Imbalanced binary predictors, Cox model ----
#' set.seed(2025)
#' data2 <- GendataIC(n, p, rho, model = "cox", balanced = FALSE)
#' X2 <- data2[[1]]; L2 <- data2[[2]]; R2 <- data2[[3]]
#'
#' result2 <- LogrankSIS(X2, L2, R2, nsis = floor(n / log(n)))
#' cat("Active predictors recovered:", intersect(result2, c(1, 2, 3, 19, 20)), "\n")
#'
#' @export
LogrankSIS <- function(X, L, R,
                       nsis = floor(dim(X)[1] / log(dim(X)[1]))) {

  ## ---- Input validation ----
  X <- as.matrix(X)
  n <- nrow(X)
  p <- ncol(X)
  L <- as.numeric(L)
  R <- as.numeric(R)

  if (length(L) != n)
    stop("'L' must have length equal to nrow(X).")
  if (length(R) != n)
    stop("'R' must have length equal to nrow(X).")
  if (any(L > R, na.rm = TRUE))
    stop("All lower bounds 'L' must be <= corresponding upper bounds 'R'.")
  if (nsis > p) {
    warning("'nsis' exceeds number of predictors; setting nsis = p.")
    nsis <- p
  }

  ## ---- Step 1: Single global NPMLE (computed once for all p features) ----
  g <- logrank_globals(L, R)

  ## ---- Step 2: Variance-adjusted log-rank utility for each feature ----
  omega <- vapply(seq_len(p),
                  function(k) logrank_score(X[, k], g),
                  numeric(1L))

  ## ---- Step 3: Return indices of top nsis predictors ----
  order(omega, decreasing = TRUE)[seq_len(nsis)]
}
