tests/testthat/test-weighted_slr.R

In neuroconductor/mimosa: 'MIMoSA': A Method for Inter-Modal Segmentation Analysis

test_that("weighted slr works", {
  set.seed(5)
  n = 1000
  p = 27
  x = matrix(rnorm(n * p), ncol = p)
  y = x * 4 + 6 * x * (x > 0) + rnorm(n * p)
  wts = c(-1, 0, 1)
  wts = expand.grid(wts, wts, wts)
  sigma = 2
  wts = exp( -rowSums(wts^2) / (2 * sigma^2))
  slr = weighted_slr(x, y, wts = wts)
  beta0 = c(2.36034024717208, 2.34077098948495, 2.48689913757922, 2.39104951698142,
            2.41039331747553, 2.46477547296319, 2.38971835788081, 2.47862633244392,
            2.30957780722152, 2.59365930400744, 2.3075284085334, 2.37720069596277,
            2.42381413625464, 2.39471180011677, 2.40482432773096, 2.41597874839678,
            2.42685771914042, 2.47724477164638, 2.37433442715709, 2.43799733421587,
            2.47776077355298, 2.32395355857814, 2.32216240067228, 2.42509735602224,
            2.42177004305034, 2.42464303660957, 2.59559528308601)
  expect_equal(slr$beta0, beta0)
  expect_named(slr, c("beta0", "beta1", "r2", "beta0_reverse",
                      "beta1_reverse", "r2_reverse"
  ))
})