tests/testthat/test-sampling-group1.R

In rbiogeme: Interface to 'Biogeme'

sampling_group1_directory <- function() {
  rbiogeme_example_path( "sampling")
}

test_that("sampling protocol helpers follow native Biogeme", {
  expect_equal(sampling_segment_sizes(10, 2), c(5L, 5L))
  expect_equal(sampling_segment_sizes(11, 2), c(6L, 5L))
  expect_equal(sampling_segment_sizes(2, 3), c(1L, 1L, 0L))

  partition <- biogeme_sampling_partition(
    segments = list(c(1, 2), c(3, 4)),
    sample_sizes = c(1, 2),
    full_set = 1:4
  )
  expect_s3_class(partition, "biogeme_sampling_partition")
  expect_equal(partition$sample_sizes, c(1L, 2L))
  expect_error(
    biogeme_sampling_partition(list(c(1, 2), c(2, 3)), c(1, 1)),
    "disjoint"
  )
  expect_error(
    biogeme_sampling_partition(list(c(1, 2)), 3),
    "cannot exceed"
  )

  combined <- cross_variable(
    "distance",
    sqrt((variable("user_lat") - variable("rest_lat"))^2)
  )
  expect_s3_class(combined, "biogeme_cross_variable")
  expect_equal(combined$name, "distance")
})

test_that("sampling examples are self-contained and document their syntax", {
  directory <- sampling_group1_directory()
  files <- file.path(directory, c(
    "plot_b01logit.R",
    "plot_b02nested.R",
    "plot_b03cnl.R"
  ))
  expect_true(all(file.exists(files)))
  for (file in files) {
    expect_silent(parse(file = file))
    contents <- paste(readLines(file, warn = FALSE), collapse = "\n")
    expect_match(contents, "prepare_sampling_example")
    expect_match(contents, "cross_variable")
    expect_match(contents, "sampled_alternatives_model")
    expect_match(contents, "Complete utility")
    expect_match(contents, "native")
  }
  b01 <- paste(readLines(files[[1L]], warn = FALSE), collapse = "\n")
  b02 <- paste(readLines(files[[2L]], warn = FALSE), collapse = "\n")
  b03 <- paste(readLines(files[[3L]], warn = FALSE), collapse = "\n")
  expect_match(b01, "logit_asian_10_alt")
  expect_match(b02, "nested_downtown_20")
  expect_match(b02, "nested_nest")
  expect_match(b03, "cnl_10_63")
  expect_match(b03, "cross_nested_nest")
})

test_that("all sampling examples run through native Biogeme", {
  skip_if_not(
    identical(Sys.getenv("RBIOGEME_RUN_INTEGRATION"), "1"),
    "Set RBIOGEME_RUN_INTEGRATION=1 to run sampling integration tests"
  )
  skip_if_not(
    rbiogeme_test_configure_python(),
    "Set RBIOGEME_PYTHON to a compatible native Biogeme interpreter"
  )
  python <- Sys.getenv("RBIOGEME_PYTHON", unset = "")

  alternatives <- Sys.getenv("RBIOGEME_SAMPLING_ALTERNATIVES", unset = "")
  observations <- Sys.getenv("RBIOGEME_SAMPLING_OBSERVATIONS", unset = "")
  root <- Sys.getenv("RBIOGEME_NATIVE_SAMPLING_ROOT", unset = "")
  if ((!nzchar(alternatives) || !file.exists(alternatives)) && nzchar(root)) {
    alternatives <- file.path(root, "restaurants.dat")
  }
  if ((!nzchar(observations) || !file.exists(observations)) && nzchar(root)) {
    observations <- file.path(root, "obs_choice.dat")
  }
  skip_if(
    !file.exists(alternatives) || !file.exists(observations),
    paste(
      "Set RBIOGEME_SAMPLING_ALTERNATIVES and RBIOGEME_SAMPLING_OBSERVATIONS",
      "or RBIOGEME_NATIVE_SAMPLING_ROOT to run sampling integration tests"
    )
  )

  directory <- sampling_group1_directory()
  output_directory <- tempfile("rbiogeme-sampling-group1-")
  rscript <- file.path(R.home("bin"), "Rscript")
  scripts <- c(
    "plot_b01logit.R",
    "plot_b02nested.R",
    "plot_b03cnl.R"
  )
  expected_models <- c(
    "logit_asian_10_alt",
    "nested_downtown_20",
    "cnl_10_63"
  )
  expected_sizes <- c(10L, 20L, 10L)

  for (index in seq_along(scripts)) {
    model_output <- file.path(output_directory, expected_models[[index]])
    output <- system2(
      rscript,
      c(
        "--vanilla",
        file.path(directory, scripts[[index]]),
        paste0("--alternatives=", normalizePath(alternatives)),
        paste0("--observations=", normalizePath(observations)),
        # Preserve the configured virtual-environment path. normalizePath()
        # resolves its executable symlink to the base Python and can lose the
        # environment's native Biogeme dependencies.
        paste0("--python=", python),
        paste0("--output=", model_output)
      ),
      stdout = TRUE,
      stderr = TRUE
    )
    expect_null(attr(output, "status"), info = paste(output, collapse = "\n"))
    output_text <- paste(output, collapse = "\n")
    expect_match(output_text, paste0("Biogeme estimation results for model ", expected_models[[index]]))
    expect_match(output_text, "Final log likelihood")
    expect_true(file.exists(file.path(model_output, paste0(expected_models[[index]], ".dat"))))
    expect_false(file.exists(file.path(model_output, paste0(expected_models[[index]], ".yaml"))))
  }
})