tests/testthat/test-priors.R

In clmstan: Cumulative Link Models with 'CmdStanR'

# =============================================================================
# Tests for prior specification functions
# =============================================================================

# =============================================================================
# Legacy API: clm_prior()
# =============================================================================

test_that("clm_prior creates object with correct class", {
  prior <- clm_prior()
  expect_s3_class(prior, "clm_prior")
})

test_that("clm_prior with no arguments returns empty object", {
  prior <- clm_prior()
  expect_equal(length(prior), 0)
})

test_that("clm_prior stores specified values", {
  prior <- clm_prior(beta_sd = 1, c_sd = 5)
  expect_equal(prior$beta_sd, 1)
  expect_equal(prior$c_sd, 5)
})

test_that("clm_prior rejects invalid values", {
  # SD must be positive

expect_error(clm_prior(beta_sd = 0), "must be positive")
  expect_error(clm_prior(beta_sd = -1), "must be positive")
  expect_error(clm_prior(c_sd = 0), "must be positive")

  # Non-numeric values
  expect_error(clm_prior(beta_sd = "1"), "must be a single numeric")
  expect_error(clm_prior(beta_sd = c(1, 2)), "must be a single numeric")
})

test_that("clm_prior accepts all parameter types", {
  # Basic priors
  prior1 <- clm_prior(beta_sd = 2)
  expect_equal(prior1$beta_sd, 2)

  # Flexible threshold
  prior2 <- clm_prior(c_sd = 5)
  expect_equal(prior2$c_sd, 5)

  # Equidistant threshold
  prior3 <- clm_prior(c1_mu = -1, c1_sd = 5, d_alpha = 1, d_beta = 1)
  expect_equal(prior3$c1_mu, -1)
  expect_equal(prior3$d_alpha, 1)

  # Symmetric threshold
  prior4 <- clm_prior(cpos_sd = 3)
  expect_equal(prior4$cpos_sd, 3)

  # Link parameters
  prior5 <- clm_prior(df_alpha = 3, df_beta = 0.2)
  expect_equal(prior5$df_alpha, 3)
  expect_equal(prior5$df_beta, 0.2)

  prior6 <- clm_prior(xi_mu = 0.5, xi_sd = 0.3)
  expect_equal(prior6$xi_mu, 0.5)
  expect_equal(prior6$xi_sd, 0.3)
})

test_that("print.clm_prior works for empty prior", {
  prior <- clm_prior()
  expect_output(print(prior), "using all defaults")
})

test_that("print.clm_prior shows specified values", {
  prior <- clm_prior(beta_sd = 1, xi_mu = 0.5)
  expect_output(print(prior), "beta_sd = 1")
  expect_output(print(prior), "xi_mu = 0.5")
})

test_that("get_default_priors returns correct defaults for flexible threshold", {
  defaults <- get_default_priors("flexible")
  expect_equal(defaults$beta_sd, 2.5)
  expect_equal(defaults$c_sd, 10)
})

test_that("get_default_priors returns correct defaults for equidistant threshold", {
  defaults <- get_default_priors("equidistant")
  expect_equal(defaults$beta_sd, 2.5)
  expect_equal(defaults$c1_mu, 0)
  expect_equal(defaults$c1_sd, 10)
  expect_equal(defaults$d_alpha, 2)
  expect_equal(defaults$d_beta, 0.5)
})

test_that("get_default_priors returns correct defaults for symmetric threshold", {
  defaults <- get_default_priors("symmetric")
  expect_equal(defaults$beta_sd, 2.5)
  expect_equal(defaults$cpos_sd, 5)
})

test_that("get_default_priors includes link parameter defaults", {
  defaults <- get_default_priors("flexible")
  expect_equal(defaults$df_alpha, 2)
  expect_equal(defaults$df_beta, 0.1)
  expect_equal(defaults$xi_mu, 0)
  expect_equal(defaults$xi_sd, 2)
  expect_equal(defaults$theta1_alpha, 2)
  expect_equal(defaults$theta1_beta, 1)
})

test_that("apply_priors_to_stan_data uses defaults when prior is NULL", {
  # Mock stan_data
  stan_data <- list(
    prior_beta_sd = 999,
    prior_c_sd = 999
  )

  result <- apply_priors_to_stan_data(stan_data, NULL, "flexible", FALSE)

  expect_equal(result$prior_beta_sd, 2.5)  # default
  expect_equal(result$prior_c_sd, 10)      # default
})

test_that("apply_priors_to_stan_data applies user priors", {
  stan_data <- list(
    prior_beta_sd = 999,
    prior_c_sd = 999
  )
  prior <- clm_prior(beta_sd = 1, c_sd = 5)

  result <- apply_priors_to_stan_data(stan_data, prior, "flexible", FALSE)

  expect_equal(result$prior_beta_sd, 1)
  expect_equal(result$prior_c_sd, 5)
})

test_that("apply_priors_to_stan_data handles equidistant threshold", {
  stan_data <- list(
    prior_beta_sd = 999,
    prior_c1_mu = 999,
    prior_c1_sd = 999,
    prior_d_alpha = 999,
    prior_d_beta = 999
  )
  prior <- clm_prior(d_alpha = 1, d_beta = 2)

  result <- apply_priors_to_stan_data(stan_data, prior, "equidistant", FALSE)

  expect_equal(result$prior_beta_sd, 2.5)   # default
  expect_equal(result$prior_c1_mu, 0)       # default
  expect_equal(result$prior_d_alpha, 1)     # user
  expect_equal(result$prior_d_beta, 2)      # user
})

test_that("apply_priors_to_stan_data handles link parameters in full model", {
  stan_data <- list(
    prior_beta_sd = 999,
    prior_c_sd = 999,
    prior_xi_mu = 999,
    prior_xi_sd = 999
  )
  prior <- clm_prior(xi_mu = 0.5, xi_sd = 0.3)

  result <- apply_priors_to_stan_data(stan_data, prior, "flexible", full = TRUE)

  expect_equal(result$prior_xi_mu, 0.5)
  expect_equal(result$prior_xi_sd, 0.3)
})

test_that("validate_prior warns for incompatible threshold priors", {
  # Equidistant priors with flexible threshold
  prior1 <- clm_prior(d_alpha = 1)
  expect_warning(validate_prior(prior1, "flexible", "logit", NULL), "equidistant")

  # Symmetric priors with flexible threshold
  prior2 <- clm_prior(cpos_sd = 3)
  expect_warning(validate_prior(prior2, "flexible", "logit", NULL), "symmetric")

  # Flexible priors with equidistant threshold
  prior3 <- clm_prior(c_sd = 5)
  expect_warning(validate_prior(prior3, "equidistant", "logit", NULL), "flexible")
})

test_that("validate_prior warns for link priors without estimation", {
  # xi prior set but not estimating xi
  prior <- clm_prior(xi_mu = 0.5)
  expect_warning(
    validate_prior(prior, "flexible", "gev", list(xi = 0)),
    "not being estimated"
  )

  # No warning when estimating
  expect_silent(
    validate_prior(prior, "flexible", "gev", list(xi = "estimate"))
  )
})

test_that("validate_prior passes for valid combinations", {
  # Empty prior
  expect_silent(validate_prior(NULL, "flexible", "logit", NULL))
  expect_silent(validate_prior(clm_prior(), "flexible", "logit", NULL))

  # Matching threshold type
  expect_silent(validate_prior(clm_prior(c_sd = 5), "flexible", "logit", NULL))
  expect_silent(validate_prior(clm_prior(d_alpha = 1), "equidistant", "logit", NULL))
  expect_silent(validate_prior(clm_prior(cpos_sd = 3), "symmetric", "logit", NULL))
})

# =============================================================================
# Distribution-based Prior API tests
# =============================================================================

# Distribution helper tests
test_that("normal() creates correct distribution object", {
  dist <- normal(0, 2.5)
  expect_s3_class(dist, "clm_dist")
  expect_equal(dist$dist, "normal")
  expect_equal(dist$mu, 0)
  expect_equal(dist$sigma, 2.5)
})

test_that("normal() uses correct defaults", {
  dist <- normal()
  expect_equal(dist$mu, 0)
  expect_equal(dist$sigma, 1)
})

test_that("normal() validates inputs", {
  expect_error(normal(sigma = -1), "positive")
  expect_error(normal(sigma = 0), "positive")
  expect_error(normal(mu = "a"), "numeric")
  expect_error(normal(sigma = c(1, 2)), "single")
})

test_that("gamma() creates correct distribution object", {
  dist <- gamma(2, 0.1)
  expect_s3_class(dist, "clm_dist")
  expect_equal(dist$dist, "gamma")
  expect_equal(dist$alpha, 2)
  expect_equal(dist$beta, 0.1)
})

test_that("gamma() validates inputs", {
  expect_error(gamma(-1, 1), "positive")
  expect_error(gamma(1, -1), "positive")
  expect_error(gamma(0, 1), "positive")
  expect_error(gamma(1, 0), "positive")
})

test_that("gamma() requires both arguments (no defaults)", {
  expect_error(gamma(), "missing")
  expect_error(gamma(2), "missing")
})

test_that("gamma() rejects non-numeric inputs", {
  expect_error(gamma("a", 1), "numeric")
  expect_error(gamma(1, "b"), "numeric")
  expect_error(gamma(c(1, 2), 1), "single")
  expect_error(gamma(1, c(1, 2)), "single")
})

test_that("student_t() creates correct distribution object", {
  dist <- student_t(3, 0, 2.5)
  expect_s3_class(dist, "clm_dist")
  expect_equal(dist$dist, "student_t")
  expect_equal(dist$df, 3)
  expect_equal(dist$mu, 0)
  expect_equal(dist$sigma, 2.5)
})

test_that("student_t() uses correct defaults", {
  dist <- student_t()
  expect_equal(dist$df, 3)
  expect_equal(dist$mu, 0)
  expect_equal(dist$sigma, 1)
})

test_that("student_t() validates inputs", {
  expect_error(student_t(df = -1), "positive")
  expect_error(student_t(df = 0), "positive")
  expect_error(student_t(sigma = -1), "positive")
  expect_error(student_t(sigma = 0), "positive")
  expect_error(student_t(df = "a"), "numeric")
  expect_error(student_t(mu = "a"), "numeric")
  expect_error(student_t(df = c(1, 2)), "single")
})

test_that("cauchy() creates correct distribution object", {
  dist <- cauchy(0, 2.5)
  expect_s3_class(dist, "clm_dist")
  expect_equal(dist$dist, "cauchy")
  expect_equal(dist$mu, 0)
  expect_equal(dist$sigma, 2.5)
})

test_that("cauchy() uses correct defaults", {
  dist <- cauchy()
  expect_equal(dist$mu, 0)
  expect_equal(dist$sigma, 1)
})

test_that("cauchy() validates inputs", {
  expect_error(cauchy(sigma = -1), "positive")
  expect_error(cauchy(sigma = 0), "positive")
  expect_error(cauchy(mu = "a"), "numeric")
  expect_error(cauchy(sigma = c(1, 2)), "single")
})

# prior() function tests
test_that("prior() creates clm_prior_spec object", {
  p <- prior(normal(0, 2.5), class = "b")
  expect_s3_class(p, "clm_prior_spec")
  expect_equal(p$class, "b")
  expect_s3_class(p$prior, "clm_dist")
})

test_that("prior() validates distribution object", {
  expect_error(prior("not a dist"), "must be a distribution object")
  expect_error(prior(list(x = 1)), "must be a distribution object")
})

test_that("prior() validates class argument", {
  expect_error(prior(normal(0, 1), class = "invalid"), "Invalid class")
})

test_that("prior() validates class-distribution compatibility", {
  # Gamma for b class should fail
  expect_error(prior(gamma(2, 1), class = "b"), "requires normal")

  # Normal for df class should fail
  expect_error(prior(normal(0, 1), class = "df"), "requires gamma")
})

test_that("prior() rejects gamma for normal-family classes", {
  # All normal-family classes should reject gamma distribution
  expect_error(prior(gamma(2, 1), class = "b"), "requires normal")
  expect_error(prior(gamma(2, 1), class = "Intercept"), "requires normal")
  expect_error(prior(gamma(2, 1), class = "c1"), "requires normal")
  expect_error(prior(gamma(2, 1), class = "cpos"), "requires normal")
  expect_error(prior(gamma(2, 1), class = "lambda_lg"), "requires normal")
  expect_error(prior(gamma(2, 1), class = "xi"), "requires normal")
})

test_that("prior() rejects normal for gamma-family classes", {
  # All gamma-family classes should reject normal distribution
  expect_error(prior(normal(0, 1), class = "d"), "requires gamma")
  expect_error(prior(normal(0, 1), class = "df"), "requires gamma")
  expect_error(prior(normal(0, 1), class = "lambda_ao"), "requires gamma")
  expect_error(prior(normal(0, 1), class = "r"), "requires gamma")
  expect_error(prior(normal(0, 1), class = "theta1"), "requires gamma")
  expect_error(prior(normal(0, 1), class = "theta2"), "requires gamma")
})

test_that("prior() rejects student_t for gamma-family classes", {
  # All gamma-family classes should reject student_t distribution
  expect_error(prior(student_t(3, 0, 1), class = "d"), "requires gamma")
  expect_error(prior(student_t(3, 0, 1), class = "df"), "requires gamma")
  expect_error(prior(student_t(3, 0, 1), class = "lambda_ao"), "requires gamma")
  expect_error(prior(student_t(3, 0, 1), class = "r"), "requires gamma")
  expect_error(prior(student_t(3, 0, 1), class = "theta1"), "requires gamma")
  expect_error(prior(student_t(3, 0, 1), class = "theta2"), "requires gamma")
})

test_that("prior() rejects cauchy for gamma-family classes", {
  # All gamma-family classes should reject cauchy distribution
  expect_error(prior(cauchy(0, 1), class = "d"), "requires gamma")
  expect_error(prior(cauchy(0, 1), class = "df"), "requires gamma")
  expect_error(prior(cauchy(0, 1), class = "lambda_ao"), "requires gamma")
  expect_error(prior(cauchy(0, 1), class = "r"), "requires gamma")
  expect_error(prior(cauchy(0, 1), class = "theta1"), "requires gamma")
  expect_error(prior(cauchy(0, 1), class = "theta2"), "requires gamma")
})

test_that("prior() accepts valid combinations", {

  # Normal-family classes (accept normal, student_t, cauchy)
  expect_s3_class(prior(normal(0, 2.5), class = "b"), "clm_prior_spec")
  expect_s3_class(prior(student_t(3, 0, 2.5), class = "b"), "clm_prior_spec")
  expect_s3_class(prior(cauchy(0, 2.5), class = "b"), "clm_prior_spec")
  expect_s3_class(prior(normal(0, 10), class = "Intercept"), "clm_prior_spec")
  expect_s3_class(prior(normal(-1, 5), class = "c1"), "clm_prior_spec")
  expect_s3_class(prior(normal(0, 3), class = "cpos"), "clm_prior_spec")
  expect_s3_class(prior(normal(0, 1), class = "lambda_lg"), "clm_prior_spec")
  expect_s3_class(prior(normal(0, 0.5), class = "xi"), "clm_prior_spec")

  # Gamma classes (only accept gamma)
  expect_s3_class(prior(gamma(2, 0.5), class = "d"), "clm_prior_spec")
  expect_s3_class(prior(gamma(2, 0.1), class = "df"), "clm_prior_spec")
  expect_s3_class(prior(gamma(0.5, 0.5), class = "lambda_ao"), "clm_prior_spec")
  expect_s3_class(prior(gamma(0.5, 0.5), class = "r"), "clm_prior_spec")
  expect_s3_class(prior(gamma(2, 1), class = "theta1"), "clm_prior_spec")
  expect_s3_class(prior(gamma(2, 1), class = "theta2"), "clm_prior_spec")
})

# c.clm_prior_spec tests
test_that("c() combines multiple priors", {
  priors <- c(
    prior(normal(0, 2.5), class = "b"),
    prior(normal(0, 10), class = "Intercept")
  )
  expect_s3_class(priors, "clm_prior_list")
  expect_length(priors, 2)
})

test_that("c() validates all arguments are clm_prior_spec", {
  expect_error(
    c(prior(normal(0, 1), class = "b"), "not a prior"),
    "must be clm_prior_spec"
  )
})

# Print methods
test_that("print.clm_dist works correctly", {
  expect_output(print(normal(0, 2.5)), "normal\\(0, 2.5\\)")
  expect_output(print(gamma(2, 0.1)), "gamma\\(2, 0.1\\)")
  expect_output(print(student_t(3, 0, 2.5)), "student_t\\(3, 0, 2.5\\)")
  expect_output(print(cauchy(0, 2.5)), "cauchy\\(0, 2.5\\)")
})

test_that("print.clm_prior_spec works correctly", {
  p <- prior(normal(0, 2.5), class = "b")
  expect_output(print(p), "Prior:.*normal")
  expect_output(print(p), "Class:.*b")
})

test_that("print.clm_prior_spec shows coef when set", {
  p <- prior(normal(0, 2.5), class = "b", coef = "temp")
  expect_output(print(p), "Prior:.*normal")
  expect_output(print(p), "Class:.*b")
  expect_output(print(p), "Coef:.*temp")
})

test_that("print.clm_prior_list works correctly", {
  priors <- c(
    prior(normal(0, 2.5), class = "b"),
    prior(gamma(2, 0.1), class = "df")
  )
  expect_output(print(priors), "Prior specifications")
  expect_output(print(priors), "b:.*normal")
  expect_output(print(priors), "df:.*gamma")
})

# Conversion tests
test_that("convert_prior_spec_to_legacy works for single prior", {
  p <- prior(normal(0, 2.5), class = "b")
  legacy <- convert_prior_spec_to_legacy(p)
  expect_s3_class(legacy, "clm_prior")
  expect_equal(legacy$beta_sd, 2.5)
})

test_that("convert_prior_spec_to_legacy works for prior list", {
  priors <- c(
    prior(normal(0, 2.5), class = "b"),
    prior(normal(0, 10), class = "Intercept"),
    prior(gamma(2, 0.1), class = "df")
  )
  legacy <- convert_prior_spec_to_legacy(priors)
  expect_s3_class(legacy, "clm_prior")
  expect_equal(legacy$beta_sd, 2.5)
  expect_equal(legacy$c_sd, 10)
  expect_equal(legacy$df_alpha, 2)
  expect_equal(legacy$df_beta, 0.1)
})

test_that("convert_prior_spec_to_legacy passes through clm_prior", {
  original <- clm_prior(beta_sd = 1)
  result <- convert_prior_spec_to_legacy(original)
  expect_identical(result, original)
})

test_that("convert_prior_spec_to_legacy handles all classes", {
  # Test each class
  expect_equal(convert_prior_spec_to_legacy(prior(normal(0, 1), class = "b"))$beta_sd, 1)
  expect_equal(convert_prior_spec_to_legacy(prior(normal(0, 5), class = "Intercept"))$c_sd, 5)
  expect_equal(convert_prior_spec_to_legacy(prior(normal(-1, 2), class = "c1"))$c1_mu, -1)
  expect_equal(convert_prior_spec_to_legacy(prior(normal(-1, 2), class = "c1"))$c1_sd, 2)
  expect_equal(convert_prior_spec_to_legacy(prior(gamma(1, 2), class = "d"))$d_alpha, 1)
  expect_equal(convert_prior_spec_to_legacy(prior(normal(0, 3), class = "cpos"))$cpos_sd, 3)
  expect_equal(convert_prior_spec_to_legacy(prior(gamma(2, 0.1), class = "df"))$df_alpha, 2)
  expect_equal(convert_prior_spec_to_legacy(prior(gamma(0.5, 0.5), class = "lambda_ao"))$lambda_ao_alpha, 0.5)
  expect_equal(convert_prior_spec_to_legacy(prior(normal(0, 1), class = "lambda_lg"))$lambda_lg_mu, 0)
  expect_equal(convert_prior_spec_to_legacy(prior(normal(0, 0.5), class = "xi"))$xi_sd, 0.5)
  expect_equal(convert_prior_spec_to_legacy(prior(gamma(0.5, 0.5), class = "r"))$r_alpha, 0.5)
  expect_equal(convert_prior_spec_to_legacy(prior(gamma(2, 1), class = "theta1"))$theta1_alpha, 2)
  expect_equal(convert_prior_spec_to_legacy(prior(gamma(3, 1), class = "theta2"))$theta2_alpha, 3)
})

test_that("convert_prior_spec_to_legacy handles student_t for normal-family classes", {
  # student_t should use sigma as SD (df is ignored in current Stan model)
  expect_equal(convert_prior_spec_to_legacy(prior(student_t(3, 0, 2.5), class = "b"))$beta_sd, 2.5)
  expect_equal(convert_prior_spec_to_legacy(prior(student_t(5, 0, 10), class = "Intercept"))$c_sd, 10)
})

test_that("convert_prior_spec_to_legacy handles cauchy for normal-family classes", {
  # cauchy should use sigma as SD
  expect_equal(convert_prior_spec_to_legacy(prior(cauchy(0, 2.5), class = "b"))$beta_sd, 2.5)
  expect_equal(convert_prior_spec_to_legacy(prior(cauchy(0, 10), class = "Intercept"))$c_sd, 10)
})

test_that("convert_prior_spec_to_legacy errors for unknown format", {
  expect_error(convert_prior_spec_to_legacy(list(x = 1)), "Unknown prior format")
  expect_error(convert_prior_spec_to_legacy("invalid"), "Unknown prior format")
})

# Backward compatibility
test_that("clm_prior() still works (backward compatibility)", {
  prior <- clm_prior(beta_sd = 2.5, c_sd = 10)
  expect_s3_class(prior, "clm_prior")
  expect_equal(prior$beta_sd, 2.5)
  expect_equal(prior$c_sd, 10)
})

# =============================================================================
# flat() distribution and extended beta prior parameters
# =============================================================================

test_that("flat() creates valid distribution object", {
  d <- flat()
  expect_s3_class(d, "clm_dist")
  expect_equal(d$dist, "flat")
})

test_that("flat() works with prior() for class 'b'", {
  p <- prior(flat(), class = "b")
  expect_s3_class(p, "clm_prior_spec")
  expect_equal(p$class, "b")
  expect_equal(p$prior$dist, "flat")
})

test_that("flat() works with threshold classes", {
  # flat() should work for threshold classes (Intercept, c1, cpos)
  expect_s3_class(prior(flat(), class = "Intercept"), "clm_prior_spec")
  expect_s3_class(prior(flat(), class = "c1"), "clm_prior_spec")
  expect_s3_class(prior(flat(), class = "cpos"), "clm_prior_spec")
})

test_that("flat() is rejected for link parameter classes", {
  # flat() should NOT work for link parameter classes
  expect_error(prior(flat(), class = "lambda_lg"), "requires normal")
  expect_error(prior(flat(), class = "xi"), "requires normal")
})

test_that("format_dist handles flat", {
  d <- flat()
  expect_equal(format_dist(d), "flat()")
})

test_that("map_class_to_params extracts all parameters for normal", {
  result <- map_class_to_params("b", normal(1, 2.5))
  expect_equal(result$beta_type, PRIOR_TYPES$normal)
  expect_equal(result$beta_mu, 1)
  expect_equal(result$beta_sd, 2.5)
  expect_true("beta_df" %in% names(result))
})

test_that("map_class_to_params extracts all parameters for student_t", {
  result <- map_class_to_params("b", student_t(5, 1, 2.5))
  expect_equal(result$beta_type, PRIOR_TYPES$student_t)
  expect_equal(result$beta_mu, 1)
  expect_equal(result$beta_sd, 2.5)
  expect_equal(result$beta_df, 5)
})

test_that("map_class_to_params extracts all parameters for cauchy", {
  result <- map_class_to_params("b", cauchy(1, 2.5))
  expect_equal(result$beta_type, PRIOR_TYPES$cauchy)
  expect_equal(result$beta_mu, 1)
  expect_equal(result$beta_sd, 2.5)
})

test_that("map_class_to_params handles flat correctly", {
  result <- map_class_to_params("b", flat())
  expect_equal(result$beta_type, PRIOR_TYPES$flat)
  expect_true(all(c("beta_mu", "beta_sd", "beta_df") %in% names(result)))
})

test_that("convert_prior_spec_to_legacy preserves mu for normal", {
  legacy <- convert_prior_spec_to_legacy(prior(normal(1, 2.5), class = "b"))
  expect_equal(legacy$beta_mu, 1)
  expect_equal(legacy$beta_sd, 2.5)
  expect_equal(legacy$beta_type, PRIOR_TYPES$normal)
})

test_that("convert_prior_spec_to_legacy preserves df for student_t", {
  legacy <- convert_prior_spec_to_legacy(prior(student_t(5, 1, 2.5), class = "b"))
  expect_equal(legacy$beta_df, 5)
  expect_equal(legacy$beta_mu, 1)
  expect_equal(legacy$beta_sd, 2.5)
  expect_equal(legacy$beta_type, PRIOR_TYPES$student_t)
})

test_that("convert_prior_spec_to_legacy handles flat", {
  legacy <- convert_prior_spec_to_legacy(prior(flat(), class = "b"))
  expect_equal(legacy$beta_type, PRIOR_TYPES$flat)
})

test_that("get_default_priors includes beta_type, beta_mu, beta_df", {
  defaults <- get_default_priors("flexible")
  expect_equal(defaults$beta_type, PRIOR_TYPES$normal)
  expect_equal(defaults$beta_mu, 0)
  expect_equal(defaults$beta_sd, 2.5)
  expect_true("beta_df" %in% names(defaults))
})

# =============================================================================
# Phase 5.3.5: Threshold prior type/df parameters
# =============================================================================

test_that("get_default_priors includes threshold type/df for flexible", {
  defaults <- get_default_priors("flexible")
  expect_equal(defaults$c_type, PRIOR_TYPES$normal)
  expect_equal(defaults$c_mu, 0)
  expect_equal(defaults$c_sd, 10)
  expect_true("c_df" %in% names(defaults))
})

test_that("get_default_priors includes threshold type/df for equidistant", {
  defaults <- get_default_priors("equidistant")
  expect_equal(defaults$c1_type, PRIOR_TYPES$normal)
  expect_equal(defaults$c1_mu, 0)
  expect_equal(defaults$c1_sd, 10)
  expect_true("c1_df" %in% names(defaults))
})

test_that("get_default_priors includes threshold type/df for symmetric", {
  defaults <- get_default_priors("symmetric")
  expect_equal(defaults$cpos_type, PRIOR_TYPES$normal)
  expect_equal(defaults$cpos_sd, 5)
  expect_true("cpos_df" %in% names(defaults))
})

test_that("map_class_to_params extracts all parameters for Intercept (normal)", {
  result <- map_class_to_params("Intercept", normal(1, 5))
  expect_equal(result$c_type, PRIOR_TYPES$normal)
  expect_equal(result$c_mu, 1)
  expect_equal(result$c_sd, 5)
  expect_true("c_df" %in% names(result))
})

test_that("map_class_to_params extracts all parameters for Intercept (student_t)", {
  result <- map_class_to_params("Intercept", student_t(5, 1, 5))
  expect_equal(result$c_type, PRIOR_TYPES$student_t)
  expect_equal(result$c_mu, 1)
  expect_equal(result$c_sd, 5)
  expect_equal(result$c_df, 5)
})

test_that("map_class_to_params extracts all parameters for Intercept (cauchy)", {
  result <- map_class_to_params("Intercept", cauchy(1, 5))
  expect_equal(result$c_type, PRIOR_TYPES$cauchy)
  expect_equal(result$c_mu, 1)
  expect_equal(result$c_sd, 5)
})

test_that("map_class_to_params extracts all parameters for Intercept (flat)", {
  result <- map_class_to_params("Intercept", flat())
  expect_equal(result$c_type, PRIOR_TYPES$flat)
  expect_true(all(c("c_mu", "c_sd", "c_df") %in% names(result)))
})

test_that("map_class_to_params extracts all parameters for c1 (normal)", {
  result <- map_class_to_params("c1", normal(-1, 5))
  expect_equal(result$c1_type, PRIOR_TYPES$normal)
  expect_equal(result$c1_mu, -1)
  expect_equal(result$c1_sd, 5)
  expect_true("c1_df" %in% names(result))
})

test_that("map_class_to_params extracts all parameters for c1 (student_t)", {
  result <- map_class_to_params("c1", student_t(7, -1, 5))
  expect_equal(result$c1_type, PRIOR_TYPES$student_t)
  expect_equal(result$c1_mu, -1)
  expect_equal(result$c1_sd, 5)
  expect_equal(result$c1_df, 7)
})

test_that("map_class_to_params extracts all parameters for c1 (flat)", {
  result <- map_class_to_params("c1", flat())
  expect_equal(result$c1_type, PRIOR_TYPES$flat)
  expect_true(all(c("c1_mu", "c1_sd", "c1_df") %in% names(result)))
})

test_that("map_class_to_params extracts all parameters for cpos (normal)", {
  result <- map_class_to_params("cpos", normal(0, 3))
  expect_equal(result$cpos_type, PRIOR_TYPES$normal)
  expect_equal(result$cpos_sd, 3)
  expect_true("cpos_df" %in% names(result))
})

test_that("map_class_to_params extracts all parameters for cpos (student_t)", {
  result <- map_class_to_params("cpos", student_t(5, 0, 3))
  expect_equal(result$cpos_type, PRIOR_TYPES$student_t)
  expect_equal(result$cpos_sd, 3)
  expect_equal(result$cpos_df, 5)
})

test_that("map_class_to_params extracts all parameters for cpos (flat)", {
  result <- map_class_to_params("cpos", flat())
  expect_equal(result$cpos_type, PRIOR_TYPES$flat)
  expect_true(all(c("cpos_sd", "cpos_df") %in% names(result)))
})

test_that("convert_prior_spec_to_legacy handles Intercept with student_t", {
  legacy <- convert_prior_spec_to_legacy(prior(student_t(5, 1, 10), class = "Intercept"))
  expect_equal(legacy$c_type, PRIOR_TYPES$student_t)
  expect_equal(legacy$c_mu, 1)
  expect_equal(legacy$c_sd, 10)
  expect_equal(legacy$c_df, 5)
})

test_that("convert_prior_spec_to_legacy handles c1 with flat", {
  legacy <- convert_prior_spec_to_legacy(prior(flat(), class = "c1"))
  expect_equal(legacy$c1_type, PRIOR_TYPES$flat)
})

test_that("convert_prior_spec_to_legacy handles cpos with cauchy", {
  legacy <- convert_prior_spec_to_legacy(prior(cauchy(0, 3), class = "cpos"))
  expect_equal(legacy$cpos_type, PRIOR_TYPES$cauchy)
  expect_equal(legacy$cpos_sd, 3)
})

test_that("apply_priors_to_stan_data handles flexible threshold type parameters", {
  stan_data <- list(
    prior_c_type = 999,
    prior_c_mu = 999,
    prior_c_sd = 999,
    prior_c_df = 999
  )
  prior <- structure(list(
    c_type = PRIOR_TYPES$student_t,
    c_mu = 1,
    c_sd = 5,
    c_df = 7
  ), class = "clm_prior")

  result <- apply_priors_to_stan_data(stan_data, prior, "flexible", FALSE)

  expect_equal(result$prior_c_type, PRIOR_TYPES$student_t)
  expect_equal(result$prior_c_mu, 1)
  expect_equal(result$prior_c_sd, 5)
  expect_equal(result$prior_c_df, 7)
})

test_that("apply_priors_to_stan_data handles equidistant threshold type parameters", {
  stan_data <- list(
    prior_c1_type = 999,
    prior_c1_mu = 999,
    prior_c1_sd = 999,
    prior_c1_df = 999
  )
  prior <- structure(list(
    c1_type = PRIOR_TYPES$cauchy,
    c1_mu = -1,
    c1_sd = 5,
    c1_df = 7
  ), class = "clm_prior")

  result <- apply_priors_to_stan_data(stan_data, prior, "equidistant", FALSE)

  expect_equal(result$prior_c1_type, PRIOR_TYPES$cauchy)
  expect_equal(result$prior_c1_mu, -1)
  expect_equal(result$prior_c1_sd, 5)
})

test_that("apply_priors_to_stan_data handles symmetric threshold type parameters", {
  stan_data <- list(
    prior_cpos_type = 999,
    prior_cpos_sd = 999,
    prior_cpos_df = 999
  )
  prior <- structure(list(
    cpos_type = PRIOR_TYPES$flat,
    cpos_sd = 3,
    cpos_df = 7
  ), class = "clm_prior")

  result <- apply_priors_to_stan_data(stan_data, prior, "symmetric", FALSE)

  expect_equal(result$prior_cpos_type, PRIOR_TYPES$flat)
})