tests/testthat/test-beta_dist.R

In algebraic.dist: Algebra over Probability Distributions

# Tests for the beta distribution class

# --- Construction ---

test_that("beta_dist constructor creates valid object with correct params", {
  b <- beta_dist(shape1 = 2, shape2 = 5)

  expect_s3_class(b, "beta_dist")
  expect_s3_class(b, "univariate_dist")
  expect_s3_class(b, "continuous_dist")
  expect_s3_class(b, "dist")
  expect_equal(b$shape1, 2)
  expect_equal(b$shape2, 5)
})

test_that("beta_dist constructor rejects invalid shape1", {
  expect_error(beta_dist(shape1 = -1, shape2 = 1), "'shape1' must be a positive scalar")
  expect_error(beta_dist(shape1 = 0, shape2 = 1), "'shape1' must be a positive scalar")
  expect_error(beta_dist(shape1 = "a", shape2 = 1), "'shape1' must be a positive scalar")
  expect_error(beta_dist(shape1 = c(1, 2), shape2 = 1), "'shape1' must be a positive scalar")
  expect_error(beta_dist(shape1 = NA_real_, shape2 = 1), "'shape1' must be a positive scalar")
})

test_that("beta_dist constructor rejects invalid shape2", {
  expect_error(beta_dist(shape1 = 1, shape2 = -1), "'shape2' must be a positive scalar")
  expect_error(beta_dist(shape1 = 1, shape2 = 0), "'shape2' must be a positive scalar")
  expect_error(beta_dist(shape1 = 1, shape2 = "b"), "'shape2' must be a positive scalar")
  expect_error(beta_dist(shape1 = 1, shape2 = c(1, 2)), "'shape2' must be a positive scalar")
  expect_error(beta_dist(shape1 = 1, shape2 = NA_real_), "'shape2' must be a positive scalar")
})

# --- Class hierarchy ---

test_that("beta_dist has correct class hierarchy", {
  b <- beta_dist(shape1 = 2, shape2 = 3)
  classes <- class(b)
  expect_equal(classes, c("beta_dist", "univariate_dist",
                          "continuous_dist", "dist"))
})

# --- is_beta_dist ---

test_that("is_beta_dist identifies beta_dist objects correctly", {
  b <- beta_dist(shape1 = 2, shape2 = 3)

  expect_true(is_beta_dist(b))
  expect_false(is_beta_dist(list(shape1 = 2, shape2 = 3)))
  expect_false(is_beta_dist(normal()))
  expect_false(is_beta_dist(uniform_dist()))
})

# --- params ---

test_that("params.beta_dist returns named vector of parameters", {
  b <- beta_dist(shape1 = 2.5, shape2 = 0.7)
  p <- params(b)

  expect_named(p, c("shape1", "shape2"))
  expect_equal(p["shape1"], c(shape1 = 2.5))
  expect_equal(p["shape2"], c(shape2 = 0.7))
})

# --- mean ---

test_that("mean.beta_dist returns shape1/(shape1+shape2)", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  expect_equal(mean(b), 2 / 7)

  b2 <- beta_dist(shape1 = 1, shape2 = 1)
  expect_equal(mean(b2), 0.5)

  b3 <- beta_dist(shape1 = 3, shape2 = 3)
  expect_equal(mean(b3), 0.5)

  b4 <- beta_dist(shape1 = 0.5, shape2 = 0.5)
  expect_equal(mean(b4), 0.5)
})

# --- vcov ---

test_that("vcov.beta_dist returns shape1*shape2/((a+b)^2*(a+b+1))", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  expected <- 2 * 5 / ((2 + 5)^2 * (2 + 5 + 1))
  expect_equal(vcov(b), expected)

  b2 <- beta_dist(shape1 = 1, shape2 = 1)
  expected2 <- 1 * 1 / ((1 + 1)^2 * (1 + 1 + 1))
  expect_equal(vcov(b2), expected2)
  expect_equal(vcov(b2), 1 / 12)  # Uniform(0,1) variance
})

# --- dim ---

test_that("dim.beta_dist returns 1 for univariate distribution", {
  b <- beta_dist(shape1 = 2, shape2 = 3)
  expect_equal(dim(b), 1)
})

# --- format / print ---

test_that("format.beta_dist returns correct string", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  expect_equal(format(b), "Beta distribution (shape1 = 2, shape2 = 5)")
})

test_that("print.beta_dist outputs to console", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  expect_output(print(b), "Beta distribution")
  expect_output(print(b), "shape1 = 2")
  expect_output(print(b), "shape2 = 5")
})

test_that("print.beta_dist returns object invisibly", {
  b <- beta_dist(shape1 = 1, shape2 = 1)
  out <- capture.output(ret <- print(b))
  expect_identical(ret, b)
})

# --- sampler ---

test_that("sampler.beta_dist returns a function that generates samples", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  samp_fn <- sampler(b)

  expect_type(samp_fn, "closure")

  samples <- samp_fn(100)
  expect_length(samples, 100)
})

test_that("sampler.beta_dist produces samples within (0, 1)", {
  set.seed(42)
  b <- beta_dist(shape1 = 2, shape2 = 5)
  samples <- sampler(b)(10000)

  expect_true(all(samples > 0))
  expect_true(all(samples < 1))
})

test_that("sampler.beta_dist produces samples with approximately correct mean", {
  set.seed(42)
  b <- beta_dist(shape1 = 2, shape2 = 5)
  samples <- sampler(b)(10000)

  expected_mean <- 2 / (2 + 5)
  sample_mean <- sum(samples) / length(samples)
  expect_equal(sample_mean, expected_mean, tolerance = 0.05)
})

# --- density ---

test_that("density.beta_dist returns correct probability density", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  pdf <- density(b)

  # Compare with dbeta at known points
  expect_equal(pdf(0.3), dbeta(0.3, shape1 = 2, shape2 = 5), tolerance = 1e-10)
  expect_equal(pdf(0.5), dbeta(0.5, shape1 = 2, shape2 = 5), tolerance = 1e-10)
  expect_equal(pdf(0.9), dbeta(0.9, shape1 = 2, shape2 = 5), tolerance = 1e-10)
})

test_that("density.beta_dist handles log argument correctly", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  pdf <- density(b)

  expect_equal(pdf(0.3, log = TRUE),
               dbeta(0.3, shape1 = 2, shape2 = 5, log = TRUE),
               tolerance = 1e-10)
})

test_that("density.beta_dist returns zero outside (0, 1)", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  pdf <- density(b)

  expect_equal(pdf(-0.1), 0)
  expect_equal(pdf(1.1), 0)
})

# --- cdf ---

test_that("cdf.beta_dist returns correct cumulative distribution", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  cdf_fn <- cdf(b)

  expect_equal(cdf_fn(0), pbeta(0, shape1 = 2, shape2 = 5), tolerance = 1e-10)
  expect_equal(cdf_fn(0.5), pbeta(0.5, shape1 = 2, shape2 = 5), tolerance = 1e-10)
  expect_equal(cdf_fn(1), pbeta(1, shape1 = 2, shape2 = 5), tolerance = 1e-10)
  expect_equal(cdf_fn(-0.1), 0, tolerance = 1e-10)
  expect_equal(cdf_fn(1.1), 1, tolerance = 1e-10)
})

test_that("cdf.beta_dist handles log.p argument correctly", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  cdf_fn <- cdf(b)

  expect_equal(cdf_fn(0.5, log.p = TRUE),
               pbeta(0.5, shape1 = 2, shape2 = 5, log.p = TRUE),
               tolerance = 1e-10)
})

# --- inv_cdf ---

test_that("inv_cdf.beta_dist returns correct quantiles", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  qf <- inv_cdf(b)

  expect_equal(qf(0.5), qbeta(0.5, shape1 = 2, shape2 = 5), tolerance = 1e-10)
  expect_equal(qf(0.95), qbeta(0.95, shape1 = 2, shape2 = 5), tolerance = 1e-10)
  expect_equal(qf(0.1), qbeta(0.1, shape1 = 2, shape2 = 5), tolerance = 1e-10)
})

test_that("inv_cdf.beta_dist round-trips with cdf", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  cdf_fn <- cdf(b)
  qf <- inv_cdf(b)

  # cdf(inv_cdf(p)) == p
  probs <- c(0.1, 0.25, 0.5, 0.75, 0.9)
  for (p in probs) {
    expect_equal(cdf_fn(qf(p)), p, tolerance = 1e-10)
  }

  # inv_cdf(cdf(x)) == x for x in (0, 1)
  vals <- c(0.1, 0.3, 0.5, 0.7, 0.9)
  for (v in vals) {
    expect_equal(qf(cdf_fn(v)), v, tolerance = 1e-10)
  }
})

# --- sup ---

test_that("sup.beta_dist returns open interval (0, 1)", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  s <- sup(b)

  expect_s3_class(s, "interval")
  expect_equal(s$infimum(), 0)
  expect_equal(s$supremum(), 1)
  expect_false(s$lower_closed)
  expect_false(s$upper_closed)
})

test_that("sup.beta_dist support contains interior but not boundary points", {
  b <- beta_dist(shape1 = 2, shape2 = 5)
  s <- sup(b)

  expect_true(s$has(0.5))
  expect_true(s$has(0.01))
  expect_true(s$has(0.99))
  expect_false(s$has(0))
  expect_false(s$has(1))
  expect_false(s$has(-0.1))
  expect_false(s$has(1.1))
})

# --- Cross-validation: Beta(1,1) == Uniform(0,1) ---

test_that("beta_dist(1, 1) density matches uniform_dist(0, 1) density", {
  b <- beta_dist(shape1 = 1, shape2 = 1)
  u <- uniform_dist(min = 0, max = 1)
  b_pdf <- density(b)
  u_pdf <- density(u)

  # Beta(1,1) is Uniform(0,1): density should be 1 on (0,1)
  test_points <- c(0.01, 0.1, 0.25, 0.5, 0.75, 0.9, 0.99)
  for (t in test_points) {
    expect_equal(b_pdf(t), u_pdf(t), tolerance = 1e-10,
                 label = paste("density at t =", t))
    expect_equal(b_pdf(t), 1, tolerance = 1e-10,
                 label = paste("density = 1 at t =", t))
  }
})

test_that("beta_dist(1, 1) CDF matches uniform_dist(0, 1) CDF", {
  b <- beta_dist(shape1 = 1, shape2 = 1)
  u <- uniform_dist(min = 0, max = 1)
  b_cdf <- cdf(b)
  u_cdf <- cdf(u)

  test_points <- c(0, 0.1, 0.25, 0.5, 0.75, 0.9, 1)
  for (t in test_points) {
    expect_equal(b_cdf(t), u_cdf(t), tolerance = 1e-10,
                 label = paste("CDF at t =", t))
  }
})

test_that("beta_dist(1, 1) mean and variance match Uniform(0,1)", {
  b <- beta_dist(shape1 = 1, shape2 = 1)
  u <- uniform_dist(min = 0, max = 1)

  expect_equal(mean(b), mean(u), tolerance = 1e-10)
  expect_equal(vcov(b), vcov(u), tolerance = 1e-10)
})