From b0341af402271a1339308ba930c12530f62d4cf8 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Wed, 9 Dec 2020 18:19:09 +0100 Subject: Add more tests and fix HS in saem --- R/saem.R | 4 +- test.log | 49 +- .../plotting/mixed-model-fit-for-nlme-object.svg | 2402 ++++++++++---------- tests/testthat/print_sfo_saemix_1.txt | 2 + tests/testthat/setup_script.R | 30 +- tests/testthat/test_mixed.R | 55 +- 6 files changed, 1318 insertions(+), 1224 deletions(-) diff --git a/R/saem.R b/R/saem.R index 88b8e172..fda5569e 100644 --- a/R/saem.R +++ b/R/saem.R @@ -269,7 +269,7 @@ saemix_model <- function(object, solution_type = "auto", transformations = c("mk k1 = exp(psi[id, 1]) odeini_fixed * ifelse(t <= tb, exp(- k1 * t), - exp(- k1 * t) * exp(- exp(psi[id, 2]) * (t - tb))) + exp(- k1 * tb) * exp(- exp(psi[id, 2]) * (t - tb))) } } } else { @@ -315,7 +315,7 @@ saemix_model <- function(object, solution_type = "auto", transformations = c("mk k1 = exp(psi[id, 2]) psi[id, 1] * ifelse(t <= tb, exp(- k1 * t), - exp(- k1 * t) * exp(- exp(psi[id, 3]) * (t - tb))) + exp(- k1 * tb) * exp(- exp(psi[id, 3]) * (t - tb))) } } } diff --git a/test.log b/test.log index 6ba8ff03..f39791ae 100644 --- a/test.log +++ b/test.log @@ -7,31 +7,62 @@ Testing mkin ✔ | 14 | Results for FOCUS D established in expertise for UBA (Ranke 2014) [1.0 s] ✔ | 4 | Calculation of FOCUS chi2 error levels [0.5 s] ✔ | 7 | Fitting the SFORB model [3.6 s] -✔ | 5 | Analytical solutions for coupled models [3.4 s] +✔ | 5 | Analytical solutions for coupled models [3.2 s] ✔ | 5 | Calculation of Akaike weights ✔ | 14 | Confidence intervals and p-values [1.2 s] ✔ | 14 | Error model fitting [4.7 s] ✔ | 3 | Time step normalisation ✔ | 4 | Test fitting the decline of metabolites from their maximum [0.3 s] ✔ | 1 | Fitting the logistic model [0.2 s] -✔ | 23 | Nonlinear mixed effects models [8.1 s] +⠏ | 8 2 | Nonlinear mixed effects models +LL by is "-1333.17 (df=13)" + +LL by is "-1333.17 (df=13)" + +LL by is "-1336.30 (df=13)" + ✖ | 11 2 | Nonlinear mixed effects models [6.4 s] +──────────────────────────────────────────────────────────────────────────────── +ERROR (test_mixed.R:11:3): Parent only models can be fitted using nonlinear mixed effects models +Error: object 'sfo_saem_1' not found +Backtrace: + 1. base::summary(sfo_saem_1) test_mixed.R:11:2 + +FAILURE (test_mixed.R:91:3): Print methods work +Results have changed from known value recorded in 'print_sfo_saemix_1.txt'. + +old[6:11] vs new[6:13] + "Data:" + "264 observations of 1 variable(s) grouped in 15 datasets" + "" + "Likelihood computed by importance sampling" ++ " " ++ "LL by is \"-653.97 (df=6)\"" + " AIC BIC logLik" + " 1320 1324 -654" + "" +──────────────────────────────────────────────────────────────────────────────── ✔ | 2 | Test dataset classes mkinds and mkindsg ✔ | 1 | mkinfit features [0.3 s] ✔ | 12 | Special cases of mkinfit calls [0.8 s] ✔ | 8 | mkinmod model generation and printing [0.2 s] ✔ | 3 | Model predictions with mkinpredict [0.4 s] -✔ | 16 | Evaluations according to 2015 NAFTA guidance [1.7 s] +✔ | 16 | Evaluations according to 2015 NAFTA guidance [1.6 s] ✔ | 9 | Nonlinear mixed-effects models [7.8 s] -✔ | 16 | Plotting [1.9 s] +✖ | 15 1 | Plotting [1.9 s] +──────────────────────────────────────────────────────────────────────────────── +FAILURE (test_plot.R:39:3): Plotting mkinfit and mmkin objects is reproducible +Figures don't match: mixed-model-fit-for-nlme-object.svg + +──────────────────────────────────────────────────────────────────────────────── ✔ | 4 | Residuals extracted from mkinfit models -✔ | 2 | Complex test case from Schaefer et al. (2007) Piacenza paper [1.5 s] +✔ | 2 | Complex test case from Schaefer et al. (2007) Piacenza paper [1.6 s] ✔ | 4 | Summary [0.1 s] ✔ | 1 | Summaries of old mkinfit objects ✔ | 4 | Results for synthetic data established in expertise for UBA (Ranke 2014) [2.3 s] -✔ | 9 | Hypothesis tests [7.4 s] -✔ | 4 | Calculation of maximum time weighted average concentrations (TWAs) [2.4 s] +✔ | 9 | Hypothesis tests [7.3 s] +✔ | 4 | Calculation of maximum time weighted average concentrations (TWAs) [2.3 s] ══ Results ═════════════════════════════════════════════════════════════════════ -Duration: 50.1 s +Duration: 48.1 s -[ FAIL 0 | WARN 0 | SKIP 0 | PASS 196 ] +[ FAIL 3 | WARN 0 | SKIP 0 | PASS 183 ] diff --git a/tests/figs/plotting/mixed-model-fit-for-nlme-object.svg b/tests/figs/plotting/mixed-model-fit-for-nlme-object.svg index 23bf722c..df102bbe 100644 --- a/tests/figs/plotting/mixed-model-fit-for-nlme-object.svg +++ b/tests/figs/plotting/mixed-model-fit-for-nlme-object.svg @@ -86,7 +86,7 @@ - + @@ -107,19 +107,19 @@ 80 100 120 - + - - - - - + + + + + 0 -20 -40 -60 -80 -100 +20 +40 +60 +80 +100 @@ -133,597 +133,597 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + @@ -734,34 +734,30 @@ - + - - - - - + + + + + 0 -20 -40 -60 -80 -100 - - - - +20 +40 +60 +80 +100 + + + - - - --3 --2 --1 + + +-4 +-2 0 -1 -2 -3 +2 +4 @@ -776,580 +772,580 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/print_sfo_saemix_1.txt b/tests/testthat/print_sfo_saemix_1.txt index d341e9e7..9dd4f175 100644 --- a/tests/testthat/print_sfo_saemix_1.txt +++ b/tests/testthat/print_sfo_saemix_1.txt @@ -6,6 +6,8 @@ Data: 264 observations of 1 variable(s) grouped in 15 datasets Likelihood computed by importance sampling + +LL by is "-653.97 (df=6)" AIC BIC logLik 1320 1324 -654 diff --git a/tests/testthat/setup_script.R b/tests/testthat/setup_script.R index 9da8b90d..4a343bc5 100644 --- a/tests/testthat/setup_script.R +++ b/tests/testthat/setup_script.R @@ -95,7 +95,6 @@ fit_tc_1 <- mkinfit(m_synth_SFO_lin, SFO_lin_a, error_model = "tc", quiet = TRUE error_model_algorithm = "threestep") # Mixed models data and -set.seed(123456) sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120) n <- n_biphasic <- 15 log_sd <- 0.3 @@ -103,6 +102,7 @@ err_1 = list(const = 1, prop = 0.05) tc <- function(value) sigma_twocomp(value, err_1$const, err_1$prop) const <- function(value) 2 +set.seed(123456) SFO <- mkinmod(parent = mkinsub("SFO")) k_parent = rlnorm(n, log(0.03), log_sd) ds_sfo <- lapply(1:n, function(i) { @@ -111,6 +111,19 @@ ds_sfo <- lapply(1:n, function(i) { add_err(ds_mean, tc, n = 1)[[1]] }) +set.seed(123456) +FOMC <- mkinmod(parent = mkinsub("FOMC")) +fomc_pop <- list(parent_0 = 100, alpha = 2, beta = 8) +fomc_parms <- as.matrix(data.frame( + alpha = rlnorm(n, log(fomc_pop$alpha), 0.4), + beta = rlnorm(n, log(fomc_pop$beta), 0.2))) +ds_fomc <- lapply(1:3, function(i) { + ds_mean <- mkinpredict(FOMC, fomc_parms[i, ], + c(parent = 100), sampling_times) + add_err(ds_mean, tc, n = 1)[[1]] +}) + +set.seed(123456) DFOP <- mkinmod(parent = mkinsub("DFOP")) dfop_pop <- list(parent_0 = 100, k1 = 0.06, k2 = 0.015, g = 0.4) dfop_parms <- as.matrix(data.frame( @@ -123,6 +136,19 @@ ds_dfop <- lapply(1:n, function(i) { add_err(ds_mean, const, n = 1)[[1]] }) +set.seed(123456) +HS <- mkinmod(parent = mkinsub("HS")) +hs_pop <- list(parent_0 = 100, k1 = 0.08, k2 = 0.01, tb = 15) +hs_parms <- as.matrix(data.frame( + k1 = rlnorm(n, log(hs_pop$k1), log_sd), + k2 = rlnorm(n, log(hs_pop$k2), log_sd), + tb = rlnorm(n, log(hs_pop$tb), 0.1))) +ds_hs <- lapply(1:10, function(i) { + ds_mean <- mkinpredict(HS, hs_parms[i, ], + c(parent = hs_pop$parent_0), sampling_times) + add_err(ds_mean, const, n = 1)[[1]] +}) + set.seed(123456) DFOP_SFO <- mkinmod( parent = mkinsub("DFOP", "m1"), @@ -152,7 +178,7 @@ ds_biphasic <- lapply(ds_biphasic_mean, function(ds) { # Mixed model fits mmkin_sfo_1 <- mmkin("SFO", ds_sfo, quiet = TRUE, error_model = "tc") -sfo_saemix_1 <- saem(mmkin_sfo_1, quiet = TRUE, transformations = "saemix") +sfo_saem_1 <- saem(mmkin_sfo_1, quiet = TRUE, transformations = "saemix") mmkin_dfop_1 <- mmkin("DFOP", ds_dfop, quiet = TRUE) dfop_saemix_1 <- saem(mmkin_dfop_1, quiet = TRUE, transformations = "mkin") diff --git a/tests/testthat/test_mixed.R b/tests/testthat/test_mixed.R index 644cccc1..6fc6c2f0 100644 --- a/tests/testthat/test_mixed.R +++ b/tests/testthat/test_mixed.R @@ -1,14 +1,15 @@ context("Nonlinear mixed effects models") test_that("Parent only models can be fitted using nonlinear mixed effects models", { + expect_error(saem(fits), "Only row objects") # Some fits were done in the setup script mmkin_sfo_2 <- update(mmkin_sfo_1, fixed_initials = c(parent = 100)) expect_error(update(mmkin_sfo_1, models = c("SFOOO")), "Please supply models.*") - sfo_saemix_2 <- saem(mmkin_sfo_1, quiet = TRUE, transformations = "mkin") - sfo_saemix_3 <- expect_error(saem(mmkin_sfo_2, quiet = TRUE), "at least two parameters") - s_sfo_s1 <- summary(sfo_saemix_1) - s_sfo_s2 <- summary(sfo_saemix_2) + sfo_saem_2 <- saem(mmkin_sfo_1, quiet = TRUE, transformations = "mkin") + sfo_saem_3 <- expect_error(saem(mmkin_sfo_2, quiet = TRUE), "at least two parameters") + s_sfo_s1 <- summary(sfo_saem_1) + s_sfo_s2 <- summary(sfo_saem_2) sfo_nlme_1 <- expect_warning(nlme(mmkin_sfo_1), "not converge") s_sfo_n <- summary(sfo_nlme_1) @@ -25,6 +26,21 @@ test_that("Parent only models can be fitted using nonlinear mixed effects models expect_equal(round(s_sfo_s1$confint_back["k_parent", "est."], 3), round(s_sfo_n$confint_back["k_parent", "est."], 3)) + mmkin_fomc_1 <- mmkin("FOMC", ds_fomc, quiet = TRUE, error_model = "tc") + fomc_saem_1 <- saem(mmkin_fomc_1, quiet = TRUE) + ci_fomc_s1 <- summary(fomc_saem_1)$confint_back + + fomc_pop <- as.numeric(fomc_pop) + expect_true(all(ci_fomc_s1[, "lower"] < fomc_pop)) + expect_true(all(ci_fomc_s1[, "upper"] > fomc_pop)) + + mmkin_fomc_2 <- update(mmkin_fomc_1, state.ini = 100, fixed_initials = "parent") + fomc_saem_2 <- saem(mmkin_fomc_2, quiet = TRUE, transformations = "mkin") + ci_fomc_s2 <- summary(fomc_saem_2)$confint_back + + expect_true(all(ci_fomc_s2[, "lower"] < fomc_pop[2:3])) + expect_true(all(ci_fomc_s2[, "upper"] > fomc_pop[2:3])) + s_dfop_s1 <- summary(dfop_saemix_1) s_dfop_s2 <- summary(dfop_saemix_2) s_dfop_n <- summary(dfop_nlme_1) @@ -35,14 +51,37 @@ test_that("Parent only models can be fitted using nonlinear mixed effects models expect_true(all(s_dfop_s2$confint_back[, "lower"] < dfop_pop)) expect_true(all(s_dfop_s2$confint_back[, "upper"] > dfop_pop)) + dfop_mmkin_means_trans <- apply(parms(mmkin_dfop_1, transformed = TRUE), 1, mean) + dfop_mmkin_means <- backtransform_odeparms(dfop_mmkin_means_trans, mmkin_dfop_1$mkinmod) + + # We get < 22% deviations by averaging the transformed parameters + rel_diff_mmkin <- (dfop_mmkin_means - dfop_pop) / dfop_pop + expect_true(all(rel_diff_mmkin < 0.22)) - # We get < 20% deviations with transformations made in mkin + # We get < 50% deviations with transformations made in mkin rel_diff_1 <- (s_dfop_s1$confint_back[, "est."] - dfop_pop) / dfop_pop - expect_true(all(rel_diff_1 < 0.2)) + expect_true(all(rel_diff_1 < 0.5)) - # We get < 8% deviations with transformations made in saemix + # We get < 12% deviations with transformations made in saemix rel_diff_2 <- (s_dfop_s2$confint_back[, "est."] - dfop_pop) / dfop_pop - expect_true(all(rel_diff_2 < 0.08)) + expect_true(all(rel_diff_2 < 0.12)) + + mmkin_hs_1 <- mmkin("HS", ds_hs, quiet = TRUE, error_model = "const") + hs_saem_1 <- saem(mmkin_hs_1, quiet = TRUE) + ci_hs_s1 <- summary(hs_saem_1)$confint_back + + hs_pop <- as.numeric(hs_pop) + # expect_true(all(ci_hs_s1[, "lower"] < hs_pop)) # k1 is overestimated + expect_true(all(ci_hs_s1[, "upper"] > hs_pop)) + + mmkin_hs_2 <- update(mmkin_hs_1, state.ini = 100, fixed_initials = "parent") + hs_saem_2 <- saem(mmkin_hs_2, quiet = TRUE) + ci_hs_s2 <- summary(hs_saem_2)$confint_back + + #expect_true(all(ci_hs_s2[, "lower"] < hs_pop[2:4])) # k1 again overestimated + expect_true(all(ci_hs_s2[, "upper"] > hs_pop[2:4])) + + # HS would likely benefit from implemenation of transformations = "saemix" }) test_that("Print methods work", { -- cgit v1.2.1