tests/testthat/test-old_vs_new.R

In wilsoncai1992/adaptest: Data-Adaptive Statistics for High-Dimensional Multiple Testing

# ################################################################################
# # setup
# ################################################################################
# set.seed(628957)
# library(MASS)
# library(Matrix)
# library(future)
# library(origami)
# library(adaptest)
# context("adaptest works the same under old and origami implementations")

# ################################################################################
# # simulation
# ################################################################################
# n.sim <- 1e2 # sample size
# p.all <- 1e4 # No. of dimensions of Y (signal + non-signal)
# p.true <- 10 # No. of dimensions for signal
# signal.true <- 0.6 # size of true signal
# signal.true.W <- 0.1

# n.top.want <- 15
# n.fold <- 10

# # epsilon
# epsilon <- matrix(rnorm(n = n.sim * p.all), nrow = n.sim, ncol = p.all)

# # A
# A.candidate <- list(rep(1, p.all), rep(0, p.all))
# A.sample <- sample(A.candidate, size = n.sim, replace = TRUE)
# A.sample <- do.call(rbind, A.sample)
# A.sample.vec <- A.sample[, 1]

# # B1
# b1.row <- c(rep(signal.true, p.true), rep(0, p.all - p.true))
# rep.row <- function(x, n) {
#   matrix(rep(x, each = n), nrow = n)
# }
# b1 <- rep.row(b1.row, n = n.sim)

# # B0
# b0.row <- rnorm(n = p.all)
# b0 <- rep.row(b0.row, n = n.sim)

# # Y
# temp1 <- b1 * A.sample
# Y <- b0 + temp1 + epsilon

# # clean up
# rm(list = c("b1", "A.sample"))
# rm(list = c("b0", "epsilon", "temp1"))


# ################################################################################
# # adaptest should be fast with futures...
# ################################################################################

# if (availableCores() > 1) {
#   plan(multiprocess)
# } else {
#   plan(sequential)
# }

# set.seed(48915672)
# time_new <- system.time(
#   result_new <- adaptest(
#     Y = Y,
#     A = A.sample.vec,
#     n_top = p.true + 5,
#     n_fold = 4,
#     learning_library = c("SL.mean", "SL.glm", "SL.step")
#   )
# )

# # get origami folds object generated by adaptest to feed into old implementaiton
# folds_vec <- origami::folds2foldvec(result_new$folds)

# time_old <- system.time(
#   result_old <- adaptest:::adaptest_old(
#     Y = Y,
#     A = A.sample.vec,
#     n_top = p.true + 5,
#     n_fold = 4,
#     folds_vec = folds_vec,
#     learning_library = c(
#       "SL.mean", "SL.glm",
#       "SL.step"
#     )
#   )
# )

# # test individual slots in the data_adapt output objects for equivalence
# # NOTE: expect_equal() invoked directly on the two objects will return a
# #       non-equivalence since the new implementation appends an extra slot
# #       "folds" to the output object (needed to make these tests possible)
# test_that("New and old routines return same top mean ranks", {
#   expect_equal(result_new$mean_rank_top, result_old$mean_rank_top)
# })

# test_that("New and old routines return same top index", {
#   expect_equal(result_new$top_index, result_old$top_index)
# })

# test_that("New and old routines return same top column names", {
#   expect_equal(result_new$top_colname, result_old$top_colname)
# })

# test_that("New and old routines return same top columns with significant Q", {
#   expect_equal(
#     result_new$top_colname_significant_q,
#     result_old$top_colname_significant_q
#   )
# })

# test_that("New and old routines return same data-adaptive target parameter", {
#   expect_equal(result_new$DE, result_old$DE)
# })

# test_that("New and old routines return same p-values", {
#   expect_equal(result_new$p_value, result_old$p_value)
# })

# test_that("New and old routines return same q-values", {
#   expect_equal(result_new$q_value, result_old$q_value)
# })

# test_that("New and old routines return same significant q-values", {
#   expect_equal(result_new$significant_q, result_old$significant_q)
# })

# test_that("New and old routines return same prob. of being in the top", {
#   expect_equal(result_new$prob_in_top, result_old$prob_in_top)
# })

# if (availableCores() > 1) {
#   test_that("New implementation is faster than the older implementation", {
#     skip_on_os("windows")
#     expect_lt(time_new["elapsed"], time_old["elapsed"])
#   })
# }