Add testthat coverage and package contributor guidance

AGENTS.md

@@ -0,0 +1,33 @@
+# Highlander package guide
+
+## Package structure
+
+- `R/` contains the package functions. `Highlander()` coordinates CMA-ES and
+  LaplacesDemon; `Lowlander()` performs an initial Latin-hypercube search;
+  `Lowlander_Z.R` contains helpers for reusing Lowlander results; and
+  `Specs_help()` builds algorithm-specific LaplacesDemon settings.
+- `man/` contains the package reference documentation, and `vignettes/` contains
+  longer usage examples.
+- `tests/testthat/` contains the package's unit tests. Testthat edition 3 is
+  configured in `DESCRIPTION`.
+
+## Tests and checks
+
+- Run the unit tests from the repository root with
+  `Rscript -e 'testthat::test_local()'`.
+- Run the full package check with `R CMD build .` followed by
+  `R CMD check --no-manual --as-cran Highlander_*.tar.gz`.
+- Keep unit tests deterministic and fast. Prefer supplied Latin-hypercube
+  matrices and small function inputs over random designs or full sampler runs.
+- The `R-CMD-check` GitHub Actions workflow runs `R CMD check`, which includes
+  the testthat suite. Add separate CI test steps only if they provide coverage
+  that the package check does not.
+
+## Change guidance
+
+- Keep user-facing function behavior and argument defaults aligned with the
+  reference documentation and README examples.
+- When changing exported functions, update their reference documentation and
+  add or adjust focused testthat coverage.
+- Avoid tests that require a long MCMC/CMA optimization run when the same
+  behavior can be checked with a small deterministic unit test.

R/Lowlander.R

@@ -19,7 +19,8 @@ Lowlander = function(lower, upper, Data, likefunc, Nsamp = 'auto', pcut = 0.1,
     }
   }
 
-  if (length(Nsamp) != 1L || is.na(Nsamp) || !is.finite(Nsamp)) {
+  if (length(Nsamp) != 1L || is.na(Nsamp) || !is.finite(Nsamp) ||
+      Nsamp < 1 || Nsamp != floor(Nsamp) || Nsamp > .Machine$integer.max) {
     stop("Nsamp must be a positive integer (>= 1) or 'auto'.")
   }
   Nsamp = as.integer(Nsamp)

tests/testthat/helper-lowlander-fixture.R

@@ -0,0 +1,11 @@
+lowlander_fixture <- function() {
+  list(
+    latin_mod = matrix(c(0, 10, 1, 11, 2, 12, 3, 13), ncol = 2, byrow = TRUE),
+    keep = 1:4,
+    output = c(4, 1, 3, 2),
+    best = c(first = 1, second = 11),
+    lower = c(0, 10),
+    upper = c(3, 13),
+    liketype = "min"
+  )
+}

tests/testthat/test-likelihood-converters.R

@@ -0,0 +1,35 @@
+test_that("CMA converters apply optimization direction and prior consistently", {
+  scalar_like <- function(parm, Data) parm[1]^2
+  prior <- function(parm, Data) -0.5
+
+  expect_equal(
+    Highlander:::.convert_CMA2CMA(
+      parm = 2, Data = list(), likefunc = scalar_like,
+      liketype = "max", prior = prior
+    ),
+    -3.5
+  )
+
+  converted <- Highlander:::.convert_CMA2LD(
+    parm = 2,
+    Data = list(applyconstraints = FALSE, applyintervals = FALSE),
+    likefunc = scalar_like,
+    liketype = "min",
+    prior = prior
+  )
+  expect_equal(converted$LP, -4.5)
+  expect_equal(converted$Dev, 8)
+  expect_equal(converted$parm, 2)
+})
+
+test_that("LD likelihoods are converted to the CMA objective", {
+  ld_like <- function(parm, Data) list(LP = -4)
+
+  expect_equal(
+    Highlander:::.convert_LD2CMA(
+      parm = 1, Data = list(), likefunc = ld_like,
+      liketype = "max", prior = function(parm, Data) -0.5
+    ),
+    4.5
+  )
+})

tests/testthat/test-lowlander-helpers.R

@@ -1,14 +1,58 @@
-test_that("Lowlander_kept ranks finite samples in the recorded direction", {
-  result <- list(
-    latin_mod = matrix(c(0, 10, 1, 11, 2, 12, 3, 13), ncol = 2, byrow = TRUE),
-    keep = 1:4,
-    output = c(4, 1, 3, 2),
-    liketype = "min"
-  )
+test_that("Lowlander_kept filters and ranks samples in the recorded direction", {
+  result <- lowlander_fixture()
+  result$keep <- c(1, 2, 3, 4)
   result$output[2] <- Inf
 
-  expect_equal(
-    Lowlander_kept(result),
-    matrix(c(3, 13, 2, 12, 0, 10), ncol = 2, byrow = TRUE)
+  kept <- Lowlander_kept(result, parm.names = c("first", "second"))
+
+  expect_equal(kept, matrix(c(3, 13, 2, 12, 0, 10), ncol = 2, byrow = TRUE,
+                           dimnames = list(NULL, c("first", "second"))))
+
+  result$output <- c(4, 1, 3, 2)
+  result$liketype <- "max"
+  expect_equal(Lowlander_kept(result)[1, ], c(0, 10))
+  expect_null(Lowlander_kept(NULL))
+})
+
+test_that("Lowlander_Z returns spread, bounded starting points", {
+  result <- lowlander_fixture()
+
+  z <- Lowlander_Z(result, N = 2, parm.names = c("first", "second"))
+  expect_equal(dim(z), c(2, 2))
+  expect_equal(colnames(z), c("first", "second"))
+  expect_equal(z, matrix(c(1, 11, 2, 12), ncol = 2, byrow = TRUE,
+                         dimnames = list(NULL, c("first", "second"))))
+
+  set.seed(10)
+  larger_z <- Lowlander_Z(result, N = 6)
+  expect_equal(dim(larger_z), c(6, 2))
+  expect_true(all(larger_z[, 1] >= 0 & larger_z[, 1] <= 3))
+  expect_true(all(larger_z[, 2] >= 10 & larger_z[, 2] <= 13))
+  expect_equal(anyDuplicated(as.data.frame(larger_z)), 0L)
+})
+
+test_that("Lowlander helpers handle unusable inputs and name the best point", {
+  expect_warning(
+    expect_null(Lowlander_kept(list(keep = 1))),
+    "missing latin_mod/keep/output"
+  )
+
+  invalid_keep <- lowlander_fixture()
+  invalid_keep$keep <- 5L
+  expect_warning(
+    expect_null(Lowlander_kept(invalid_keep)),
+    "no valid kept samples"
   )
+
+  nonfinite <- lowlander_fixture()
+  nonfinite$output[nonfinite$keep] <- Inf
+  expect_warning(
+    expect_null(Lowlander_kept(nonfinite)),
+    "All kept Lowlander samples have non-finite likelihood"
+  )
+
+  best <- Lowlander_best(lowlander_fixture(), parm.names = c("first", "second"))
+  expect_equal(best, c(first = 1, second = 11))
+  expect_null(Lowlander_best(NULL))
+  expect_warning(expect_null(Lowlander_best(list())), "no .*best element")
 })

tests/testthat/test-lowlander.R

@@ -0,0 +1,92 @@
+test_that("Lowlander maps design points to bounds and selects the best sample", {
+  latin <- cbind(seq(0, 1, length.out = 6), seq(0, 1, length.out = 6))
+  colnames(latin) <- c("x", "y")
+  result <- Lowlander(
+    lower = c(0, 0),
+    upper = c(1, 1),
+    Data = list(),
+    likefunc = function(parm, Data) sum((parm - c(0.2, 0.2))^2),
+    Nsamp = nrow(latin),
+    pcut = 0.75,
+    latin = latin,
+    parm.names = c("x", "y")
+  )
+
+  expect_equal(result$latin_mod, latin)
+  expect_equal(result$best, c(x = 0.2, y = 0.2))
+  expect_equal(result$keep, 1:4)
+  expect_equal(result$lower, c(x = 0, y = 0))
+  expect_equal(result$upper, c(x = 0.6, y = 0.6))
+  expect_equal(result$frac_keep, 4 / 6)
+  expect_equal(result$bad, integer())
+})
+
+test_that("Lowlander supports maximization and excludes non-finite samples", {
+  latin <- cbind(seq(0, 1, length.out = 6), seq(0, 1, length.out = 6))
+  result <- Lowlander(
+    lower = c(0, 0),
+    upper = c(1, 1),
+    Data = list(),
+    likefunc = function(parm, Data) {
+      if (all(parm == 0.4)) return(NA_real_)
+      sum(parm)
+    },
+    Nsamp = nrow(latin),
+    pcut = 0.8,
+    liketype = "max",
+    latin = latin
+  )
+
+  expect_equal(result$liketype, "max")
+  expect_equal(result$bad, 3L)
+  expect_equal(result$best, c(1, 1))
+  expect_true(all(result$keep %in% setdiff(seq_len(nrow(latin)), result$bad)))
+})
+
+test_that("Lowlander validates its design and scalar likelihood output", {
+  latin <- matrix(seq(0, 1, length.out = 8), ncol = 2)
+  args <- list(
+    lower = c(0, 0),
+    upper = c(1, 1),
+    Data = list(),
+    likefunc = function(parm, Data) sum(parm),
+    Nsamp = nrow(latin),
+    pcut = 0.5,
+    latin = latin
+  )
+
+  expect_error(
+    do.call(Lowlander, utils::modifyList(args, list(upper = 1))),
+    "'lower' and 'upper'"
+  )
+  expect_error(
+    do.call(Lowlander, utils::modifyList(args, list(pcut = 1))),
+    "'pcut'"
+  )
+  expect_error(
+    do.call(Lowlander, utils::modifyList(args, list(Nsamp = 0))),
+    "Nsamp must be a positive integer"
+  )
+  expect_error(
+    do.call(Lowlander, utils::modifyList(args, list(Nsamp = 1.5))),
+    "Nsamp must be a positive integer"
+  )
+  expect_error(
+    do.call(Lowlander, utils::modifyList(
+      args, list(latin = matrix(2, nrow = nrow(latin), ncol = 2))
+    )),
+    "values in 'latin'"
+  )
+  expect_error(
+    do.call(Lowlander, utils::modifyList(
+      args, list(likefunc = function(parm, Data) list(LP = 1, Dev = 2))
+    )),
+    "single numeric value"
+  )
+  expect_error(
+    do.call(Lowlander, utils::modifyList(
+      args, list(likefunc = function(parm, Data) "not numeric")
+    )),
+    "must return numeric values"
+  )
+})

tests/testthat/test-specs-help.R

@@ -0,0 +1,28 @@
+test_that("Specs_help provides algorithm defaults and seeds ensemble samplers", {
+  data <- list(parm.names = c("first", "second"))
+  lowlander <- lowlander_fixture()
+
+  expect_null(Specs_help("CHARM", data))
+
+  aies <- Specs_help("AIES", data, Lowlander = lowlander, Nc = 5, CPUs = 2)
+  expect_equal(aies$Nc, 6L)
+  expect_equal(dim(aies$Z), c(6, 2))
+  expect_true(all(aies$Z[, 1] >= lowlander$lower[1] &
+                  aies$Z[, 1] <= lowlander$upper[1]))
+
+  demc <- Specs_help("DEMC", data, Lowlander = lowlander,
+                     Iterations = 12, Thinning = 2)
+  expect_equal(dim(demc$Z), c(7, 2, 4))
+  expect_true(all(demc$Z[, 1, ] >= lowlander$lower[1] &
+                  demc$Z[, 1, ] <= lowlander$upper[1]))
+})
+
+test_that("Specs_help scales Griddy-Gibbs grids to plausible bounds", {
+  data <- list(parm.names = c("first", "second"))
+  specs <- Specs_help("AGG", data, Lowlander = lowlander_fixture())
+
+  expect_length(specs$Grid, 2)
+  expect_equal(specs$Grid[[1]][1], -0.75)
+  expect_equal(specs$Grid[[1]][length(specs$Grid[[1]])], 0.75)
+  expect_null(specs$dparm)
+})