diff options
| -rw-r--r-- | NEWS.md | 2 | ||||
| -rw-r--r-- | R/mkinfit.R | 6 | ||||
| -rw-r--r-- | R/mmkin.R | 53 |
3 files changed, 53 insertions, 8 deletions
@@ -1,5 +1,7 @@ # mkin 0.9.50.4 (unreleased) +- 'print' method for 'mmkin' objects + - 'saemix_model', 'saemix_data': Helper functions to fit nonlinear mixed-effects models for mmkin row objects using the saemix package # mkin 0.9.50.3 (2020-10-08) diff --git a/R/mkinfit.R b/R/mkinfit.R index ee7c0b99..65dd5d75 100644 --- a/R/mkinfit.R +++ b/R/mkinfit.R @@ -292,7 +292,7 @@ mkinfit <- function(mkinmod, observed, # Also remove zero values to avoid instabilities (e.g. of the 'tc' error model) if (any(observed$value == 0)) { zero_warning <- "Observations with value of zero were removed from the data" - summary_warnings <- c(summary_warnings, zero_warning) + summary_warnings <- c(summary_warnings, Z = zero_warning) warning(zero_warning) observed <- subset(observed, value != 0) } @@ -860,7 +860,7 @@ mkinfit <- function(mkinmod, observed, if (fit$convergence != 0) { convergence_warning = paste0("Optimisation did not converge:\n", fit$message) - summary_warnings <- c(summary_warnings, convergence_warning) + summary_warnings <- c(summary_warnings, C = convergence_warning) warning(convergence_warning) } else { if(!quiet) message("Optimisation successfully terminated.\n") @@ -938,7 +938,7 @@ mkinfit <- function(mkinmod, observed, if (fit$shapiro.p < 0.05) { shapiro_warning <- paste("Shapiro-Wilk test for standardized residuals: p = ", signif(fit$shapiro.p, 3)) warning(shapiro_warning) - summary_warnings <- c(summary_warnings, shapiro_warning) + summary_warnings <- c(summary_warnings, S = shapiro_warning) } fit$summary_warnings <- summary_warnings @@ -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 = "") + } + +} |