Printing method for mmkin objects

1 files changed, 48 insertions, 5 deletions

diff --git a/R/mmkin.R b/R/mmkin.R
index d879fec4..6f088de0 100644
--- a/R/mmkin.R
+++ b/R/mmkin.R
@@ -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 = "")
+  }
+
+}