tests/testthat/test-indicators-group1.R

In rbiogeme: Interface to 'Biogeme'

test_that("the indicators b01 example is present and self-contained", {
  example <- rbiogeme_example_path( "indicators", "plot_b01expressions.R"
  )
  expect_true(file.exists(example))
  expect_silent(parse(example))
})

test_that("standalone expression values and derivatives match native Biogeme", {
  skip_if_not(
    rbiogeme_test_configure_python(),
    "Set RBIOGEME_PYTHON to a compatible native Biogeme interpreter"
  )

  b <- biogeme_beta("b", start = 1)
  expression <- exp(-b * b + 1)
  r_evaluation <- evaluate_biogeme_expression(
    expression,
    points = data.frame(b = c(2, 3))
  )

  native_expressions <- reticulate::import("biogeme.expressions", convert = FALSE)
  native_jax <- reticulate::import("biogeme.jax_calculator", convert = FALSE)
  native_b <- native_expressions$Beta("b", 1, NULL, NULL, 0)
  native_expression <- native_expressions$exp(-native_b * native_b + 1)
  native_initial <- reticulate::py_to_r(native_jax$get_value_and_derivatives(
    native_expression,
    numerically_safe = FALSE,
    use_jit = TRUE,
    named_results = TRUE
  ))
  native_function <- native_jax$create_function_simple_expression(
    native_expression,
    numerically_safe = FALSE,
    use_jit = TRUE,
    named_output = TRUE
  )
  native_points <- lapply(c(2, 3), function(value) {
    reticulate::py_to_r(native_function(
      reticulate::r_to_py(list(as.numeric(value))),
      gradient = TRUE,
      hessian = TRUE,
      bhhh = FALSE
    ))
  })

  expect_equal(
    r_evaluation$initial[["function"]],
    native_initial[["function"]],
    tolerance = 1e-12
  )
  expect_equal(
    r_evaluation$initial$gradient[["b"]],
    native_initial$gradient[["b"]],
    tolerance = 1e-12
  )
  expect_equal(
    r_evaluation$initial$hessian[["b"]][["b"]],
    native_initial$hessian[["b"]][["b"]],
    tolerance = 1e-12
  )
  expect_equal(
    r_evaluation$initial$bhhh[["b"]][["b"]],
    native_initial$bhhh[["b"]][["b"]],
    tolerance = 1e-12
  )

  for (index in seq_along(native_points)) {
    r_point <- r_evaluation$evaluations[[index]]
    native_point <- native_points[[index]]
    expect_equal(r_point[["function"]], native_point[["function"]], tolerance = 1e-12)
    expect_equal(r_point$gradient[["b"]], native_point$gradient[["b"]], tolerance = 1e-12)
    expect_equal(
      r_point$hessian[["b"]][["b"]],
      native_point$hessian[["b"]][["b"]],
      tolerance = 1e-12
    )
    expect_null(r_point$bhhh)
  }
})