aboutsummaryrefslogtreecommitdiff
path: root/R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2022-10-28 11:59:54 +0200
committerJohannes Ranke <jranke@uni-bremen.de>2022-10-28 11:59:54 +0200
commitb1740ade9a1746ccdb325b95915ef88872489f03 (patch)
tree7f39227fda408ce2f788dd9481266167fb87505e /R
parent782bb645325efa8d1d1f971370478fd369b0a107 (diff)
Export status method for mhmkin, move to status.R
Diffstat (limited to 'R')
-rw-r--r--R/mhmkin.R39
-rw-r--r--R/status.R43
2 files changed, 43 insertions, 39 deletions
diff --git a/R/mhmkin.R b/R/mhmkin.R
index 47b84b9d..7f3ff9fa 100644
--- a/R/mhmkin.R
+++ b/R/mhmkin.R
@@ -136,45 +136,6 @@ print.mhmkin <- function(x, ...) {
print(status(x))
}
-status.mhmkin <- function(object, ...) {
- if (inherits(object[[1]], "saem.mmkin")) {
- test_func <- function(fit) {
- 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")
- }
- result <- lapply(object, test_func)
- result <- unlist(result)
- dim(result) <- dim(object)
- dimnames(result) <- dimnames(object)
-
- class(result) <- "status.mhmkin"
- return(result)
-}
-
-#' @export
-print.status.mhmkin <- function(x, ...) {
- class(x) <- NULL
- 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")
-}
-
#' @export
AIC.mhmkin <- function(object, ..., k = 2) {
if (inherits(object[[1]], "saem.mmkin")) {
diff --git a/R/status.R b/R/status.R
index 44d2a9bc..8bcd3a16 100644
--- a/R/status.R
+++ b/R/status.R
@@ -68,3 +68,46 @@ print.status.mmkin <- function(x, ...) {
if (any(x == "OK")) cat("OK: No warnings\n")
if (any(x == "E")) cat("E: Error\n")
}
+
+#' @rdname status
+#' @export
+status.mhmkin <- function(object, ...) {
+ if (inherits(object[[1]], "saem.mmkin")) {
+ test_func <- function(fit) {
+ 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")
+ }
+ result <- lapply(object, test_func)
+ result <- unlist(result)
+ dim(result) <- dim(object)
+ dimnames(result) <- dimnames(object)
+
+ class(result) <- "status.mhmkin"
+ return(result)
+}
+
+#' @rdname status
+#' @export
+print.status.mhmkin <- function(x, ...) {
+ class(x) <- NULL
+ 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")
+}
+

Contact - Imprint