DEV: Add variable_design, tests and docs

NAMESPACE

@@ -26,3 +26,4 @@ export(power_pool_random)
 export(power_size_results)
 export(sample_size_pool)
 export(sample_size_pool_random)
+export(variable_design)

R/sample_design.R

@@ -1,12 +1,22 @@
-#' fixed_design s3 constructor
+#' S3 sample_design constructors
 #'
 #' Stores parameters related to the sampling design. Aims to reduce having to
-#' input each param separately across functions (e.g. power/optimise).
+#' input each param separately across functions (e.g. power/optimise). Can
+#' either be of class `fixed_design` or `variable_design`.
 #'
 #' @param pool_size numeric/NULL The number of units per pool. Must be a numeric
-#'   value greater than 0.
+#'   value greater than 0. `fixed_design` only.
 #' @param pool_number numeric/NULL The number of pools per cluster. Numeric
-#'   inputs must be an integer greater than or equal to 1.
+#'   inputs must be an integer greater than or equal to 1. `fixed_design` only.
+#' @param catch_dist An object of class `distribution` (e.g. produced by
+#'   `nb_catch()`) defining the distribution of the possible catch. If
+#'   `correlation = 0` the catch is for the whole survey. For `correlation > 0`
+#'   the catch is per cluster (i.e. cluster size). `variable_design` only.
+#' @param pool_strat function Defines a rule for how a number of units will be
+#'   divided into pools. Must take a single numeric argument and return a named
+#'   list of pool sizes and pool numbers. `pool_max_size()` and
+#'   `pool_target_number` provide convenience functions for defining common
+#'   pooling strategies. `variable_design` only.
 #' @param sensitivity numeric The probability that the test correctly identifies
 #'   a true positive. Must be a numeric value between 0 and 1, inclusive of
 #'   both. A value of 1 indicates that the test can perfectly identify all true
@@ -20,16 +30,35 @@
 #' @export
 #'
 #' @examples
-#' perfect <- fixed_design(pool_size = 10)
+#' fd_perfect <- fixed_design(pool_size = 10)
 #' 
-#' imperfect <- fixed_design(
+#' fd_imperfect <- fixed_design(
 #'   pool_size = 10, pool_number = NULL, sensitivity = 0.95, specificity = 0.99
 #' )
+#' 
+#' vd_target <- variable_design(
+#'   catch_dist = nb_catch(10, 11),
+#'   pool_strat = pool_target_number(20)
+#' )
+#' 
+#' vd_max <- variable_design(
+#'   catch_dist = nb_catch(10, 11),
+#'   pool_strat = pool_max_size(20)
+#' )
+#' 
+#' vd_max_imperfect <- variable_design(
+#'   catch_dist = nb_catch(10, 11),
+#'   pool_strat = pool_max_size(20),
+#'   sensitivity = 0.95,
+#'   specificity = 0.98
+#' )
 fixed_design <- function(pool_size = NULL,
                          pool_number = NULL,
                          sensitivity = 1,
                          specificity = 1) {
 
+  # allow NULLs for optimise functions to identify which 
+  # variable should be optimised
   if (!is.null(pool_size)) {
     check_geq2(pool_size, 0)
   }
@@ -51,3 +80,24 @@ fixed_design <- function(pool_size = NULL,
   )
 }
 
+#' @rdname fixed_design
+#' @export
+variable_design <- function(catch_dist, 
+                            pool_strat,
+                            sensitivity = 1,
+                            specificity = 1) {
+
+  # sens and spec cannot be NULL
+  check_in_range2(sensitivity)
+  check_in_range2(specificity)
+
+  structure(
+    list(
+      catch_dist = catch_dist,
+      pool_strat = pool_strat,
+      sensitivity = sensitivity,
+      specificity = specificity
+    ),
+    class = c("variable_design", "sample_design")
+  )
+}

tests/testthat/test-sample_design.R

@@ -1,11 +1,12 @@
-# fixtures ----
+# fixed_design ----
+## fixtures ----
 fixed_perfect <- fixed_design(
   pool_size = 10, pool_number = NULL, sensitivity = 1, specificity = 1
 )
 
 fixed_null <- fixed_design() # sens/spec == 1, pool_size/num == NULL
 
-# fixed_design ----
+## test ----
 test_that("fixed_design constructor", {
   expect_equal(class(fixed_perfect), c("fixed_design", "sample_design"))
   expect_equal(fixed_perfect$pool_size, 10)
@@ -26,3 +27,34 @@ test_that("fixed_design bad inputs caught", {
   expect_error(fixed_design(pool_size = -1))
   expect_error(fixed_design(pool_number = -1))
 })
+
+# variable_design ----
+## fixtures ----
+
+var_target <- variable_design(
+  catch_dist = nb_catch(5, 10), 
+  pool_strat = pool_target_number(20)
+)
+
+var_max <- variable_design(
+  catch_dist = nb_catch(5, 10), 
+  pool_strat = pool_max_size(20)
+)
+
+## tests ----
+test_that("variable_design constructor (target_size)", {
+  expect_equal(class(var_target), c("variable_design", "sample_design"))
+  expect_equal(var_target$catch_dist, nb_catch(5, 10))
+  expect_equal(var_target$pool_strat, pool_target_number(20))
+  expect_equal(var_target$sensitivity, 1)
+  expect_equal(var_target$specificity, 1)
+})
+
+test_that("variable_design constructor (max_size)", {
+  expect_equal(class(var_max), c("variable_design", "sample_design"))
+  expect_equal(var_max$pool_strat, pool_max_size(20))
+})
+
+test_that("null variable_design", {
+  expect_error(variable_design())
+})