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 --- .../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 +- 4 files changed, 1276 insertions(+), 1213 deletions(-) (limited to 'tests') 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