diff options
author | Johannes Ranke <jranke@uni-bremen.de> | 2022-11-04 10:54:43 +0100 |
---|---|---|
committer | Johannes Ranke <jranke@uni-bremen.de> | 2022-11-04 10:54:43 +0100 |
commit | ce7a20e54d8005264f13d3e9fe0c99f84d20b85e (patch) | |
tree | 50e3ca40c5c13bb93495e4e1f2080e2e7db52439 | |
parent | 0389d523f049945c85eba42d4a006523595043f0 (diff) |
Make illparms.mhmkin and anova.saem.mmkin more robust
-rw-r--r-- | R/anova.saem.mmkin.R | 5 | ||||
-rw-r--r-- | R/illparms.R | 18 | ||||
-rw-r--r-- | R/mhmkin.R | 3 |
3 files changed, 14 insertions, 12 deletions
diff --git a/R/anova.saem.mmkin.R b/R/anova.saem.mmkin.R index e506fb8b..00ddc0c3 100644 --- a/R/anova.saem.mmkin.R +++ b/R/anova.saem.mmkin.R @@ -30,9 +30,10 @@ anova.saem.mmkin <- function(object, ..., is_model <- sapply(dots, is, "saem.mmkin") if (any(is_model)) { mods <- c(list(object), dots[is_model]) + successful <- sapply(mods, function(x) !inherits(x$so, "try-error")) # Ensure same data, ignoring covariates - same_data <- sapply(dots[is_model], function(x) { + same_data <- sapply(mods[successful], function(x) { identical(object$data[c("ds", "name", "time", "value")], x$data[c("ds", "name", "time", "value")]) }) @@ -56,7 +57,7 @@ anova.saem.mmkin <- function(object, ..., } names(mods) <- model.names - llks <- lapply(model.names, function(x) { + llks <- lapply(model.names[successful], function(x) { llk <- try(logLik(mods[[x]], method = method)) if (inherits(llk, "try-error")) stop("Could not obtain log likelihood with '", method, "' method for ", x) diff --git a/R/illparms.R b/R/illparms.R index c9a4f854..01e75cf1 100644 --- a/R/illparms.R +++ b/R/illparms.R @@ -93,22 +93,22 @@ print.illparms.mmkin <- function(x, ...) { #' @rdname illparms #' @export illparms.saem.mmkin <- function(object, conf.level = 0.95, random = TRUE, errmod = TRUE, ...) { - if (inherits(object, "try-error")) { - failed <- NA + if (inherits(object$so, "try-error")) { + ill_parms <- NA } else { ints <- intervals(object, conf.level = conf.level) - failed <- character(0) + ill_parms <- character(0) if (random) { - failed_random <- ints$random[, "lower"] < 0 - failed <- c(failed, names(which(failed_random))) + ill_parms_random <- ints$random[, "lower"] < 0 + ill_parms <- c(ill_parms, names(which(ill_parms_random))) } if (errmod) { - failed_errmod <- ints$errmod[, "lower"] < 0 & ints$errmod[, "est."] > 0 - failed <- c(failed, names(which(failed_errmod))) + ill_parms_errmod <- ints$errmod[, "lower"] < 0 & ints$errmod[, "est."] > 0 + ill_parms <- c(ill_parms, names(which(ill_parms_errmod))) } } - class(failed) <- "illparms.saem.mmkin" - return(failed) + class(ill_parms) <- "illparms.saem.mmkin" + return(ill_parms) } #' @rdname illparms @@ -207,6 +207,7 @@ 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, model.names = model.names)) + rlang::inject(anova(!!!(object), method = method, test = test, + model.names = model.names)) } |