diff options
Diffstat (limited to 'R/mmkin.R')
| -rw-r--r-- | R/mmkin.R | 53 |
1 files changed, 48 insertions, 5 deletions
@@ -100,9 +100,9 @@ mmkin <- function(models = c("SFO", "FOMC", "DFOP"), datasets, } if (is.null(cluster)) { - results <- mclapply(as.list(1:n.fits), fit_function, mc.cores = cores) + results <- parallel::mclapply(as.list(1:n.fits), fit_function, mc.cores = cores) } else { - results <- parLapply(cluster, as.list(1:n.fits), fit_function) + results <- parallel::parLapply(cluster, as.list(1:n.fits), fit_function) } attributes(results) <- attributes(fit_indices) @@ -112,8 +112,6 @@ mmkin <- function(models = c("SFO", "FOMC", "DFOP"), datasets, #' Subsetting method for mmkin objects #' -#' Subsetting method for mmkin objects. -#' #' @param x An \code{\link{mmkin} object} #' @param i Row index selecting the fits for specific models #' @param j Column index selecting the fits to specific datasets @@ -136,7 +134,6 @@ mmkin <- function(models = c("SFO", "FOMC", "DFOP"), datasets, #' # This extracts an mkinfit object with lots of components #' fits[["FOMC", "B"]] #' ) -#' #' @export `[.mmkin` <- function(x, i, j, ..., drop = FALSE) { class(x) <- NULL @@ -144,3 +141,49 @@ mmkin <- function(models = c("SFO", "FOMC", "DFOP"), datasets, if (!drop) class(x_sub) <- "mmkin" return(x_sub) } + +#' Print method for mmkin objects +#' +#' @param x An [mmkin] object. +#' @param \dots Not used. +#' @export +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 + + x_t <- t(x) # To make lapply work by rows + display <- lapply(x_t, + 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 = "") + } + +} |