tests/testthat/test-config-bundle.R

In SmokingHistoryGenerator: R Package for the Smoking History Generator

library(SmokingHistoryGenerator)
library(testthat)

test_that(".shg_params_paths_exist is false when any core table file is missing", {
  skip_on_cran()
  z <- shg_test_split_param_zips()
  smok_zip <- z$smok
  mort_zip <- z$mort

  tmp_cache <- tempfile("shg_cfg_paths_exist_")
  dir.create(tmp_cache)
  old <- Sys.getenv("R_USER_CACHE_DIR", "")
  Sys.setenv(R_USER_CACHE_DIR = tmp_cache)
  on.exit({
    if (nzchar(old)) Sys.setenv(R_USER_CACHE_DIR = old)
    else Sys.unsetenv("R_USER_CACHE_DIR")
    unlink(tmp_cache, recursive = TRUE)
  }, add = TRUE)

  shg <- new(SHGInterface)
  shg$load_params(smoking_url = smok_zip, mortality_url = mort_zip)
  expect_true(SmokingHistoryGenerator:::.shg_params_paths_exist(shg))

  unlink(file.path(shg$input_data_folder, shg$cessation_filename))
  expect_false(SmokingHistoryGenerator:::.shg_params_paths_exist(shg))
})

test_that("shg_apply_config loads bundle via smok_params_source and mort_params_source", {
  skip_on_cran()
  z <- shg_test_split_param_zips()
  smok_zip <- z$smok
  mort_zip <- z$mort

  tmp_cache <- tempfile("shg_apply_cfg_bundle_")
  dir.create(tmp_cache)
  on.exit(unlink(tmp_cache, recursive = TRUE), add = TRUE)
  old <- Sys.getenv("R_USER_CACHE_DIR", "")
  Sys.setenv(R_USER_CACHE_DIR = tmp_cache)
  on.exit({
    if (nzchar(old)) Sys.setenv(R_USER_CACHE_DIR = old)
    else Sys.unsetenv("R_USER_CACHE_DIR")
  }, add = TRUE)

  shg <- new(SHGInterface)
  shg_apply_config(shg, list(
    smok_params_source = smok_zip,
    mort_params_source = mort_zip,
    mort_params_type = "ocm",
    cohort_year = 1950L
  ))
  expect_true(SmokingHistoryGenerator:::.shg_params_paths_exist(shg))
  expect_equal(shg$mortality_filename, "mortality/ocm-excl-lung-cancer.csv")
})

test_that("shg_apply_config maps mortality alias to mort_params_type", {
  skip_on_cran()
  z <- shg_test_split_param_zips()
  smok_zip <- z$smok
  mort_zip <- z$mort

  tmp_cache <- tempfile("shg_apply_cfg_mort_alias_")
  dir.create(tmp_cache)
  on.exit(unlink(tmp_cache, recursive = TRUE), add = TRUE)
  old <- Sys.getenv("R_USER_CACHE_DIR", "")
  Sys.setenv(R_USER_CACHE_DIR = tmp_cache)
  on.exit({
    if (nzchar(old)) Sys.setenv(R_USER_CACHE_DIR = old)
    else Sys.unsetenv("R_USER_CACHE_DIR")
  }, add = TRUE)

  shg <- new(SHGInterface)
  shg_apply_config(shg, list(
    smok_params_source = smok_zip,
    mort_params_source = mort_zip,
    mortality = "ocm",
    cohort_year = 1950L
  ))
  expect_equal(shg$mortality_filename, "mortality/ocm-excl-lung-cancer.csv")
})

test_that("shg_apply_config preserves explicit paths when no param sources", {
  shg <- new(SHGInterface)
  ext <- system.file("extdata", "2018", package = "SmokingHistoryGenerator")
  shg_apply_config(shg, list(
    input_data_folder = ext,
    initiation_filename = "smoking/initiation.csv",
    cessation_filename = "smoking/cessation.csv",
    mortality_filename = "mortality/acm.csv",
    cpd_filename = "smoking/cpd.csv",
    cohort_year = 1950L
  ))
  expect_equal(normalizePath(shg$input_data_folder, winslash = "/"),
               normalizePath(ext, winslash = "/"))
  expect_true(SmokingHistoryGenerator:::.shg_params_paths_exist(shg))
})

test_that("shg_config_bundle adds NA provenance without load_params", {
  shg <- new(SHGInterface)
  b <- shg_config_bundle(shg)
  expect_type(b, "list")
  expect_false(inherits(b, "shg_config"))
  expect_true(is.na(b$smok_params_source))
  expect_true(is.na(b$mort_params_type))
})

test_that("shg_config_bundle records source after load_params (local zip)", {
  skip_on_cran()
  z <- shg_test_split_param_zips()
  smok_zip <- z$smok
  mort_zip <- z$mort

  tmp_cache <- tempfile("shg_cfg_bundle_")
  dir.create(tmp_cache)
  on.exit(unlink(tmp_cache, recursive = TRUE), add = TRUE)
  old <- Sys.getenv("R_USER_CACHE_DIR", "")
  Sys.setenv(R_USER_CACHE_DIR = tmp_cache)
  on.exit({
    if (nzchar(old)) Sys.setenv(R_USER_CACHE_DIR = old)
    else Sys.unsetenv("R_USER_CACHE_DIR")
  }, add = TRUE)

  shg <- new(SHGInterface)
  shg$load_params(smoking_url = smok_zip, mortality_url = mort_zip, mort_params_type = "ocm")
  b <- shg_config_bundle(shg)
  expect_equal(b$smok_params_source, smok_zip)
  expect_equal(b$mort_params_source, mort_zip)
  expect_equal(b$mort_params_type, "ocm")
  expect_true(nzchar(b$input_data_folder))
})

test_that("shg_use_config_bundle re-extracts when cache folder exists but files gone", {
  skip_on_cran()
  z <- shg_test_split_param_zips()
  smok_zip <- z$smok
  mort_zip <- z$mort

  tmp_cache <- tempfile("shg_cfg_rehydr_")
  dir.create(tmp_cache)
  on.exit(unlink(tmp_cache, recursive = TRUE), add = TRUE)
  old <- Sys.getenv("R_USER_CACHE_DIR", "")
  Sys.setenv(R_USER_CACHE_DIR = tmp_cache)
  on.exit({
    if (nzchar(old)) Sys.setenv(R_USER_CACHE_DIR = old)
    else Sys.unsetenv("R_USER_CACHE_DIR")
  }, add = TRUE)

  yml <- tempfile(fileext = ".yml")
  on.exit(unlink(yml), add = TRUE)

  shg1 <- new(SHGInterface)
  shg1$load_params(smoking_url = smok_zip, mortality_url = mort_zip)
  shg1$runSimFromFixedValues(50, 0, 0, 1950)
  shg_save_config(shg1, yml, quiet = TRUE)

  unlink(shg1$input_data_folder, recursive = TRUE)

  shg2 <- new(SHGInterface)
  expect_message(
    shg_use_config_bundle(shg2, yml),
    "re-loading bundles"
  )
  expect_true(file.exists(file.path(shg2$input_data_folder, shg2$initiation_filename)))
  expect_equal(shg2$mortality_filename, shg1$mortality_filename)
})

test_that("YAML config: cache reuse, clear cache, load_config re-fetches", {
  skip_on_cran()
  z <- shg_test_split_param_zips()
  smok_zip <- z$smok
  mort_zip <- z$mort

  tmp_cache <- tempfile("shg_cfg_e2e_")
  dir.create(tmp_cache)
  old <- Sys.getenv("R_USER_CACHE_DIR", "")
  Sys.setenv(R_USER_CACHE_DIR = tmp_cache)
  on.exit({
    if (nzchar(old)) Sys.setenv(R_USER_CACHE_DIR = old)
    else Sys.unsetenv("R_USER_CACHE_DIR")
    unlink(tmp_cache, recursive = TRUE)
  }, add = TRUE)

  yml <- tempfile(fileext = ".yml")
  on.exit(unlink(yml), add = TRUE)

  shg1 <- new(SHGInterface)
  shg1$load_params(smoking_url = smok_zip, mortality_url = mort_zip, mort_params_type = "acm")
  shg1$runSimFromFixedValues(100, 0, 0, 1950)
  shg_save_config(shg1, yml, quiet = TRUE)

  shg2 <- new(SHGInterface)
  cfg2 <- shg_load_config(shg2, yml)
  expect_type(cfg2, "list")
  expect_true(file.exists(file.path(shg2$input_data_folder, shg2$initiation_filename)))
  expect_equal(shg2$mortality_filename, shg1$mortality_filename)
  expect_equal(shg2$smok_params_source, smok_zip)

  shg3 <- new(SHGInterface)
  shg_load_params(shg3, smoking_url = smok_zip, mortality_url = mort_zip)
  expect_true(file.exists(file.path(shg3$input_data_folder, shg3$initiation_filename)))

  shg_clear_params_cache()

  shg4 <- new(SHGInterface)
  expect_message(
    shg_load_config(shg4, yml),
    "re-loading bundles"
  )
  expect_true(file.exists(file.path(shg4$input_data_folder, shg4$initiation_filename)))
  expect_equal(shg4$mortality_filename, shg1$mortality_filename)
})

test_that("shg_load_config restores config and can re-fetch after cache clear", {
  skip_on_cran()
  z <- shg_test_split_param_zips()
  smok_zip <- z$smok
  mort_zip <- z$mort

  tmp_cache <- tempfile("shg_cfg_load_params_config_")
  dir.create(tmp_cache)
  old <- Sys.getenv("R_USER_CACHE_DIR", "")
  Sys.setenv(R_USER_CACHE_DIR = tmp_cache)
  on.exit({
    if (nzchar(old)) Sys.setenv(R_USER_CACHE_DIR = old)
    else Sys.unsetenv("R_USER_CACHE_DIR")
    unlink(tmp_cache, recursive = TRUE)
  }, add = TRUE)

  yml <- tempfile(fileext = ".yml")
  on.exit(unlink(yml), add = TRUE)

  shg1 <- new(SHGInterface)
  shg1$load_params(smoking_url = smok_zip, mortality_url = mort_zip, mort_params_type = "ocm")
  shg1$runSimFromFixedValues(80, 0, 0, 1950)
  shg_save_config(shg1, yml, quiet = TRUE)

  shg_clear_params_cache()

  shg2 <- new(SHGInterface)
  expect_message(
    shg_load_config(shg2, yml),
    "re-loading bundles"
  )
  expect_true(file.exists(file.path(shg2$input_data_folder, shg2$initiation_filename)))
  expect_equal(shg2$mortality_filename, "mortality/ocm-excl-lung-cancer.csv")
})

test_that("SHGInterface$load_config and runSim delegate correctly", {
  skip_on_cran()
  z <- shg_test_split_param_zips()
  smok_zip <- z$smok
  mort_zip <- z$mort

  tmp_cache <- tempfile("shg_cfg_load_config_method_")
  dir.create(tmp_cache)
  old <- Sys.getenv("R_USER_CACHE_DIR", "")
  Sys.setenv(R_USER_CACHE_DIR = tmp_cache)
  on.exit({
    if (nzchar(old)) Sys.setenv(R_USER_CACHE_DIR = old)
    else Sys.unsetenv("R_USER_CACHE_DIR")
    unlink(tmp_cache, recursive = TRUE)
  }, add = TRUE)

  yml <- tempfile(fileext = ".yml")
  on.exit(unlink(yml), add = TRUE)

  shg1 <- new(SHGInterface)
  shg1$load_params(smoking_url = smok_zip, mortality_url = mort_zip)
  shg1$runSimFromFixedValues(40, 0, 0, 1950)
  shg_save_config(shg1, yml, quiet = TRUE)

  shg_clear_params_cache()

  shg2 <- new(SHGInterface)
  cfg <- NULL
  expect_message({ cfg <- shg2$load_config(yml) }, "re-loading bundles")
  expect_true(is.list(cfg))
  expect_true(file.exists(file.path(shg2$input_data_folder, shg2$initiation_filename)))

  out <- shg2$runSim(cfg, attach_run_info = FALSE)
  expect_s3_class(out, "data.frame")
  expect_equal(nrow(out), 40)

  out2 <- shg_run(shg2, cfg, attach_run_info = FALSE)
  expect_equal(nrow(out2), 40)
})

test_that("SHGInterface$save_config matches shg_save_config output", {
  skip_on_cran()
  z <- shg_test_split_param_zips()
  smok_zip <- z$smok
  mort_zip <- z$mort

  tmp_cache <- tempfile("shg_cfg_save_method_")
  dir.create(tmp_cache)
  old <- Sys.getenv("R_USER_CACHE_DIR", "")
  Sys.setenv(R_USER_CACHE_DIR = tmp_cache)
  on.exit({
    if (nzchar(old)) Sys.setenv(R_USER_CACHE_DIR = old)
    else Sys.unsetenv("R_USER_CACHE_DIR")
    unlink(tmp_cache, recursive = TRUE)
  }, add = TRUE)

  yml1 <- tempfile(fileext = ".yml")
  yml2 <- tempfile(fileext = ".yml")
  on.exit(unlink(c(yml1, yml2)), add = TRUE)

  shg <- new(SHGInterface)
  shg$load_params(smoking_url = smok_zip, mortality_url = mort_zip)
  shg$runSimFromFixedValues(10, 0, 0, 1950)
  shg$save_config(yml1, quiet = TRUE)
  shg_save_config(shg, yml2, quiet = TRUE)

  expect_equal(readLines(yml1), readLines(yml2))
})

test_that("shg_save_config writes repro-effective engine settings", {
  skip_on_cran()
  z <- shg_test_split_param_zips()
  smok_zip <- z$smok
  mort_zip <- z$mort

  tmp_cache <- tempfile("shg_cfg_repro_effective_")
  dir.create(tmp_cache)
  old <- Sys.getenv("R_USER_CACHE_DIR", "")
  Sys.setenv(R_USER_CACHE_DIR = tmp_cache)
  on.exit({
    if (nzchar(old)) Sys.setenv(R_USER_CACHE_DIR = old)
    else Sys.unsetenv("R_USER_CACHE_DIR")
    unlink(tmp_cache, recursive = TRUE)
  }, add = TRUE)

  yml <- tempfile(fileext = ".yml")
  on.exit(unlink(yml), add = TRUE)

  shg <- new(SHGInterface)
  shg$number_of_segments <- -1
  shg$num_threads <- -1
  shg$load_params(smoking_url = smok_zip, mortality_url = mort_zip)
  shg$runSimFromFixedValues(5000, 0, 0, 1950)

  cfg_intent <- shg$getConfig()
  expect_equal(cfg_intent$number_of_segments, -1)
  expect_equal(cfg_intent$num_threads, -1)

  shg_save_config(shg, yml, quiet = TRUE)
  cfg_saved <- yaml::read_yaml(yml)
  expect_true(cfg_saved$number_of_segments >= 1)
  expect_false(identical(cfg_saved$number_of_segments, -1))
  expect_false("num_threads" %in% names(cfg_saved))
})

test_that("shg_save_config errors after population run following fixed cohort run", {
  skip_on_cran()
  z <- shg_test_split_param_zips()
  smok_zip <- z$smok
  mort_zip <- z$mort

  tmp_cache <- tempfile("shg_cfg_save_pop_invalidate_")
  dir.create(tmp_cache)
  old <- Sys.getenv("R_USER_CACHE_DIR", "")
  Sys.setenv(R_USER_CACHE_DIR = tmp_cache)
  on.exit({
    if (nzchar(old)) Sys.setenv(R_USER_CACHE_DIR = old)
    else Sys.unsetenv("R_USER_CACHE_DIR")
    unlink(tmp_cache, recursive = TRUE)
  }, add = TRUE)

  yml <- tempfile(fileext = ".yml")
  on.exit(unlink(yml), add = TRUE)

  shg <- new(SHGInterface)
  shg$num_threads <- 1
  shg$number_of_segments <- 1
  shg$load_params(smoking_url = smok_zip, mortality_url = mort_zip)
  shg$runSimFromFixedValues(5, 0, 0, 1950)
  pop <- data.frame(
    race = rep(0, 3),
    sex = rep(0, 3),
    birth_cohort = rep(1950, 3)
  )
  shg$runSimFromDataFrame(pop)
  expect_error(shg_save_config(shg, yml, quiet = TRUE), "runSimFromDataFrame")
})

test_that("shg_save_config errors when run metadata not recorded", {
  skip_on_cran()
  z <- shg_test_split_param_zips()
  smok_zip <- z$smok
  mort_zip <- z$mort

  tmp_cache <- tempfile("shg_cfg_save_fail_")
  dir.create(tmp_cache)
  old <- Sys.getenv("R_USER_CACHE_DIR", "")
  Sys.setenv(R_USER_CACHE_DIR = tmp_cache)
  on.exit({
    if (nzchar(old)) Sys.setenv(R_USER_CACHE_DIR = old)
    else Sys.unsetenv("R_USER_CACHE_DIR")
    unlink(tmp_cache, recursive = TRUE)
  }, add = TRUE)

  shg <- new(SHGInterface)
  shg$load_params(smoking_url = smok_zip, mortality_url = mort_zip)
  yml <- tempfile(fileext = ".yml")
  on.exit(unlink(yml), add = TRUE)
  expect_error(shg_save_config(shg, yml, quiet = TRUE), "runSimFromFixedValues")
})


test_that("shg_write_config_yaml nests bundle keys under params and normalize flattens", {
  skip_on_cran()
  z <- shg_test_split_param_zips()
  smok_zip <- z$smok
  mort_zip <- z$mort

  tf <- tempfile(fileext = ".yml")
  on.exit(unlink(tf), add = TRUE)
  cfg <- list(
    config_version = "1.0",
    rng_strategy = "RngStream",
    smok_params_source = smok_zip,
    mort_params_source = mort_zip,
    mort_params_type = "acm",
    cohort_year = 1950,
    individuals = 5,
    race = 0,
    sex = 0
  )
  shg_write_config_yaml(cfg, tf)
  rd <- yaml::read_yaml(tf)
  expect_true(is.list(rd$params))
  n <- SmokingHistoryGenerator:::.shg_normalize_config_list(rd)
  expect_equal(n$smok_params_source, smok_zip)
  expect_equal(n$mort_params_type, "acm")
  expect_null(n$params)
})

test_that("normalize rejects removed params_bundle_source", {
  expect_error(
    SmokingHistoryGenerator:::.shg_normalize_config_list(
      list(params_bundle_source = "/old/combined.zip")
    ),
    "params_bundle_source was removed"
  )
})

test_that("normalize migrates legacy results_* and strips legacy repro md5 keys", {
  x <- list(
    cohort_year = 1950L,
    results_content_md5 = "abc",
    results_summary = list(n_rows = 2L),
    repro_engine_md5 = "old",
    r_session_md5 = "old2"
  )
  n <- SmokingHistoryGenerator:::.shg_normalize_config_list(x)
  expect_null(n$results_content_md5)
  expect_null(n$results_summary)
  expect_null(n$repro_engine_md5)
  expect_null(n$r_session_md5)
  expect_equal(n$results$content_md5, "abc")
  expect_equal(n$results$summary$n_rows, 2L)
})

test_that("shg_write_config_yaml keeps results verification block", {
  tf <- tempfile(fileext = ".yml")
  on.exit(unlink(tf), add = TRUE)
  cfg <- list(
    config_version = "1.0",
    cohort_year = 1950L,
    results = list(content_md5 = "abc", summary = list(n_rows = 3L)),
    repro_digest = "def"
  )
  shg_write_config_yaml(cfg, tf)
  rd <- yaml::read_yaml(tf)
  expect_equal(rd$results$content_md5, "abc")
  expect_equal(rd$repro_digest, "def")
})

test_that("shg_write_config_yaml drops results when it is a data frame", {
  tf <- tempfile(fileext = ".yml")
  on.exit(unlink(tf), add = TRUE)
  cfg <- list(cohort_year = 1950L, results = data.frame(a = 1L))
  shg_write_config_yaml(cfg, tf)
  rd <- yaml::read_yaml(tf)
  expect_null(rd$results)
})