From a1b5d63e031d22b190e9e9fc30753b699ad6b4ea Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Thu, 23 Nov 2023 05:20:17 +0100
Subject: fix: 'R/illparms.R': An ill-defined random effect is now also found
 if there is only one random effect in the model. Also add a test for this.

---
 NEWS.md                             |  6 +++++-
 R/illparms.R                        | 10 ++++++----
 tests/testthat/test_saemix_parent.R | 27 +++++++++++++++++++++++++++
 3 files changed, 38 insertions(+), 5 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 96088a62..100f8b6c 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,4 +1,8 @@
-# mkin 1.2.6
+# mkin 1.2.7
+
+- 'R/illparms.R': Fix a bug that prevented an ill-defined random effect to be found if there was only one random effect in the model. Also add a test for this.
+
+# mkin 1.2.6 (2023-10-14)
 
 - 'inst/rmarkdown/templates/hierarchical_kinetics/skeleton/skeleton.Rmd': Fix an erroneous call to the 'endpoints()' function
 
diff --git a/R/illparms.R b/R/illparms.R
index 68a6bff6..b4b37fbb 100644
--- a/R/illparms.R
+++ b/R/illparms.R
@@ -102,12 +102,14 @@ illparms.saem.mmkin <- function(object, conf.level = 0.95, random = TRUE, errmod
     ints <- intervals(object, conf.level = conf.level)
     ill_parms <- character(0)
     if (random) {
-      ill_parms_random <- ints$random[, "lower"] < 0
-      ill_parms <- c(ill_parms, names(which(ill_parms_random)))
+      ill_parms_random_i <- which(ints$random[, "lower"] < 0)
+      ill_parms_random <- rownames(ints$random)[ill_parms_random_i]
+      ill_parms <- c(ill_parms, ill_parms_random)
     }
     if (errmod) {
-      ill_parms_errmod <- ints$errmod[, "lower"] < 0 & ints$errmod[, "upper"] > 0
-      ill_parms <- c(ill_parms, names(which(ill_parms_errmod)))
+      ill_parms_errmod_i <- which(ints$errmod[, "lower"] < 0 & ints$errmod[, "upper"] > 0)
+      ill_parms_errmod <- rownames(ints$errmod)[ill_parms_errmod_i]
+      ill_parms <- c(ill_parms, ill_parms_errmod)
     }
     if (slopes) {
       if (is.null(object$so)) stop("Slope testing is only implemented for the saemix backend")
diff --git a/tests/testthat/test_saemix_parent.R b/tests/testthat/test_saemix_parent.R
index 7fbecd0c..c80b4fa1 100644
--- a/tests/testthat/test_saemix_parent.R
+++ b/tests/testthat/test_saemix_parent.R
@@ -148,3 +148,30 @@ test_that("We can also use mkin solution methods for saem", {
   rel_diff <- abs(distimes_dfop_analytical - distimes_dfop) / distimes_dfop
   expect_true(all(rel_diff < 0.01))
 })
+
+test_that("illparms finds a single random effect that is ill-defined", {
+  set.seed(123456)
+  n <- 4
+  SFO <- mkinmod(parent = mkinsub("SFO"))
+  sfo_pop <- list(parent_0 = 100, k_parent = 0.03)
+  sfo_parms <- as.matrix(data.frame(
+      k_parent = rlnorm(n, log(sfo_pop$k_parent), 0.001)))
+  sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120)
+  err_1 = list(const = 1, prop = 0.05)
+  tc <- function(value) sigma_twocomp(value, err_1$const, err_1$prop)
+  set.seed(123456)
+  ds_sfo <- lapply(1:n, function(i) {
+    ds_mean <- mkinpredict(SFO, sfo_parms[i, ],
+      c(parent = sfo_pop$parent_0), sampling_times)
+    add_err(ds_mean, tc, n = 1)[[1]]
+  })
+  m_mmkin <- mmkin("SFO", ds_sfo, error_model = "tc", quiet = TRUE)
+  m_saem_1 <- saem(m_mmkin)
+  expect_equal(
+    as.character(illparms(m_saem_1)),
+    c("sd(parent_0)", "sd(log_k_parent)"))
+  m_saem_2 <- saem(m_mmkin, no_random_effect = "parent_0")
+  expect_equal(
+    as.character(illparms(m_saem_2)),
+    "sd(log_k_parent)")
+}
-- 
cgit v1.2.1