Fix tests, try FOMC ill-defined again

4 files changed, 243 insertions, 37 deletions

diff --git a/test.log b/test.log
index 935df857..3593b2a7 100644
--- a/test.log
+++ b/test.log
@@ -9,14 +9,218 @@ Testing mkin
 Calculation of FOCUS chi2 error levels: ..
 Results for FOCUS D established in expertise for UBA (Ranke 2014): ......
 The t-test for significant difference from zero: ..
-Fitting the FOMC model with large parameter correlation: S
+Fitting the FOMC model with large parameter correlation: Model cost at call  1 :  2154.97 
+Model cost at call  2 :  2154.97 
+Model cost at call  4 :  2154.97 
+Model cost at call  5 :  388.1874 
+Model cost at call  9 :  198.5808 
+Model cost at call  10 :  198.5806 
+Model cost at call  13 :  167.315 
+Model cost at call  15 :  167.315 
+Model cost at call  17 :  122.5165 
+Model cost at call  21 :  110.3697 
+Model cost at call  25 :  99.37279 
+Model cost at call  26 :  99.37279 
+Model cost at call  29 :  85.86611 
+Model cost at call  30 :  85.86609 
+Model cost at call  33 :  83.79827 
+Model cost at call  35 :  83.79825 
+Model cost at call  37 :  77.76253 
+Model cost at call  39 :  77.76252 
+Model cost at call  40 :  77.76252 
+Model cost at call  41 :  74.85232 
+Model cost at call  45 :  71.0713 
+Model cost at call  49 :  69.0689 
+Model cost at call  53 :  65.69063 
+Model cost at call  54 :  65.69063 
+Model cost at call  57 :  63.81175 
+Model cost at call  58 :  63.81174 
+Model cost at call  61 :  61.77925 
+Model cost at call  65 :  60.68903 
+Model cost at call  69 :  58.787 
+Model cost at call  73 :  57.79498 
+Model cost at call  77 :  56.72184 
+Model cost at call  78 :  56.72184 
+Model cost at call  81 :  56.27078 
+Model cost at call  82 :  56.27077 
+Model cost at call  85 :  55.76643 
+Model cost at call  89 :  55.06746 
+Model cost at call  93 :  54.77276 
+Model cost at call  97 :  54.46435 
+Model cost at call  101 :  53.97206 
+Model cost at call  105 :  53.7466 
+Model cost at call  109 :  53.45331 
+Model cost at call  113 :  53.15008 
+Model cost at call  117 :  52.8698 
+Model cost at call  122 :  52.79044 
+Model cost at call  126 :  52.64587 
+Model cost at call  127 :  52.56412 
+Model cost at call  131 :  52.37304 
+Model cost at call  135 :  52.29005 
+Model cost at call  139 :  52.20652 
+Model cost at call  143 :  52.05187 
+Model cost at call  147 :  51.95367 
+Model cost at call  151 :  51.80296 
+Model cost at call  152 :  51.80296 
+Model cost at call  153 :  51.80296 
+Model cost at call  155 :  51.79287 
+Model cost at call  156 :  51.79286 
+Model cost at call  157 :  51.79286 
+Model cost at call  159 :  51.71749 
+Model cost at call  163 :  51.69885 
+Model cost at call  164 :  51.66416 
+Model cost at call  169 :  51.61289 
+Model cost at call  173 :  51.5739 
+Model cost at call  177 :  51.5122 
+Model cost at call  181 :  51.44598 
+Model cost at call  185 :  51.42107 
+Model cost at call  189 :  51.37519 
+Model cost at call  193 :  51.32105 
+Model cost at call  194 :  51.32105 
+Model cost at call  195 :  51.32105 
+Model cost at call  197 :  51.29233 
+Model cost at call  199 :  51.29233 
+Model cost at call  200 :  51.29233 
+Model cost at call  202 :  51.27541 
+Model cost at call  206 :  51.24732 
+Model cost at call  210 :  51.20348 
+Model cost at call  214 :  51.1884 
+Model cost at call  218 :  51.15654 
+Model cost at call  222 :  51.12473 
+Model cost at call  226 :  51.1093 
+Model cost at call  230 :  51.09604 
+Model cost at call  234 :  51.07288 
+Model cost at call  238 :  51.04678 
+Model cost at call  243 :  51.03801 
+Model cost at call  247 :  51.02297 
+Model cost at call  248 :  51.01588 
+Model cost at call  252 :  50.99353 
+Model cost at call  253 :  50.99353 
+Model cost at call  254 :  50.99353 
+Model cost at call  256 :  50.98775 
+Model cost at call  257 :  50.97537 
+Model cost at call  258 :  50.97537 
+Model cost at call  259 :  50.97537 
+Model cost at call  260 :  50.97537 
+Model cost at call  262 :  50.97142 
+Model cost at call  266 :  50.96632 
+Model cost at call  272 :  50.9654 
+Model cost at call  276 :  50.96385 
+Model cost at call  279 :  50.96385 
+Model cost at call  284 :  50.96354 
+Model cost at call  286 :  50.96354 
+Model cost at call  290 :  50.96292 
+Model cost at call  293 :  50.96292 
+Model cost at call  298 :  50.9628 
+Model cost at call  300 :  50.9628 
+Model cost at call  305 :  50.96277 
+Model cost at call  307 :  50.96277 
+Model cost at call  312 :  50.96277 
+Model cost at call  314 :  50.96277 
+Model cost at call  318 :  50.96276 
+Model cost at call  321 :  50.96276 
+Model cost at call  326 :  50.96276 
+Model cost at call  328 :  50.96276 
+Model cost at call  332 :  50.96275 
+Model cost at call  333 :  50.96274 
+Model cost at call  336 :  50.96274 
+Model cost at call  337 :  50.96274 
+Model cost at call  342 :  50.96274 
+Model cost at call  344 :  50.96274 
+Model cost at call  348 :  50.96274 
+Model cost at call  351 :  50.96274 
+Model cost at call  357 :  50.96274 
+Model cost at call  359 :  50.96274 
+Model cost at call  363 :  50.96274 
+Model cost at call  364 :  50.96274 
+Model cost at call  367 :  50.96274 
+Model cost at call  375 :  50.96274 
+Model cost at call  381 :  50.96274 
+Model cost at call  388 :  50.96274 
+Model cost at call  452 :  50.96274 
+.Model cost at call  1 :  2154.97 
+Model cost at call  3 :  2154.97 
+Model cost at call  5 :  2154.97 
+Model cost at call  6 :  716.4083 
+Model cost at call  8 :  716.4082 
+Model cost at call  11 :  136.1354 
+Model cost at call  12 :  136.1354 
+Model cost at call  15 :  64.35183 
+Model cost at call  16 :  64.35183 
+Model cost at call  20 :  61.48715 
+Model cost at call  22 :  61.48715 
+Model cost at call  24 :  59.59792 
+Model cost at call  26 :  59.59792 
+Model cost at call  28 :  57.47603 
+Model cost at call  30 :  57.47603 
+Model cost at call  32 :  57.10469 
+Model cost at call  34 :  57.10468 
+Model cost at call  36 :  54.78942 
+Model cost at call  38 :  54.78942 
+Model cost at call  40 :  54.29399 
+Model cost at call  42 :  54.29399 
+Model cost at call  44 :  53.55295 
+Model cost at call  46 :  53.55294 
+Model cost at call  49 :  53.10239 
+Model cost at call  51 :  53.10239 
+Model cost at call  53 :  52.95095 
+Model cost at call  55 :  52.95095 
+Model cost at call  57 :  52.41198 
+Model cost at call  59 :  52.41198 
+Model cost at call  61 :  52.24816 
+Model cost at call  63 :  52.24816 
+Model cost at call  65 :  51.99669 
+Model cost at call  67 :  51.99669 
+Model cost at call  69 :  51.82092 
+Model cost at call  71 :  51.82092 
+Model cost at call  74 :  51.69389 
+Model cost at call  76 :  51.69389 
+Model cost at call  78 :  51.64468 
+Model cost at call  80 :  51.64468 
+Model cost at call  82 :  51.46367 
+Model cost at call  84 :  51.46366 
+Model cost at call  86 :  51.407 
+Model cost at call  88 :  51.407 
+Model cost at call  90 :  51.30871 
+Model cost at call  92 :  51.30871 
+Model cost at call  94 :  51.23556 
+Model cost at call  96 :  51.23556 
+Model cost at call  98 :  51.17829 
+Model cost at call  100 :  51.17829 
+Model cost at call  103 :  51.13498 
+Model cost at call  105 :  51.13498 
+Model cost at call  107 :  51.11419 
+Model cost at call  109 :  51.11419 
+Model cost at call  111 :  51.05405 
+Model cost at call  113 :  51.05405 
+Model cost at call  115 :  51.0096 
+Model cost at call  117 :  51.0096 
+Model cost at call  119 :  50.97496 
+Model cost at call  121 :  50.97496 
+Model cost at call  125 :  50.96419 
+Model cost at call  126 :  50.96419 
+Model cost at call  129 :  50.96365 
+Model cost at call  131 :  50.96365 
+Model cost at call  134 :  50.96354 
+Model cost at call  136 :  50.96354 
+Model cost at call  138 :  50.96333 
+Model cost at call  140 :  50.96333 
+Model cost at call  142 :  50.9629 
+Model cost at call  144 :  50.9629 
+Model cost at call  147 :  50.96282 
+Model cost at call  149 :  50.96282 
+Model cost at call  152 :  50.9628 
+Model cost at call  156 :  50.96277 
+Model cost at call  161 :  50.96276 
+Model cost at call  165 :  50.96275 
+Model cost at call  170 :  50.96274 
+Model cost at call  175 :  50.96274 
+Optimisation by method Marq successfully terminated.
+.
 Model predictions with mkinpredict: ...
-Fitting of parent only models: .....................
+Fitting of parent only models: ......................
 Complex test case from Schaefer et al. (2007) Piacenza paper: ..
 Results for synthetic data established in expertise for UBA (Ranke 2014): ....
 Calculation of maximum time weighted average concentrations (TWAs): ...
 
-Skipped ------------------------------------------------------------------------
-1. Fitting with large parameter correlation gives warnings (@test_FOMC_ill-defined.R#30) - Skip test for warnings triggered by large parameter correlation as it failed on r-forge
-
 DONE ===========================================================================
diff --git a/tests/testthat/test_FOMC_ill-defined.R b/tests/testthat/test_FOMC_ill-defined.R
index 3ca8a99e..ee3d2b68 100644
--- a/tests/testthat/test_FOMC_ill-defined.R
+++ b/tests/testthat/test_FOMC_ill-defined.R
@@ -27,7 +27,7 @@ FOMC_test <- data.frame(
 
 test_that("Fitting with large parameter correlation gives warnings", {
 
-  skip("Skip test for warnings triggered by large parameter correlation as it failed on r-forge")
+  #skip("Skip test for warnings triggered by large parameter correlation as it failed on r-forge")
 
   # When fitting from the maximum, the Port algorithm does not converge (with
   # default settings)
diff --git a/tests/testthat/test_parent_only.R b/tests/testthat/test_parent_only.R
index 5dcf297c..1d100cca 100644
--- a/tests/testthat/test_parent_only.R
+++ b/tests/testthat/test_parent_only.R
@@ -23,7 +23,7 @@ calc_dev.percent <- function(fitlist, reference, endpoints = TRUE, round_results
   for (i in 1:length(fitlist)) {
     fit <- fitlist[[i]]
     if (endpoints) {
-      results <- c(fit$bparms.optim, 
+      results <- c(fit$bparms.optim,
                    endpoints(fit)$distimes$DT50,
                    endpoints(fit)$distimes$DT90)
     } else {
@@ -44,21 +44,23 @@ SFORB <- mkinmod(parent = list(type = "SFORB"))
 test_that("Fits for FOCUS A deviate less than 0.1% from median of values from FOCUS report", {
   fit.A.SFO <- list(mkinfit("SFO", FOCUS_2006_A, quiet = TRUE))
 
-  median.A.SFO <- as.numeric(lapply(subset(FOCUS_2006_SFO_ref_A_to_F, 
-                                        dataset == "A", 
+  median.A.SFO <- as.numeric(lapply(subset(FOCUS_2006_SFO_ref_A_to_F,
+                                        dataset == "A",
                                         c(M0, k, DT50, DT90)), "median"))
 
   dev.percent.A.SFO <- calc_dev.percent(fit.A.SFO, median.A.SFO)
   expect_equivalent(dev.percent.A.SFO[[1]] < 0.1, rep(TRUE, 4))
 
   # Fitting FOCUS A with FOMC is possible, but the correlation between
-  # alpha and beta, when obtained, is 1.0000, and the fit sometimes failed on
-  # Windows, as the Port algorithm did not converge (winbuilder, 2015-05-15)
-  fit.A.FOMC <- try(list(mkinfit("FOMC", FOCUS_2006_A, quiet = TRUE)))
+  # alpha and beta, when obtained, is 1.0000, and the fit does not
+  # converge using the Port algorithm, which yields a warning
+  expect_warning(
+    fit.A.FOMC <- try(list(mkinfit("FOMC", FOCUS_2006_A, quiet = TRUE))))
+
   if (!inherits(fit.A.FOMC, "try-error")) {
 
-    median.A.FOMC <- as.numeric(lapply(subset(FOCUS_2006_FOMC_ref_A_to_F, 
-                                          dataset == "A", 
+    median.A.FOMC <- as.numeric(lapply(subset(FOCUS_2006_FOMC_ref_A_to_F,
+                                          dataset == "A",
                                           c(M0, alpha, beta, DT50, DT90)), "median"))
 
     dev.percent.A.FOMC <- calc_dev.percent(fit.A.FOMC, median.A.FOMC)
@@ -68,8 +70,8 @@ test_that("Fits for FOCUS A deviate less than 0.1% from median of values from FO
 
   fit.A.DFOP <- list(mkinfit("DFOP", FOCUS_2006_A, quiet = TRUE))
 
-  median.A.DFOP <- as.numeric(lapply(subset(FOCUS_2006_DFOP_ref_A_to_B, 
-                                        dataset == "A", 
+  median.A.DFOP <- as.numeric(lapply(subset(FOCUS_2006_DFOP_ref_A_to_B,
+                                        dataset == "A",
                                         c(M0, k1, k2, f, DT50, DT90)), "median"))
 
   dev.percent.A.DFOP <- calc_dev.percent(fit.A.DFOP, median.A.DFOP)
@@ -78,8 +80,8 @@ test_that("Fits for FOCUS A deviate less than 0.1% from median of values from FO
 
   fit.A.HS <- list(mkinfit("HS", FOCUS_2006_A, quiet = TRUE))
 
-  median.A.HS <- as.numeric(lapply(subset(FOCUS_2006_HS_ref_A_to_F, 
-                                        dataset == "A", 
+  median.A.HS <- as.numeric(lapply(subset(FOCUS_2006_HS_ref_A_to_F,
+                                        dataset == "A",
                                         c(M0, k1, k2, tb, DT50, DT90)), "median"))
 
   dev.percent.A.HS <- calc_dev.percent(fit.A.HS, median.A.HS)
@@ -89,8 +91,8 @@ test_that("Fits for FOCUS A deviate less than 0.1% from median of values from FO
 test_that("Fits for FOCUS B deviate less than 0.1% from median of values from FOCUS report", {
   fit.B.SFO <- list(mkinfit("SFO", FOCUS_2006_B, quiet = TRUE))
 
-  median.B.SFO <- as.numeric(lapply(subset(FOCUS_2006_SFO_ref_A_to_F, 
-                                        dataset == "B", 
+  median.B.SFO <- as.numeric(lapply(subset(FOCUS_2006_SFO_ref_A_to_F,
+                                        dataset == "B",
                                         c(M0, k, DT50, DT90)), "median"))
 
   dev.percent.B.SFO <- calc_dev.percent(fit.B.SFO, median.B.SFO)
@@ -98,8 +100,8 @@ test_that("Fits for FOCUS B deviate less than 0.1% from median of values from FO
 
   fit.B.FOMC <- list(mkinfit("FOMC", FOCUS_2006_B, quiet = TRUE))
 
-  median.B.FOMC <- as.numeric(lapply(subset(FOCUS_2006_FOMC_ref_A_to_F, 
-                                        dataset == "B", 
+  median.B.FOMC <- as.numeric(lapply(subset(FOCUS_2006_FOMC_ref_A_to_F,
+                                        dataset == "B",
                                         c(M0, alpha, beta, DT50, DT90)), "median"))
 
   dev.percent.B.FOMC <- calc_dev.percent(fit.B.FOMC, median.B.FOMC)
@@ -107,8 +109,8 @@ test_that("Fits for FOCUS B deviate less than 0.1% from median of values from FO
 
   fit.B.DFOP <- list(mkinfit("DFOP", FOCUS_2006_B, quiet = TRUE))
 
-  median.B.DFOP <- as.numeric(lapply(subset(FOCUS_2006_DFOP_ref_A_to_B, 
-                                        dataset == "B", 
+  median.B.DFOP <- as.numeric(lapply(subset(FOCUS_2006_DFOP_ref_A_to_B,
+                                        dataset == "B",
                                         c(M0, k1, k2, f, DT50, DT90)), "median"))
 
   dev.percent.B.DFOP <- calc_dev.percent(fit.B.DFOP, median.B.DFOP)
@@ -117,9 +119,9 @@ test_that("Fits for FOCUS B deviate less than 0.1% from median of values from FO
 
   fit.B.HS <- list(mkinfit("HS", FOCUS_2006_B, quiet = TRUE))
 
-  median.B.HS <- as.numeric(lapply(subset(FOCUS_2006_HS_ref_A_to_F, 
-                                        dataset == "B", 
-                                        c(M0, k1, k2, tb, DT50, DT90)), 
+  median.B.HS <- as.numeric(lapply(subset(FOCUS_2006_HS_ref_A_to_F,
+                                        dataset == "B",
+                                        c(M0, k1, k2, tb, DT50, DT90)),
                                    "median", na.rm = TRUE))
 
   dev.percent.B.HS <- calc_dev.percent(fit.B.HS, median.B.HS)
@@ -133,8 +135,8 @@ test_that("Fits for FOCUS B deviate less than 0.1% from median of values from FO
 test_that("Fits for FOCUS C deviate less than 0.1% from median of values from FOCUS report", {
   fit.C.SFO <- list(mkinfit("SFO", FOCUS_2006_C, quiet = TRUE))
 
-  median.C.SFO <- as.numeric(lapply(subset(FOCUS_2006_SFO_ref_A_to_F, 
-                                        dataset == "C", 
+  median.C.SFO <- as.numeric(lapply(subset(FOCUS_2006_SFO_ref_A_to_F,
+                                        dataset == "C",
                                         c(M0, k, DT50, DT90)), "median"))
 
   dev.percent.C.SFO <- calc_dev.percent(fit.C.SFO, median.C.SFO)
@@ -142,18 +144,18 @@ test_that("Fits for FOCUS C deviate less than 0.1% from median of values from FO
 
   fit.C.FOMC <- list(mkinfit("FOMC", FOCUS_2006_C, quiet = TRUE))
 
-  median.C.FOMC <- as.numeric(lapply(subset(FOCUS_2006_FOMC_ref_A_to_F, 
-                                        dataset == "C", 
+  median.C.FOMC <- as.numeric(lapply(subset(FOCUS_2006_FOMC_ref_A_to_F,
+                                        dataset == "C",
                                         c(M0, alpha, beta, DT50, DT90)), "median"))
 
-  dev.percent.C.FOMC <- calc_dev.percent(fit.C.FOMC, median.C.FOMC, 
+  dev.percent.C.FOMC <- calc_dev.percent(fit.C.FOMC, median.C.FOMC,
                                          round_results = 2) # Not enough precision in FOCUS results
   expect_equivalent(dev.percent.C.FOMC[[1]] < 0.1, rep(TRUE, 5))
 
   fit.C.HS <- list(mkinfit("HS", FOCUS_2006_C, quiet = TRUE))
 
-  median.C.HS <- as.numeric(lapply(subset(FOCUS_2006_HS_ref_A_to_F, 
-                                        dataset == "C", 
+  median.C.HS <- as.numeric(lapply(subset(FOCUS_2006_HS_ref_A_to_F,
+                                        dataset == "C",
                                         c(M0, k1, k2, tb, DT50, DT90)), "median"))
 
   dev.percent.C.HS <- calc_dev.percent(fit.C.HS, median.C.HS, round_results = c(2, 4, 6, 2, 2))
@@ -202,7 +204,7 @@ test_that("DFOP fits give approximately (0.001%) equal results with different so
 test_that("SFORB fits give approximately (0.002%) equal results with different solution methods", {
   fit.B.SFORB.default <- mkinfit(SFORB, FOCUS_2006_B, quiet=TRUE)$bparms.optim
 
-  fits.B.SFORB <- list()          
+  fits.B.SFORB <- list()
   fits.B.SFORB[[1]] <- mkinfit(SFORB, FOCUS_2006_B, quiet=TRUE, solution_type = "eigen")
   fits.B.SFORB[[2]] <- mkinfit(SFORB, FOCUS_2006_B, quiet=TRUE, solution_type = "deSolve")
   dev.percent <- calc_dev.percent(fits.B.SFORB, fit.B.SFORB.default, endpoints = FALSE)
diff --git a/tests/testthat/test_twa.R b/tests/testthat/test_twa.R
index 3a28e0c1..19e706e1 100644
--- a/tests/testthat/test_twa.R
+++ b/tests/testthat/test_twa.R
@@ -1,4 +1,4 @@
-# Copyright (C) 2016 Johannes Ranke
+# Copyright (C) 2016,2017 Johannes Ranke
 # Contact: jranke@uni-bremen.de
 
 # This file is part of the R package mkin
@@ -37,7 +37,7 @@ test_that("Time weighted average concentrations are correct", {
                 outtimes = outtimes_7)
     twa_num <- mean(pred_7$parent)
     names(twa_num) <- 7
-    twa_ana <- twa(fit, 7)
+    twa_ana <- max_twa_parent(fit, 7)
 
     # Test for absolute difference (scale = 1)
     expect_equal(twa_num, twa_ana, tolerance = 0.001, scale = 1)