list_rel_diff and testing_util tests

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)
+}
+
+

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
+})