From e6f9e9ca89e35e610d9895b979f1351a47451db0 Mon Sep 17 00:00:00 2001
From: Johannes Ranke <jranke@uni-bremen.de>
Date: Fri, 29 May 2020 16:05:11 +0200
Subject: Improve handling of warnings, reorganize tests

---
 R/mkinfit.R | 27 ++++++++++++++++++++-------
 1 file changed, 20 insertions(+), 7 deletions(-)

(limited to 'R/mkinfit.R')

diff --git a/R/mkinfit.R b/R/mkinfit.R
index d7b1b7f4..ec2d3412 100644
--- a/R/mkinfit.R
+++ b/R/mkinfit.R
@@ -233,7 +233,7 @@ if(getRversion() >= '2.15.1') utils::globalVariables(c("name", "time", "value"))
 #' fit.FOMC = mkinfit("FOMC", FOCUS_2006_D, quiet = TRUE, error_model = "tc")
 #' fit.FOMC_SFO <- mkinfit(FOMC_SFO, FOCUS_D, quiet = TRUE,
 #'   parms.ini = fit.FOMC$bparms.ode, error_model = "tc")
-#'
+#' }
 #' @export
 mkinfit <- function(mkinmod, observed,
   parms.ini = "auto",
@@ -258,6 +258,8 @@ mkinfit <- function(mkinmod, observed,
 {
   call <- match.call()
 
+  summary_warnings <- character()
+
   # Derive the name used for the model
   if (is.character(mkinmod)) mkinmod_name <- mkinmod
   else mkinmod_name <- deparse(substitute(mkinmod))
@@ -289,7 +291,9 @@ mkinfit <- function(mkinmod, observed,
 
   # Also remove zero values to avoid instabilities (e.g. of the 'tc' error model)
   if (any(observed$value == 0)) {
-    warning("Observations with value of zero were removed from the data")
+    zero_warning <- "Observations with value of zero were removed from the data"
+    summary_warnings <- c(summary_warnings, zero_warning)
+    warning(zero_warning)
     observed <- subset(observed, value != 0)
   }
 
@@ -848,8 +852,9 @@ mkinfit <- function(mkinmod, observed,
   fit$error_model_algorithm <- error_model_algorithm
 
   if (fit$convergence != 0) {
-    fit$warning = paste0("Optimisation did not converge:\n", fit$message)
-    warning(fit$warning)
+    convergence_warning = paste0("Optimisation did not converge:\n", fit$message)
+    summary_warnings <- c(warnings, convergence_warning)
+    warning(convergence_warning)
   } else {
     if(!quiet) message("Optimisation successfully terminated.\n")
   }
@@ -918,14 +923,22 @@ mkinfit <- function(mkinmod, observed,
   fit$errparms <- errparms
   fit$df.residual <- n_observed - length(c(degparms, errparms))
 
+  # Assign the class here so method dispatch works for residuals
+  class(fit) <- c("mkinfit")
+
   # Check for normal distribution of residuals
-  fit$shapiro.p <- shapiro.test(residuals.mkinfit(fit, standardized = TRUE))$p.value
-  if (fit$shapiro.p < 0.05) warning("The p-value for the Shapiro-Wilk test of normality on standardized residuals is < 0.05")
+  fit$shapiro.p <- shapiro.test(residuals(fit, standardized = TRUE))$p.value
+  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)
+  }
+
+  fit$summary_warnings <- summary_warnings
 
   fit$date <- date()
   fit$version <- as.character(utils::packageVersion("mkin"))
   fit$Rversion <- paste(R.version$major, R.version$minor, sep=".")
 
-  class(fit) <- c("mkinfit")
   return(fit)
 }
-- 
cgit v1.2.1