aboutsummaryrefslogtreecommitdiff
path: root/tests/testthat/setup_script.R
diff options
context:
space:
mode:
authorJohannes Ranke <jranke@uni-bremen.de>2022-11-18 19:14:47 +0100
committerJohannes Ranke <jranke@uni-bremen.de>2022-11-18 19:14:47 +0100
commit5364f037a72863ef5ba81e14ba4417f68fd389f9 (patch)
treefac84908a74553009b0ab03d7a8c21cdf3a7f086 /tests/testthat/setup_script.R
parenta14237fc1580b09f8772cd3330b0a445785e48ac (diff)
Make mixed model test data permanent to ensure reproducibility
To ensure that tests on different platforms work on the same data, the mixed modelling test data previosly generated in tests/testthat/setup_script.R were generated once using the script in inst/dataset/generation/ds_mixed.R, and are now distributed with the package.
Diffstat (limited to 'tests/testthat/setup_script.R')
-rw-r--r--tests/testthat/setup_script.R99
1 files changed, 7 insertions, 92 deletions
diff --git a/tests/testthat/setup_script.R b/tests/testthat/setup_script.R
index 362038c3..c554800d 100644
--- a/tests/testthat/setup_script.R
+++ b/tests/testthat/setup_script.R
@@ -81,112 +81,27 @@ fit_obs_1 <- mkinfit(m_synth_SFO_lin, SFO_lin_a, error_model = "obs", quiet = TR
fit_tc_1 <- mkinfit(m_synth_SFO_lin, SFO_lin_a, error_model = "tc", quiet = TRUE,
error_model_algorithm = "threestep")
-# Mixed models data and fits
-sampling_times = c(0, 1, 3, 7, 14, 28, 60, 90, 120)
-n <- n_biphasic <- 15
-log_sd <- 0.3
-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)
-set.seed(123456)
-ds_sfo <- lapply(1:n, function(i) {
- ds_mean <- mkinpredict(SFO, c(k_parent = k_parent[i]),
- c(parent = 100), sampling_times)
- 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)))
-set.seed(123456)
-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(
- k1 = rlnorm(n, log(dfop_pop$k1), log_sd),
- k2 = rlnorm(n, log(dfop_pop$k2), log_sd),
- g = plogis(rnorm(n, qlogis(dfop_pop$g), log_sd))))
-set.seed(123456)
-ds_dfop <- lapply(1:n, function(i) {
- ds_mean <- mkinpredict(DFOP, dfop_parms[i, ],
- c(parent = dfop_pop$parent_0), sampling_times)
- add_err(ds_mean, tc, 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)))
-set.seed(123456)
-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"),
- m1 = mkinsub("SFO"),
- quiet = TRUE)
-dfop_sfo_pop <- list(parent_0 = 100,
- k_m1 = 0.007, f_parent_to_m1 = 0.5,
- k1 = 0.1, k2 = 0.02, g = 0.5)
-syn_biphasic_parms <- as.matrix(data.frame(
- k1 = rlnorm(n_biphasic, log(dfop_sfo_pop$k1), log_sd),
- k2 = rlnorm(n_biphasic, log(dfop_sfo_pop$k2), log_sd),
- g = plogis(rnorm(n_biphasic, qlogis(dfop_sfo_pop$g), log_sd)),
- f_parent_to_m1 = plogis(rnorm(n_biphasic,
- qlogis(dfop_sfo_pop$f_parent_to_m1), log_sd)),
- k_m1 = rlnorm(n_biphasic, log(dfop_sfo_pop$k_m1), log_sd)))
-ds_biphasic_mean <- lapply(1:n_biphasic,
- function(i) {
- mkinpredict(DFOP_SFO, syn_biphasic_parms[i, ],
- c(parent = 100, m1 = 0), sampling_times)
- }
-)
-set.seed(123456)
-ds_biphasic <- lapply(ds_biphasic_mean, function(ds) {
- add_err(ds,
- sdfunc = function(value) sqrt(err_1$const^2 + value^2 * err_1$prop^2),
- n = 1, secondary = "m1")[[1]]
-})
-
# Mixed model fits
mmkin_sfo_1 <- mmkin("SFO", ds_sfo, quiet = TRUE, error_model = "tc", cores = n_cores)
mmkin_dfop_1 <- mmkin("DFOP", ds_dfop, quiet = TRUE, cores = n_cores,
error_model = "tc")
-mmkin_biphasic <- mmkin(list("DFOP-SFO" = DFOP_SFO), ds_biphasic, quiet = TRUE, cores = n_cores,
+DFOP_SFO <- mkinmod(parent = mkinsub("DFOP", "m1"),
+ m1 = mkinsub("SFO"), quiet = TRUE)
+mmkin_dfop_sfo <- mmkin(list("DFOP-SFO" = DFOP_SFO), ds_dfop_sfo, quiet = TRUE, cores = n_cores,
control = list(eval.max = 500, iter.max = 400),
error_model = "tc")
# nlme
dfop_nlme_1 <- suppressWarnings(nlme(mmkin_dfop_1))
-nlme_biphasic <- suppressWarnings(nlme(mmkin_biphasic))
+nlme_dfop_sfo <- suppressWarnings(nlme(mmkin_dfop_sfo))
# saemix
sfo_saem_1 <- saem(mmkin_sfo_1, quiet = TRUE, transformations = "saemix")
sfo_saem_1_reduced <- update(sfo_saem_1, no_random_effect = "parent_0")
-dfop_saemix_1 <- saem(mmkin_dfop_1, quiet = TRUE, transformations = "mkin",
+dfop_saem_1 <- saem(mmkin_dfop_1, quiet = TRUE, transformations = "mkin",
no_random_effect = c("parent_0", "g_qlogis"))
-saem_biphasic_m <- saem(mmkin_biphasic, transformations = "mkin", quiet = TRUE)
-saem_biphasic_s <- saem(mmkin_biphasic, transformations = "saemix", quiet = TRUE)
+saem_dfop_sfo_m <- saem(mmkin_dfop_sfo, transformations = "mkin", quiet = TRUE)
+saem_dfop_sfo_s <- saem(mmkin_dfop_sfo, transformations = "saemix", quiet = TRUE)

Contact - Imprint