tests/testthat/test-mrs.R

make_mrs_data <- function() {
  set.seed(12345)
  list(
    X = matrix(c(rnorm(30, -0.25), rnorm(30, 0.25)), ncol = 1L),
    G = rep(1:2, each = 30L)
  )
}

test_that("mrs fits a representative tree and posterior samples", {
  data <- make_mrs_data()
  fit <- mrs(data$X, data$G, K = 2, n_post_samples = 1)

  expect_s3_class(fit, "mrs")
  expect_true(is.matrix(fit$RepresentativeTree$EffectSizes))
  expect_true(is.matrix(fit$RepresentativeTree$Regions))
  expect_length(fit$PostSamples, 1L)
  expect_true(is.matrix(fit$PostSamples[[1L]]$EffectSizes))
  expect_true(is.matrix(fit$PostSamples[[1L]]$Regions))
  expect_true(is.finite(fit$LogLikelihood))
})

test_that("mrs rejects inputs that could make the C++ core unsafe", {
  data <- make_mrs_data()

  expect_error(mrs(data$X, data$G[-1L]), "one integer group label")
  expect_error(mrs(data$X, data$G + 1L), "every integer label")
  expect_error(mrs(data$X, data$G, K = 15), "'K'")
  expect_error(mrs(data$X, data$G, Omega = matrix(c(-1, 0), nrow = 1L)),
               "outside 'Omega'")
})

test_that("default bounds support constant and negative-valued dimensions", {
  X <- cbind(rep(-5, 20), seq(-10, -1, length.out = 20))
  G <- rep(1:2, each = 10)
  fit <- mrs(X, G, K = 2)

  expect_s3_class(fit, "mrs")
  expect_equal(fit$Data$Omega[, 1L], apply(X, 2L, min))
  expect_true(all(fit$Data$Omega[, 2L] > apply(X, 2L, max)))
})

test_that("observations on explicit bounds map to valid dyadic bins", {
  X <- cbind(seq(-2, 2, length.out = 40), seq(1, 5, length.out = 40))
  G <- rep(1:2, each = 20)
  Omega <- t(apply(X, 2L, range))

  fit <- mrs(X, G, Omega = Omega, K = 3)
  expect_s3_class(fit, "mrs")
  expect_equal(fit$Data$Omega, Omega)
  expect_true(all(unlist(fit$RepresentativeTree$DataPoints) %in% seq_len(nrow(X))))
})

test_that("andova validates replicates and fits small data", {
  set.seed(12345)
  X <- matrix(rnorm(48), ncol = 1L)
  G <- rep(1:2, each = 24L)
  H <- rep(rep(1:3, each = 8L), 2L)

  fit <- andova(X, G, H, K = 2, nu_vec = c(0.5, 1), n_grid_theta = 10)
  expect_s3_class(fit, "mrs")
  expect_error(andova(X, G, replace(H, 1L, 5L), K = 2), "consecutive labels")
})

test_that("Bayesian FDR plotting masks complete effect-size rows", {
  data <- make_mrs_data()
  fit <- mrs(data$X, data$G, K = 2)

  plot_file <- tempfile(fileext = ".pdf")
  grDevices::pdf(plot_file)
  result <- plot1DSigWindows(fit, fdr = 0.2, precision = 0.1)
  grDevices::dev.off()
  unlink(plot_file)
  expect_named(result, c("indices", "threshold"))
  expect_true(result$threshold >= 0 && result$threshold <= 1)
})

test_that("native routines are registered", {
  routines <- getDLLRegisteredRoutines("MRS")$.Call
  expect_true(all(c("_MRS_fitMRScpp", "_MRS_fitMRSNESTEDcpp") %in% names(routines)))
})

Try the MRS package in your browser

Any scripts or data that you put into this service are public.

MRS documentation built on July 22, 2026, 5:10 p.m.