tests/testthat/test-hamiltonian.R

In rmcmc: Robust Markov Chain Monte Carlo Methods

hamiltonian_proposal_with_n_step <- function(n_step, sample_n_step = NULL) {
  function(scale = NULL, shape = NULL) {
    hamiltonian_proposal(
      n_step = n_step,
      scale = scale,
      shape = shape,
      sample_n_step = sample_n_step
    )
  }
}

for (n_step in c(1L, 2L, 5L)) {
  test_scale_and_shape_proposal(
    hamiltonian_proposal_with_n_step(n_step),
    proposal_name = sprintf("Hamiltonian proposal with n_step = %i", n_step),
    target_distribution = standard_normal_target_distribution(),
    dimensions = c(1L, 2L),
    scales = c(0.5, 1., 2.)
  )
}

for (dimension in c(1L, 2L, 3L)) {
  for (scale in c(0.5, 1., 2.)) {
    for (n_step in c(1L, 2L, 5L)) {
      test_that(
        sprintf(
          paste0(
            "Hamiltonian involution is an involution ",
            "(dimension %i, scale %.1f, n_step %i)"
          ),
          dimension, scale, n_step
        ),
        {
          target_distribution <- standard_normal_target_distribution()
          withr::with_seed(seed = default_seed(), {
            state <- chain_state(
              position = rnorm(dimension), momentum = rnorm(dimension)
            )
          })
          inv_state <- involution_hamiltonian(
            state, n_step, scale, target_distribution
          )
          inv_inv_state <- involution_hamiltonian(
            inv_state, n_step, scale, target_distribution
          )
          expect_equal(state$position(), inv_inv_state$position())
          expect_equal(state$momentum(), inv_inv_state$momentum())
        }
      )
    }
  }
}

test_scale_and_shape_proposal(
  hamiltonian_proposal_with_n_step(
    n_step = c(1, 5),
    sample_n_step = function(n) n[1] + sample.int(n[2] - n[1] + 1, 1) - 1
  ),
  proposal_name = sprintf("Hamiltonian proposal with randomized n_step"),
  target_distribution = standard_normal_target_distribution(),
  dimensions = c(1L, 2L),
  scales = c(0.5, 1., 2.)
)