From d68f7cc800fe2342642056780b915821dbe113e0 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Mon, 28 Feb 2022 11:17:56 +0100 Subject: With saemix 3.0 on CRAN there's no need to check for it in tests --- tests/testthat/setup_script.R | 25 +++++------ tests/testthat/test-dmta.R | 64 ++++++++++++++++++++++++++++ tests/testthat/test_mixed.R | 3 -- tests/testthat/test_nlmixr.r | 99 ------------------------------------------- tests/testthat/test_plot.R | 14 +++--- 5 files changed, 79 insertions(+), 126 deletions(-) create mode 100644 tests/testthat/test-dmta.R delete mode 100644 tests/testthat/test_nlmixr.r diff --git a/tests/testthat/setup_script.R b/tests/testthat/setup_script.R index 693a2a25..4688b7d7 100644 --- a/tests/testthat/setup_script.R +++ b/tests/testthat/setup_script.R @@ -183,28 +183,25 @@ ds_biphasic <- lapply(ds_biphasic_mean, function(ds) { }) # Mixed model fits -saemix_available <- FALSE -if (requireNamespace("saemix", quietly = TRUE)) { - if(packageVersion("saemix") >= "3.0") saemix_available <- TRUE -} 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) mmkin_biphasic <- mmkin(list("DFOP-SFO" = DFOP_SFO), ds_biphasic, quiet = TRUE, cores = n_cores) mmkin_biphasic_mixed <- mixed(mmkin_biphasic) +# nlme dfop_nlme_1 <- nlme(mmkin_dfop_1) nlme_biphasic <- nlme(mmkin_biphasic) -if (saemix_available) { - sfo_saem_1 <- saem(mmkin_sfo_1, quiet = TRUE, transformations = "saemix") +# saemix +sfo_saem_1 <- saem(mmkin_sfo_1, quiet = TRUE, transformations = "saemix") - dfop_saemix_1 <- saem(mmkin_dfop_1, quiet = TRUE, transformations = "mkin") - dfop_saemix_2 <- saem(mmkin_dfop_1, quiet = TRUE, transformations = "saemix") +dfop_saemix_1 <- saem(mmkin_dfop_1, quiet = TRUE, transformations = "mkin") +dfop_saemix_2 <- saem(mmkin_dfop_1, quiet = TRUE, transformations = "saemix") - saem_biphasic_m <- saem(mmkin_biphasic, transformations = "mkin", quiet = TRUE) - saem_biphasic_s <- saem(mmkin_biphasic, transformations = "saemix", quiet = TRUE) -} +saem_biphasic_m <- saem(mmkin_biphasic, transformations = "mkin", quiet = TRUE) +saem_biphasic_s <- saem(mmkin_biphasic, transformations = "saemix", quiet = TRUE) +# UBA datasets ds_uba <- lapply(experimental_data_for_UBA_2019[6:10], function(x) subset(x$data[c("name", "time", "value")])) names(ds_uba) <- paste("Dataset", 6:10) @@ -216,7 +213,5 @@ f_uba_mmkin <- mmkin(list("SFO-SFO" = sfo_sfo_uba, "DFOP-SFO" = dfop_sfo_uba), ds_uba, quiet = TRUE, cores = n_cores) f_uba_dfop_sfo_mixed <- mixed(f_uba_mmkin[2, ]) -if (saemix_available) { - f_uba_sfo_sfo_saem <- saem(f_uba_mmkin["SFO-SFO", ], quiet = TRUE, transformations = "saemix") - f_uba_dfop_sfo_saem <- saem(f_uba_mmkin["DFOP-SFO", ], quiet = TRUE, transformations = "saemix") -} +f_uba_sfo_sfo_saem <- saem(f_uba_mmkin["SFO-SFO", ], quiet = TRUE, transformations = "saemix") +f_uba_dfop_sfo_saem <- saem(f_uba_mmkin["DFOP-SFO", ], quiet = TRUE, transformations = "saemix") diff --git a/tests/testthat/test-dmta.R b/tests/testthat/test-dmta.R new file mode 100644 index 00000000..12bbcb8e --- /dev/null +++ b/tests/testthat/test-dmta.R @@ -0,0 +1,64 @@ +local_edition(3) + +# Data +dmta_ds <- lapply(1:7, function(i) { + ds_i <- dimethenamid_2018$ds[[i]]$data + ds_i[ds_i$name == "DMTAP", "name"] <- "DMTA" + ds_i$time <- ds_i$time * dimethenamid_2018$f_time_norm[i] + ds_i +}) +names(dmta_ds) <- sapply(dimethenamid_2018$ds, function(ds) ds$title) +dmta_ds[["Elliot"]] <- rbind(dmta_ds[["Elliot 1"]], dmta_ds[["Elliot 2"]]) +dmta_ds[["Elliot 1"]] <- dmta_ds[["Elliot 2"]] <- NULL + +# mkin +nlm_dfop <- mmkin("DFOP", dmta_ds) +nlm_dfop_tc <- mmkin("DFOP", dmta_ds, error_model = "tc") +parms(nlm_dfop_tc) + +# nlme +nlme_dfop_tc <- nlme(nlm_dfop_tc) +summary(nlme_dfop_tc) +intervals(nlme_dfop_tc) + +# saemix +saem_saemix_dfop_tc <- saem(nlm_dfop_tc) +saem_saemix_dfop_tc$so <- saemix::llgq.saemix(saem_saemix_dfop_tc$so) +summary(saem_saemix_dfop_tc) +intervals(saem_saemix_dfop_tc) +AIC(saem_saemix_dfop_tc$so) +AIC(saem_saemix_dfop_tc$so, "gq") +AIC(saem_saemix_dfop_tc$so, "lin") +saemix::plot(saem_saemix_dfop_tc$so, plot.type = "likelihood") +saemix::plot(saem_saemix_dfop_tc$so, plot.type = "convergence") + +saem_saemix_dfop_tc_1k <- saem(nlm_dfop_tc, nbiter.saemix = c(1000, 100)) +AIC(saem_saemix_dfop_tc_1k$so) +saemix::plot(saem_saemix_dfop_tc_1k$so, plot.type = "convergence") +saemix::plot(saem_saemix_dfop_tc_1k$so, plot.type = "likelihood") +intervals(saem_saemix_dfop_tc_1k) + +saem_saemix_dfop_tc_1.5k <- saem(nlm_dfop_tc, nbiter.saemix = c(1500, 100)) +saem_saemix_dfop_tc_1.5k$so <- saemix::llgq.saemix(saem_saemix_dfop_tc_1.5k$so) +saemix::plot(saem_saemix_dfop_tc_1.5k$so, plot.type = "convergence") +AIC(saem_saemix_dfop_tc_1.5k$so) +AIC(saem_saemix_dfop_tc_1.5k$so, "gq") +intervals(saem_saemix_dfop_tc_1.5k) + +# nlmixr saem +saem_nlmixr_dfop_tc <- nlmixr(nlm_dfop_tc, est = "saem", + control = nlmixr::saemControl(nBurn = 300, nEm = 100, nmc = 9, print = 0)) +intervals(saem_nlmixr_dfop_tc) +summary(saem_nlmixr_dfop_tc) +AIC(saem_nlmixr_dfop_tc$nm) + +saem_nlmixr_dfop_tc_1k <- nlmixr(nlm_dfop_tc, est = "saem", + control = nlmixr::saemControl(nBurn = 1000, nEm = 300, nmc = 9, print = 0)) +intervals(saem_nlmixr_dfop_tc_1k) +summary(saem_nlmixr_dfop_tc_1k) +AIC(saem_nlmixr_dfop_tc_1k$nm) + +focei_nlmixr_dfop_tc <- nlmixr(nlm_dfop_tc, est = "focei") +intervals(focei_nlmixr_dfop_tc) + +AIC(saem_nlmixr_dfop_tc$nm) diff --git a/tests/testthat/test_mixed.R b/tests/testthat/test_mixed.R index 6ac93295..40bd3fdf 100644 --- a/tests/testthat/test_mixed.R +++ b/tests/testthat/test_mixed.R @@ -1,7 +1,6 @@ context("Nonlinear mixed-effects models") test_that("Parent fits using saemix are correctly implemented", { - skip_if(!saemix_available) expect_error(saem(fits), "Only row objects") # Some fits were done in the setup script @@ -97,7 +96,6 @@ test_that("Print methods work", { expect_known_output(print(mmkin_biphasic_mixed, digits = 2), "print_mmkin_biphasic_mixed.txt") expect_known_output(print(nlme_biphasic, digits = 1), "print_nlme_biphasic.txt") - skip_if(!saemix_available) expect_known_output(print(sfo_saem_1, digits = 1), "print_sfo_saem_1.txt") }) @@ -126,7 +124,6 @@ test_that("nlme results are reproducible to some degree", { test_that("saem results are reproducible for biphasic fits", { - skip_if(!saemix_available) test_summary <- summary(saem_biphasic_s) test_summary$saemixversion <- "Dummy 0.0 for testing" test_summary$mkinversion <- "Dummy 0.0 for testing" diff --git a/tests/testthat/test_nlmixr.r b/tests/testthat/test_nlmixr.r deleted file mode 100644 index dcbb50ac..00000000 --- a/tests/testthat/test_nlmixr.r +++ /dev/null @@ -1,99 +0,0 @@ - - -# dmta_ds <- lapply(1:8, function(i) { -# ds_i <- dimethenamid_2018$ds[[i]]$data -# ds_i[ds_i$name == "DMTAP", "name"] <- "DMTA" -# ds_i$time <- ds_i$time * dimethenamid_2018$f_time_norm[i] -# ds_i -# }) -# names(dmta_ds) <- sapply(dimethenamid_2018$ds, function(ds) ds$title) -# dmta_ds[["Borstel"]] <- rbind(dmta_ds[["Borstel 1"]], dmta_ds[["Borstel 2"]]) -# dmta_ds[["Borstel 1"]] <- NULL -# dmta_ds[["Borstel 2"]] <- NULL -# dmta_ds[["Elliot"]] <- rbind(dmta_ds[["Elliot 1"]], dmta_ds[["Elliot 2"]]) -# dmta_ds[["Elliot 1"]] <- NULL -# dmta_ds[["Elliot 2"]] <- NULL -# dfop_sfo3_plus <- mkinmod( -# DMTA = mkinsub("DFOP", c("M23", "M27", "M31")), -# M23 = mkinsub("SFO"), -# M27 = mkinsub("SFO"), -# M31 = mkinsub("SFO", "M27", sink = FALSE), -# quiet = TRUE -# ) -# f_dmta_mkin_tc <- mmkin( -# list("DFOP-SFO3+" = dfop_sfo3_plus), -# dmta_ds, quiet = TRUE, error_model = "tc") -# -# d_dmta_nlmixr <- nlmixr_data(f_dmta_mkin_tc) -# m_dmta_nlmixr <- function () -# { -# ini({ -# DMTA_0 = 98.7697627680706 -# eta.DMTA_0 ~ 2.35171765917765 -# log_k_M23 = -3.92162409637283 -# eta.log_k_M23 ~ 0.549278519419884 -# log_k_M27 = -4.33774620773911 -# eta.log_k_M27 ~ 0.864474956685295 -# log_k_M31 = -4.24767627688461 -# eta.log_k_M31 ~ 0.750297149164171 -# f_DMTA_tffm0_1_qlogis = -2.092409 -# eta.f_DMTA_tffm0_1_qlogis ~ 0.3 -# f_DMTA_tffm0_2_qlogis = -2.180576 -# eta.f_DMTA_tffm0_2_qlogis ~ 0.3 -# f_DMTA_tffm0_3_qlogis = -2.142672 -# eta.f_DMTA_tffm0_3_qlogis ~ 0.3 -# log_k1 = -2.2341008812259 -# eta.log_k1 ~ 0.902976221565793 -# log_k2 = -3.7762779983269 -# eta.log_k2 ~ 1.57684519529298 -# g_qlogis = 0.450175725479389 -# eta.g_qlogis ~ 3.0851335687675 -# sigma_low_DMTA = 0.697933852349996 -# rsd_high_DMTA = 0.0257724286053519 -# sigma_low_M23 = 0.697933852349996 -# rsd_high_M23 = 0.0257724286053519 -# sigma_low_M27 = 0.697933852349996 -# rsd_high_M27 = 0.0257724286053519 -# sigma_low_M31 = 0.697933852349996 -# rsd_high_M31 = 0.0257724286053519 -# }) -# model({ -# DMTA_0_model = DMTA_0 + eta.DMTA_0 -# DMTA(0) = DMTA_0_model -# k_M23 = exp(log_k_M23 + eta.log_k_M23) -# k_M27 = exp(log_k_M27 + eta.log_k_M27) -# k_M31 = exp(log_k_M31 + eta.log_k_M31) -# k1 = exp(log_k1 + eta.log_k1) -# k2 = exp(log_k2 + eta.log_k2) -# g = expit(g_qlogis + eta.g_qlogis) -# f_DMTA_tffm0_1 = expit(f_DMTA_tffm0_1_qlogis + eta.f_DMTA_tffm0_1_qlogis) -# f_DMTA_tffm0_2 = expit(f_DMTA_tffm0_2_qlogis + eta.f_DMTA_tffm0_2_qlogis) -# f_DMTA_tffm0_3 = expit(f_DMTA_tffm0_3_qlogis + eta.f_DMTA_tffm0_3_qlogis) -# f_DMTA_to_M23 = f_DMTA_tffm0_1 -# f_DMTA_to_M27 = (1 - f_DMTA_tffm0_1) * f_DMTA_tffm0_2 -# f_DMTA_to_M31 = (1 - f_DMTA_tffm0_1) * (1 - f_DMTA_tffm0_2) * f_DMTA_tffm0_3 -# d/dt(DMTA) = -((k1 * g * exp(-k1 * time) + k2 * (1 - -# g) * exp(-k2 * time))/(g * exp(-k1 * time) + (1 - -# g) * exp(-k2 * time))) * DMTA -# d/dt(M23) = +f_DMTA_to_M23 * ((k1 * g * exp(-k1 * time) + -# k2 * (1 - g) * exp(-k2 * time))/(g * exp(-k1 * time) + -# (1 - g) * exp(-k2 * time))) * DMTA - k_M23 * M23 -# d/dt(M27) = +f_DMTA_to_M27 * ((k1 * g * exp(-k1 * time) + -# k2 * (1 - g) * exp(-k2 * time))/(g * exp(-k1 * time) + -# (1 - g) * exp(-k2 * time))) * DMTA - k_M27 * M27 + -# k_M31 * M31 -# d/dt(M31) = +f_DMTA_to_M31 * ((k1 * g * exp(-k1 * time) + -# k2 * (1 - g) * exp(-k2 * time))/(g * exp(-k1 * time) + -# (1 - g) * exp(-k2 * time))) * DMTA - k_M31 * M31 -# DMTA ~ add(sigma_low_DMTA) + prop(rsd_high_DMTA) -# M23 ~ add(sigma_low_M23) + prop(rsd_high_M23) -# M27 ~ add(sigma_low_M27) + prop(rsd_high_M27) -# M31 ~ add(sigma_low_M31) + prop(rsd_high_M31) -# }) -# } -# m_dmta_nlmixr_mkin <- nlmixr_model(f_dmta_mkin_tc, test_log_parms = TRUE) -# f_dmta_nlmixr_saem <- nlmixr(f_dmta_mkin_tc, est = "saem", control = saemControl(print = 250)) -# f_dmta_nlmixr_focei <- nlmixr(f_dmta_mkin_tc, est = "focei", control = foceiControl(print = 250)) -# plot(f_dmta_nlmixr_saem) -# plot(f_dmta_nlmixr_focei) -# diff --git a/tests/testthat/test_plot.R b/tests/testthat/test_plot.R index e08fe277..4f484cf3 100644 --- a/tests/testthat/test_plot.R +++ b/tests/testthat/test_plot.R @@ -33,10 +33,8 @@ test_that("Plotting mkinfit, mmkin and mixed model objects is reproducible", { plot_biphasic_mmkin <- function() plot(f_uba_dfop_sfo_mixed) vdiffr::expect_doppelganger("mixed model fit for mmkin object", plot_biphasic_mmkin) - if (saemix_available) { - plot_biphasic_saem_s <- function() plot(f_uba_dfop_sfo_saem) - vdiffr::expect_doppelganger("mixed model fit for saem object with saemix transformations", plot_biphasic_saem_s) - } + plot_biphasic_saem_s <- function() plot(f_uba_dfop_sfo_saem) + vdiffr::expect_doppelganger("mixed model fit for saem object with saemix transformations", plot_biphasic_saem_s) skip_on_travis() @@ -46,12 +44,10 @@ test_that("Plotting mkinfit, mmkin and mixed model objects is reproducible", { #plot_biphasic_mmkin <- function() plot(mixed(mmkin_biphasic)) # Biphasic fits with lots of data and fits have lots of potential for differences plot_biphasic_nlme <- function() plot(nlme_biphasic) - if (saemix_available) { - #plot_biphasic_saem_s <- function() plot(saem_biphasic_s) - plot_biphasic_saem_m <- function() plot(saem_biphasic_m) + #plot_biphasic_saem_s <- function() plot(saem_biphasic_s) + plot_biphasic_saem_m <- function() plot(saem_biphasic_m) - vdiffr::expect_doppelganger("mixed model fit for saem object with mkin transformations", plot_biphasic_saem_m) - } + vdiffr::expect_doppelganger("mixed model fit for saem object with mkin transformations", plot_biphasic_saem_m) # different results when working with eigenvalues plot_errmod_fit_D_obs_eigen <- function() plot_err(fit_D_obs_eigen, sep_obs = FALSE) -- cgit v1.2.1