aboutsummaryrefslogtreecommitdiff
path: root/R/mmkin.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2022-07-21 17:15:12 +0200
committerJohannes Ranke <jranke@uni-bremen.de>2022-07-21 17:43:16 +0200
commitb703ee38ffc8877be843cf5a557dd9c32c54f977 (patch)
tree4da8adf610a1e431f514efc256f44bb7abdec4ca /R/mmkin.R
parentad6ef5013dce7ef1ef9bbcadbd278b71da9b6f72 (diff)
Summary method for mmkin objects
Also, add a method for gathering convergence information and a method for gathering information on ill-defined parameters
Diffstat (limited to 'R/mmkin.R')
-rw-r--r--R/mmkin.R51
1 files changed, 10 insertions, 41 deletions
diff --git a/R/mmkin.R b/R/mmkin.R
index fe04129e..247fd5fa 100644
--- a/R/mmkin.R
+++ b/R/mmkin.R
@@ -114,15 +114,18 @@ mmkin <- function(models = c("SFO", "FOMC", "DFOP"), datasets,
return(res)
}
- if (is.null(cluster)) {
- results <- parallel::mclapply(as.list(1:n.fits), fit_function,
- mc.cores = cores, mc.preschedule = FALSE)
- } else {
- results <- parallel::parLapply(cluster, as.list(1:n.fits), fit_function)
- }
+ fit_time <- system.time({
+ if (is.null(cluster)) {
+ results <- parallel::mclapply(as.list(1:n.fits), fit_function,
+ mc.cores = cores, mc.preschedule = FALSE)
+ } else {
+ results <- parallel::parLapply(cluster, as.list(1:n.fits), fit_function)
+ }
+ })
attributes(results) <- attributes(fit_indices)
attr(results, "call") <- call
+ attr(results, "time") <- fit_time
class(results) <- "mmkin"
return(results)
}
@@ -168,41 +171,7 @@ mmkin <- function(models = c("SFO", "FOMC", "DFOP"), datasets,
print.mmkin <- function(x, ...) {
cat("<mmkin> object\n")
cat("Status of individual fits:\n\n")
- all_summary_warnings <- character()
- sww <- 0 # Counter for Shapiro-Wilks warnings
-
- display <- lapply(x,
- 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")
- }
- })
- display <- unlist(display)
- dim(display) <- dim(x)
- dimnames(display) <- dimnames(x)
- print(display, quote = FALSE)
-
- cat("\n")
- if (any(display == "OK")) cat("OK: No warnings\n")
- if (any(display == "E")) cat("E: Error\n")
- u_swn <- unique(names(all_summary_warnings))
- u_w <- all_summary_warnings[u_swn]
- for (i in seq_along(u_w)) {
- cat(names(u_w)[i], ": ", u_w[i], "\n", sep = "")
- }
-
+ print(convergence(x))
}
#' @export

Contact - Imprint