aboutsummaryrefslogtreecommitdiff
path: root/R/convergence.R
diff options
context:
space:
mode:
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