tests/testthat/test-acceptance_ratio.R

In BayesMallows: Bayesian Preference Learning with the Mallows Rank Model

test_that("acceptance rates are computed", {
  cl <- parallel::makeCluster(2)
  set.seed(1)
  mod <- compute_mallows(
    data = setup_rank_data(potato_visual),
    compute_options = set_compute_options(burnin = 10, nmc = 100),
    cl = cl
  )
  expect_equal(get_acceptance_ratios(mod)$alpha_acceptance, list(0.911111111111111, 0.833333333333333))
  expect_equal(get_acceptance_ratios(mod)$rho_acceptance, list(0.977777777777778, 0.9))

  mod <- compute_mallows(
    data = setup_rank_data(potato_visual),
    compute_options = set_compute_options(burnin = 10, nmc = 100, alpha_prop_sd = 100),
    cl = cl
  )
  expect_equal(get_acceptance_ratios(mod)$alpha_acceptance, list(0.0444444444444444, 0.0333333333333333))
  expect_equal(get_acceptance_ratios(mod)$rho_acceptance, list(0.977777777777778, 0.988888888888889))

  mod <- compute_mallows(
    data = setup_rank_data(potato_visual),
    compute_options = set_compute_options(burnin = 10, nmc = 100, alpha_prop_sd = 0.00001),
    cl = cl
  )
  expect_equal(get_acceptance_ratios(mod)$alpha_acceptance, list(0.988888888888889, 0.988888888888889))
  expect_equal(get_acceptance_ratios(mod)$rho_acceptance, list(0.922222222222222, 0.888888888888889))

  mod <- compute_mallows(
    data = setup_rank_data(potato_visual),
    compute_options = set_compute_options(burnin = 10, nmc = 100, leap_size = 9),
    cl = cl
  )
  expect_equal(get_acceptance_ratios(mod)$alpha_acceptance, list(0.711111111111111, 0.777777777777778))
  expect_equal(get_acceptance_ratios(mod)$rho_acceptance, list(0.566666666666667, 0.511111111111111))

  set.seed(1)
  mod1 <- compute_mallows(
    data = setup_rank_data(potato_visual),
    compute_options = set_compute_options(burnin = 10, nmc = 100, rho_thinning = 1),
    cl = cl
  )
  set.seed(1)
  mod2 <- compute_mallows(
    data = setup_rank_data(potato_visual),
    compute_options = set_compute_options(burnin = 10, nmc = 100, rho_thinning = 3),
    cl = cl
  )
  expect_equal(mod1$acceptance_ratios$rho_acceptance, mod2$acceptance_ratios$rho_acceptance)
  parallel::stopCluster(cl)
})

test_that("acceptance rates work with SMC", {
  set.seed(1)
  mod0 <- compute_mallows(
    data = setup_rank_data(potato_visual[1:6, ]),
    compute_options = set_compute_options(nmc = 100, burnin = 10)
  )

  mod1 <- update_mallows(mod0, setup_rank_data(potato_visual[7:12, ]),
    smc_options = set_smc_options(n_particles = 100)
  )
  expect_equal(as.numeric(mod1$acceptance_ratios$alpha_acceptance), .966)
  expect_equal(as.numeric(mod1$acceptance_ratios$rho_acceptance), .964)

  mod2 <- update_mallows(mod1, setup_rank_data(potato_weighing[1:6, ]))
  expect_equal(as.numeric(mod2$acceptance_ratios$alpha_acceptance), .958)
  expect_equal(as.numeric(mod2$acceptance_ratios$rho_acceptance), .888)

  mod3 <- update_mallows(
    model = mod2,
    new_data = setup_rank_data(potato_weighing[7:12, ])
  )
  expect_equal(as.numeric(mod3$acceptance_ratios$alpha_acceptance), .902)
  expect_equal(as.numeric(mod3$acceptance_ratios$rho_acceptance), .854)
})