tests/testthat/test-metrics.R

In convoyinc/abayes: Bayesian A/B Testing

context('Testing functions that calculate metrics on the posterior distribution work')

test_that('b_gt_a and expected_loss_b work correctly for beta distribution', {
    dist_a <- beta_dist(alpha = 3, beta = 5)
    dist_b <- beta_dist(alpha = 4, beta = 4)
    prob <- b_gt_a(dist_a = dist_a, dist_b = dist_b)
    loss <- expected_loss_b(dist_a = dist_a, dist_b = dist_b)
    theta_a <- simulate_data(dist_a, 1e7)
    theta_b <- simulate_data(dist_b, 1e7)
    sim_prob <- mean(theta_b > theta_a)
    sim_loss <- mean(pmax(theta_a - theta_b, 0))
    expect_true(abs(prob - sim_prob) < 0.01)
    expect_true(abs(loss - sim_loss) < 0.01)
    
    dist_a <- beta_dist(alpha = 3300, beta = 5000)
    dist_b <- beta_dist(alpha = 3350, beta = 5000)
    prob <- b_gt_a(dist_a = dist_a, dist_b = dist_b)
    loss <- expected_loss_b(dist_a = dist_a, dist_b = dist_b)
    theta_a <- simulate_data(dist_a, 1e7)
    theta_b <- simulate_data(dist_b, 1e7)
    sim_prob <- mean(theta_b > theta_a)
    sim_loss <- mean(pmax(theta_a - theta_b, 0))
    expect_true(abs(prob - sim_prob) < 0.01)
    expect_true(abs(loss - sim_loss) < 0.01)
})

test_that('b_gt_a and expected_loss_b work correctly for normal gamma distribution', {
    set.seed(123)
    dist_a <- normal_gamma_dist(mu = 0, lambda = 1, alpha = 2, beta = 3)
    dist_b <- normal_gamma_dist(mu = 0, lambda = 3, alpha = 2, beta = 1)
    theta_a <- simulate_data(dist_a, 5)
    theta_b <- simulate_data(dist_b, 5)
    prob <- b_gt_a(dist_a, dist_b, theta_a, theta_b)
    loss <- expected_loss_b(dist_a, dist_b, theta_a, theta_b)
    expect_equal(prob, 0.6)
    expect_true(abs(loss - 0.318) < 0.01)
})

test_that('b_gt_a works correctly for gamma distribution', {
    dist_a <- gamma_dist(alpha = 3, beta = 5)
    dist_b <- gamma_dist(alpha = 4, beta = 4)
    prob <- b_gt_a(dist_a = dist_a, dist_b = dist_b)
    loss <- expected_loss_b(dist_a = dist_a, dist_b = dist_b)
    theta_a <- simulate_data(dist_a, 1e7)
    theta_b <- simulate_data(dist_b, 1e7)
    sim_prob <- mean(theta_b > theta_a)
    sim_loss <- mean(pmax(theta_a - theta_b, 0))
    expect_true(abs(prob - sim_prob) < 0.01)
    expect_true(abs(loss - sim_loss) < 0.01)
    
    dist_a <- gamma_dist(alpha = 3300, beta = 400)
    dist_b <- gamma_dist(alpha = 4650, beta = 550)
    prob <- b_gt_a(dist_a = dist_a, dist_b = dist_b)
    loss <- expected_loss_b(dist_a = dist_a, dist_b = dist_b)
    theta_a <- simulate_data(dist_a, 1e6)
    theta_b <- simulate_data(dist_b, 1e6)
    sim_prob <- mean(theta_b > theta_a)
    sim_loss <- mean(pmax(theta_a - theta_b, 0))
    expect_true(abs(prob - sim_prob) < 0.01)
})

test_that('get metrics produces correct output', {
    dist_a <- gamma_dist(alpha = 3, beta = 5)
    dist_b <- gamma_dist(alpha = 4, beta = 4)
    metrics <- get_metrics(posteriors = list(a = dist_a, b = dist_b), sim_batch_size = 1e4)
    expect_equal(metrics[['prob_b_gt_a']], b_gt_a(dist_a, dist_b))
})