# Tests for getMuVar ----------------------------------------------------------- # ------------------------------------------------------------------ # Test: correct mu_var for simple reference case # Input: # - response_rate = 0.5, tau_scale = 1, n_worth = 2 # Behaviour: # - getMuVar() implements: mu_var = (n_worth * p * (1 - p))^-1 - tau_scale^2 # Expectations: # - Result equals manual calculation, is a finite double. # Why: # - Sanity-checks the core formula and numeric type for a simple case. # ------------------------------------------------------------------ test_that("mu_var calculation is correct for simple case", { # Manual calculation: (n_worth * p * (1 - p))^-1 - tau_scale^2 expected <- (2 * 0.5 * (1 - 0.5))^-1 - 1^2 result <- getMuVar(response_rate = 0.5, tau_scale = 1, n_worth = 2) expect_equal(result, expected) expect_type(result, "double") expect_true(is.finite(result)) }) # ------------------------------------------------------------------ # Test: response_rate must lie strictly between 0 and 1 # Input: # - response_rate = -0.1 and 1.5, tau_scale = 1 # Behaviour: # - Function should reject probabilities outside (0,1). # Expectations: # - Errors for each invalid response_rate. # Why: # - The variance formula assumes a valid Bernoulli probability. # ------------------------------------------------------------------ test_that("error if response_rate out of bounds", { expect_error(getMuVar(response_rate = -0.1, tau_scale = 1)) expect_error(getMuVar(response_rate = 1.5, tau_scale = 1)) }) # ------------------------------------------------------------------ # Test: tau_scale must be non-negative # Input: # - response_rate = 0.5, tau_scale = -1 # Behaviour: # - Negative scale parameter is invalid and must trigger an error. # Expectations: # - Error for tau_scale < 0. # Why: # - tau_scale represents a scale for a prior; negative values are not meaningful. # ------------------------------------------------------------------ test_that("error if tau_scale negative", { expect_error(getMuVar(response_rate = 0.5, tau_scale = -1)) }) # ------------------------------------------------------------------ # Test: n_worth must be a positive integer # Input: # - n_worth = 0 and 1.5 # Behaviour: # - Non-positive or non-integer n_worth should fail validation. # Expectations: # - Errors in both cases. # Why: # - n_worth describes an “effective sample size”; must be >= 1 and integer. # ------------------------------------------------------------------ test_that("error if n_worth not positive integer", { expect_error(getMuVar(response_rate = 0.5, tau_scale = 1, n_worth = 0)) expect_error(getMuVar(response_rate = 0.5, tau_scale = 1, n_worth = 1.5)) }) # Tests for getPriorParametersBerry -------------------------------------------- # ------------------------------------------------------------------ # Test: getPriorParametersBerry returns correctly structured object # Input: # - target_rates = c(0.2, 0.8), tau_scale = 1, n_worth = 2 # Behaviour: # - Function builds a prior_parameters_list for "berry" with fields # mu_mean, mu_sd, tau_scale. # Expectations: # - Class "prior_parameters_list", name "berry", inner list with # mu_mean, mu_sd, tau_scale. # Why: # - Verifies the returned container type and its internal naming. # ------------------------------------------------------------------ test_that("valid input returns prior_parameters_list with correct structure", { result <- getPriorParametersBerry(target_rates = c(0.2, 0.8), tau_scale = 1, n_worth = 2) expect_s3_class(result, "prior_parameters_list") expect_named(result, "berry") # Check inner structure expect_true(is.list(result$berry)) expect_named(result$berry, c("mu_mean", "mu_sd", "tau_scale")) }) # ------------------------------------------------------------------ # Test: mu_sd is computed from mu_var as defined by max-variance target rate # Input: # - target_rates = c(0.2, 0.8), tau_scale = 1, n_worth = 2 # Behaviour: # - Pick target_rate furthest from 0.5, compute # mu_var = (n_worth * p * (1 - p))^-1 - tau_scale^2, then mu_sd = sqrt(mu_var). # Expectations: # - result$berry$mu_sd equals the manually computed value. # Why: # - Confirms the link between target_rates, mu_var and mu_sd. # ------------------------------------------------------------------ test_that("mu_sd is computed correctly for simple case", { target_rates <- c(0.2, 0.8) tau_scale <- 1 n_worth <- 2 target_rate_max_var <- target_rates[abs(target_rates - 0.5) == max(abs(target_rates - 0.5))][1] expected_mu_var <- (n_worth * target_rate_max_var * (1 - target_rate_max_var))^-1 - tau_scale^2 expected_mu_sd <- sqrt(expected_mu_var) result <- getPriorParametersBerry(target_rates, tau_scale, n_worth) expect_equal(result$berry$mu_sd, expected_mu_sd) }) # ------------------------------------------------------------------ # Test: getPriorParametersBerry errors if mu_var <= 0 # Input: # - target_rates = 0.5, tau_scale = 100, n_worth = 1 # Behaviour: # - Very large tau_scale leads to mu_var <= 0, which is invalid. # Expectations: # - Error is thrown. # Why: # - A non-positive mu_var cannot produce a real standard deviation. # ------------------------------------------------------------------ test_that("error if mu_var <= 0", { # Large tau_scale will make mu_var negative expect_error( getPriorParametersBerry(target_rates = c(0.5), tau_scale = 100, n_worth = 1) ) }) # ------------------------------------------------------------------ # Test: single target_rate works and returns a berry prior # Input: # - target_rates = 0.5, tau_scale = 1, n_worth = 1 # Behaviour: # - Function should still construct a valid prior_parameters_list. # Expectations: # - Class "prior_parameters_list", name "berry". # Why: # - Ensures single-cohort use is supported. # ------------------------------------------------------------------ test_that("single target_rate works", { result <- getPriorParametersBerry(target_rates = c(0.5), tau_scale = 1, n_worth = 1) expect_s3_class(result, "prior_parameters_list") expect_named(result, "berry") }) # Tests for setPriorParametersBerry -------------------------------------------- # ------------------------------------------------------------------ # Test: setPriorParametersBerry creates correct structure # Input: # - mu_mean = 0.1, mu_sd = 0.5, tau_scale = 1 # Behaviour: # - Function wraps values into a "berry" prior_parameters_list. # Expectations: # - Class "prior_parameters_list", name "berry", # berry list contains mu_mean, mu_sd, tau_scale. # Why: # - Tests manual prior specification path for Berry. # ------------------------------------------------------------------ test_that("valid input returns prior_parameters_list with correct structure", { result <- setPriorParametersBerry( mu_mean = 0.1, mu_sd = 0.5, tau_scale = 1 ) expect_s3_class(result, "prior_parameters_list") expect_named(result, "berry") expect_true(is.list(result$berry)) expect_named(result$berry, c("mu_mean", "mu_sd", "tau_scale")) }) # ------------------------------------------------------------------ # Test: mu_sd must be strictly positive # Input: # - mu_sd = 0 # Behaviour: # - Function should reject non-positive standard deviations. # Expectations: # - Error mentioning "mu_sd". # Why: # - Standard deviations must be > 0. # ------------------------------------------------------------------ test_that("error if mu_sd is non-positive", { expect_error( setPriorParametersBerry(mu_mean = 0.1, mu_sd = 0, tau_scale = 1), "mu_sd" ) }) # ------------------------------------------------------------------ # Test: tau_scale must be strictly positive # Input: # - tau_scale = 0 # Behaviour: # - Function should reject non-positive scale values. # Expectations: # - Error mentioning "tau_scale". # Why: # - Scale parameter for tau must be > 0. # ------------------------------------------------------------------ test_that("error if tau_scale is non-positive", { expect_error( setPriorParametersBerry(mu_mean = 0.1, mu_sd = 0.5, tau_scale = 0), "tau_scale" ) }) # ------------------------------------------------------------------ # Test: mu_mean must be numeric # Input: # - mu_mean = "a" (character) # Behaviour: # - Non-numeric mu_mean should be rejected. # Expectations: # - Error mentioning "mu_mean". # Why: # - Prior mean is a numeric parameter on the link scale. # ------------------------------------------------------------------ test_that("error if mu_mean is not numeric", { expect_error( setPriorParametersBerry(mu_mean = "a", mu_sd = 0.5, tau_scale = 1), "mu_mean" ) }) # Tests for getPriorParametersExNeX -------------------------------------------- # ------------------------------------------------------------------ # Test: getPriorParametersExNex returns correctly structured object # Input: # - target_rates = c(0.3, 0.9), tau_scale = 1, n_worth = 2, w_j = 0.5 # Behaviour: # - Builds an "exnex" prior with fields mu_mean, mu_sd, tau_scale, # mu_j, tau_j, w_j. # Expectations: # - Class "prior_parameters_list", name "exnex", # exnex list has all expected fields. # Why: # - Checks the container structure for the ExNex prior definition. # ------------------------------------------------------------------ test_that("valid input returns prior_parameters_list with correct structure", { result <- getPriorParametersExNex(target_rates = c(0.3, 0.9), tau_scale = 1, n_worth = 2, w_j = 0.5) expect_s3_class(result, "prior_parameters_list") expect_named(result, "exnex") # Check inner structure expect_true(is.list(result$exnex)) expect_named(result$exnex, c("mu_mean", "mu_sd", "tau_scale", "mu_j", "tau_j", "w_j")) }) # ------------------------------------------------------------------ # Test: ExNex prior uses logit transform for mu_mean and mu_j # Input: # - target_rates = 0.8, tau_scale = 1, n_worth = 2, w_j = 0.5 # Behaviour: # - mu_mean = logit(p_max_var), mu_j = logit(target_rates). # Expectations: # - result$exnex$mu_mean and mu_j match manual logit calculations. # Why: # - Confirms link-scale parameterisation is correctly applied. # ------------------------------------------------------------------ test_that("mu_mean and mu_j use logit transform", { target_rates <- 0.8 tau_scale <- 1 n_worth <- 2 w_j <- 0.5 target_rate_max_var <- target_rates[abs(target_rates - 0.5) == max(abs(target_rates - 0.5))][1] expected_mu_mean <- logit(target_rate_max_var) expected_mu_j <- logit(target_rates) result <- getPriorParametersExNex(target_rates, tau_scale, n_worth, w_j) expect_equal(result$exnex$mu_mean, expected_mu_mean) expect_equal(result$exnex$mu_j, expected_mu_j) }) # ------------------------------------------------------------------ # Test: getPriorParametersExNex errors if mu_var <= 0 # Input: # - target_rates = 0.5, tau_scale = 100, n_worth = 1 # Behaviour: # - Large tau_scale makes mu_var non-positive. # Expectations: # - Error thrown. # Why: # - Same reason as Berry: must have positive variance for mu. # ------------------------------------------------------------------ test_that("error if mu_var <= 0", { # Large tau_scale will make mu_var negative expect_error( getPriorParametersExNex(target_rates = c(0.5), tau_scale = 100, n_worth = 1) ) }) # ------------------------------------------------------------------ # Test: mu_sd and tau_j computations follow theoretical formulas # Input: # - target_rates = 0.8, tau_scale = 1, n_worth = 2 # Behaviour: # - mu_sd from max-variance target, tau_j from per-cohort variance formula. # Expectations: # - result$exnex$mu_sd and tau_j match manual calculations. # Why: # - Ensures ExNex prior scale parameters are derived correctly. # ------------------------------------------------------------------ test_that("mu_sd and tau_j are computed correctly", { target_rates <- 0.8 tau_scale <- 1 n_worth <- 2 target_rate_max_var <- target_rates[abs(target_rates - 0.5) == max(abs(target_rates - 0.5))][1] expected_mu_var <- (n_worth * target_rate_max_var * (1 - target_rate_max_var))^-1 - tau_scale^2 expected_mu_sd <- sqrt(expected_mu_var) expected_tau_j <- sqrt((n_worth * target_rates * (1 - target_rates))^-1) result <- getPriorParametersExNex(target_rates, tau_scale, n_worth, w_j = 0.5) expect_equal(result$exnex$mu_sd, expected_mu_sd) expect_equal(result$exnex$tau_j, expected_tau_j) }) # Tests for setPriorParametersExNeX -------------------------------------------- # ------------------------------------------------------------------ # Test: setPriorParametersExNeX creates full exnex structure # Input: # - Vectors for mu_mean, mu_sd, tau_scale, mu_j, tau_j, w_j. # Behaviour: # - Returns a prior_parameters_list named "exnex" with all components. # Expectations: # - Class "prior_parameters_list", name "exnex", # exnex element has mu_mean, mu_sd, tau_scale, mu_j, tau_j, w_j. # Why: # - Validates the manual ExNex prior construction path. # ------------------------------------------------------------------ test_that("valid input returns prior_parameters_list with correct structure", { result <- setPriorParametersExNex( mu_mean = c(0.1, 0.2), mu_sd = c(0.5, 0.6), tau_scale = 1, mu_j = c(0.1, 0.2), tau_j = c(0.3, 0.4), w_j = c(0.3, 0.3, 0.4) ) expect_s3_class(result, "prior_parameters_list") expect_named(result, "exnex") expect_true(is.list(result$exnex)) expect_named(result$exnex, c("mu_mean", "mu_sd", "tau_scale", "mu_j", "tau_j", "w_j")) }) # ------------------------------------------------------------------ # Test: w_j length rules when mu_mean length = 1 # Input: # - mu_mean length 1, w_j length 3 # Behaviour: # - For a single mu_mean, w_j length 3 is not allowed. # Expectations: # - Error. # Why: # - Tests internal consistency checks between mixing weights and mean length. # ------------------------------------------------------------------ test_that("error if w_j length is invalid when mu_mean length = 1", { expect_error( setPriorParametersExNex( mu_mean = c(0.1), mu_sd = c(0.5), tau_scale = 1, mu_j = c(0.1), tau_j = c(0.3), w_j = c(0.3, 0.3, 0.4) # length 3 is invalid for mu_mean length 1 ) ) }) # Tests for getPriorParametersExNeXAdj ----------------------------------------- # ------------------------------------------------------------------ # Test: getPriorParametersExNeXAdj returns exnex_adj with centered mu's # Input: # - target_rates = c(0.2, 0.3), tau_scale = 1, n_worth = 2, w_j = 0.5 # Behaviour: # - Returns "exnex_adj" prior with mu_mean and mu_j shifted to 0. # Expectations: # - Class "prior_parameters_list", name "exnex_adj", # mu_mean = 0, mu_j = 0-vector. # Why: # - Confirms adjusted ExNex prior is properly centered. # ------------------------------------------------------------------ test_that("valid input returns prior_parameters_list with correct structure", { result <- getPriorParametersExNexAdj( target_rates = c(0.2, 0.3), tau_scale = 1, n_worth = 2, w_j = 0.5 ) expect_s3_class(result, "prior_parameters_list") expect_named(result, "exnex_adj") expect_true(is.list(result$exnex_adj)) expect_named(result$exnex_adj, c("mu_mean", "mu_sd", "tau_scale", "mu_j", "tau_j", "w_j")) # Check adjusted values expect_equal(result$exnex_adj$mu_mean, 0) expect_equal(result$exnex_adj$mu_j, rep(0, length(c(0.2, 0.3)))) }) # Tests for setPriorParametersExNeXAdj ----------------------------------------- # ------------------------------------------------------------------ # Test: setPriorParametersExNeXAdj creates correct exnex_adj structure # Input: # - Vectors for mu_mean, mu_sd, tau_scale, mu_j, tau_j, w_j. # Behaviour: # - Returns "exnex_adj" prior_parameters_list with all fields. # Expectations: # - Class "prior_parameters_list", name "exnex_adj", # exnex_adj has mu_mean, mu_sd, tau_scale, mu_j, tau_j, w_j. # Why: # - Checks manual specification of adjusted ExNex prior. # ------------------------------------------------------------------ test_that("valid input returns prior_parameters_list with correct structure", { result <- setPriorParametersExNexAdj( mu_mean = c(0.1, 0.2), mu_sd = c(0.5, 0.6), tau_scale = 1, mu_j = c(0.1, 0.2), tau_j = c(0.3, 0.4), w_j = c(0.3, 0.3, 0.4) ) expect_s3_class(result, "prior_parameters_list") expect_named(result, "exnex_adj") expect_true(is.list(result$exnex_adj)) expect_named(result$exnex_adj, c("mu_mean", "mu_sd", "tau_scale", "mu_j", "tau_j", "w_j")) }) # ------------------------------------------------------------------ # Test: acceptable w_j lengths when mu_mean length = 1 # Input: # - mu_mean length 1, w_j length 1 (valid). # Behaviour: # - Function should accept such configuration silently. # Expectations: # - No error raised. # Why: # - Sanity-checks "short" w_j is allowed in simple case. # ------------------------------------------------------------------ test_that("'w_j' length rule works when mu_mean length = 1", { # Valid cases: w_j length 1 or 2 expect_silent( setPriorParametersExNexAdj( mu_mean = 0.1, mu_sd = 0.5, tau_scale = 1, mu_j = c(0.1), tau_j = c(0.3), w_j = c(0.5) # length 1 ) ) }) # Tests for getPriorParametersPooled -------------------------------------------- # ------------------------------------------------------------------ # Test: getPriorParametersPooled returns pooled Beta parameters # Input: # - target_rates = c(0.2, 0.4, 0.6), n_worth = 2 # Behaviour: # - Selects a target_rate (internally defined rule) and computes # a = p * n_worth, b = (1 - p) * n_worth. # Expectations: # - Class "prior_parameters_list", name "pooled", with positive a,b. # Why: # - Validates the pooled Beta( a, b ) construction. # ------------------------------------------------------------------ test_that("valid input returns prior_parameters_list with correct structure", { result <- getPriorParametersPooled( target_rates = c(0.2, 0.4, 0.6), n_worth = 2 ) expect_s3_class(result, "prior_parameters_list") expect_named(result, "pooled") expect_true(is.list(result$pooled)) expect_named(result$pooled, c("a", "b")) expect_true(result$pooled$a > 0) expect_true(result$pooled$b > 0) }) # ------------------------------------------------------------------ # Test: pooled prior requires valid target_rates in (0,1) # Input: # - target_rates including 0 or 1. # Behaviour: # - Must error on invalid probabilities. # Expectations: # - Errors mentioning "target_rates". # Why: # - Beta prior requires positive support away from 0 and 1. # ------------------------------------------------------------------ test_that("error if target_rates contains invalid values", { expect_error(getPriorParametersPooled(target_rates = c(0, 0.5), n_worth = 1), "target_rates") expect_error(getPriorParametersPooled(target_rates = c(1, 0.5), n_worth = 1), "target_rates") }) # ------------------------------------------------------------------ # Test: n_worth must be positive for pooled prior # Input: # - n_worth = 0 # Behaviour: # - Function should reject non-positive n_worth. # Expectations: # - Error mentioning "n_worth". # Why: # - n_worth again represents effective sample size. # ------------------------------------------------------------------ test_that("error if n_worth is non-positive", { expect_error(getPriorParametersPooled(target_rates = c(0.3, 0.4), n_worth = 0), "n_worth") }) # ------------------------------------------------------------------ # Test: pooled prior selects target_rate closest to 0.5 # Input: # - target_rates = c(0.1, 0.4, 0.8), n_worth = 3 # Behaviour: # - Among candidates, p = 0.4 is closest to 0.5, so a = 0.4*3, b = 0.6*3. # Expectations: # - result$pooled$a == 0.4*3, result$pooled$b == 0.6*3. # Why: # - Checks selection logic for the central rate. # ------------------------------------------------------------------ test_that("selects target_rate closest to 0.5", { result <- getPriorParametersPooled(target_rates = c(0.1, 0.4, 0.8), n_worth = 3) expect_equal(result$pooled$a, 0.4 * 3) expect_equal(result$pooled$b, (1 - 0.4) * 3) }) # Tests for setPriorParametersPooled ------------------------------------------- # ------------------------------------------------------------------ # Test: setPriorParametersPooled builds pooled Beta structure # Input: # - a = 2, b = 3 # Behaviour: # - Wraps into "pooled" prior_parameters_list. # Expectations: # - Class "prior_parameters_list", name "pooled", a and b preserved. # Why: # - Tests manual specification path for pooled prior. # ------------------------------------------------------------------ test_that("valid input returns prior_parameters_list with correct structure", { result <- setPriorParametersPooled(a = 2, b = 3) expect_s3_class(result, "prior_parameters_list") expect_named(result, "pooled") expect_true(is.list(result$pooled)) expect_named(result$pooled, c("a", "b")) expect_equal(result$pooled$a, 2) expect_equal(result$pooled$b, 3) }) # Tests for getPriorParametersStratified --------------------------------------- # ------------------------------------------------------------------ # Test: stratified prior computes a_j and b_j per target rate # Input: # - target_rates = c(0.2, 0.4, 0.6), n_worth = 2 # Behaviour: # - a_j = p * n_worth, b_j = (1 - p) * n_worth elementwise. # Expectations: # - result$stratified$a_j and b_j match manual multiplication. # Why: # - Verifies Beta-prior parameters for each stratum. # ------------------------------------------------------------------ test_that("computes a_j and b_j correctly for multiple target rates", { target_rates <- c(0.2, 0.4, 0.6) n_worth <- 2 result <- getPriorParametersStratified(target_rates, n_worth) expect_equal(result$stratified$a_j, target_rates * n_worth) expect_equal(result$stratified$b_j, (1 - target_rates) * n_worth) }) # ------------------------------------------------------------------ # Test: stratified prior handles a single target rate # Input: # - target_rates = 0.3, n_worth = 5 # Behaviour: # - Computes scalar a_j and b_j. # Expectations: # - a_j = 0.3*5, b_j = 0.7*5. # Why: # - Ensures single-stratum usage is supported. # ------------------------------------------------------------------ test_that("handles single target rate correctly", { result <- getPriorParametersStratified(target_rates = 0.3, n_worth = 5) expect_equal(result$stratified$a_j, 0.3 * 5) expect_equal(result$stratified$b_j, (1 - 0.3) * 5) }) # ------------------------------------------------------------------ # Test: stratified result has stable structure # Input: # - target_rates = c(0.25, 0.75), n_worth = 3 # Behaviour: # - Returns "stratified" prior with a_j and b_j fields. # Expectations: # - Class "prior_parameters_list", name "stratified", fields a_j,b_j. # Why: # - Confirms naming and type are consistent. # ------------------------------------------------------------------ test_that("result structure is consistent", { result <- getPriorParametersStratified(c(0.25, 0.75), 3) expect_s3_class(result, "prior_parameters_list") expect_named(result, "stratified") expect_named(result$stratified, c("a_j", "b_j")) }) # Tests for setPriorParametersStratified --------------------------------------- # ------------------------------------------------------------------ # Test: setPriorParametersStratified preserves a_j,b_j and structure # Input: # - a_j = c(1,2,3), b_j = c(4,5,6) # Behaviour: # - Returns "stratified" prior with these vectors. # Expectations: # - a_j,b_j unchanged; class prior_parameters_list. # Why: # - Checks manual specification path for stratified Beta priors. # ------------------------------------------------------------------ test_that("returns correct structure and preserves input values", { a_j <- c(1, 2, 3) b_j <- c(4, 5, 6) result <- setPriorParametersStratified(a_j, b_j) expect_equal(result$stratified$a_j, a_j) expect_equal(result$stratified$b_j, b_j) expect_s3_class(result, "prior_parameters_list") }) # ------------------------------------------------------------------ # Test: setPriorParametersStratified works with single-element vectors # Input: # - a_j = 10, b_j = 20 # Behaviour: # - Returns scalar a_j,b_j under "stratified". # Expectations: # - Values preserved. # Why: # - Confirms scalar case is supported smoothly. # ------------------------------------------------------------------ test_that("works with single-element vectors", { result <- setPriorParametersStratified(a_j = 10, b_j = 20) expect_equal(result$stratified$a_j, 10) expect_equal(result$stratified$b_j, 20) }) # ------------------------------------------------------------------ # Test: length consistency for a_j and b_j # Input: # - a_j length 2, b_j length 1 # Behaviour: # - Function should error on mismatched lengths. # Expectations: # - Error mentioning "a_j and b_j". # Why: # - Each stratum must have both a and b. # ------------------------------------------------------------------ test_that("length consistency check works", { expect_error(setPriorParametersStratified(a_j = c(1, 2), b_j = c(3)), "a_j and b_j") }) # Tests for getPriorParameters ------------------------------------------------- # ------------------------------------------------------------------ # Test: getPriorParameters returns combined prior_parameters_list # Input: # - method_names = c("berry", "pooled", "stratified", "exnex", "exnex_adj"), # plus reasonable target_rates, n_worth, tau_scale, w_j. # Behaviour: # - Constructs all requested method priors and merges them. # Expectations: # - Class "prior_parameters_list", 5 elements, names sorted as in implementation. # Why: # - Validates the high-level prior factory for multiple methods. # ------------------------------------------------------------------ test_that("valid input returns a prior_parameters_list with correct names and class", { result <- getPriorParameters( method_names = c("berry", "pooled", "stratified", "exnex", "exnex_adj"), target_rates = c(0.2, 0.1, 0.3, 0.2, 0.4, 0.6), n_worth = 2, tau_scale = 1, w_j = 0.5 ) expect_s3_class(result, "prior_parameters_list") expect_named(result, c("berry", "exnex", "exnex_adj", "pooled", "stratified")) expect_type(result, "list") expect_length(result, 5) }) # ------------------------------------------------------------------ # Test: getPriorParameters errors on invalid method_names # Input: # - method_names = "invalid" # Behaviour: # - Function must reject unknown methods. # Expectations: # - Error. # Why: # - Guards against typos or unsupported priors. # ------------------------------------------------------------------ test_that("invalid method_names throws error", { expect_error(getPriorParameters( method_names = "invalid", target_rates = c(0.2, 0.3) )) }) # ------------------------------------------------------------------ # Test: getPriorParameters errors on invalid target_rates # Input: # - target_rates outside [0,1] # Behaviour: # - Should reject probabilities <=0 or >=1. # Expectations: # - Error. # Why: # - All underlying constructions assume valid rates. # ------------------------------------------------------------------ test_that("invalid target_rates throws error", { expect_error(getPriorParameters( method_names = "berry", target_rates = c(-0.1, 1.2) )) }) # ------------------------------------------------------------------ # Test: getPriorParameters errors on invalid tau_scale # Input: # - tau_scale = -1 # Behaviour: # - Negative tau_scale should fail. # Expectations: # - Error. # Why: # - Same constraint as lower-level prior builders. # ------------------------------------------------------------------ test_that("invalid tau_scale throws error", { expect_error(getPriorParameters( method_names = "berry", target_rates = c(0.2, 0.3), tau_scale = -1 )) }) # ------------------------------------------------------------------ # Test: getPriorParameters errors on invalid n_worth # Input: # - n_worth = 0 # Behaviour: # - Must reject non-positive effective sample size. # Expectations: # - Error. # Why: # - Consistency with other n_worth checks. # ------------------------------------------------------------------ test_that("invalid n_worth throws error", { expect_error(getPriorParameters( method_names = "berry", target_rates = c(0.2, 0.3), n_worth = 0 )) }) # ------------------------------------------------------------------ # Test: getPriorParameters errors on invalid w_j # Input: # - w_j = 2 (outside [0,1] or invalid) # Behaviour: # - Weight must be in acceptable range. # Expectations: # - Error. # Why: # - Mixture weights need to be interpretable probabilities. # ------------------------------------------------------------------ test_that("invalid w_j throws error", { expect_error(getPriorParameters( method_names = "berry", target_rates = c(0.2, 0.3), w_j = 2 )) }) # Tests for combinePriorParameters --------------------------------------------- # ------------------------------------------------------------------ # Test: combinePriorParameters merges multiple prior_parameter objects # Input: # - prior_parameters_stratified + prior_parameters_berry # Behaviour: # - Flattens and merges, returning a single prior_parameters_list. # Expectations: # - Class "prior_parameters_list", length 2, names are union of input names, # each element is a list. # Why: # - Confirms high-level combination for multi-method priors. # ------------------------------------------------------------------ test_that("combinePriorParameters returns correct structure with real objects", { prior_parameters_stratified <- setPriorParametersStratified(c(1, 2), c(3, 4)) prior_parameters_berry <- setPriorParametersBerry(1, 1, 2) result <- combinePriorParameters(list(prior_parameters_berry, prior_parameters_stratified)) # Check class and type expect_s3_class(result, "prior_parameters_list") expect_type(result, "list") # Names should match method names from input expect_named(result, sort(c(names(prior_parameters_berry), names(prior_parameters_stratified)))) # Length should equal number of input elements expect_length(result, 2) # Each element should be a list (inner structure) expect_true(all(vapply(result, is.list, logical(1)))) }) # ------------------------------------------------------------------ # Test: combinePriorParameters sorts method names alphabetically # Input: # - [stratified, berry] in that order # Behaviour: # - Resulting list names should be sorted. # Expectations: # - names(result) == sort of input method names. # Why: # - Ensures deterministic ordering in combined prior. # ------------------------------------------------------------------ test_that("combinePriorParameters sorts names alphabetically", { prior_parameters_stratified <- setPriorParametersStratified(c(1, 2), c(3, 4)) prior_parameters_berry <- setPriorParametersBerry(0, 1, 2) result <- combinePriorParameters(list(prior_parameters_stratified, prior_parameters_berry)) expect_equal(names(result), sort(c(names(prior_parameters_stratified), names(prior_parameters_berry)))) }) # ------------------------------------------------------------------ # Test: combinePriorParameters errors on duplicate method names # Input: # - Two separate prior_parameters_berry objects. # Behaviour: # - Duplicate "berry" name should be rejected. # Expectations: # - Error. # Why: # - Each method may appear only once in the combined object. # ------------------------------------------------------------------ test_that("combinePriorParameters errors on duplicate method names", { prior_parameters_berry1 <- setPriorParametersBerry(0, 1, 2) prior_parameters_berry2 <- setPriorParametersBerry(0, 1, 2) expect_error( combinePriorParameters(list(prior_parameters_berry1, prior_parameters_berry2)) ) }) # ------------------------------------------------------------------ # Test: combinePriorParameters errors when input is not a list # Input: # - "not_a_list" # Behaviour: # - Type check should fail for non-list input. # Expectations: # - Error. # Why: # - Enforces input contract: a list of prior_parameters_list objects. # ------------------------------------------------------------------ test_that("combinePriorParameters errors if input is not a list", { expect_error(combinePriorParameters("not_a_list")) }) # ------------------------------------------------------------------ # Test: combinePriorParameters errors if any element has wrong class # Input: # - One prior_parameters_berry, one plain list(dummy = TRUE) # Behaviour: # - Mixed-class list must be rejected. # Expectations: # - Error. # Why: # - Every element must be a proper prior_parameters_list. # ------------------------------------------------------------------ test_that("combinePriorParameters errors if any element is not prior_parameters_list", { prior_parameters_berry <- setPriorParametersBerry(0, 1, 2) bad_input <- list(prior_parameters_berry, list(dummy = TRUE)) expect_error(combinePriorParameters(bad_input)) })