diff --git a/R/test-util.R b/R/test-util.R deleted file mode 100644 index 70c432b..0000000 --- a/R/test-util.R +++ /dev/null @@ -1,20 +0,0 @@ -# To address issue [#27](https://github.com/AngusMcLure/PoolPoweR/issues/27). -# Ensures that relative tolerance is used between small values when testing for -# equality. -numeric_rel_diff <- function(act, exp, tolerance) { - rd <- abs(act-exp)/abs(exp) - if(rd < tolerance) TRUE - else { - warning(glue::glue("Relative difference: {rd} is >= tolerance: {tolerance}")) - FALSE - } -} - -matrix_rel_diff <- function(act, exp, tolerance) { - mean_rd <- mean(abs(act-exp)/mean(exp)) - if(mean_rd < tolerance) TRUE - else { - warning(glue::glue("Mean relative difference: {mean_rd} is >= tolerance: {tolerance}")) - FALSE - } -} diff --git a/R/testing_util.R b/R/testing_util.R new file mode 100644 index 0000000..4a76cb2 --- /dev/null +++ b/R/testing_util.R @@ -0,0 +1,31 @@ +# To address issue [#27](https://github.com/AngusMcLure/PoolPoweR/issues/27). +# Ensures that relative tolerance is used between small values when testing for +# equality. +numeric_rel_diff <- function(act, exp, tolerance, var_name=FALSE) { + rd <- abs(act-exp)/abs(exp) + if(rd < tolerance) return(TRUE) + else { + if(is.character(var_name)) message(glue::glue("In {var_name}:")) + message(glue::glue("Relative difference: {rd} is >= tolerance: {tolerance}")) + return(FALSE) + } +} + +matrix_rel_diff <- function(act, exp, tolerance) { + mean_rd <- mean(abs(act-exp)/mean(abs(exp))) + if(mean_rd < tolerance) return(TRUE) + else { + message(glue::glue("Mean relative difference: {mean_rd} is >= tolerance: {tolerance}")) + return(FALSE) + } +} + +list_rel_diff <- function(act, exp, tolerance) { + var_names <- names(act) + comp <- mapply(numeric_rel_diff, act, exp, var_names, + MoreArgs = list(tolerance = tolerance)) + if(any(!comp)) return(FALSE) + return(TRUE) +} + + diff --git a/tests/testthat/test-testing_util.R b/tests/testthat/test-testing_util.R new file mode 100644 index 0000000..0459005 --- /dev/null +++ b/tests/testthat/test-testing_util.R @@ -0,0 +1,28 @@ +test_that("numeric_rel_diff()", { + expect_true(numeric_rel_diff(0.0234491, 0.0234492, tolerance = 1e-5)) + expect_false(numeric_rel_diff(0.0234491, 0.0234492, tolerance = 1e-6)) +}) + +test_that("list_rel_diff()", { + act <- list(x=1, y=2, z=0.2513798) + exp <- list(x=1, y=2, z=0.2514) + expect_true(list_rel_diff(act, exp, 1e-4)) + expect_false(list_rel_diff(act, exp, 1e-5)) +}) + +test_that("matrix_rel_diff() with rounding", { + act <- matrix(c(0.3931327, -0.6625920, 0.8810527, -0.8209938), nrow = 2) + exp <- matrix(c(0.3931, -0.6626, 0.8811, -0.8210), nrow = 2) + expect_true(matrix_rel_diff(act, exp, tolerance = 1e-4)) + expect_false(matrix_rel_diff(act, exp, tolerance = 1e-5)) + + # What happens when you have a big range + act <- matrix(c(888, 0.0012345, 777, 222), nrow = 2) + exp <- matrix(c(888, 0.001235, 777, 222), nrow = 2) + expect_true(matrix_rel_diff(act, exp, tolerance = 1e-5)) + + act <- matrix(c(888, 0.0012345, 777, 222), nrow = 2) + exp <- matrix(c(900, 0.001235, 777, 222), nrow = 2) + expect_true(matrix_rel_diff(act, exp, tolerance = 1e-2)) + # hmm +})