diff options
| -rw-r--r-- | R/rsc.R | 24 | ||||
| -rw-r--r-- | R/stability_score.R | 5 |
2 files changed, 24 insertions, 5 deletions
@@ -1,4 +1,18 @@ -rsc <- function(cv, threshold = "minimum"){ +rsc <- function(cv, threshold = "minimum", weights = NULL){ + + if(!is.null(weights)){ + if(is.matrix(weights)){ + weights <- as.numeric(weights[lower.tri(weights)]) + } + + if(is.vector(weights)){ + if(length(weights) != length(cv$rmadvec)){ + stop('weights must be a vector matching rmadvec') + } + }else{ + stop('weights must be a vector matching rmadvec or p x p matrix') + } + } ## inputs ## cv = u ## a class cv_rsc or any other correlation matrix @@ -25,9 +39,13 @@ rsc <- function(cv, threshold = "minimum"){ } } - ## threshold the rmadvec - cv$rmadvec[ abs(cv$rmadvec) < threshold ] <- 0 + if(is.null(weights)){ + cv$rmadvec[ abs(cv$rmadvec) < threshold ] <- 0 + }else{ + T <- abs(cv$rmadvec) * weights + cv$rmadvec[ T < threshold ] <- 0 + } nc <- length(cv$rmadvec) p <- {1 + sqrt( 1 + 8 * nc ) } / 2 diff --git a/R/stability_score.R b/R/stability_score.R index 7841214..45fc078 100644 --- a/R/stability_score.R +++ b/R/stability_score.R @@ -20,7 +20,8 @@ stability_score <- function(X, K = 25, subsample_fraction = 0.7){ 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)) + delta_sd <- pmax(delta_sd, quantile(delta_sd[lower.tri(delta_sd)], 0.05)) score <- 1 / delta_sd - score / median(score[upper.tri(score)]) + W <- score / median(score[lower.tri(score)]) + return(W[lower.tri(W)]) } |