From 2890a954d8443e1aab04a5c5fa128574fa6cde87 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Wed, 10 Aug 2022 14:21:26 +0200
Subject: Naming of random effects for reduced parameter models

---
 R/intervals.R                          |  5 +--
 R/summary.saem.mmkin.R                 | 13 +++++---
 tests/testthat/summary_hfit_sfo_tc.txt | 58 ++++++++++++++++++++++++++++++++++
 tests/testthat/test_mhmkin.R           | 11 +++++++
 4 files changed, 81 insertions(+), 6 deletions(-)
 create mode 100644 tests/testthat/summary_hfit_sfo_tc.txt

diff --git a/R/intervals.R b/R/intervals.R
index 258eb4ad..705ef6eb 100644
--- a/R/intervals.R
+++ b/R/intervals.R
@@ -77,8 +77,9 @@ intervals.saem.mmkin <- function(object, level = 0.95, backtransform = TRUE, ...
   attr(confint_ret, "label") <- "Fixed effects:"
 
   # Random effects
-  ranef_ret <- as.matrix(conf.int[paste0("SD.", pnames), c("lower", "est.", "upper")])
-  rownames(ranef_ret) <- paste0(gsub("SD\\.", "sd(", rownames(ranef_ret)), ")")
+  sdnames <- intersect(rownames(conf.int), paste("SD", pnames, sep = "."))
+  ranef_ret <- as.matrix(conf.int[sdnames, c("lower", "est.", "upper")])
+  rownames(ranef_ret) <- paste0(gsub("SD\\.", "sd(", sdnames), ")")
   attr(ranef_ret, "label") <- "Random effects:"
 
 
diff --git a/R/summary.saem.mmkin.R b/R/summary.saem.mmkin.R
index fa52a579..f41e7e20 100644
--- a/R/summary.saem.mmkin.R
+++ b/R/summary.saem.mmkin.R
@@ -73,7 +73,12 @@
 #' f_mmkin_dfop_sfo <- mmkin(list(dfop_sfo), ds_syn_dfop_sfo,
 #'   quiet = TRUE, error_model = "tc", cores = 5)
 #' f_saem_dfop_sfo <- saem(f_mmkin_dfop_sfo)
-#' summary(f_saem_dfop_sfo, data = TRUE)
+#' print(f_saem_dfop_sfo)
+#' illparms(f_saem_dfop_sfo)
+#' f_saem_dfop_sfo_2 <- update(f_saem_dfop_sfo, covariance.model = diag(c(0, 0, 1, 1, 1, 0)))
+#' illparms(f_saem_dfop_sfo_2)
+#' intervals(f_saem_dfop_sfo_2)
+#' summary(f_saem_dfop_sfo_2, data = TRUE)
 #' }
 #'
 #' @export
@@ -138,8 +143,8 @@ summary.saem.mmkin <- function(object, data = FALSE, verbose = FALSE, distimes =
     list(pnames, pnames))
 
   # Random effects
-  rnames <- paste0("SD.", pnames)
-  confint_ranef <- as.matrix(conf.int[rnames, c("estimate", "lower", "upper")])
+  sdnames <- intersect(rownames(conf.int), paste0("SD.", pnames))
+  confint_ranef <- as.matrix(conf.int[sdnames, c("estimate", "lower", "upper")])
   colnames(confint_ranef)[1] <- "est."
 
   # Error model
@@ -202,7 +207,7 @@ print.summary.saem.mmkin <- function(x, digits = max(3, getOption("digits") - 3)
   cat("\nModel predictions using solution type", x$solution_type, "\n")
 
   cat("\nFitted in", x$time[["elapsed"]],  "s\n")
-  cat("Using", paste(x$so@options$nbiter.saemix, collapse = ", "), 
+  cat("Using", paste(x$so@options$nbiter.saemix, collapse = ", "),
     "iterations and", x$so@options$nb.chains, "chains\n")
 
   cat("\nVariance model: ")
diff --git a/tests/testthat/summary_hfit_sfo_tc.txt b/tests/testthat/summary_hfit_sfo_tc.txt
new file mode 100644
index 00000000..ad701cee
--- /dev/null
+++ b/tests/testthat/summary_hfit_sfo_tc.txt
@@ -0,0 +1,58 @@
+saemix version used for fitting:      Dummy 0.0 for testing 
+mkin version used for pre-fitting:  Dummy 0.0 for testing 
+R version used for fitting:         Dummy R version for testing 
+Date of fit:     Dummy date for testing 
+Date of summary: Dummy date for testing 
+
+Equations:
+d_parent/dt = - k_parent * parent
+
+Data:
+106 observations of 1 variable(s) grouped in 6 datasets
+
+Model predictions using solution type analytical 
+
+Fitted in test time 0 s
+Using 300, 100 iterations and 9 chains
+
+Variance model: Two-component variance function 
+
+Mean of starting values for individual parameters:
+    parent_0 log_k_parent 
+         101           -3 
+
+Fixed degradation parameter values:
+None
+
+Results:
+
+Likelihood computed by importance sampling
+  AIC BIC logLik
+  533 531   -261
+
+Optimised parameters:
+             est. lower upper
+parent_0      101   100   102
+log_k_parent   -3    -4    -3
+
+Correlation: 
+             pr_0
+log_k_parent 0.1 
+
+Random effects:
+                est. lower upper
+SD.log_k_parent  0.3   0.1   0.4
+
+Variance model:
+    est. lower upper
+a.1 0.91  0.64  1.17
+b.1 0.05  0.04  0.06
+
+Backtransformed parameters:
+          est. lower upper
+parent_0 1e+02 1e+02 1e+02
+k_parent 4e-02 3e-02 4e-02
+
+Estimated disappearance times:
+       DT50 DT90
+parent   19   64
diff --git a/tests/testthat/test_mhmkin.R b/tests/testthat/test_mhmkin.R
index e059948a..eced5583 100644
--- a/tests/testthat/test_mhmkin.R
+++ b/tests/testthat/test_mhmkin.R
@@ -29,4 +29,15 @@ test_that("Multiple hierarchical kinetic models can be fitted and diagnosed", {
   hfit_sfo_tc <- update(hfits[["SFO", "tc"]],
     covariance.model = diag(c(0, 1)))
   expect_equal(illparms(hfit_sfo_tc), character(0))
+
+  test_summary <- summary(hfit_sfo_tc)
+  test_summary$saemixversion <- "Dummy 0.0 for testing"
+  test_summary$mkinversion <- "Dummy 0.0 for testing"
+  test_summary$Rversion <- "Dummy R version for testing"
+  test_summary$date.fit <- "Dummy date for testing"
+  test_summary$date.summary <- "Dummy date for testing"
+  test_summary$time <- c(elapsed = "test time 0")
+
+  expect_known_output(print(test_summary, digits = 1),
+    "summary_hfit_sfo_tc.txt")
 })
-- 
cgit v1.2.1