Fix merging named lists and add custom function to utils

R/compatibility.R

@@ -205,7 +205,7 @@ set_equilibrium <- function(parameters, init_EIR, eq_params = NULL) {
     age = EQUILIBRIUM_AGES,
     h = malariaEquilibrium::gq_normal(parameters$n_heterogeneity_groups)
   )
-  parameters <- c(
+  parameters <- merged_named_lists(
     list(
       init_foim = eq$FOIM,
       init_EIR = init_EIR,

R/utils.R

@@ -118,3 +118,27 @@ prob_to_rate <- function(prob){
 rate_to_prob <- function(rate){
   1 - exp(-rate)
 }
+
+#'@title Combine named lists retaining first instance of non-unique names
+#' @description merges multiple named lists into a single list
+#' preserving the first occurrence of each unique name
+#'@noRd
+merged_named_lists <- function(...) {
+  args <- list(...)
+  if (length(args) == 1 && is.list(args[[1]]) && !is.null(args[[1]][[1]])) {
+    named_list <- args[[1]]
+  } else {
+    named_list <- args
+  }
+
+  result <- list()
+  for (item in named_list) {
+    for (name in names(item)) {
+      if (!name %in% names(result)) {
+        idx <- which(names(item) == name)[1]
+        result[[name]] <- item[[idx]]
+      }
+    }
+  }
+  return(result)
+}

tests/testthat/test-utils.R

@@ -41,3 +41,40 @@ test_that("bitset_index errors if size does not match", {
   b <- individual::Bitset$new(20)$insert(c(2,4,5,8,9))
   expect_error(bitset_index(a, b), "Incompatible bitmap sizes")
 })
+
+test_that("merged_named_lists works with duplicate 'a's in lists", {
+  x <- list(
+    { tmp <- list(1, 2); names(tmp) <- c("a", "a"); tmp },
+    { tmp <- list(3); names(tmp) <- "a"; tmp },
+    { tmp <- list(3); names(tmp) <- "b"; tmp }
+  )
+  result <- merged_named_lists(x)
+  expected <- list(a = 1, b = 3)
+  expect_equal(result, expected)
+})
+
+test_that("merged_named_lists works with single list containing duplicates", {
+  x <- list(
+    { tmp <- list(1, 2, 3); names(tmp) <- c("a", "a", "b"); tmp }
+  )
+  result <- merged_named_lists(x)
+  expected <- list(a = 1, b = 3)
+  expect_equal(result, expected)
+})
+
+test_that("merged_named_lists works with mixed lists and top-level elements", {
+  x <- list(
+    list(a = 1, b = 2),
+    list(a = 3),
+    a = 4
+  )
+  result <- merged_named_lists(x)
+  expected <- list(a = 1, b = 2)
+  expect_equal(result, expected)
+})
+
+test_that("merged_named_lists works with multiple list arguments", {
+  result <- merged_named_lists(list(a = 1, b = 2), list(a = 3), list(b = 3))
+  expected <- list(a = 1, b = 2)
+  expect_equal(result, expected)
+})