Use mean rel diff in matrix check

AngusMcLure · Dec 11, 2023 · 43a52bb · 43a52bb
1 parent 5fec80a
commit 43a52bb
Show file tree

Hide file tree

Showing 2 changed files with 5 additions and 11 deletions.
diff --git a/R/test-util.R b/R/test-util.R
@@ -11,16 +11,10 @@ numeric_rel_diff <- function(act, exp, tolerance) {
 }
 
 matrix_rel_diff <- function(act, exp, tolerance) {
-  cm <- matrix(c(1,1,1,1), nrow = 2)
-  comp <- all.equal(act/exp, cm)
-  #comp <- mean(abs(act-exp)/mean(exp))
-  if(is.logical(comp)) return(TRUE) # All values are perfectly equal
+  mean_rd <- mean(abs(act-exp)/mean(exp))
+  if(mean_rd < tolerance) TRUE
   else {
-    mean_rel_diff <- as.numeric(strsplit(comp, " ")[[1]][4])
-    if(mean_rel_diff < tolerance) return(TRUE)
-    else {
-      warning(glue::glue("mean_rel_diff: {mean_rel_diff} is >= tolerance: {tolerance}"))
-      return(FALSE)
-    }
+    warning(glue::glue("Mean relative difference: {mean_rd} is >= tolerance: {tolerance}"))
+    FALSE
   }
 }
diff --git a/tests/testthat/test-fisher_information.R b/tests/testthat/test-fisher_information.R
@@ -29,7 +29,7 @@ test_that("fi_pool_cluster() outputs a 2x2 matrix for input vectors of length 2"
     pool_size = c(1, 2), pool_number = c(5, 10), prevalence = 0.01, correlation = 0.05,
     sensitivity = 0.95, specificity = 0.99)
   exp <- matrix(c(926.41807, -23.055960, -23.055960, 9.535592), nrow = 2)
-  expect_true(matrix_rel_diff(act, exp, tolerance = 1e-7))
+  expect_true(matrix_rel_diff(act, exp, tolerance = 1e-8))
 })
 
 # Input argument checks --------------------------------------------------------