diff options
Diffstat (limited to 'R/convergence.R')
-rw-r--r-- | R/convergence.R | 71 |
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") -} |