diff options
Diffstat (limited to 'R/rsc.R')
| -rw-r--r-- | R/rsc.R | 24 |
1 files changed, 21 insertions, 3 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 |