Iteratively enforce full column rank on a design matrix

Given a candidate predictor matrix X and an optional unnamed covariate matrix C, builds the design [1, X, C] and removes rank-deficient columns from X until the design has full column rank. Rank-deficient columns are identified via the pivot of qr([1, X, C]). On each iteration, one problematic column is dropped using dropCollinearColumns. If iterative pruning does not achieve full rank, falls back to ldPruneByCorrelation at a descending sequence of correlation thresholds.

Usage

enforceDesignFullRank(
  X,
  C,
  strategy = c("correlation", "variance", "response_correlation"),
  response = NULL,
  maxIterations = 300L,
  corrThresholds = seq(0.75, 0.5, by = -0.05),
  verbose = FALSE,
  seed = NULL
)

Arguments

X: Numeric matrix with column names (the predictors subject to pruning).
C: Numeric matrix of covariates (can be unnamed) that will be kept. Pass NULL or a zero-column matrix when there are no covariates.
strategy: Passed through to dropCollinearColumns.
response: Passed through to dropCollinearColumns when strategy = "response_correlation".
maxIterations: Integer. Hard cap on the iterative-prune loop. Default 300.
corrThresholds: Numeric vector of |cor| thresholds used for the ldPruneByCorrelation fallback, tried in order. Default seq(0.75, 0.5, by = -0.05).
verbose: Logical. If TRUE, print per-iteration progress. Default FALSE.
seed: Integer or NULL. Seeds the tie-break draw on the rare occasion that exactly two equally-collinear columns are candidates for removal (strategy = "correlation"), via a scoped withr::local_seed, so the session RNG is left untouched. NULL (default) leaves the draw under the session RNG, so an outer set.seed() still governs it.

Value

The pruned predictor matrix X (covariates C are not modified).

Examples

set.seed(1)
X <- matrix(rnorm(100 * 4), 100, 4)
X[, 4] <- X[, 1] + X[, 2]          # rank-deficient
colnames(X) <- c("a", "b", "c", "d")
C <- matrix(rnorm(100), 100, 1)
X2 <- enforceDesignFullRank(X, C, strategy = "variance")
qr(cbind(1, X2, C))$rank == ncol(cbind(1, X2, C))
#> [1] TRUE