ocbe-uio / BayesMallows

R-package for Bayesian preference learning with the Mallows rank model.
https://ocbe-uio.github.io/BayesMallows/
GNU General Public License v3.0
21 stars 9 forks source link

Swap issue 368 #384

Closed osorensen closed 6 months ago

osorensen commented 6 months ago

Almost there now for the modal ranking. Seems correctly implemented but have to add some unit tests.

library(BayesMallows)
library(patchwork)
library(microbenchmark)

mod1 <- compute_mallows(
  data = setup_rank_data(potato_visual),
  compute_options = set_compute_options(nmc = 10000, burnin = 1000)
  )

mod2 <- compute_mallows(
  data = setup_rank_data(potato_visual),
  compute_options = set_compute_options(
    nmc = 10000, burnin = 1000, rho_proposal = "swap")
)

assess_convergence(mod1) + assess_convergence(mod2)


assess_convergence(mod1, parameter = "rho", items = 1:5) +
assess_convergence(mod2, parameter = "rho", items = 1:5)


plot(mod1) + plot(mod2)


microbenchmark(
  compute_mallows(
    data = setup_rank_data(potato_visual)
  ),
  compute_mallows(
    data = setup_rank_data(potato_visual),
    compute_options = set_compute_options(rho_proposal = "swap")
  )
)
#> Warning in microbenchmark(compute_mallows(data =
#> setup_rank_data(potato_visual)), : less accurate nanosecond times to avoid
#> potential integer overflows
#> Unit: milliseconds
#>                                                                                                                  expr
#>                                                                compute_mallows(data = setup_rank_data(potato_visual))
#>  compute_mallows(data = setup_rank_data(potato_visual), compute_options = set_compute_options(rho_proposal = "swap"))
#>       min       lq     mean   median       uq      max neval cld
#>  32.80193 33.46756 36.69203 34.49510 35.74001 78.19069   100   a
#>  32.47028 33.41500 36.54135 34.07779 35.49235 80.22909   100   a

mod1 <- compute_mallows(
  data = setup_rank_data(preferences = beach_preferences),
  compute_options = set_compute_options(nmc = 5000, burnin = 1000)
)
mod2 <- compute_mallows(
  data = setup_rank_data(preferences = beach_preferences),
  compute_options = set_compute_options(nmc = 5000, burnin = 1000, rho_proposal = "swap")
)
assess_convergence(mod1) + assess_convergence(mod2)

assess_convergence(mod1, parameter = "rho", items = 1:5) +
  assess_convergence(mod2, parameter = "rho", items = 1:5)


plot(mod1) + plot(mod2)


microbenchmark(
  compute_mallows(
    data = setup_rank_data(preferences = beach_preferences)
  ),
  compute_mallows(
    data = setup_rank_data(preferences = beach_preferences),
    compute_options = set_compute_options(rho_proposal = "swap")
  )
)
#> Unit: milliseconds
#>                                                                                                                                         expr
#>                                                                     compute_mallows(data = setup_rank_data(preferences = beach_preferences))
#>  compute_mallows(data = setup_rank_data(preferences = beach_preferences),      compute_options = set_compute_options(rho_proposal = "swap"))
#>       min       lq     mean   median       uq      max neval cld
#>  480.3424 487.5387 495.5723 492.2454 496.9240 591.0838   100   a
#>  478.5248 488.7884 498.2841 493.1363 499.1616 595.9734   100   a

Created on 2024-02-21 with reprex v2.1.0