diff options
author | Johannes Ranke <jranke@uni-bremen.de> | 2022-11-07 05:58:50 +0100 |
---|---|---|
committer | Johannes Ranke <jranke@uni-bremen.de> | 2022-11-07 05:58:50 +0100 |
commit | b9b3c72cf076ce0393aa53a4d723a195b856c99c (patch) | |
tree | 7ba083b0f6e4f0241d4224fe074ac7138fafb609 | |
parent | 7ec1454c0a0c89987644bbe1981716595d4f1f4b (diff) |
Make print and summary for saem.mmkin more robust
If the likelihood computed by importance sampling, these methods failed.
Now they report "Not available" or NA, respectively.
-rw-r--r-- | R/saem.R | 15 | ||||
-rw-r--r-- | R/summary.saem.mmkin.R | 11 |
2 files changed, 18 insertions, 8 deletions
@@ -257,11 +257,16 @@ print.saem.mmkin <- function(x, digits = max(3, getOption("digits") - 3), ...) { cat("\nFit did not terminate successfully\n") } else { cat("\nLikelihood computed by importance sampling\n") - print(data.frame( - AIC = AIC(x$so, type = "is"), - BIC = BIC(x$so, type = "is"), - logLik = logLik(x$so, type = "is"), - row.names = " "), digits = digits) + ll <- try(logLik(x$so, type = "is"), silent = TRUE) + if (inherits(ll, "try-error")) { + cat("Not available\n") + } else { + print(data.frame( + AIC = AIC(x$so, type = "is"), + BIC = BIC(x$so, type = "is"), + logLik = logLik(x$so, type = "is"), + row.names = " "), digits = digits) + } cat("\nFitted parameters:\n") conf.int <- parms(x, ci = TRUE) diff --git a/R/summary.saem.mmkin.R b/R/summary.saem.mmkin.R index ea2f02e2..2754e9f0 100644 --- a/R/summary.saem.mmkin.R +++ b/R/summary.saem.mmkin.R @@ -176,9 +176,14 @@ summary.saem.mmkin <- function(object, data = FALSE, verbose = FALSE, distimes = object$verbose <- verbose object$fixed <- object$mmkin_orig[[1]]$fixed - object$AIC = AIC(object$so) - object$BIC = BIC(object$so) - object$logLik = logLik(object$so, method = "is") + ll <-try(logLik(object$so, method = "is"), silent = TRUE) + if (inherits(ll, "try-error")) { + object$logLik <- object$AIC <- object $BIC <- NA + } else { + object$logLik = logLik(object$so, method = "is") + object$AIC = AIC(object$so) + object$BIC = BIC(object$so) + } ep <- endpoints(object) if (length(ep$ff) != 0) |