Function and tests for check_in_range()

R/check_inputs.R

@@ -5,15 +5,17 @@ check_input <- function(argument_name, value) {
 
 check_geq <- function(argument_name, input_value) {
   # Check that an input value is numeric, and greater than `min`
-  # Set `min` dynamically depending on the argument requirements
+  # Stop condition for developers only
   geq0 <- c('pool_size', 'pool_number', 'cost_unit',
             'cost_pool', 'cost_cluster', 'interval')
   geq1 <- c('max_s', 'max_N')
+  if(!argument_name %in% c(geq0, geq1)) stop("Needs to be one of the accepted_args")
+  # So one function can be used for all >= checks
   min <- 0
   if(argument_name %in% geq1) min <- 1
 
   if(!is.numeric(input_value) | input_value < min) {
-    cli::cli_alert_info("{.field {argument_name}} needs to be a numeric value {min} or greater.")
+    cli::cli_alert_info("{.field {argument_name}} must be a numeric value {min} or greater.")
   }
   if(!is.numeric(input_value)) {
     cli::cli_alert_danger("{.val {input_value}} is a {class(input_value)}.")
@@ -22,3 +24,19 @@ check_geq <- function(argument_name, input_value) {
     cli::cli_alert_danger("{.val {input_value}} is < {min}")
   }
 }
+
+check_in_range <- function(argument_name, input_value) {
+  # Is the input between 0 to 1, inclusive?
+  # Stop condition for developers only
+  accepted_args <- c('prevalence', 'correlation', 'sensitivity', 'specificity')
+  if(!argument_name %in% accepted_args) stop("Needs to be one of the accepted_args")
+
+  if(input_value < 0 | input_value > 1) {
+    cli::cli_alert_info("{.field {argument_name}} must be a numeric value between 0 and 1, inclusive.")
+  }
+  if(!is.numeric(input_value)) {
+    cli::cli_alert_danger("{.val {input_value}} is a {class(input_value)}.")
+  }
+  if(input_value < 0) cli::cli_alert_danger("{.val {input_value}} is < 0")
+  if(input_value > 1) cli::cli_alert_danger("{.val {input_value}} is > 1")
+}

tests/testthat/_snaps/check_inputs.md

@@ -3,22 +3,38 @@
     Code
       check_geq("pool_size", "chr")
     Message <cliMessage>
-      i pool_size needs to be a numeric value 0 or greater.
+      i pool_size must be a numeric value 0 or greater.
       x "chr" is a character.
 
 ---
 
     Code
       check_geq("pool_size", -1)
     Message <cliMessage>
-      i pool_size needs to be a numeric value 0 or greater.
+      i pool_size must be a numeric value 0 or greater.
       x -1 is < 0
 
 ---
 
     Code
       check_geq("max_s", 0)
     Message <cliMessage>
-      i max_s needs to be a numeric value 1 or greater.
+      i max_s must be a numeric value 1 or greater.
       x 0 is < 1
 
+# check_in_range()
+
+    Code
+      check_in_range("prevalence", -1)
+    Message <cliMessage>
+      i prevalence must be a numeric value between 0 and 1, inclusive.
+      x -1 is < 0
+
+---
+
+    Code
+      check_in_range("prevalence", 1.1)
+    Message <cliMessage>
+      i prevalence must be a numeric value between 0 and 1, inclusive.
+      x 1.1 is > 1
+

tests/testthat/test-check_inputs.R

@@ -6,4 +6,16 @@ test_that("check_geq()", {
   expect_snapshot(check_geq("pool_size", "chr"))
   expect_snapshot(check_geq("pool_size", -1))
   expect_snapshot(check_geq("max_s", 0))
+  expect_error(check_geq("prevalence", 0.05),
+               "Needs to be one of the accepted_args")
+})
+
+test_that("check_in_range()", {
+  expect_silent(check_in_range("prevalence", 0.05))
+  expect_snapshot(check_in_range("prevalence", -1))
+  expect_snapshot(check_in_range("prevalence", 1.1))
+  expect_error(check_in_range("pool_size", 1.1),
+               "Needs to be one of the accepted_args")
+  expect_silent(check_in_range("sensitivity", 1))
+  expect_silent(check_in_range("specificity", 0))
 })