aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
Diffstat (limited to 'R')
-rw-r--r--R/mhmkin.R28
-rw-r--r--R/status.R18
2 files changed, 32 insertions, 14 deletions
diff --git a/R/mhmkin.R b/R/mhmkin.R
index 6265a59e..14a7ac29 100644
--- a/R/mhmkin.R
+++ b/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))
+ }
}
diff --git a/R/status.R b/R/status.R
index 8bcd3a16..f9d79e7d 100644
--- a/R/status.R
+++ b/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")
+ }
}
}
}

Contact - Imprint