From 48d9cad339394c3aa0d730d9a27b1c0680ce13e8 Mon Sep 17 00:00:00 2001 From: Ranke Johannes Date: Mon, 7 Sep 2026 13:45:39 +0200 Subject: Add DTx function, check and test The tolerance of one test had to be increased in test_deSolve.R, and four vdiffr snapshots with negligible differences were updated. Tests run with a maximum of 16 cores when running in the Agroscope Apptainer environment. --- .../_snaps/multistart/llhist-for-dfop-sfo-fit.svg | 34 +-- ...t-for-saem-object-with-mkin-transformations.svg | 148 ++++++------- .../_snaps/multistart/parplot-for-dfop-sfo-fit.svg | 236 ++++++++++----------- .../plot/mixed-model-fit-for-nlme-object.svg | 20 +- tests/testthat/print_dfop_saem_1.txt | 10 +- tests/testthat/setup_script.R | 7 +- tests/testthat/test_deSolve.R | 3 +- tests/testthat/test_endpoints.R | 49 +++++ 8 files changed, 282 insertions(+), 225 deletions(-) create mode 100644 tests/testthat/test_endpoints.R (limited to 'tests') diff --git a/tests/testthat/_snaps/multistart/llhist-for-dfop-sfo-fit.svg b/tests/testthat/_snaps/multistart/llhist-for-dfop-sfo-fit.svg index 3b9d51fb..4c91a43e 100644 --- a/tests/testthat/_snaps/multistart/llhist-for-dfop-sfo-fit.svg +++ b/tests/testthat/_snaps/multistart/llhist-for-dfop-sfo-fit.svg @@ -27,20 +27,22 @@ --1149.30 --1149.25 --1149.20 --1149.15 --1149.10 --1149.05 --1149.00 +-1149.5 +-1149.4 +-1149.3 +-1149.2 +-1149.1 +-1149.0 +-1148.9 - + + 0 -1 -2 +1 +2 +3 @@ -48,13 +50,13 @@ - - - + + + - - - + + + original fit diff --git a/tests/testthat/_snaps/multistart/mixed-model-fit-for-saem-object-with-mkin-transformations.svg b/tests/testthat/_snaps/multistart/mixed-model-fit-for-saem-object-with-mkin-transformations.svg index 5e534dd1..381fed52 100644 --- a/tests/testthat/_snaps/multistart/mixed-model-fit-for-saem-object-with-mkin-transformations.svg +++ b/tests/testthat/_snaps/multistart/mixed-model-fit-for-saem-object-with-mkin-transformations.svg @@ -342,7 +342,7 @@ - + @@ -933,51 +933,51 @@ - - - + + + - - + + - - - - - - - - + + + + + + + + - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + @@ -1585,7 +1585,7 @@ - + @@ -2099,7 +2099,7 @@ - + @@ -2107,54 +2107,54 @@ - - - + + + - - - + + + - - + + - - - + + + - - - + + + - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/multistart/parplot-for-dfop-sfo-fit.svg b/tests/testthat/_snaps/multistart/parplot-for-dfop-sfo-fit.svg index c733f84f..9be7ee5f 100644 --- a/tests/testthat/_snaps/multistart/parplot-for-dfop-sfo-fit.svg +++ b/tests/testthat/_snaps/multistart/parplot-for-dfop-sfo-fit.svg @@ -25,104 +25,104 @@ - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + - + @@ -167,28 +167,28 @@ - - - - - - - - - - - - - - - - - - - - - - + + + + + + + + + + + + + + + + + + + + + + diff --git a/tests/testthat/_snaps/plot/mixed-model-fit-for-nlme-object.svg b/tests/testthat/_snaps/plot/mixed-model-fit-for-nlme-object.svg index c94012ce..76fed0dc 100644 --- a/tests/testthat/_snaps/plot/mixed-model-fit-for-nlme-object.svg +++ b/tests/testthat/_snaps/plot/mixed-model-fit-for-nlme-object.svg @@ -813,7 +813,7 @@ - + @@ -833,7 +833,7 @@ - + @@ -900,7 +900,7 @@ - + @@ -921,7 +921,7 @@ - + @@ -964,8 +964,8 @@ - - + + @@ -1243,8 +1243,8 @@ - - + + @@ -1291,8 +1291,8 @@ - - + + diff --git a/tests/testthat/print_dfop_saem_1.txt b/tests/testthat/print_dfop_saem_1.txt index 3a1f1667..3d036357 100644 --- a/tests/testthat/print_dfop_saem_1.txt +++ b/tests/testthat/print_dfop_saem_1.txt @@ -9,15 +9,15 @@ Data: Likelihood computed by importance sampling AIC BIC logLik - 1409 1415 -696 + 1409 1414 -696 Fitted parameters: estimate lower upper -parent_0 99.96 98.82 101.11 -log_k1 -2.71 -2.94 -2.49 +parent_0 99.97 98.83 101.12 +log_k1 -2.71 -2.94 -2.48 log_k2 -4.14 -4.26 -4.01 g_qlogis -0.36 -0.54 -0.17 -a.1 0.93 0.69 1.17 +a.1 0.92 0.68 1.17 b.1 0.05 0.04 0.05 -SD.log_k1 0.37 0.23 0.51 +SD.log_k1 0.37 0.23 0.52 SD.log_k2 0.23 0.14 0.31 diff --git a/tests/testthat/setup_script.R b/tests/testthat/setup_script.R index b2147fbe..111daa30 100644 --- a/tests/testthat/setup_script.R +++ b/tests/testthat/setup_script.R @@ -4,7 +4,12 @@ require(testthat) # Per default (on my box where I set NOT_CRAN in .Rprofile) use all cores minus one # Otherwise (CRAN check systems) use the allowed maximum of two cores if (identical(Sys.getenv("NOT_CRAN"), "true")) { - n_cores <- parallel::detectCores() - 1 + # We cannot use all course if on the Agroscope cluster, if not we use all but one + if (grepl("agsad.admin.ch", Sys.getenv("http_proxy"))) { + n_cores = 16 + } else { + n_cores <- parallel::detectCores() - 1 + } } else { n_cores <- 2 } diff --git a/tests/testthat/test_deSolve.R b/tests/testthat/test_deSolve.R index 3d15de35..c7acdc43 100644 --- a/tests/testthat/test_deSolve.R +++ b/tests/testthat/test_deSolve.R @@ -13,7 +13,8 @@ test_that("Solutions with deSolve work if we have no observations at time zero", solution_type = "deSolve", quiet = TRUE) expect_equal( parms(f_sfo_sfo_nozero), - parms(f_sfo_sfo_nozero_deSolve) + parms(f_sfo_sfo_nozero_deSolve), + tolerance = 1e-5 ) }) diff --git a/tests/testthat/test_endpoints.R b/tests/testthat/test_endpoints.R new file mode 100644 index 00000000..284e1379 --- /dev/null +++ b/tests/testthat/test_endpoints.R @@ -0,0 +1,49 @@ +context("DTx calculations") + +test_that("The DTx function gives the same results as the endpoints function", { + # We silently assume that the calculations in the endpoint function are correct + + SFO_fit <- fits[["SFO", "FOCUS_C"]] + SFO_distimes <- endpoints(SFO_fit)$distimes + SFO_DTx <- DTx("SFO", c(k = parms(SFO_fit)[["k_parent"]])) + + expect_equal( + as.numeric(SFO_distimes), + as.numeric(SFO_DTx) + ) + + FOMC_fit <- fits[["FOMC", "FOCUS_C"]] + FOMC_distimes <- endpoints(FOMC_fit)$distimes + FOMC_DTx <- DTx("FOMC", c( + alpha = parms(FOMC_fit)[["alpha"]], + beta = parms(FOMC_fit)[["beta"]]), exact = TRUE) + + expect_equal( + as.numeric(FOMC_distimes), + as.numeric(FOMC_DTx) + ) + + DFOP_fit <- fits[["DFOP", "FOCUS_C"]] + DFOP_distimes <- endpoints(DFOP_fit)$distimes + DFOP_DTx <- DTx("DFOP", c( + k1 = parms(DFOP_fit)[["k1"]], + k2 = parms(DFOP_fit)[["k2"]], + g = parms(DFOP_fit)[["g"]]), exact = TRUE) + + expect_equal( + as.numeric(DFOP_distimes), + as.numeric(DFOP_DTx) + ) + + HS_fit <- fits[["HS", "FOCUS_C"]] + HS_distimes <- endpoints(HS_fit)$distimes + HS_DTx <- DTx("HS", c( + k1 = parms(HS_fit)[["k1"]], + k2 = parms(HS_fit)[["k2"]], + tb = parms(HS_fit)[["tb"]]), exact = TRUE) + + expect_equal( + as.numeric(HS_distimes), + as.numeric(HS_DTx) + ) +}) -- cgit v1.2.3