From 37bd36fe8a75163cbf0f97cb7a0e2f7466a53617 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Thu, 13 Oct 2022 03:48:54 +0200
Subject: Cope with failed FIM inversions

---
 R/illparms.R | 18 +++++++++++++-----
 R/mhmkin.R   | 18 ++++++++++++++----
 R/saem.R     |  3 ++-
 3 files changed, 29 insertions(+), 10 deletions(-)

(limited to 'R')

diff --git a/R/illparms.R b/R/illparms.R
index c2f0263b..931d8f05 100644
--- a/R/illparms.R
+++ b/R/illparms.R
@@ -106,12 +106,20 @@ illparms.mhmkin <- function(object, conf.level = 0.95, random = TRUE, errmod = T
   }
   result <- lapply(object,
     function(fit) {
-      if (check_failed(fit)) return("E")
-      ill <- illparms(fit, conf.level = conf.level, random = random, errmod = errmod)
-      if (length(ill) > 0) {
-        return(paste(ill, collapse = ", "))
+      if (check_failed(fit)) {
+        return("E")
       } else {
-        return("")
+        if (!is.null(fit$FIM_failed) &&
+          "random effects and error model parameters" %in% fit$FIM_failed) {
+          return("NA")
+        } else {
+          ill <- illparms(fit, conf.level = conf.level, random = random, errmod = errmod)
+          if (length(ill) > 0) {
+            return(paste(ill, collapse = ", "))
+          } else {
+            return("")
+          }
+        }
       }
     })
   result <- unlist(result)
diff --git a/R/mhmkin.R b/R/mhmkin.R
index 15c92f3c..2cf9ba06 100644
--- a/R/mhmkin.R
+++ b/R/mhmkin.R
@@ -138,12 +138,19 @@ print.mhmkin <- function(x, ...) {
 
 #' @export
 convergence.mhmkin <- function(object, ...) {
-  all_summary_warnings <- character()
-
   if (inherits(object[[1]], "saem.mmkin")) {
     test_func <- function(fit) {
-      if (inherits(fit$so, "try-error")) return("E")
-      else return("OK")
+      if (inherits(fit$so, "try-error")) {
+        return("E")
+      } else {
+        if (!is.null(fit$FIM_failed)) {
+          return_values <- c("fixed effects" = "Fth",
+            "random effects and error model parameters" = "FO")
+          return(paste(return_values[fit$FIM_failed], collapse = ", "))
+        } else {
+          return("OK")
+        }
+      }
     }
   } else {
     stop("Only mhmkin objects containing saem.mmkin objects currently supported")
@@ -163,6 +170,9 @@ print.convergence.mhmkin <- function(x, ...) {
   print(x, quote = FALSE)
   cat("\n")
   if (any(x == "OK")) cat("OK: Fit terminated successfully\n")
+  if (any(x == "Fth")) cat("Fth: Could not invert FIM for fixed effects\n")
+  if (any(x == "FO")) cat("FO: Could not invert FIM for random effects and error model parameters\n")
+  if (any(x == "Fth, FO")) cat("Fth, FO: Could not invert FIM for fixed effects, nor for random effects and error model parameters\n")
   if (any(x == "E")) cat("E: Error\n")
 }
 
diff --git a/R/saem.R b/R/saem.R
index 05cce682..99712c92 100644
--- a/R/saem.R
+++ b/R/saem.R
@@ -160,7 +160,7 @@ saem.mmkin <- function(object,
   if (!fit_failed) {
     if (any(is.na(f_saemix@results@se.fixed))) FIM_failed <- c(FIM_failed, "fixed effects")
     if (any(is.na(c(f_saemix@results@se.omega, f_saemix@results@se.respar)))) {
-      FIM_failed <- c(FIM_failed, "random effects and residual error parameters")
+      FIM_failed <- c(FIM_failed, "random effects and error model parameters")
     }
     if (!is.null(FIM_failed) & fail_with_errors) {
       stop("Could not invert FIM for ", paste(FIM_failed, collapse = " and "))
@@ -208,6 +208,7 @@ saem.mmkin <- function(object,
     so = f_saemix,
     call = call,
     time = fit_time,
+    FIM_failed = FIM_failed,
     mean_dp_start = attr(m_saemix, "mean_dp_start"),
     bparms.fixed = object[[1]]$bparms.fixed,
     data = return_data,
-- 
cgit v1.2.1