aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2022-11-07 05:58:50 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2022-11-07 05:58:50 +0100
commitb9b3c72cf076ce0393aa53a4d723a195b856c99c (patch)
tree7ba083b0f6e4f0241d4224fe074ac7138fafb609
parent7ec1454c0a0c89987644bbe1981716595d4f1f4b (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.R15
-rw-r--r--R/summary.saem.mmkin.R11
2 files changed, 18 insertions, 8 deletions
diff --git a/R/saem.R b/R/saem.R
index 1c54ed93..09a4832f 100644
--- a/R/saem.R
+++ b/R/saem.R
@@ -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)

Contact - Imprint