From 9f8518e1ef17fd23b5923bc37a50ccddcbeb299d Mon Sep 17 00:00:00 2001 From: Chris Sobczak Date: Wed, 10 Jun 2026 20:02:05 -0700 Subject: Add stability_score and signal to noise ratio plot functions --- R/stability_score.R | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) create mode 100644 R/stability_score.R (limited to 'R/stability_score.R') diff --git a/R/stability_score.R b/R/stability_score.R new file mode 100644 index 0000000..7841214 --- /dev/null +++ b/R/stability_score.R @@ -0,0 +1,26 @@ +#' Stability Score +#' +#' Computing entry wise stability score for selection +#' +#' @param X The data matrix to operate on +#' @param K Number of k-folds (default 25) +#' @param subsample_fraction Hold out fraction (default 0.7) +#' +#' @return Score array +#' @export +stability_score <- function(X, K = 25, subsample_fraction = 0.7){ + n <- nrow(X) + p <- ncol(X) + rho <- vector('list', K) + for(r in seq_len(K)){ + idx <- sample(n, size = floor(subsample_fraction * n)) + rho[[r]] <- cor(X[idx, ]) + } + R <- simplify2array(rho) + theta <- acos(pmax(pmin(R, 1), -1)) + delta <- theta - pi/2 + delta_sd <- apply(delta, c(1, 2), sd) + delta_sd <- pmax(delta_sd, quantile(delta_sd[upper.tri(delta_sd)], 0.05)) + score <- 1 / delta_sd + score / median(score[upper.tri(score)]) +} -- cgit v1.2.3