From ca17d57dce048f57e03241f6120d539ec70d785a Mon Sep 17 00:00:00 2001
From: Luca Coraggio <luca.coraggio@unina.it>
Date: Sun, 17 Oct 2021 19:00:08 +0000
Subject: version 2.0

---
 R/rsc.R | 89 +++++++++++++++++++++++++++++++++++------------------------------
 1 file changed, 48 insertions(+), 41 deletions(-)

(limited to 'R/rsc.R')

diff --git a/R/rsc.R b/R/rsc.R
index 6cf4e15..8182d1c 100644
--- a/R/rsc.R
+++ b/R/rsc.R
@@ -1,42 +1,49 @@
-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)
+rsc <- function(cv, threshold = "minimum"){
+
+    ## inputs
+    ## cv         = u   ## a class cv_rsc or any other correlation matrix
+    ## threshold  = "minimum" ## "minimum", "minimum1se" or numeric in (0,1)
+
+    if(class(cv) == "rsc_cv"){
+
+        ## check threshold
+        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
+            }
+        }
+
+
+        ## threshold the rmadvec 
+        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")
+
+        ## attach dimnames if needed 
+        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)
 }
-- 
cgit v1.2.3