From 934190153a440bede296cc5748121a2c0186b9c1 Mon Sep 17 00:00:00 2001
From: CosmoNaught <santonicosmo@gmail.com>
Date: Wed, 16 Oct 2024 14:09:17 +0100
Subject: [PATCH] Fix merging named lists and add custom function to utils

---
 R/compatibility.R           |  2 +-
 R/utils.R                   | 24 ++++++++++++++++++++++++
 tests/testthat/test-utils.R | 37 +++++++++++++++++++++++++++++++++++++
 3 files changed, 62 insertions(+), 1 deletion(-)

diff --git a/R/compatibility.R b/R/compatibility.R
index ec71d3df..2aa10465 100644
--- a/R/compatibility.R
+++ b/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,
diff --git a/R/utils.R b/R/utils.R
index 0c98b099..bd0792bb 100644
--- a/R/utils.R
+++ b/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)
+}
diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R
index 0b1f56ec..ce9c2028 100644
--- a/tests/testthat/test-utils.R
+++ b/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)
+})
\ No newline at end of file