diff options
| -rw-r--r-- | DESCRIPTION | 3 | ||||
| -rw-r--r-- | R/rsc.R | 13 | ||||
| -rwxr-xr-x | man/rsc.Rd | 12 | ||||
| -rw-r--r-- | tests/testthat.R | 12 | ||||
| -rw-r--r-- | tests/testthat/test-rsc.R | 19 |
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 @@ -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 @@ -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) +}) |