Add tests to improve optimise_prevalence.R cover.

Fix (temporary) catch for interval in optimise_s_prevalence().

.Rbuildignore

@@ -6,7 +6,7 @@
 ^Figures*
 man/hello.Rd
 ^LICENSE\.md$
-dependencies/
+^dev_resources/$
 ^\.github$
 ^PoolPoweR\.Rproj$
 ^CHANGELOG.md$

CHANGELOG.md

@@ -23,15 +23,16 @@ and this project adheres to
 **Focus:** Package
 - [ ] Fix integrand issue  
 - [ ] Implement codecov.io  
+- [ ] Refactor functions (i.e. break down into smaller ones for readability)
 - [ ] Configure and optimise GHA workflows
-- [ ] Refer to package and tidyverse guides for coherency and note rooms for improvement
 
 ### [v0.0.3]
 **Focus:** Documentation
 - [ ] Revise documentation so majority @inheritParams fi_pool
 - [ ] Rename interval [#13](https://github.com/AngusMcLure/PoolPoweR/issues/13)
 - [ ] Update docs with cluster and non-cluster cases
 [#14](https://github.com/AngusMcLure/PoolPoweR/issues/14)
+- [ ] Add PoolPoweR-package.R (#18)  
 - [x] Rename real.scale to real_scale
 
 ### [v0.0.2] - 2023-12-01

R/fisher_information.R

@@ -305,7 +305,7 @@ fi_pool_cluster <- function(pool_size,
             prod(choose(N, y))
         })
       }
-    }
+    } ## End for form == "beta"
     tol <- 1e-5
     if (abs(sum(lik) - 1) > tol ||
       abs(sum(lik_theta)) > tol ||

R/optimise_prevalence.R

@@ -78,6 +78,8 @@ optimise_s_prevalence <- function(pool_number = 1,
          respect to s often has mulitple minima and therefore the discrete
          distribution is not currently supported for optimisation')
   }
+  if (interval < 0) stop("interval must be 0 or higher")
+
   invalid_cost <- FALSE # trigger for when costs are infinite to ensure that there's no cost output in these cases
   # print(c(theta = prevalence, sens = sensitivity, spec = specificity, unit = cost_unit, test = cost_pool, location =cost_cluster , rho = correlation, N = N, form = form, max_s = max_s))
 
@@ -173,8 +175,6 @@ optimise_s_prevalence <- function(pool_number = 1,
       cost_interval = cost_interval,
       catch_interval = N * c(lower, upper)
     )
-  } else {
-    stop("interval must be between 0 and 1.")
   }
   out
 }
@@ -219,10 +219,10 @@ optimise_sN_prevalence <- function(prevalence,
     }
     opt$N <- Nopt
     if (opt$N == max_N) {
-      warning("Maximum cost effectivness is achieved at or above the maximum number of pools allowed. Consider increasing max.N")
+      warning("Maximum cost effectivness is achieved at or above the maximum number of pools allowed. Consider increasing max_N")
     }
     if (opt$s == max_s) {
-      warning("Maximum cost effectivness is achieved at or above the maximum size of pools allowed. Consider increasing max.s")
+      warning("Maximum cost effectivness is achieved at or above the maximum size of pools allowed. Consider increasing max_s")
     }
   }
 

tests/testthat/test-design_effect.R

@@ -1,4 +1,15 @@
 test_that("design_effect() gives consistent output for basic tests", {
+  # This one has reasonable inputs
+  expect_equal(
+    design_effect(
+      pool_size = 5,
+      pool_number = 10,
+      prevalence = 0.01,
+      correlation = 0.05,
+      sensitivity = 0.99,
+      specificity = 0.95),
+    0.7240988, tolerance = 1e-7
+  )
   expect_equal(
     design_effect(
       pool_size = 10,

tests/testthat/test-optimise_prevalence.R

@@ -1,4 +1,11 @@
 test_that("optimise_sN_prevalence() gives consistent output for basic tests", {
+  # Reasonable params
+  expect_true(all.equal(
+    optimise_sN_prevalence(
+      prevalence = 0.01, cost_unit = 5, cost_pool = 10,
+      cost_cluster = 100, correlation = 0.05
+    ), list(s=5,cost =0.2513798, catch=20, N=4),tolerance=1e-7))
+  # Rest not so much
   expect_true(all.equal(
     optimise_sN_prevalence(
       prevalence = 0.9,
@@ -31,7 +38,7 @@ test_that("optimise_sN_prevalence() gives consistent output for basic tests", {
   ))
 })
 
-test_that("optimise_sN_prevalence() basic tests when correlation == 0 (flow control)", {
+test_that("optimise_sN_prevalence() when correlation == 0", {
   expect_true(all.equal(
     optimise_sN_prevalence(
       prevalence = 0.9,
@@ -49,7 +56,33 @@ test_that("optimise_sN_prevalence() basic tests when correlation == 0 (flow cont
   ))
 })
 
+test_that("optimise_sN_prevalence() when opt$N == max_N", {
+  expect_warning(
+    optimise_sN_prevalence(
+      prevalence = 0.01, cost_unit = 5, cost_pool = 10,
+      cost_cluster = 100, correlation = 0.05, max_N = 4),
+    "Maximum cost effectivness is achieved at or above the maximum number of pools allowed. Consider increasing max_N")
+})
+
+# TODO: fix this
+#test_that("optimise_sN_prevalence() when opt$s == max_s", {
+#  # Not an amazing text, catches all the optimise_s_prevalence() warnings too
+#  tryCatch(
+#  optimise_sN_prevalence(
+#    prevalence = 0.01, cost_unit = 5, cost_pool = 10,
+#    cost_cluster = 100, correlation = 0.05, max_s = 5)
+#  )
+#  expect_warning()
+#
+#})
+
 test_that("optimise_s_prevalence() gives consistent output for basic tests", {
+  # Reasonable parameters
+  expect_true(all.equal(
+    optimise_s_prevalence(prevalence = 0.01, cost_unit = 5, cost_pool = 10),
+    list(s=19, cost=0.05998076, catch=19), tolerance = 1e-7
+  ))
+  # Not very
   expect_true(all.equal(
     optimise_s_prevalence(
       prevalence = 0.7, cost_unit = 10, cost_pool = 100,
@@ -72,7 +105,42 @@ test_that("optimise_s_prevalence() gives consistent output for basic tests", {
   ))
 })
 
+test_that("optimise_s_prevalence() throws error when form == 'discrete'", {
+  expect_error(optimise_s_prevalence(
+    prevalence = 0.01, cost_unit = 5, cost_pool = 10, form = "discrete"),
+    'When form = "discrete" the cost of unit information function with
+         respect to s often has mulitple minima and therefore the discrete
+         distribution is not currently supported for optimisation')
+})
+
+test_that("optimise_s_prevalence() when cost_unit == Inf", {
+  expect_true(all.equal(
+    optimise_s_prevalence(prevalence = 0.01, cost_unit = Inf, cost_pool = 10, interval = 0.1),
+    list(s=1, cost=NA, catch=1, s_interval=c(1,19), cost_interval=NA, catch_interval=c(1,19))
+    ))
+})
+
+test_that("optimise_s_prevalence() when cost_pool == Inf", {
+  expect_true(all.equal(
+    optimise_s_prevalence(prevalence = 0.1, cost_unit = 5, cost_pool = Inf, interval = 0.1),
+    list(s=15, cost=NA, catch=15, s_interval=c(10,21), cost_interval=NA, catch_interval=c(10,21))
+  ))
+})
+
+test_that("optimise_s_prevalence() hits max_s when determining cost floor/ceiling", {
+  expect_warning(
+    optimise_s_prevalence(prevalence = 0.01, cost_unit = 5, cost_pool = Inf, max_s = 50),
+    'Maximum cost effectivness is achieved at or above the maximum size of pools allowed. Consider increasing max_s')
+})
+
+test_that("optimise_s_prevalence() when cost(max_s) < max_cost", {
+  expect_warning(
+    optimise_s_prevalence(prevalence = 0.1, cost_pool = 1, cost_unit = 0.5, max_s = 6, interval = 0.1),
+    'A pool size greater than max_s may fall within the specified range of cost effectiveness. Consider increasing max_s')
+})
+
 test_that("optimise_s_prevalence() extremely bad integrand behaviour", {
+  # This takes a few seconds to run
   expect_error(
     optimise_s_prevalence(
       prevalence = 0.2, cost_unit = 1, cost_pool = 200,

tests/testthat/test-util.R

@@ -0,0 +1,11 @@
+# As util helper functions will be used to catch warnings soon
+test_that("interval is >= 0", {
+  expect_error(
+    optimise_s_prevalence(prevalence = 0.01, cost_unit = 5, cost_pool = 10, interval = -1),
+    'interval must be 0 or higher')
+  expect_equal(
+    optimise_s_prevalence(prevalence = 0.1, cost_unit = 5, cost_pool = 10, interval = 2),
+    list(s=5, cost=0.786439, catch =5, s_interval=c(1,25),
+         cost_interval=c(1.35, 2.262155), catch_interval=c(1,25)),
+    tolerance = 1e-7)
+})