aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2022-10-13 03:48:54 +0200
committerJohannes Ranke <jranke@uni-bremen.de>2022-10-13 03:50:05 +0200
commit37bd36fe8a75163cbf0f97cb7a0e2f7466a53617 (patch)
tree96bbd9b61006731b3d295e517def3b66ecd959ef /R
parente7e8105390ebf3d6f034811bc7cce1d9640b7357 (diff)
Cope with failed FIM inversions
Diffstat (limited to 'R')
-rw-r--r--R/illparms.R18
-rw-r--r--R/mhmkin.R18
-rw-r--r--R/saem.R3
3 files changed, 29 insertions, 10 deletions
diff --git a/R/illparms.R b/R/illparms.R
index c2f0263b..931d8f05 100644
--- a/R/illparms.R
+++ b/R/illparms.R
@@ -106,12 +106,20 @@ illparms.mhmkin <- function(object, conf.level = 0.95, random = TRUE, errmod = T
}
result <- lapply(object,
function(fit) {
- 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 = ", "))
+ if (check_failed(fit)) {
+ return("E")
} else {
- return("")
+ if (!is.null(fit$FIM_failed) &&
+ "random effects and error model parameters" %in% fit$FIM_failed) {
+ return("NA")
+ } else {
+ ill <- illparms(fit, conf.level = conf.level, random = random, errmod = errmod)
+ if (length(ill) > 0) {
+ return(paste(ill, collapse = ", "))
+ } else {
+ return("")
+ }
+ }
}
})
result <- unlist(result)
diff --git a/R/mhmkin.R b/R/mhmkin.R
index 15c92f3c..2cf9ba06 100644
--- a/R/mhmkin.R
+++ b/R/mhmkin.R
@@ -138,12 +138,19 @@ print.mhmkin <- function(x, ...) {
#' @export
convergence.mhmkin <- function(object, ...) {
- all_summary_warnings <- character()
-
if (inherits(object[[1]], "saem.mmkin")) {
test_func <- function(fit) {
- if (inherits(fit$so, "try-error")) return("E")
- else return("OK")
+ if (inherits(fit$so, "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 = ", "))
+ } else {
+ return("OK")
+ }
+ }
}
} else {
stop("Only mhmkin objects containing saem.mmkin objects currently supported")
@@ -163,6 +170,9 @@ print.convergence.mhmkin <- function(x, ...) {
print(x, quote = FALSE)
cat("\n")
if (any(x == "OK")) cat("OK: Fit terminated successfully\n")
+ if (any(x == "Fth")) cat("Fth: Could not invert FIM for fixed effects\n")
+ if (any(x == "FO")) cat("FO: Could not invert FIM for random effects and error model parameters\n")
+ if (any(x == "Fth, FO")) cat("Fth, FO: Could not invert FIM for fixed effects, nor for random effects and error model parameters\n")
if (any(x == "E")) cat("E: Error\n")
}
diff --git a/R/saem.R b/R/saem.R
index 05cce682..99712c92 100644
--- a/R/saem.R
+++ b/R/saem.R
@@ -160,7 +160,7 @@ saem.mmkin <- function(object,
if (!fit_failed) {
if (any(is.na(f_saemix@results@se.fixed))) FIM_failed <- c(FIM_failed, "fixed effects")
if (any(is.na(c(f_saemix@results@se.omega, f_saemix@results@se.respar)))) {
- FIM_failed <- c(FIM_failed, "random effects and residual error parameters")
+ FIM_failed <- c(FIM_failed, "random effects and error model parameters")
}
if (!is.null(FIM_failed) & fail_with_errors) {
stop("Could not invert FIM for ", paste(FIM_failed, collapse = " and "))
@@ -208,6 +208,7 @@ saem.mmkin <- function(object,
so = f_saemix,
call = call,
time = fit_time,
+ FIM_failed = FIM_failed,
mean_dp_start = attr(m_saemix, "mean_dp_start"),
bparms.fixed = object[[1]]$bparms.fixed,
data = return_data,

Contact - Imprint