aboutsummaryrefslogtreecommitdiff
path: root/R/convergence.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2022-10-28 10:31:16 +0200
committerJohannes Ranke <jranke@uni-bremen.de>2022-10-28 10:31:16 +0200
commit4c868d65be04c8ee3fedc89d28d0e7d8c5da05e0 (patch)
tree6aa3123f7b722bcffdbdc06c06abe867726c8b91 /R/convergence.R
parent0e9220c6b9132602a3d69e4be582a02da8b07822 (diff)
Rename 'convergence' method to 'status'
The reason is that it is misleading in the case of saem.mmkin objects, because convergence is not really checked there.
Diffstat (limited to 'R/convergence.R')
-rw-r--r--R/convergence.R71
1 files changed, 0 insertions, 71 deletions
diff --git a/R/convergence.R b/R/convergence.R
deleted file mode 100644
index e75bb1b1..00000000
--- a/R/convergence.R
+++ /dev/null
@@ -1,71 +0,0 @@
-#' Method to get convergence information
-#'
-#' @param object The object to investigate
-#' @param x The object to be printed
-#' @param \dots For potential future extensions
-#' @return For [mkinfit] objects, a character vector containing
-#' For [mmkin] objects, an object of class 'convergence.mmkin' with a
-#' suitable printing method.
-#' @export
-convergence <- function(object, ...)
-{
- UseMethod("convergence", object)
-}
-
-#' @rdname convergence
-#' @export
-#' @examples
-#' \dontrun{
-#' fits <- mmkin(
-#' c("SFO", "FOMC"),
-#' list("FOCUS A" = FOCUS_2006_A,
-#' "FOCUS B" = FOCUS_2006_C),
-#' quiet = TRUE)
-#' convergence(fits)
-#' }
-convergence.mmkin <- function(object, ...) {
- all_summary_warnings <- character()
- sww <- 0 # Counter for Shapiro-Wilks warnings
-
- result <- lapply(object,
- function(fit) {
- if (inherits(fit, "try-error")) return("E")
- sw <- fit$summary_warnings
- swn <- names(sw)
- if (length(sw) > 0) {
- if (any(grepl("S", swn))) {
- sww <<- sww + 1
- swn <- gsub("S", paste0("S", sww), swn)
- }
- warnstring <- paste(swn, collapse = ", ")
- names(sw) <- swn
- all_summary_warnings <<- c(all_summary_warnings, sw)
- return(warnstring)
- } else {
- return("OK")
- }
- })
- result <- unlist(result)
- dim(result) <- dim(object)
- dimnames(result) <- dimnames(object)
-
- u_swn <- unique(names(all_summary_warnings))
- attr(result, "unique_warnings") <- all_summary_warnings[u_swn]
- class(result) <- "convergence.mmkin"
- return(result)
-}
-
-#' @rdname convergence
-#' @export
-print.convergence.mmkin <- function(x, ...) {
- u_w <- attr(x, "unique_warnings")
- attr(x, "unique_warnings") <- NULL
- class(x) <- NULL
- print(x, quote = FALSE)
- cat("\n")
- for (i in seq_along(u_w)) {
- cat(names(u_w)[i], ": ", u_w[i], "\n", sep = "")
- }
- if (any(x == "OK")) cat("OK: No warnings\n")
- if (any(x == "E")) cat("E: Error\n")
-}

Contact - Imprint