tests/testthat/test-BVSelection.R

In spinBayes: Semi-Parametric Gene-Environment Interaction via Bayesian Variable Selection

create_BVCSparse <- function(p, iterations, burn.in){
  GS.r0 = GS.zeta = GS.phi = matrix(0, iterations, p)
  GS.r0[,1] = GS.phi[,1] = rbinom(iterations, 1, 0.9)
  GS.r0[,2] = GS.phi[,3] = rbinom(iterations, 1, 0.8)
  GS.zeta[,p] = rbinom(iterations, 1, 0.85)
  posterior = list(GS.r0=GS.r0, GS.phi=GS.phi, GS.zeta=GS.zeta)
  coefficient = NULL
  obj = list(posterior=posterior, coefficient=coefficient, iterations=iterations, burn.in=burn.in)
  class(obj) = c("BVCfit", "BVCSparse")
  obj
}

create_BVCNonSparse <- function(p, q, iterations, burn.in){
  basis = list(q=q); L=q-1
  GS.r0 = matrix(0, iterations, p)
  # GS.zeta = NULL
  GS.rs = matrix(0, iterations, p*L)
  GS.r0[,1] = GS.rs[,1] = rnorm(iterations, mean = -15, sd = 1)
  GS.r0[,2] = GS.rs[,(3*L)] = rnorm(iterations, mean = 15, sd = 1)
  GS.r0[,3] = rnorm(iterations, mean = 0, sd = 1)
  posterior = list(GS.r0=GS.r0, GS.rs=GS.rs)
  coefficient = NULL
  obj = list(posterior=posterior, coefficient=coefficient, iterations=iterations,
             burn.in=burn.in, basis=basis)
  class(obj) = c("BVCfit", "BVCNonSparse")
  obj
}

test_that("selection for BVCSparse class", {
  p = 5
  spbayes=create_BVCSparse(p, 1000, 100)
  selected = BVSelection(spbayes)
  expect_true(grepl("Median Probability Model", selected$method))
  expect_equal(selected$indices$Constant, 2)
  expect_equal(selected$indices$Varying, c(1,3))
  expect_equal(selected$indices$Linear, p)
})

test_that("selection for BVCNonSparse class", {
  spbayes=create_BVCNonSparse(5, 3, 1000, 100)
  selected = BVSelection(spbayes)
  expect_match(selected$method, "95% credible interval")
  expect_equal(selected$indices$Constant, 2)
  expect_equal(selected$indices$Varying, c(1,3))
  expect_true(is.null(selected$indices$Linear))
})

test_that("selection for default method", {
  spbayes=BVCfit(X=X, Y=Y, Z=Z, clin=clin, hyper=list(r.v=10))
  selected = BVSelection(spbayes)
  expect_true(grepl("Median Probability Model", selected$method))
  expect_equal(length(selected$indices), 3)
})

test_that("selection for non-structural method", {
  spbayes=BVCfit(X=X, Y=Y, Z=Z, E=E, clin=clin, structural=FALSE)
  selected = BVSelection(spbayes)
  expect_true(grepl("Median Probability Model", selected$method))
  expect_true(is.null(selected$indices$Constant))
  expect_true(selected$summary["Constant effect",]==0)
})

test_that("selection for non-sparse method", {
  spbayes=BVCfit(X=X, Y=Y, Z=Z, clin=clin, sparse=FALSE)
  selected = BVSelection(spbayes, prob=0.9)
  expect_match(selected$method, "90% credible interval")
  expect_output(print(selected))
  expect_true(is.null(selected$indices$Linear))
  expect_true(selected$summary["Linear interaction",]==0)
})

# test_that("selection for BLasso method", {
#   spbayes=BVCfit(X=X, Y=Y, Z=Z, E=E, clin=clin, VC=FALSE)
#   selected = BVSelection(spbayes, prob=0.9)
#   expect_output(print(selected))
#   expect_match(selected$method, "90% credible interval")
# })