diff options
Diffstat (limited to 'R')
| -rw-r--r-- | R/illparms.R | 5 | ||||
| -rw-r--r-- | R/mhmkin.R | 16 | 
2 files changed, 13 insertions, 8 deletions
| diff --git a/R/illparms.R b/R/illparms.R index e4b28c56..c2f0263b 100644 --- a/R/illparms.R +++ b/R/illparms.R @@ -101,9 +101,12 @@ illparms.saem.mmkin <- function(object, conf.level = 0.95, random = TRUE, errmod  #' @rdname illparms  #' @export  illparms.mhmkin <- function(object, conf.level = 0.95, random = TRUE, errmod = TRUE, ...) { +  if (inherits(object[[1]], "saem.mmkin")) { +    check_failed <- function(x) if (inherits(x$so, "try-error")) TRUE else FALSE +  }    result <- lapply(object,      function(fit) { -      if (inherits(fit, "try-error")) return("E") +      if (check_failed(fit)) return("E")        ill <- illparms(fit, conf.level = conf.level, random = random, errmod = errmod)        if (length(ill) > 0) {          return(paste(ill, collapse = ", ")) @@ -140,13 +140,15 @@ print.mhmkin <- function(x, ...) {  convergence.mhmkin <- function(object, ...) {    all_summary_warnings <- character() -  result <- lapply(object, -    function(fit) { -      if (inherits(fit, "try-error")) return("E") -      else { -        return("OK") -      } -  }) +  if (inherits(object[[1]], "saem.mmkin")) { +    test_func <- function(fit) { +      if (inherits(fit$so, "try-error")) return("E") +      else return("OK") +    } +  } else { +    stop("Only mhmkin objects containing saem.mmkin objects currently supported") +  } +  result <- lapply(object, test_func)    result <- unlist(result)    dim(result) <- dim(object)    dimnames(result) <- dimnames(object) | 
