diff --git a/tests/testthat/test-PROPR-updatepermutes.R b/tests/testthat/test-PROPR-updatepermutes.R new file mode 100644 index 0000000..88b956f --- /dev/null +++ b/tests/testthat/test-PROPR-updatepermutes.R @@ -0,0 +1,52 @@ +library(testthat) +library(propr) + +N <- 100 +a <- seq(from = 5, to = 15, length.out = N) +b <- a * rnorm(N, mean = 1, sd = 0.1) +c <- rnorm(N, mean = 10) +d <- rnorm(N, mean = 10) +e <- rep(10, N) +X <- data.frame(a, b, c, d, e) + +# compute pcor.bshrink without fixed seed +pcorbshrink1 <- propr(X, metric = "pcor.bshrink", p=10) +pcorbshrink1 <- updateCutoffs(pcorbshrink1) + +pcorbshrink2 <- propr(X, metric = "pcor.bshrink", p=10) +pcorbshrink2 <- updateCutoffs(pcorbshrink2) + +# compute pcor.bshrink with fixed seed +pcorbshrink1_ <- propr(X, metric = "pcor.bshrink", p=10, fixseed=TRUE) +pcorbshrink1_ <- updateCutoffs(pcorbshrink1_) + +pcorbshrink2_ <- propr(X, metric = "pcor.bshrink", p=10, fixseed=TRUE) +pcorbshrink2_ <- updateCutoffs(pcorbshrink2_) + +# test that the results are as expected +test_that("test that fdr will stay the same only if fixseed=TRUE", { + + expect_false( + isTRUE(all.equal( + pcorbshrink1@permutes, + pcorbshrink2@permutes + )) + ) + + expect_false( + isTRUE(all.equal( + pcorbshrink1@fdr, + pcorbshrink2@fdr + )) + ) + + expect_equal( + pcorbshrink1_@permutes, + pcorbshrink2_@permutes + ) + + expect_equal( + pcorbshrink1_@fdr, + pcorbshrink2_@fdr + ) +}) \ No newline at end of file