Deal with 'saem' fits failing when updating an 'mhmkin' object

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: mkin
 Type: Package
 Title: Kinetic Evaluation of Chemical Degradation Data
-Version: 1.2.7
-Date: 2023-11-25
+Version: 1.2.8
+Date: 2023-11-26
 Authors@R: c(
   person("Johannes", "Ranke", role = c("aut", "cre", "cph"),
     email = "johannes.ranke@jrwb.de",

NEWS.md

@@ -1,3 +1,7 @@
+# mkin 1.2.8
+
+- 'R/{mhmkin,status}.R': Deal with 'saem' fits that fail when updating an 'mhmkin' object
+
 # 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.

R/mhmkin.R

@@ -219,11 +219,22 @@ print.mhmkin <- function(x, ...) {
   print(status(x))
 }
 
+#' Check if fit within an mhmkin object failed
+#' @param x The object to be checked
+check_failed <- function(x) {
+  if (inherits(x, "try-error")) {
+    return(TRUE)
+  } else {
+    if (inherits(x$so, "try-error")) {
+      return(TRUE)
+    } else {
+      return(FALSE)
+    }
+  }
+}
+
 #' @export
 AIC.mhmkin <- function(object, ..., k = 2) {
-  if (inherits(object[[1]], "saem.mmkin")) {
-    check_failed <- function(x) if (inherits(x$so, "try-error")) TRUE else FALSE
-  }
   res <- sapply(object, function(x) {
     if (check_failed(x)) return(NA)
     else return(AIC(x$so, k = k))
@@ -235,9 +246,6 @@ AIC.mhmkin <- function(object, ..., k = 2) {
 
 #' @export
 BIC.mhmkin <- function(object, ...) {
-  if (inherits(object[[1]], "saem.mmkin")) {
-    check_failed <- function(x) if (inherits(x$so, "try-error")) TRUE else FALSE
-  }
   res <- sapply(object, function(x) {
     if (check_failed(x)) return(NA)
     else return(BIC(x$so))
@@ -280,7 +288,13 @@ 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,
+  failed_index <- which(sapply(object, check_failed), arr.ind = TRUE)
+  if (length(failed_index > 0)) {
+    rlang::inject(anova(!!!(object[-failed_index]), method = method, test = test,
+      model.names = model.names[-failed_index]))
+  } else {
+    rlang::inject(anova(!!!(object), method = method, test = test,
       model.names = model.names))
+  }
 }
 

R/status.R

@@ -74,15 +74,19 @@ print.status.mmkin <- function(x, ...) {
 status.mhmkin <- function(object, ...) {
   if (inherits(object[[1]], "saem.mmkin")) {
     test_func <- function(fit) {
-      if (inherits(fit$so, "try-error")) {
-        return("E")
+      if (inherits(fit, "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 = ", "))
+        if (inherits(fit$so, "try-error")) {
+          return("E")
         } else {
-          return("OK")
+          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")
+          }
         }
       }
     }

log/build.log

@@ -7,5 +7,5 @@
 * checking for empty or unneeded directories
 Removed empty directory ‘mkin/inst/rmarkdown/templates/hierarchical_kinetics_parent’
 Removed empty directory ‘mkin/vignettes/web_only’
-* building ‘mkin_1.2.7.tar.gz’
+* building ‘mkin_1.2.8.tar.gz’
 

log/check.log

@@ -9,9 +9,9 @@
 * using options ‘--no-tests --as-cran’
 * checking for file ‘mkin/DESCRIPTION’ ... OK
 * checking extension type ... Package
-* this is package ‘mkin’ version ‘1.2.7’
+* this is package ‘mkin’ version ‘1.2.8’
 * package encoding: UTF-8
-* checking CRAN incoming feasibility ... [2s/15s] Note_to_CRAN_maintainers
+* checking CRAN incoming feasibility ... [2s/14s] Note_to_CRAN_maintainers
 Maintainer: ‘Johannes Ranke <johannes.ranke@jrwb.de>’
 * checking package namespace information ... OK
 * checking package dependencies ... OK
@@ -62,7 +62,7 @@ Maintainer: ‘Johannes Ranke <johannes.ranke@jrwb.de>’
 * checking sizes of PDF files under ‘inst/doc’ ... OK
 * checking installed files from ‘inst/doc’ ... OK
 * checking files in ‘vignettes’ ... OK
-* checking examples ... [10s/10s] OK
+* checking examples ... OK
 * checking for unstated dependencies in ‘tests’ ... OK
 * checking tests ... SKIPPED
 * checking for unstated dependencies in vignettes ... OK

log/test.log

@@ -4,39 +4,39 @@
 ✔ |          5 | Analytical solutions for coupled models [1.5s]
 ✔ |          5 | Calculation of Akaike weights
 ✔ |          3 | Export dataset for reading into CAKE
-✔ |          6 | Use of precompiled symbols in mkinpredict [3.3s]
+✔ |          6 | Use of precompiled symbols in mkinpredict [3.2s]
 ✔ |         12 | Confidence intervals and p-values
-✔ |      1  12 | Dimethenamid data from 2018 [13.1s]
+✔ |      1  12 | Dimethenamid data from 2018 [13.8s]
 ✔ |         14 | Error model fitting [2.5s]
 ✔ |          5 | Time step normalisation
 ✔ |          4 | Calculation of FOCUS chi2 error levels
 ✔ |         14 | Results for FOCUS D established in expertise for UBA (Ranke 2014)
 ✔ |          4 | Test fitting the decline of metabolites from their maximum
 ✔ |          1 | Fitting the logistic model
-✔ |         10 | Batch fitting and diagnosing hierarchical kinetic models [20.4s]
-✔ |      2  16 | Nonlinear mixed-effects models [149.9s]
+✔ |         10 | Batch fitting and diagnosing hierarchical kinetic models [19.8s]
+✔ |      2  16 | Nonlinear mixed-effects models [149.6s]
 ✔ |          3 | Test dataset classes mkinds and mkindsg
 ✔ |         10 | Special cases of mkinfit calls
 ✔ |          3 | mkinfit features
 ✔ |          8 | mkinmod model generation and printing
 ✔ |          3 | Model predictions with mkinpredict
-✔ |         12 | Multistart method for saem.mmkin models [23.0s]
-✔ |         16 | Evaluations according to 2015 NAFTA guidance [1.5s]
-✔ |          9 | Nonlinear mixed-effects models with nlme [3.6s]
-✔ |         15 | Plotting [4.8s]
+✔ |         12 | Multistart method for saem.mmkin models [23.6s]
+✔ |         16 | Evaluations according to 2015 NAFTA guidance [1.6s]
+✔ |          9 | Nonlinear mixed-effects models with nlme [4.0s]
+✔ |         15 | Plotting [4.7s]
 ✔ |          4 | Residuals extracted from mkinfit models
-✔ |      1  38 | saemix parent models [35.2s]
+✔ |      1  38 | saemix parent models [36.4s]
 ✔ |          2 | Complex test case from Schaefer et al. (2007) Piacenza paper
 ✔ |         11 | Processing of residue series
-✔ |         10 | Fitting the SFORB model [1.6s]
+✔ |         10 | Fitting the SFORB model [1.8s]
 ✔ |          1 | Summaries of old mkinfit objects
 ✔ |          5 | Summary
 ✔ |          4 | Results for synthetic data established in expertise for UBA (Ranke 2014)
-✔ |          9 | Hypothesis tests [2.8s]
+✔ |          9 | Hypothesis tests [3.1s]
 ✔ |          4 | Calculation of maximum time weighted average concentrations (TWAs)
 
 ══ Results ═════════════════════════════════════════════════════════════════════
-Duration: 268.2 s
+Duration: 270.7 s
 
 ── Skipped tests (4) ───────────────────────────────────────────────────────────
 • Fitting this ODE model with saemix takes about 5 minutes on my new system