From 1623d0f0df92e2d4f44faa7a64a0b795e275b444 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Fri, 21 Jul 2017 16:16:01 +0200 Subject: Fix tests, try FOMC ill-defined again --- test.log | 214 ++++++++++++++++++++++++++++++++- tests/testthat/test_FOMC_ill-defined.R | 2 +- tests/testthat/test_parent_only.R | 60 ++++----- tests/testthat/test_twa.R | 4 +- 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) -- cgit v1.2.1