4. High-Dimensional Data & Variable Screening • SuperSurv

Introduction

In modern clinical research and bioinformatics, it is common to encounter high-dimensional datasets where the number of predictors (genes, biomarkers, clinical features) far exceeds the number of observed events ( $p \gg n$ ).

Feeding thousands of raw variables directly into complex machine learning algorithms introduces two massive problems: 1. Computational Bottlenecks: Algorithms like Random Survival Forests become prohibitively slow. 2. Overfitting: Models will mathematically memorize background noise instead of true biological signals, destroying out-of-sample prediction accuracy.

SuperSurv elegantly handles this through Variable Screening. Screening acts as a computational filter before the models are fitted. It evaluates all predictors, drops the statistical noise, and only passes the most highly associated features into your base learners.

1. Simulating High-Dimensional Data

To demonstrate how screening works, we will use our standard metabric dataset, but we will artificially inject 100 columns of pure random noise. This simulates a high-dimensional genomic dataset where most measured features have absolutely no relationship to patient survival.

library(SuperSurv)
library(survival)

data("metabric", package = "SuperSurv")
set.seed(42)

# Create 100 columns of random noise (simulating irrelevant genes/biomarkers)
n_patients <- nrow(metabric)
noise_data <- matrix(rnorm(n_patients * 20), nrow = n_patients)
colnames(noise_data) <- paste0("noise_", 1:20)
# Combine the real data with the noise
high_dim_data <- cbind(metabric, noise_data)

# Standard Train/Test Split
train_idx <- sample(1:nrow(high_dim_data), 0.7 * nrow(high_dim_data))
train <- high_dim_data[train_idx, ]
test  <- high_dim_data[-train_idx, ]

X_tr <- train[, grep("^x|^noise", names(high_dim_data))]
X_te <- test[, grep("^x|^noise", names(high_dim_data))]
new.times <- seq(50, 200, by = 25)

2. Defining the Screening Algorithms

Just as we have a library for prediction algorithms, SuperSurv utilizes a library for screening algorithms. You can pair any prediction model with any screening function to create a streamlined pipeline.

SuperSurv includes a comprehensive suite of built-in screeners: * screen.marg: Marginal screening (keeps variables with strong univariate associations). * screen.glmnet: Penalized Lasso screening (shrinks irrelevant feature coefficients to exact zero). * screen.elasticnet: Elastic Net screening (combines Lasso and Ridge penalties; highly recommended for highly correlated biological features like gene expression data). * screen.rfsrc: Tree-based screening (keeps features with high Random Forest variable importance). * screen.var: Unsupervised screening (drops features with near-zero variance). * screen.all: A baseline passthrough (keeps all variables without screening).

Let’s build a library that tests different combinations of prediction and screening:

# We pass a list of vectors. The first element is the prediction model, 
# and the second element is the screening algorithm.

my_screen_library <- list(
  c("surv.coxph", "screen.all"),         # Baseline: Cox model with ALL variables
  c("surv.coxph", "screen.marg"),        # Screen by marginal association, then fit Cox
  c("surv.weibull", "screen.elasticnet"),# Screen via Elastic Net, then fit Weibull
  c("surv.rpart", "screen.var")          # Drop zero-variance noise, then fit a Tree
)

# For the censoring library, we use an unscreened approach 
cens_library <- c("surv.coxph")

3. Training with Embedded Screening

When we pass this paired library into SuperSurv, the meta-learner handles the cross-validation with absolute statistical rigor.

Crucial Methodological Detail: The screening step is performed inside the cross-validation folds. If you screen the entire dataset before splitting it into folds, you cause “data leakage,” leading to overly optimistic benchmark metrics. SuperSurv protects you from this automatically.

fit_highdim <- SuperSurv(
  time = train$duration,
  event = train$event,
  X = X_tr,
  newdata = X_te,
  new.times = new.times,
  event.library = my_screen_library, # Pass our screened library
  cens.library = cens_library,
  control = list(saveFitLibrary = TRUE),
  verbose = T,
  nFolds = 3
)

4. Evaluating the Screened Ensemble

Despite injecting 100 columns of pure noise, our ensemble still performs exceptionally well because the screening algorithms successfully filtered out the irrelevant variables before the base learners could overfit to them.

We can evaluate this exactly as we did in previous tutorials using eval_summary() and plot_benchmark().

# Check the integrated performance
screened_performance <- eval_summary(
  object = fit_highdim,
  newdata = X_te,
  time = test$duration,
  event = test$event,
  eval_times = new.times
)

# Plot the benchmark
# plot_benchmark(fit_highdim, newdata = X_te, time = test$duration, event = test$event, eval_times = new.times)

By leveraging SuperSurv’s screening capabilities, you can scale your survival analysis to massive genomic and clinical datasets without sacrificing computational speed or predictive accuracy.

5. Identifying the Selected Features

After the Super Learner finishes its cross-validation and fitting, you likely want to know which variables actually survived the screening process. In clinical and biological research, these selected features often represent the most important biomarkers or predictive genes.

SuperSurv stores this screening information directly inside the fitted model object, specifically separated into event.whichScreen and cens.whichScreen. We can extract the logical matrix that indicates which columns were passed to each specific base learner.

# The event.whichScreen object is a logical matrix.
# Rows correspond to the predictors, and columns correspond to the algorithms in our event library.

# 1. Get the logical vector for the 2nd model (Row 2)
is_selected <- fit_highdim$event.whichScreen[2, ] 

# 2. Map it to our original column names
selected_features <- colnames(X_tr)[is_selected]

cat("Total features evaluated:", ncol(X_tr), "\n")
#> Total features evaluated: 29
cat("Features retained by Elastic Net:", length(selected_features), "\n\n")
#> Features retained by Elastic Net: 10

cat("Selected Features:\n")
#> Selected Features:
print(selected_features)
#>  [1] "x0"       "x1"       "x2"       "x3"       "x4"       "x5"      
#>  [7] "x6"       "x7"       "x8"       "noise_10"

By extracting these features, you can seamlessly transition from pure predictive modeling into downstream biological inference or pathway analysis.