tests/testthat/test-parameters.R

In bmm: Easy and Accessible Bayesian Measurement Models Using 'brms'

library(testthat)

# ===========================================================================
# parameters() for bmmodel objects
# ===========================================================================

test_that("parameters() returns correct structure for sdm", {
  m <- sdm(resp_error = "y")
  p <- parameters(m)

  expect_s3_class(p, "bmm_parameters")
  expect_s3_class(p, "data.frame")
  expect_true(all(c("parameter", "description", "fixed", "value", "link") %in% names(p)))
  expect_equal(nrow(p), 3)
  expect_true(all(c("mu", "c", "kappa") %in% p$parameter))
})

test_that("parameters() flags fixed parameters for sdm", {
  m <- sdm(resp_error = "y")
  p <- parameters(m)

  mu_row <- p[p$parameter == "mu", ]
  expect_true(mu_row$fixed)
  expect_equal(mu_row$value, "0")

  c_row <- p[p$parameter == "c", ]
  expect_false(c_row$fixed)
  expect_true(is.na(c_row$value))
})

test_that("parameters() shows correct link functions", {
  m <- sdm(resp_error = "y")
  p <- parameters(m)

  expect_equal(p$link[p$parameter == "c"], "log")
  expect_equal(p$link[p$parameter == "kappa"], "log")
  expect_equal(p$link[p$parameter == "mu"], "tan_half")
})

test_that("parameters() works for imm model", {
  m <- imm(
    resp_error = "y", nt_features = "nt",
    nt_distances = "d", set_size = 2
  )
  p <- parameters(m)

  expect_s3_class(p, "bmm_parameters")
  expect_true(all(c("kappa", "a", "c", "s") %in% p$parameter))
})

test_that("parameters() works for mixture3p model", {
  m <- mixture3p(resp_error = "y", nt_features = "nt", set_size = 2)
  p <- parameters(m)

  expect_s3_class(p, "bmm_parameters")
  expect_true(all(c("thetat", "thetant", "kappa") %in% p$parameter))
})

test_that("parameters() works for m3 ss version", {
  m <- m3(
    resp_cats = c("corr", "other", "npl"),
    num_options = c(1, 4, 5), version = "ss"
  )
  p <- parameters(m)

  expect_s3_class(p, "bmm_parameters")
  expect_true(all(c("b", "c", "a") %in% p$parameter))
})

test_that("parameters() for m3 custom without formula shows note", {
  m <- m3(
    resp_cats = c("corr", "other", "npl"),
    num_options = c(1, 4, 5), version = "custom",
    links = list(c = "log", a = "log")
  )
  p <- parameters(m)

  expect_false(is.null(attr(p, "m3_note")))
  expect_match(attr(p, "m3_note"), "custom M3 model")
})

test_that("parameters() for m3 custom with formula discovers params", {
  m <- m3(
    resp_cats = c("corr", "other", "npl"),
    num_options = c(1, 4, 5), version = "custom",
    links = list(c = "log", a = "log")
  )
  ff <- bmf(corr ~ b + a + c, other ~ b + a, npl ~ b, c ~ 1, a ~ 1)
  p <- parameters(m, formula = ff)

  expect_true("a" %in% p$parameter)
  expect_true("c" %in% p$parameter)
  expect_null(attr(p, "m3_note"))
})

test_that("parameters() identifies free parameters for sdm", {
  m <- sdm(resp_error = "y")
  p <- parameters(m)

  free_pars <- p[!p$fixed, ]
  expect_equal(nrow(free_pars), 2)
  expect_true(all(c("c", "kappa") %in% free_pars$parameter))
})

test_that("parameters() includes descriptions", {
  m <- sdm(resp_error = "y")
  p <- parameters(m)

  expect_true(all(nchar(p$description) > 0))
  expect_true(is.character(p$description))
})

# ===========================================================================
# print.bmmodel()
# ===========================================================================

test_that("print.bmmodel() produces output", {
  m <- sdm(resp_error = "y")
  out <- capture.output(print(m))

  expect_true(any(grepl("Parameters:", out)))
  expect_true(any(grepl("parameters\\(\\)", out)))
})

test_that("print.bmmodel() shows fixed parameters", {
  m <- sdm(resp_error = "y")
  out <- capture.output(print(m))

  expect_true(any(grepl("Fixed:", out)))
  expect_true(any(grepl("mu", out)))
})