Add weights option to scale thresholded values

2 files changed, 24 insertions, 5 deletions

diff --git a/R/rsc.R b/R/rsc.R
index f82df51..b46ae84 100644
--- a/R/rsc.R
+++ b/R/rsc.R
@@ -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)])
 }