aboutsummaryrefslogtreecommitdiff
path: root/R
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 /R
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.
Diffstat (limited to 'R')
-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