summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChris Sobczak <chris@sobczak.family>2026-06-10 20:54:26 -0700
committerChris Sobczak <chris@sobczak.family>2026-06-10 20:54:26 -0700
commit14cb619997719aac2971b5ef89feacc421764458 (patch)
tree89c90e84b40579d67c0ad72811f2b1719ff70f46
parentcbed2931c9244daa2e1e8d4c0b13958f8e5e0148 (diff)
Update docs
-rw-r--r--DESCRIPTION3
-rw-r--r--R/rsc.R13
-rwxr-xr-xman/rsc.Rd12
-rw-r--r--tests/testthat.R12
-rw-r--r--tests/testthat/test-rsc.R19
5 files changed, 53 insertions, 6 deletions
diff --git a/DESCRIPTION b/DESCRIPTION
index 8ded430..47185d1 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -21,3 +21,6 @@ Version: 2.0.5
Date: 2026-06-10
License: GPL (>= 2)
Config/roxygen2/version: 8.0.0.9000
+Suggests:
+ testthat (>= 3.0.0)
+Config/testthat/edition: 3
diff --git a/R/rsc.R b/R/rsc.R
index b46ae84..025ec0b 100644
--- a/R/rsc.R
+++ b/R/rsc.R
@@ -39,19 +39,22 @@ rsc <- function(cv, threshold = "minimum", weights = NULL){
}
}
+ # make a copy
+ rmadvec <- cv$rmadvec
+
## threshold the rmadvec
if(is.null(weights)){
- cv$rmadvec[ abs(cv$rmadvec) < threshold ] <- 0
+ rmadvec[ abs(rmadvec) < threshold ] <- 0
}else{
- T <- abs(cv$rmadvec) * weights
- cv$rmadvec[ T < threshold ] <- 0
+ T <- abs(rmadvec) * weights
+ rmadvec[ T < threshold ] <- 0
}
- nc <- length(cv$rmadvec)
+ nc <- length(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[lower.tri(R , diag = FALSE)] <- rmadvec
R <- forceSymmetric(R , uplo="L")
## attach dimnames if needed
diff --git a/man/rsc.Rd b/man/rsc.Rd
index 3fa5fb3..c878cde 100755
--- a/man/rsc.Rd
+++ b/man/rsc.Rd
@@ -11,7 +11,7 @@
\usage{
- rsc(cv, threshold = "minimum")
+ rsc(cv, threshold = "minimum", weights = NULL)
}
@@ -26,6 +26,16 @@
optimal threshold according to the selection performed in
\code{\link{rsc_cv}}.
}
+ \item{weights}{
+ When \code{weights} are provided, thresholding
+ is applied to \code{|r| * weights} instead of
+ \code{|r|}. Final estimator values are unchanged.
+ This can be a p x p matrix
+ or a vector of the length of the lower
+ triangle. These weights should be generated
+ by using \code{\link{stability_score}} for
+ the inverse variance of the subsampled angles.
+ }
}
diff --git a/tests/testthat.R b/tests/testthat.R
new file mode 100644
index 0000000..cfeb4a2
--- /dev/null
+++ b/tests/testthat.R
@@ -0,0 +1,12 @@
+# This file is part of the standard setup for testthat.
+# It is recommended that you do not modify it.
+#
+# Where should you do additional test configuration?
+# Learn more about the roles of various files in:
+# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview
+# * https://testthat.r-lib.org/articles/special-files.html
+
+library(testthat)
+library(RSC)
+
+test_check("RSC")
diff --git a/tests/testthat/test-rsc.R b/tests/testthat/test-rsc.R
new file mode 100644
index 0000000..e392bb5
--- /dev/null
+++ b/tests/testthat/test-rsc.R
@@ -0,0 +1,19 @@
+test_that("rsc unchanged when weights = NULL", {
+ set.seed(1)
+ p <- 10
+ X <- matrix(rnorm(p * p), p)
+ cv <- rsc_cv(X, ncores = 1)
+ R1 <- rsc(cv)
+ R2 <- rsc(cv, weights = NULL)
+ expect_equal(R1, R2)
+})
+
+test_that("if given weights of all 1 of the right dimensions, rsc should be unchanged", {
+ set.seed(1)
+ p <- 10
+ X <- matrix(rnorm(p * p), p)
+ cv <- rsc_cv(X, ncores = 1)
+ R1 <- rsc(cv)
+ R2 <- rsc(cv, weights = matrix(data = 1, ncol = p, nrow = p))
+ expect_equal(R1, R2)
+})