diff options
| -rw-r--r-- | NEWS.md | 6 | ||||
| -rw-r--r-- | R/illparms.R | 10 | ||||
| -rw-r--r-- | tests/testthat/test_saemix_parent.R | 27 |
3 files changed, 38 insertions, 5 deletions
@@ -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)") +} |