From b6ea4f22fc1b6d1caea29f6b1e44774d14d6697c Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Mon, 3 Jun 2019 07:56:44 +0200 Subject: Status von Samstag morgen - untested --- tests/testthat/test_error_models.R | 42 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 42 insertions(+) (limited to 'tests') diff --git a/tests/testthat/test_error_models.R b/tests/testthat/test_error_models.R index d7a5cea8..94703e7f 100644 --- a/tests/testthat/test_error_models.R +++ b/tests/testthat/test_error_models.R @@ -177,3 +177,45 @@ test_that("Reweighting method 'tc' produces reasonable variance estimates", { # from 15 datasets expect_true(all(abs(tcf_met_2_15_tc_error_model_errors) < 0.10)) }) + +test_that("The two-component error model finds the best known AIC values for parent models", { + skip_on_cran() + experimental_data_for_UBA_2019 + library(parallel) + source("~/git/mkin/R/mkinfit.R") + source("~/git/mkin/R/mmkin.R") + f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data) + f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + error_model = "tc", error_model_algorithm = "direct") + f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + error_model = "tc", error_model_algorithm = "twostep") + f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + error_model = "tc", error_model_algorithm = "threestep") + f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + error_model = "tc", error_model_algorithm = "fourstep") + f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + error_model = "tc", error_model_algorithm = "IRLS") + AIC(f_9) + f_tc_exp <- mmkin(c("SFO"), + lapply(experimental_data_for_UBA_2019, function(x) x$data), + error_model = "tc", + error_model_algorithm = "direct", + quiet = TRUE) + f_tc_exp <- mmkin(c("SFO"), + lapply(experimental_data_for_UBA_2019, function(x) x$data), + error_model = "tc", + error_model_algorithm = "twostep", + quiet = TRUE) + f_tc_exp <- mmkin(c("SFO"), + lapply(experimental_data_for_UBA_2019, function(x) x$data), + error_model = "tc", + error_model_algorithm = "threestep", + quiet = TRUE) + + AIC_exp <- lapply(f_tc_exp, AIC) + dim(AIC_exp) <- dim(f_tc_exp) + dimnames(AIC_exp) <- dimnames(f_tc_exp) + expect_equivalent(round(AIC_exp["SFO", c(9, 11, 12)], 1), c(134.9, 125.5, 82.0)) +}) + + -- cgit v1.2.1 From 9a96391589fef9f80f9c6c4881cc48a509cb75f2 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Tue, 4 Jun 2019 11:15:52 +0200 Subject: Algorithms direct, two-, three-, fourstep, IRLS All of them are working now and allow for comparison Based on SFO, DFOP and HS fits to twelve test datasets, only the combination of direct and threestep is needed to find the lowest AIC --- tests/testthat/test_error_models.R | 50 ++++++++++++++++++++++++++++++++++---- 1 file changed, 45 insertions(+), 5 deletions(-) (limited to 'tests') diff --git a/tests/testthat/test_error_models.R b/tests/testthat/test_error_models.R index 94703e7f..c656f7d2 100644 --- a/tests/testthat/test_error_models.R +++ b/tests/testthat/test_error_models.R @@ -180,7 +180,6 @@ test_that("Reweighting method 'tc' produces reasonable variance estimates", { test_that("The two-component error model finds the best known AIC values for parent models", { skip_on_cran() - experimental_data_for_UBA_2019 library(parallel) source("~/git/mkin/R/mkinfit.R") source("~/git/mkin/R/mmkin.R") @@ -195,27 +194,68 @@ test_that("The two-component error model finds the best known AIC values for par error_model = "tc", error_model_algorithm = "fourstep") f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, error_model = "tc", error_model_algorithm = "IRLS") + f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + error_model = "tc", error_model_algorithm = "d_3") AIC(f_9) - f_tc_exp <- mmkin(c("SFO"), + f_10 <- mkinfit("DFOP", experimental_data_for_UBA_2019[[10]]$data, + error_model = "tc", error_model_algorithm = "IRLS") + f_tc_exp_direct <- mmkin(c("SFO", "DFOP", "HS"), lapply(experimental_data_for_UBA_2019, function(x) x$data), error_model = "tc", error_model_algorithm = "direct", quiet = TRUE) - f_tc_exp <- mmkin(c("SFO"), + f_tc_exp_twostep <- mmkin(c("SFO", "DFOP", "HS"), lapply(experimental_data_for_UBA_2019, function(x) x$data), error_model = "tc", error_model_algorithm = "twostep", quiet = TRUE) - f_tc_exp <- mmkin(c("SFO"), + f_tc_exp_threestep <- mmkin(c("SFO", "DFOP", "HS"), lapply(experimental_data_for_UBA_2019, function(x) x$data), error_model = "tc", error_model_algorithm = "threestep", quiet = TRUE) + f_tc_exp_fourstep <- mmkin(c("SFO", "DFOP", "HS"), + lapply(experimental_data_for_UBA_2019, function(x) x$data), + error_model = "tc", + error_model_algorithm = "fourstep", + quiet = TRUE) + f_tc_exp_IRLS <- mmkin(c("SFO", "DFOP", "HS"), + lapply(experimental_data_for_UBA_2019, function(x) x$data), + error_model = "tc", + error_model_algorithm = "IRLS", + quiet = TRUE) + + AIC_exp_direct <- lapply(f_tc_exp_direct, AIC) + AIC_exp_direct <- lapply(AIC_exp_direct, round, 1) + dim(AIC_exp_direct) <- dim(f_tc_exp_direct) + dimnames(AIC_exp_direct) <- dimnames(f_tc_exp_direct) + + AIC_exp_twostep <- lapply(f_tc_exp_twostep, AIC) + AIC_exp_twostep <- lapply(AIC_exp_twostep, round, 1) + dim(AIC_exp_twostep) <- dim(f_tc_exp_twostep) + dimnames(AIC_exp_twostep) <- dimnames(f_tc_exp_twostep) + + AIC_exp_threestep <- lapply(f_tc_exp_threestep, AIC) + AIC_exp_threestep <- lapply(AIC_exp_threestep, round, 1) + dim(AIC_exp_threestep) <- dim(f_tc_exp_threestep) + dimnames(AIC_exp_threestep) <- dimnames(f_tc_exp_threestep) + + AIC_exp_fourstep <- lapply(f_tc_exp_fourstep, AIC) + AIC_exp_fourstep <- lapply(AIC_exp_fourstep, round, 1) + dim(AIC_exp_fourstep) <- dim(f_tc_exp_fourstep) + dimnames(AIC_exp_fourstep) <- dimnames(f_tc_exp_fourstep) + + AIC_exp_IRLS <- lapply(f_tc_exp_IRLS, AIC) + AIC_exp_IRLS <- lapply(AIC_exp_IRLS, round, 1) + dim(AIC_exp_IRLS) <- dim(f_tc_exp_IRLS) + dimnames(AIC_exp_IRLS) <- dimnames(f_tc_exp_IRLS) AIC_exp <- lapply(f_tc_exp, AIC) dim(AIC_exp) <- dim(f_tc_exp) dimnames(AIC_exp) <- dimnames(f_tc_exp) - expect_equivalent(round(AIC_exp["SFO", c(9, 11, 12)], 1), c(134.9, 125.5, 82.0)) + unlist(AIC_exp["SFO", c(9, 11, 12)]) + expect_equivalent(round(unlist(AIC_exp["SFO", c(9, 11, 12)]), 1), + c(134.9, 125.5, 82.0)) }) -- cgit v1.2.1 From 95178837d3f91e84837628446b5fd468179af2b9 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Tue, 4 Jun 2019 15:09:28 +0200 Subject: Additional algorithm "d_c", more tests, docs The new algorithm tries direct optimization of the likelihood, as well as a three step procedure. In this way, we consistently get the model with the highest likelihood for SFO, DFOP and HS for all 12 new test datasets. --- tests/testthat/AIC_exp_d_3.out | 0 tests/testthat/FOCUS_2006_D.csf | 2 +- tests/testthat/test_error_models.R | 115 +++++++++++++------------------------ 3 files changed, 41 insertions(+), 76 deletions(-) create mode 100644 tests/testthat/AIC_exp_d_3.out (limited to 'tests') diff --git a/tests/testthat/AIC_exp_d_3.out b/tests/testthat/AIC_exp_d_3.out new file mode 100644 index 00000000..e69de29b diff --git a/tests/testthat/FOCUS_2006_D.csf b/tests/testthat/FOCUS_2006_D.csf index da2e2fbe..43215ec4 100644 --- a/tests/testthat/FOCUS_2006_D.csf +++ b/tests/testthat/FOCUS_2006_D.csf @@ -5,7 +5,7 @@ Description: MeasurementUnits: % AR TimeUnits: days Comments: Created using mkin::CAKE_export -Date: 2019-05-08 +Date: 2019-06-04 Optimiser: IRLS [Data] diff --git a/tests/testthat/test_error_models.R b/tests/testthat/test_error_models.R index c656f7d2..6bb93d48 100644 --- a/tests/testthat/test_error_models.R +++ b/tests/testthat/test_error_models.R @@ -178,84 +178,49 @@ test_that("Reweighting method 'tc' produces reasonable variance estimates", { expect_true(all(abs(tcf_met_2_15_tc_error_model_errors) < 0.10)) }) -test_that("The two-component error model finds the best known AIC values for parent models", { +test_that("The different error model fitting methods work for parent fits", { skip_on_cran() - library(parallel) - source("~/git/mkin/R/mkinfit.R") - source("~/git/mkin/R/mmkin.R") - f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data) - f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, - error_model = "tc", error_model_algorithm = "direct") - f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, - error_model = "tc", error_model_algorithm = "twostep") - f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, - error_model = "tc", error_model_algorithm = "threestep") - f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, - error_model = "tc", error_model_algorithm = "fourstep") - f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, - error_model = "tc", error_model_algorithm = "IRLS") - f_9 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, - error_model = "tc", error_model_algorithm = "d_3") - AIC(f_9) - f_10 <- mkinfit("DFOP", experimental_data_for_UBA_2019[[10]]$data, - error_model = "tc", error_model_algorithm = "IRLS") - f_tc_exp_direct <- mmkin(c("SFO", "DFOP", "HS"), - lapply(experimental_data_for_UBA_2019, function(x) x$data), - error_model = "tc", - error_model_algorithm = "direct", - quiet = TRUE) - f_tc_exp_twostep <- mmkin(c("SFO", "DFOP", "HS"), - lapply(experimental_data_for_UBA_2019, function(x) x$data), - error_model = "tc", - error_model_algorithm = "twostep", - quiet = TRUE) - f_tc_exp_threestep <- mmkin(c("SFO", "DFOP", "HS"), - lapply(experimental_data_for_UBA_2019, function(x) x$data), - error_model = "tc", - error_model_algorithm = "threestep", - quiet = TRUE) - f_tc_exp_fourstep <- mmkin(c("SFO", "DFOP", "HS"), - lapply(experimental_data_for_UBA_2019, function(x) x$data), - error_model = "tc", - error_model_algorithm = "fourstep", - quiet = TRUE) - f_tc_exp_IRLS <- mmkin(c("SFO", "DFOP", "HS"), + + f_9_OLS <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + quiet = TRUE) + expect_equivalent(round(AIC(f_9_OLS), 2), 137.43) + + f_9_direct <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + error_model = "tc", error_model_algorithm = "direct", quiet = TRUE) + expect_equivalent(round(AIC(f_9_direct), 2), 134.94) + + f_9_twostep <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + error_model = "tc", error_model_algorithm = "twostep", quiet = TRUE) + expect_equivalent(round(AIC(f_9_twostep), 2), 134.94) + + f_9_threestep <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + error_model = "tc", error_model_algorithm = "threestep", quiet = TRUE) + expect_equivalent(round(AIC(f_9_threestep), 2), 139.43) + + f_9_fourstep <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + error_model = "tc", error_model_algorithm = "fourstep", quiet = TRUE) + expect_equivalent(round(AIC(f_9_fourstep), 2), 139.43) + + f_9_IRLS <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + error_model = "tc", error_model_algorithm = "IRLS", quiet = TRUE) + expect_equivalent(round(AIC(f_9_IRLS), 2), 139.43) + + f_9_d_3 <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + error_model = "tc", error_model_algorithm = "d_3", quiet = TRUE) + expect_equivalent(round(AIC(f_9_d_3), 2), 134.94) +}) + +test_that("The default error model algorithm finds the best known AIC values for parent fits", { + f_tc_exp_d_3 <- mmkin(c("SFO", "DFOP", "HS"), lapply(experimental_data_for_UBA_2019, function(x) x$data), error_model = "tc", - error_model_algorithm = "IRLS", + error_model_algorithm = "d_3", quiet = TRUE) - AIC_exp_direct <- lapply(f_tc_exp_direct, AIC) - AIC_exp_direct <- lapply(AIC_exp_direct, round, 1) - dim(AIC_exp_direct) <- dim(f_tc_exp_direct) - dimnames(AIC_exp_direct) <- dimnames(f_tc_exp_direct) - - AIC_exp_twostep <- lapply(f_tc_exp_twostep, AIC) - AIC_exp_twostep <- lapply(AIC_exp_twostep, round, 1) - dim(AIC_exp_twostep) <- dim(f_tc_exp_twostep) - dimnames(AIC_exp_twostep) <- dimnames(f_tc_exp_twostep) - - AIC_exp_threestep <- lapply(f_tc_exp_threestep, AIC) - AIC_exp_threestep <- lapply(AIC_exp_threestep, round, 1) - dim(AIC_exp_threestep) <- dim(f_tc_exp_threestep) - dimnames(AIC_exp_threestep) <- dimnames(f_tc_exp_threestep) - - AIC_exp_fourstep <- lapply(f_tc_exp_fourstep, AIC) - AIC_exp_fourstep <- lapply(AIC_exp_fourstep, round, 1) - dim(AIC_exp_fourstep) <- dim(f_tc_exp_fourstep) - dimnames(AIC_exp_fourstep) <- dimnames(f_tc_exp_fourstep) - - AIC_exp_IRLS <- lapply(f_tc_exp_IRLS, AIC) - AIC_exp_IRLS <- lapply(AIC_exp_IRLS, round, 1) - dim(AIC_exp_IRLS) <- dim(f_tc_exp_IRLS) - dimnames(AIC_exp_IRLS) <- dimnames(f_tc_exp_IRLS) - - AIC_exp <- lapply(f_tc_exp, AIC) - dim(AIC_exp) <- dim(f_tc_exp) - dimnames(AIC_exp) <- dimnames(f_tc_exp) - unlist(AIC_exp["SFO", c(9, 11, 12)]) - expect_equivalent(round(unlist(AIC_exp["SFO", c(9, 11, 12)]), 1), - c(134.9, 125.5, 82.0)) -}) - + AIC_exp_d_3 <- lapply(f_tc_exp_d_3, AIC) + AIC_exp_d_3 <- lapply(AIC_exp_d_3, round, 1) + dim(AIC_exp_d_3) <- dim(f_tc_exp_d_3) + dimnames(AIC_exp_d_3) <- dimnames(f_tc_exp_d_3) + expect_known_output(AIC_exp_d_3, "AIC_exp_d_3.out") +}) -- cgit v1.2.1 From 307a317666b8a1cdfe2293371ad8671403680a36 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Tue, 4 Jun 2019 21:10:58 +0200 Subject: Fix a bug introduced in the last commit --- tests/testthat/test_error_models.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'tests') diff --git a/tests/testthat/test_error_models.R b/tests/testthat/test_error_models.R index 6bb93d48..404f02ab 100644 --- a/tests/testthat/test_error_models.R +++ b/tests/testthat/test_error_models.R @@ -181,7 +181,7 @@ test_that("Reweighting method 'tc' produces reasonable variance estimates", { test_that("The different error model fitting methods work for parent fits", { skip_on_cran() - f_9_OLS <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, + f_9_OLS <- mkinfit("SFO", experimental_data_for_UBA_2019[[9]]$data, quiet = TRUE) expect_equivalent(round(AIC(f_9_OLS), 2), 137.43) -- cgit v1.2.1 From 4b323789265213bd65165873e7efe5e45a579275 Mon Sep 17 00:00:00 2001 From: Johannes Ranke Date: Wed, 5 Jun 2019 15:45:31 +0200 Subject: Adapt tests to new algorithms and output One of the tests exceeded the number of iterations when using the d_3 error model algorithm, so only use "direct" in this case. --- tests/testthat/FOCUS_2006_D.csf | 2 +- tests/testthat/summary_DFOP_FOCUS_C.txt | 5 +++-- tests/testthat/test_error_models.R | 2 +- 3 files changed, 5 insertions(+), 4 deletions(-) (limited to 'tests') diff --git a/tests/testthat/FOCUS_2006_D.csf b/tests/testthat/FOCUS_2006_D.csf index 43215ec4..668b1151 100644 --- a/tests/testthat/FOCUS_2006_D.csf +++ b/tests/testthat/FOCUS_2006_D.csf @@ -5,7 +5,7 @@ Description: MeasurementUnits: % AR TimeUnits: days Comments: Created using mkin::CAKE_export -Date: 2019-06-04 +Date: 2019-06-05 Optimiser: IRLS [Data] diff --git a/tests/testthat/summary_DFOP_FOCUS_C.txt b/tests/testthat/summary_DFOP_FOCUS_C.txt index fb8051c5..5c6f4257 100644 --- a/tests/testthat/summary_DFOP_FOCUS_C.txt +++ b/tests/testthat/summary_DFOP_FOCUS_C.txt @@ -12,8 +12,9 @@ Model predictions using solution type analytical Fitted using test 0 model solutions performed in test time 0 s -Error model: -Constant variance +Error model: Constant variance + +Error model algorithm: d_3 Starting values for parameters to be optimised: value type diff --git a/tests/testthat/test_error_models.R b/tests/testthat/test_error_models.R index 404f02ab..fa1f7131 100644 --- a/tests/testthat/test_error_models.R +++ b/tests/testthat/test_error_models.R @@ -153,7 +153,7 @@ test_that("Reweighting method 'tc' produces reasonable variance estimates", { # For a single fit, we get a relative error of less than 10% in the error # model components f_met_2_tc_e4 <- mkinfit(m_synth_DFOP_lin, d_met_2_15[[1]], quiet = TRUE, - error_model = "tc") + error_model = "tc", error_model_algorithm = "direct") parm_errors_met_2_tc_e4 <- (f_met_2_tc_e4$errparms - c(0.5, 0.07)) / c(0.5, 0.07) expect_true(all(abs(parm_errors_met_2_tc_e4) < 0.1)) -- cgit v1.2.1