Internal BAR thresholding operator

Description

Computes the thresholding update used in the BAR penalty.

Usage

BAR_threshold(resid, lambda, n)

Arguments

Value

A scalar thresholded value.

Internal soft-thresholding operator

Description

Computes the soft-thresholding update used in SCAD, ALASSO, and LASSO penalties.

Usage

Soft(z, lambda)

Arguments

Value

A numeric value (or vector) after soft-thresholding.

Penalized AFT estimation for right-censored data

Description

Fits a penalized accelerated failure time (AFT) model for right-censored survival data using induced smoothing and a penalized coordinate descent algorithm. Supported penalties include BAR, LASSO, adaptive LASSO, and SCAD.

Usage

aftpen(
  dt,
  lambda,
  se,
  type = c("BAR", "LASSO", "ALASSO", "SCAD"),
  r = 3.7,
  eps = 1e-08,
  max.iter = 100
)

Arguments

Details

The function first calls the Rcpp backend is_aft_cpp() to obtain an initial estimator together with gradient and Hessian information. A Cholesky-based transformation is then applied, followed by coordinate-wise penalized updates.

For type = "BAR", the update uses the internal BAR_threshold() operator. For type = "LASSO", "ALASSO", and "SCAD", soft-thresholding-based updates are used.

Value

A list containing the following components:

• beta: final coefficient estimate on the original scale.

Examples

n = 100
p = 10
beta0 = c(rep(1,3),rep(0,7))
x = matrix(rnorm(n * p), n, p)
T = exp(x%*%beta0 + rnorm(n))
C = rexp(n, rate = exp(-2))
d = 1*(T<C)
y = pmin(T,C)
dt = data.frame(y,d,x)
fit <- aftpen(dt, lambda = 0.1, se = "CF", type = "BAR")
fit$beta

Penalized AFT estimation for clustered-partly interval censored data

Description

Fits a penalized accelerated failure time (AFT) model for partly interval censored survival data using induced smoothing and a penalized coordinate descent algorithm. Supported penalties include BAR, LASSO, adaptive LASSO, and SCAD.

Usage

aftpen_pic(
  dt,
  lambda,
  se,
  type = c("BAR", "LASSO", "ALASSO", "SCAD"),
  r = 3.7,
  eps = 1e-08,
  max.iter = 100
)

Arguments

Details

The input data dt are assumed to arise from clustered partly interval-censored survival data with informative cluster sizes.

Specifically, observations are grouped into clusters, where each cluster shares a latent frailty variable that affects both the failure times and the cluster size. As a result, the number of observations within each cluster is not fixed but depends on the underlying frailty, leading to an informative cluster size structure.

For each subject, the failure time follows an accelerated failure time (AFT) model, and the observed data consist of an interval (L, R) together with an indicator delta. When L = R (i.e., delta = 1), the observation is exact; otherwise (delta = 0), the observation is censored and may correspond to left-censoring, right-censoring, or interval-censoring depending on the relationship between the true failure time and the inspection times.

The function first calls the Rcpp backend is_aftp_pic_cpp() to obtain an initial estimator together with gradient and Hessian information. A Cholesky-based transformation is then applied, followed by coordinate-wise penalized updates.

For type = "BAR", the update uses the internal BAR_threshold() operator. For "LASSO", "ALASSO", and "SCAD", soft-thresholding-based updates are used.

Value

A list containing the following components:

• beta: final coefficient estimate on the original scale.

Examples

set.seed(1)

## simplified generator for clustered partly interval-censored data
n <- 50
p <- 2
beta0 <- c(1, 1)
clu_rate <- 0.5
exactrates <- 0.8
left <- 0.001
right <- 0.01

## cluster-level frailty and informative cluster sizes
eta <- 1 / clu_rate
v <- rgamma(n, shape = eta, rate = eta)
m <- ifelse(v > median(v), 5, 3)
id <- rep(seq_len(n), m)
vi <- rep(v, m)

## subject-level covariates and failure times
N <- sum(m)
x <- matrix(rnorm(N * p), ncol = p)
T <- as.vector(exp(x %*% beta0 + vi * log(rexp(N))))

## build (L, R, delta)
L <- R <- delta <- numeric(N)
index <- rbinom(N, 1, exactrates)

for (i in seq_len(N)) {
  if (index[i] == 1) {
    L[i] <- T[i]
    R[i] <- T[i]
    delta[i] <- 1
  } else {
    U <- cumsum(c(1e-8, runif(10, left, right)))
    LL <- U[-length(U)]
    RR <- U[-1]

    if (T[i] < min(LL)) {
      L[i] <- 1e-8
      R[i] <- min(LL)
      delta[i] <- 0
    } else if (T[i] > max(RR)) {
      L[i] <- max(RR)
      R[i] <- 1e8
      delta[i] <- 0
    } else {
      idd <- which(T[i] > LL & T[i] < RR)
      if (length(idd) == 1) {
        L[i] <- LL[idd]
        R[i] <- RR[idd]
        delta[i] <- 0
      } else {
        L[i] <- T[i]
        R[i] <- T[i]
        delta[i] <- 1
      }
    }
  }
}

dt <- data.frame(
  L = L, R = R, delta = delta, id = id,
  x1 = x[, 1], x2 = x[, 2]
)

fit <- aftpen_pic(dt, lambda = 0.001, se = "CF", type = "BAR")
fit$beta