summaryrefslogtreecommitdiff
path: root/R/rsc.R
diff options
context:
space:
mode:
Diffstat (limited to 'R/rsc.R')
-rw-r--r--R/rsc.R42
1 files changed, 42 insertions, 0 deletions
diff --git a/R/rsc.R b/R/rsc.R
new file mode 100644
index 0000000..6cf4e15
--- /dev/null
+++ b/R/rsc.R
@@ -0,0 +1,42 @@
+rsc <- function(cv, threshold = "minimum") {
+ if (class(cv) == "rsc_cv") {
+ if (is.numeric(threshold)) {
+ if (length(threshold) > 1) {
+ stop("if a specific value for 'threshold' is chosen, this must be a single numeric value in (0,1)")
+ }
+ else if (threshold <= 0 | threshold >= 1) {
+ stop("if a specific value for 'threshold' is chosen, this must be a single numeric value in (0,1)")
+ }
+ }
+ else {
+ if ({
+ threshold != "minimum"
+ } & {
+ threshold != "minimum1se"
+ }) {
+ stop("'threshold' must be one of the following: 'minimum', 'minimum1se', a numeric value in (0,1).")
+ }
+ if (threshold == "minimum") {
+ threshold <- cv$minimum
+ }
+ else if (threshold == "minimum1se") {
+ threshold <- cv$minimum1se
+ }
+ }
+ cv$rmadvec[abs(cv$rmadvec) < threshold] <- 0
+ nc <- length(cv$rmadvec)
+ p <- {
+ 1 + sqrt(1 + 8 * nc)
+ }/2
+ R <- Matrix(1, nrow = p, ncol = p, sparse = TRUE)
+ R[lower.tri(R, diag = FALSE)] <- cv$rmadvec
+ R <- forceSymmetric(R, uplo = "L")
+ if (!is.null(cv$varnames)) {
+ dimnames(R)[[1]] <- dimnames(R)[[2]] <- cv$varnames
+ }
+ }
+ else {
+ stop("'cv' must be a an object of class 'rsc_cv' obtained from 'rsc::rsc_cv'")
+ }
+ return(R)
+}