From dd4e62ad803b74667378808aa0249cab6326d05c Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Mon, 25 Feb 2019 19:12:46 +0100 Subject: Test CAKE export --- tests/testthat/FOCUS_2006_D.csf | 52 ++++++++++++++++++++++++ tests/testthat/FOCUS_2006_D.txt | 0 tests/testthat/test_CAKE_export.R | 51 +++++++++++++++++++++++ tests/testthat/test_FOCUS_D_UBA_expertise.R | 2 +- tests/testthat/test_plots_summary_twa.R | 2 + tests/testthat/test_plots_twa.R | 63 ----------------------------- 6 files changed, 106 insertions(+), 64 deletions(-) create mode 100644 tests/testthat/FOCUS_2006_D.csf create mode 100644 tests/testthat/FOCUS_2006_D.txt create mode 100644 tests/testthat/test_CAKE_export.R delete mode 100644 tests/testthat/test_plots_twa.R (limited to 'tests') diff --git a/tests/testthat/FOCUS_2006_D.csf b/tests/testthat/FOCUS_2006_D.csf new file mode 100644 index 00000000..d695e90d --- /dev/null +++ b/tests/testthat/FOCUS_2006_D.csf @@ -0,0 +1,52 @@ +[FileInfo] +CAKE-Version: 3.3 (Release) +Name: FOCUS 2006 D +Description: +MeasurementUnits: % AR +TimeUnits: days +Comments: Created using mkin::CAKE_export +Date: 2019-02-25 +Optimiser: IRLS + +[Data] +NewDataSet: FOCUS C +Time Parent +0 85.1 +1 57.9 +3 29.9 +7 14.6 +14 9.7 +28 6.6 +63 4 +91 3.9 +119 0.6 + +NewDataSet: FOCUS D +Time Parent M1 +0 99.46 0 +0 102.04 0 +1 93.5 4.84 +1 92.5 5.64 +3 63.23 12.91 +3 68.99 12.96 +7 52.32 22.97 +7 55.13 24.47 +14 27.27 41.69 +14 26.64 33.21 +21 11.5 44.37 +21 11.64 46.44 +35 2.85 41.22 +35 2.91 37.95 +50 0.69 41.19 +50 0.63 40.01 +75 0.05 40.09 +75 0.06 33.85 +100 31.04 +100 33.13 +120 25.15 +120 33.31 + + +[ComponentNames] +Parent:parent +M1:m1 diff --git a/tests/testthat/FOCUS_2006_D.txt b/tests/testthat/FOCUS_2006_D.txt new file mode 100644 index 00000000..e69de29b diff --git a/tests/testthat/test_CAKE_export.R b/tests/testthat/test_CAKE_export.R new file mode 100644 index 00000000..aeb192c8 --- /dev/null +++ b/tests/testthat/test_CAKE_export.R @@ -0,0 +1,51 @@ +# Copyright (C) 2019 Johannes Ranke +# Contact: jranke@uni-bremen.de + +# This file is part of the R package mkin + +# mkin is free software: you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation, either version 3 of the License, or (at your option) any later +# version. + +# This program is distributed in the hope that it will be useful, but WITHOUT +# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS +# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more +# details. + +# You should have received a copy of the GNU General Public License along with +# this program. If not, see + +context("Export dataset for reading into CAKE") + +test_that("Exporting is reproducible", { + CAKE_export(list("FOCUS C" = FOCUS_2006_C, + "FOCUS D" = FOCUS_2006_D), + map = c(parent = "Parent", m1 = "M1"), + filename = "FOCUS_2006_D.csf", overwrite = TRUE, + study = "FOCUS 2006 D") + csf <- readLines(con = "FOCUS_2006_D.csf") + expect_known_output(csf, "FOCUS_2006_D.txt") +}) + +test_that("Test data from Appendix D are correctly evaluated", { + expect_message(res <- nafta(MRID_555555, "MRID 555555")) + + # From Figure D.1 + dtx_sop <- matrix(c(407, 541, 429, 1352, 5192066, 2383), nrow = 3, ncol = 2) + expect_equivalent(res$distimes[, 1:2], dtx_sop, tolerance = 1, + scale = 1) + + C0_sop <- c(SFO = 83.8, IORE = 96.9, DFOP = 97.6) + C0_mkin <- sapply(res$parameters, function(x) x["parent_0", "Estimate"]) + expect_equivalent(C0_mkin, C0_sop, scale = 1, tolerance = 0.1) + + expect_equal(round(res$S_c), 717) + expect_equal(signif(res$S[["SFO"]], 3), 1.38e+3) + expect_equal(round(res$t_rep), 841) + + expect_known_output(print(res), "print_nafta_analysis.txt") + + plot_nafta <- function() plot(res) + vdiffr::expect_doppelganger("Plot NAFTA analysis", plot_nafta) +}) diff --git a/tests/testthat/test_FOCUS_D_UBA_expertise.R b/tests/testthat/test_FOCUS_D_UBA_expertise.R index 74097afa..42c4fcfb 100644 --- a/tests/testthat/test_FOCUS_D_UBA_expertise.R +++ b/tests/testthat/test_FOCUS_D_UBA_expertise.R @@ -1,4 +1,4 @@ -# Copyright (C) 2015,2018 Johannes Ranke +# Copyright (C) 2015,2019 Johannes Ranke # Contact: jranke@uni-bremen.de # This file is part of the R package mkin diff --git a/tests/testthat/test_plots_summary_twa.R b/tests/testthat/test_plots_summary_twa.R index d5f4f199..5201567d 100644 --- a/tests/testthat/test_plots_summary_twa.R +++ b/tests/testthat/test_plots_summary_twa.R @@ -68,10 +68,12 @@ context("Plotting") test_that("Plotting mmkin objects is reproducible", { skip_on_cran() plot_sep_FOCUS_C_SFO <- function() plot_sep(fits[["SFO", "FOCUS_C"]]) + mkinparplot_FOCUS_C_SFO <- function() mkinparplot(fits[["SFO", "FOCUS_C"]]) mmkin_FOCUS_C <- function() plot(fits[, "FOCUS_C"]) mmkin_SFO <- function() plot(fits["SFO",]) vdiffr::expect_doppelganger("mkinfit plot for FOCUS C with sep = TRUE", plot_sep_FOCUS_C_SFO) + vdiffr::expect_doppelganger("mkinparplot for FOCUS C SFO", mkinparplot_FOCUS_C_SFO) vdiffr::expect_doppelganger("mmkin plot for FOCUS C", mmkin_FOCUS_C) vdiffr::expect_doppelganger("mmkin plot for SFO (FOCUS C and D)", mmkin_SFO) }) diff --git a/tests/testthat/test_plots_twa.R b/tests/testthat/test_plots_twa.R deleted file mode 100644 index ff899bc9..00000000 --- a/tests/testthat/test_plots_twa.R +++ /dev/null @@ -1,63 +0,0 @@ -# Copyright (C) 2016-2019 Johannes Ranke -# Contact: jranke@uni-bremen.de - -# This file is part of the R package mkin - -# mkin is free software: you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation, either version 3 of the License, or (at your option) any later -# version. - -# This program is distributed in the hope that it will be useful, but WITHOUT -# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS -# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more -# details. - -# You should have received a copy of the GNU General Public License along with -# this program. If not, see - -models <- c("SFO", "FOMC", "DFOP", "HS") -fits <- mmkin(models, - list(FOCUS_C = FOCUS_2006_C, FOCUS_D = FOCUS_2006_D), - quiet = TRUE, cores = if (Sys.getenv("TRAVIS") == "") 15 else 1) - -context("Calculation of maximum time weighted average concentrations (TWAs)") - -test_that("Time weighted average concentrations are correct", { - skip_on_cran() - - outtimes_10 <- seq(0, 10, length.out = 10000) - - for (ds in c("FOCUS_C", "FOCUS_D")) { - for (model in models) { - fit <- fits[[model, ds]] - bpar <- summary(fit)$bpar[, "Estimate"] - pred_10 <- mkinpredict(fit$mkinmod, - odeparms = bpar[2:length(bpar)], - odeini = c(parent = bpar[[1]]), - outtimes = outtimes_10) - twa_num <- mean(pred_10$parent) - names(twa_num) <- 10 - twa_ana <- max_twa_parent(fit, 10) - - # Test for absolute difference (scale = 1) - # The tolerance can be reduced if the length of outtimes is increased, - # but this needs more computing time so we stay with lenght.out = 10k - expect_equal(twa_num, twa_ana, tolerance = 0.003, scale = 1) - } - } -}) - -context("Plotting") - -test_that("Plotting mmkin objects is reproducible", { - skip_on_cran() - plot_sep_FOCUS_C_SFO <- function() plot_sep(fits[["SFO", "FOCUS_C"]]) - mmkin_FOCUS_C <- function() plot(fits[, "FOCUS_C"]) - mmkin_SFO <- function() plot(fits["SFO",]) - - vdiffr::expect_doppelganger("mkinfit plot for FOCUS C with sep = TRUE", plot_sep_FOCUS_C_SFO) - vdiffr::expect_doppelganger("mmkin plot for FOCUS C", mmkin_FOCUS_C) - vdiffr::expect_doppelganger("mmkin plot for SFO (FOCUS C and D)", mmkin_SFO) -}) - -- cgit v1.2.1