diff options
Diffstat (limited to 'R')
-rw-r--r-- | R/mhmkin.R | 28 | ||||
-rw-r--r-- | R/status.R | 18 |
2 files changed, 32 insertions, 14 deletions
@@ -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)) + } } @@ -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") + } } } } |