tests/testthat/test-validation-and-plotting.R

In MRS: Multi-Resolution Scanning for Cross-Sample and Cross-Group Differences

test_that("mrs validates scalar, matrix, group, and bound inputs", {
  X <- matrix(seq_len(20), ncol = 1L)
  G <- rep(1:2, each = 10L)

  expect_error(mrs(character(0), numeric(0)), "non-empty numeric matrix")
  expect_error(mrs(replace(X, 1L, NA_real_), G), "finite values")
  expect_error(mrs(replace(X, 1L, Inf), G), "finite values")
  expect_error(mrs(X, replace(G, 1L, 1.5)), "integer group label")
  expect_error(mrs(X, G, n_groups = 3), "every integer label")
  expect_error(mrs(X, G, Omega = matrix(c(2, 1), nrow = 1L)),
               "lower bound smaller")
  expect_error(mrs(X, G, Omega = matrix(c(0, 25, 0, 25), nrow = 2L)),
               "one row per column")
  expect_error(mrs(X, G, K = -1), "'K'")
  expect_error(mrs(X, G, n_post_samples = 0.5), "'n_post_samples'")
  expect_error(mrs(X, G, baseline = 3), "'baseline'")
  expect_error(mrs(X, G, min_n_node = -1), "'min_n_node'")
  expect_error(mrs(X, G, return_tree = 1), "TRUE or FALSE")
  expect_error(mrs(X, G, alpha = 0), "positive finite")
  expect_error(mrs(X, G, beta = 0.9), "between 1 and 2")
  expect_error(mrs(X, G, gamma = 1.1), "between 0 and 1")
  expect_error(mrs(X, G, eta = -0.1), "between 0 and 1")
  expect_error(mrs(X, G, init_state = c(0.5, 0.5, 0.5)), "sum to 1")
})

test_that("andova validates replicate and integration inputs", {
  X <- matrix(seq_len(48) / 10, ncol = 1L)
  G <- rep(1:2, each = 24L)
  H <- rep(rep(1:3, each = 8L), 2L)

  expect_error(andova(X, G, H[-1L], K = 2), "positive integer replicate label")
  expect_error(andova(X, G, replace(H, 1L, 1.5), K = 2),
               "positive integer replicate label")
  expect_error(andova(X, G, H, n_subgroups = c(2, 3), K = 2),
               "match the observed")
  expect_error(andova(X, G, H, K = 1), "'K'")
  expect_error(andova(X, G, H, K = 2, method = "invalid"), "arg")
  expect_error(andova(X, G, H, K = 2, n_grid_theta = 0), "'n_grid_theta'")
  expect_error(andova(X, G, H, K = 2, nu_vec = c(1, 0)), "positive finite")
})

test_that("summary explains when no representative tree was requested", {
  set.seed(12345)
  X <- matrix(rnorm(40), ncol = 1L)
  G <- rep(1:2, each = 20L)
  fit <- mrs(X, G, K = 2, return_tree = FALSE)

  expect_error(summary(fit), "no representative tree")
  expect_error(plotTree(fit), "no representative tree")
})

test_that("print.summary.mrs prints every group effect for each region", {
  object <- structure(list(
    Posterior_Null = 0.1,
    Prior_Null = 0.2,
    Num_Regions = 2L,
    Alt_Prob = c(0.9, 0.8),
    Effect_Size = matrix(c(1, 2, 3, 4), nrow = 2L, byrow = TRUE),
    Regions = matrix(c(0, 1, 1, 2), nrow = 2L, byrow = TRUE),
    Directions = c(1L, 1L)
  ), class = "summary.mrs")

  output <- capture.output(print(object))
  expect_true(any(grepl("Effect Size:  1 2", output, fixed = TRUE)))
  expect_true(any(grepl("Effect Size:  3 4", output, fixed = TRUE)))
})

test_that("representative-tree layout preserves binary topology", {
  levels <- c(2L, 1L, 0L, 2L, 1L)
  ids <- c(1L, 1L, 0L, 0L, 0L)
  tree_layout <- MRS:::.representative_tree_layout(levels, ids)

  expect_equal(tree_layout$coordinates[, "y"], max(levels) - levels)
  expect_equal(tree_layout$coordinates[c(4L, 1L, 2L), "x"], 1:3)
  expect_equal(unname(tree_layout$coordinates[5L, "x"]), 1.5)
  expect_equal(unname(tree_layout$coordinates[3L, "x"]), 2.25)

  parents <- tree_layout$edges[, "parent"]
  children <- tree_layout$edges[, "child"]
  expect_true(all(levels[children] == levels[parents] + 1L))
  expect_true(all(ids[children] %/% 2L == ids[parents]))

  expect_error(
    MRS:::.representative_tree_layout(c(0L, 2L), c(0L, 0L)),
    "must have a parent"
  )
})

test_that("plotting validates options and handles zero effect sizes", {
  set.seed(12345)
  X <- matrix(rnorm(120), ncol = 2L)
  G <- rep(1:2, each = 30L)
  fit <- mrs(X, G, K = 2)
  zero_fit <- fit
  zero_fit$RepresentativeTree$EffectSizes[] <- 0

  output <- tempfile(fileext = ".pdf")
  grDevices::pdf(output)
  expect_no_error(plotTree(zero_fit, type = "eff", legend = TRUE))
  expect_no_error(plot2D(fit, type = "prob", data.points = "none",
                         background = "none", legend = TRUE))
  expect_no_error(plot2D(fit, type = "eff", data.points = "differential",
                         background = "smeared", abs = FALSE))
  grDevices::dev.off()
  unlink(output)

  expect_error(plotTree(fit, type = "bad"), "arg")
  expect_error(plotTree(fit, node.size = 0), "positive finite")
  expect_error(plot2D(fit, dim = c(1, 1)), "distinct valid")
  expect_error(plot2D(fit, levels = integer()), "one or more levels")
  expect_error(plot2D(fit, regions = 1), "one zero/one indicator")
})