Merge branch 'power_out' of https://github.com/AngusMcLure/PoolPoweR …

…into power_out

R/power.R

@@ -155,14 +155,14 @@ power_pool <- function(pool_size, pool_number, cluster_number,
   )
 
   # Prepare output
-  total_pools = cluster_number * pool_number
-  total_units = total_pools * pool_size
-  if (sensitivity == 1 && specificity == 1) {
-    perf = "a perfect"
-  } else {
-    perf = "an imperfect"
-  }
-  text = paste("A survey design using", perf, "diagnostic test on pooled samples with the above parameters has a statistical power of", round(power, 3))
+  total_pools <- cluster_number * pool_number
+  total_units <- total_pools * pool_size
+  text <- paste(
+    "A survey design using", 
+    is_perfect_test(sensitivity, specificity), 
+    "diagnostic test on pooled samples with the above parameters has a statistical power of", 
+    round(power, 3)
+  )
 
   power_size_results(  
     sensitivity = sensitivity,
@@ -266,7 +266,12 @@ power_pool_random <- function(catch_dist, pool_strat, cluster_number,
   } else {
     perf = "an imperfect"
   }
-  text = paste("A survey design using", perf, "diagnostic test on pooled samples with the above parameters has a statistical power of", round(power, 3))
+  text = paste(
+    "A survey design using", 
+    is_perfect_test(sensitivity, specificity), 
+    "diagnostic test on pooled samples with the above parameters has a statistical power of",
+    round(power, 3)
+  )
 
   power_size_results(  
     sensitivity = sensitivity,
@@ -348,13 +353,8 @@ sample_size_pool <- function(pool_size, pool_number,
   total_clusters <- ceiling(total_clusters_raw)
   total_pools <- total_clusters * pool_number
   total_units <- total_pools * pool_size
-  if (sensitivity == 1 && specificity == 1) {
-    perf = "a perfect"
-  } else {
-    perf = "an imperfect"
-  }
-  text = paste0(
-    "A survey design using ", perf, 
+  text <- paste0(
+    "A survey design using ", is_perfect_test(sensitivity, specificity), 
     " diagnostic test on pooled samples with the above parameters requires a total of ",
     total_clusters, " clusters, ", 
     total_pools, " total pools, and ", 
@@ -453,8 +453,34 @@ sample_size_pool_random <- function(catch_dist, pool_strat,
   exp_total_pools <- round(ev(\(catch) sum(pool_strat(catch)$pool_number),
                               catch_dist, max_iter, rel_tol) * total_clusters, 1)
 
-  return(list(clusters = total_clusters,
-              expected_pools = exp_total_pools,
-              expected_units = exp_total_units))
+  # Prepare output
+  text = paste0(
+    "A survey design using ", is_perfect_test(sensitivity, specificity), 
+    " diagnostic test on pooled samples with the above parameters requires a total of ",
+    total_clusters, " clusters, ", 
+    exp_total_pools, " expected total pools, and ", 
+    exp_total_units, " expected total units."
+  )
+
+  power_size_results(  
+    sensitivity = sensitivity,
+    specificity = specificity,
+    # prevalence
+    prev_null = theta0,
+    prev_alt = thetaa,
+    correlation = correlation,
+    # statistical test
+    sig_level = sig_level,
+    power = power,
+    alternative = alternative,
+    # sample design
+    catch_dist = catch_dist,
+    pool_strat = as.character(pool_strat),
+    cluster_number = total_clusters,
+    exp_total_pools = exp_total_pools,
+    exp_total_units = exp_total_units,
+    # parsing
+    text = text
+  )
 
 }

R/power_utils.R

@@ -5,21 +5,23 @@
 #' stored and displayed consistently, summarising calculations results and the
 #' inputs for context.
 #' 
-#' @param sensitivity .
-#' @param specificity .
-#' @param prev_null .
-#' @param prev_alt .
-#' @param correlation .
-#' @param sig_level .
-#' @param power .
-#' @param alternative .
-#' @param pool_size required for power_pool and sample_size_pool
-#' @param pool_number required for power_pool and sample_size_pool
-#' @param catch_dist required for power_pool_random and sample_size_pool_random
-#' @param pool_strat required for power_pool_random and sample_size_pool_random
-#' @param cluster_number . 
-#' @param total_pools .
-#' @param total_units .
+#' @param sensitivity required
+#' @param specificity required
+#' @param prev_null required
+#' @param prev_alt required
+#' @param correlation required
+#' @param sig_level required
+#' @param power required
+#' @param alternative required
+#' @param pool_size required for power_pool and sample_size_pool or NA
+#' @param pool_number required for power_pool and sample_size_pool or NA
+#' @param catch_dist required for power_pool_random and sample_size_pool_random or NA
+#' @param pool_strat required for power_pool_random and sample_size_pool_random or NA
+#' @param cluster_number required 
+#' @param total_pools NA if sample_size_pool_random
+#' @param total_pools NA if unless sample_size_pool_random
+#' @param exp_total_pool required for sample_size_pool_random or NA
+#' @param exp_total_units required for sample_size_pool_random or NA
 #' @param text chr Explanatory summary text to be printed at the end
 #'
 #' @return An object of class \code{power_size_results} containing selected
@@ -41,8 +43,9 @@
 power_size_results <- function(sensitivity, specificity, prev_null, prev_alt, 
                                correlation, sig_level, power, alternative,
                                pool_size = NA, pool_number = NA, catch_dist = NA, 
-                               pool_strat = NA, cluster_number, total_pools, 
-                               total_units, text) {
+                               pool_strat = NA, cluster_number, total_pools = NA, 
+                               total_units = NA, exp_total_pools = NA, 
+                               exp_total_units = NA, text) {
 
   # Group parameters to different lists for printing
   diag_test <- list(
@@ -65,14 +68,20 @@ power_size_results <- function(sensitivity, specificity, prev_null, prev_alt,
     alternative = alternative
   )
 
-  if (!is.na(pool_size) && !is.na(pool_number)) {
+  # TODO: refactor so temp_design is passed as an arg to class
+  if (!is.na(pool_size) && !is.na(pool_number)) { # power_pool, sample_size_pool
     temp_design <- list(
       pool_size = pool_size,
       pool_number = pool_number,
       total_pools = total_pools,
       total_units = total_units
     )
-  } else { # *_random
+  } else if (!is.na(exp_total_pools) && !is.na(exp_total_units)) { # sample_size_pool_random
+    temp_design <- list(
+      exp_total_pools = exp_total_pools,
+      exp_total_units = exp_total_units
+    )
+  } else { # power_pool_random
    temp_design <- list(
       catch_mean = mean(catch_dist),
       catch_variance = distributions3::variance(catch_dist),
@@ -122,4 +131,11 @@ print.power_size_results <- function(x, ...) {
   }
   cat("\n", text)
   invisible(x)
-}
+}
+
+is_perfect_test <- function(sensitivity, specificity) {
+  if (sensitivity == 1 && specificity == 1) {
+    return("a perfect")
+  }
+  return("an imperfect")
+}

tests/testthat/test-power.R

@@ -1,3 +1,10 @@
+exp1 <- function(act) {
+  # Common output across tests
+  expect_equal(act$sample_design$cluster_number, 75)
+  expect_equal(act$sample_design$exp_total_pools, 150)
+  expect_equal(act$sample_design$exp_total_units, 1500)
+}
+
 test_that(
   "power_pool() no corr", {
     act <- power_pool(pool_size = 10, pool_number = 2, cluster_number = 50, prevalence_null = 0.01, prevalence_alt = 0.02)
@@ -127,23 +134,21 @@ test_that(
 test_that(
   "sample_size_pool_random()", {
     act <- sample_size_pool_random(nb_catch(20,25), pool_target_number(2), prevalence_null = 0.01, prevalence_alt = 0.02, correlation = 0.01)
-    exp <- list(clusters = 75, expected_pools = 150, expected_units = 1500)
-    expect_equal(act, exp)
+    exp1(act)
   }
 )
 
 test_that(
   "sample_size_pool_random() links", {
-    exp <- list(clusters = 75, expected_pools = 150, expected_units = 1500) 
-
     act <- sample_size_pool_random(nb_catch(20,25), pool_target_number(2), prevalence_null = 0.01, prevalence_alt = 0.02, correlation = 0.01, link = "cloglog")
-    expect_equal(act, exp) # same as logit 
+    exp1(act)
 
     act <- sample_size_pool_random(nb_catch(20,25), pool_target_number(2), prevalence_null = 0.01, prevalence_alt = 0.02, correlation = 0.01, link = "log")
-    expect_equal(act, exp) # same as logit
+    exp1(act)
 
     act <- sample_size_pool_random(nb_catch(20,25), pool_target_number(2), prevalence_null = 0.01, prevalence_alt = 0.02, correlation = 0.01, link = "identity")
-    exp <- list(clusters = 59, expected_pools = 118, expected_units = 1180) 
-    expect_equal(act, exp)
+    expect_equal(act$sample_design$cluster_number, 59)
+    expect_equal(act$sample_design$exp_total_pools, 118)
+    expect_equal(act$sample_design$exp_total_units, 1180)
   }
 )