tests/testthat/test-profiling-group1.R

In rbiogeme: Interface to 'Biogeme'

profiling_group1_files <- function() {
  rbiogeme_example_path(
    "profiling",
    "plot_cnl_profiling.R"
  )
}

test_that("the CNL profiling example is self-contained", {
  file <- profiling_group1_files()
  expect_true(file.exists(file))
  expect_silent(parse(file = file))
  contents <- paste(readLines(file, warn = FALSE), collapse = "\n")
  expect_match(contents, "prepare_swissmetro_example")
  expect_match(contents, "swissmetro_data")
  expect_match(contents, "cross_nested_logit_model")
  expect_match(contents, "profile_jax")
  expect_match(contents, "Function \\+ gradient \\+ Hessian")
  expect_match(contents, "Function \\+ gradient \\+ BHHH")
})

test_that("native JAX profiling runs all four cases", {
  skip_if_not(
    identical(Sys.getenv("RBIOGEME_RUN_INTEGRATION"), "1"),
    "Set RBIOGEME_RUN_INTEGRATION=1 to run profiling integration tests"
  )
  skip_if_not(
    rbiogeme_test_configure_python(),
    "Set RBIOGEME_PYTHON to a compatible native Biogeme interpreter"
  )
  data_path <- rbiogeme_test_swissmetro_path()
  skip_if(!nzchar(data_path), "Set RBIOGEME_SWISSMETRO_DATA to the Swissmetro .dat file")

  output_directory <- tempfile("rbiogeme-cnl-profiling-")
  rscript <- file.path(R.home("bin"), "Rscript")
  output <- system2(
    rscript,
    c(
      "--vanilla",
      profiling_group1_files(),
      paste0("--data=", data_path),
      paste0("--python=", Sys.getenv("RBIOGEME_PYTHON")),
      paste0("--output=", output_directory)
    ),
    stdout = TRUE,
    stderr = TRUE
  )
  expect_null(attr(output, "status"))
  output_text <- paste(output, collapse = "\n")
  expect_match(output_text, "JAX environment:")
  expect_match(output_text, "=== Function only ===")
  expect_match(output_text, "=== Function \\+ gradient ===")
  expect_match(output_text, "=== Function \\+ gradient \\+ Hessian ===")
  expect_match(output_text, "=== Function \\+ gradient \\+ BHHH ===")
  profile_headers <- gregexpr("JAX execution profile", output_text, fixed = TRUE)[[1L]]
  expect_equal(length(profile_headers), 4L)
  expect_false(grepl("Traceback", output_text, fixed = TRUE))
})