From ce7a20e54d8005264f13d3e9fe0c99f84d20b85e Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Fri, 4 Nov 2022 10:54:43 +0100
Subject: Make illparms.mhmkin and anova.saem.mmkin more robust

---
 R/anova.saem.mmkin.R |  5 +++--
 R/illparms.R         | 18 +++++++++---------
 R/mhmkin.R           |  3 ++-
 3 files changed, 14 insertions(+), 12 deletions(-)

(limited to 'R')

diff --git a/R/anova.saem.mmkin.R b/R/anova.saem.mmkin.R
index e506fb8b..00ddc0c3 100644
--- a/R/anova.saem.mmkin.R
+++ b/R/anova.saem.mmkin.R
@@ -30,9 +30,10 @@ anova.saem.mmkin <- function(object, ...,
   is_model <- sapply(dots, is, "saem.mmkin")
   if (any(is_model)) {
     mods <- c(list(object), dots[is_model])
+    successful <- sapply(mods, function(x) !inherits(x$so, "try-error"))
 
     # Ensure same data, ignoring covariates
-    same_data <- sapply(dots[is_model], function(x) {
+    same_data <- sapply(mods[successful], function(x) {
       identical(object$data[c("ds", "name", "time", "value")],
         x$data[c("ds", "name", "time", "value")])
     })
@@ -56,7 +57,7 @@ anova.saem.mmkin <- function(object, ...,
     }
     names(mods) <- model.names
 
-    llks <- lapply(model.names, function(x) {
+    llks <- lapply(model.names[successful], function(x) {
       llk <- try(logLik(mods[[x]], method = method))
       if (inherits(llk, "try-error"))
         stop("Could not obtain log likelihood with '", method, "' method for ", x)
diff --git a/R/illparms.R b/R/illparms.R
index c9a4f854..01e75cf1 100644
--- a/R/illparms.R
+++ b/R/illparms.R
@@ -93,22 +93,22 @@ print.illparms.mmkin <- function(x, ...) {
 #' @rdname illparms
 #' @export
 illparms.saem.mmkin <- function(object, conf.level = 0.95, random = TRUE, errmod = TRUE, ...) {
-  if (inherits(object, "try-error")) {
-    failed <- NA
+  if (inherits(object$so, "try-error")) {
+    ill_parms <- NA
   } else {
     ints <- intervals(object, conf.level = conf.level)
-    failed <- character(0)
+    ill_parms <- character(0)
     if (random) {
-      failed_random <- ints$random[, "lower"] < 0
-      failed <- c(failed, names(which(failed_random)))
+      ill_parms_random <- ints$random[, "lower"] < 0
+      ill_parms <- c(ill_parms, names(which(ill_parms_random)))
     }
     if (errmod) {
-      failed_errmod <- ints$errmod[, "lower"] < 0 & ints$errmod[, "est."] > 0
-      failed <- c(failed, names(which(failed_errmod)))
+      ill_parms_errmod <- ints$errmod[, "lower"] < 0 & ints$errmod[, "est."] > 0
+      ill_parms <- c(ill_parms, names(which(ill_parms_errmod)))
     }
   }
-  class(failed) <- "illparms.saem.mmkin"
-  return(failed)
+  class(ill_parms) <- "illparms.saem.mmkin"
+  return(ill_parms)
 }
 
 #' @rdname illparms
diff --git a/R/mhmkin.R b/R/mhmkin.R
index 175d12ec..de41c733 100644
--- a/R/mhmkin.R
+++ b/R/mhmkin.R
@@ -207,6 +207,7 @@ anova.mhmkin <- function(object, ...,
   if (identical(model.names, "auto")) {
     model.names <- outer(rownames(object), colnames(object), paste)
   }
-  rlang::inject(anova(!!!(object), method = method, test = test, model.names = model.names))
+  rlang::inject(anova(!!!(object), method = method, test = test, 
+      model.names = model.names))
 }
 
-- 
cgit v1.2.1