Input parameter validation for built-in EVSI

chjackson · Jul 20, 2023 · 3ef990d · 3ef990d
1 parent bc80f3b
commit 3ef990d
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 0 deletions.
diff --git a/R/study.R b/R/study.R
@@ -5,12 +5,14 @@
 
 datagen_binary <- function(inputs, n=100, pars){
     nsim <- nrow(inputs)
+    validate_prob(inputs[,pars[1]], pars[1])
     data.frame(
         X1 = rbinom(nsim, size=n, prob=inputs[,pars[1]])
     )
 }
 
 likelihood_binary <- function(Y, inputs, n=100, pars){
+    validate_prob(inputs[,pars[1]], pars[1])
     loglik <-
         dbinom(Y[,"X1"], size=n, inputs[,pars[1]], log=TRUE) 
     exp(loglik)
@@ -49,13 +51,17 @@ analysis_trial_binary <- function(data, args, pars,...){
 
 datagen_trial_binary <- function(inputs, n=100, pars){
     nsim <- nrow(inputs)
+    validate_prob(inputs[,pars[1]], pars[1])
+    validate_prob(inputs[,pars[2]], pars[2])
     data.frame(
         X1 = rbinom(nsim, size=n, prob=inputs[,pars[1]]),
         X2 = rbinom(nsim, size=n, prob=inputs[,pars[2]])
     )
 }
 
 likelihood_trial_binary <- function(Y, inputs, n=100, pars){
+    validate_prob(inputs[,pars[1]], pars[1])
+    validate_prob(inputs[,pars[2]], pars[2])
     loglik <-
         dbinom(Y[,"X1"], size=n, inputs[,pars[1]], log=TRUE) + 
         dbinom(Y[,"X2"], size=n, inputs[,pars[2]], log=TRUE) 
@@ -102,3 +108,8 @@ check_analysis_args <- function(args, required){
       stop(sprintf("`%s` not supplied in `analysis_args`", i))
   }
 }
+
+validate_prob <- function(p, name){
+  if (any((p<0)|(p>1)))
+    stop(sprintf("%s should represent a probability, but it has values that are greater than 1 or less than 0", name))
+}
diff --git a/tests/testthat/test_evsi_errors.R b/tests/testthat/test_evsi_errors.R
@@ -51,3 +51,10 @@ test_that("Do we need to specify pars for EVSI",{
   expect_error(evsi(chemo_nb, chemo_pars, study="binary", method="mm", pars = "p_wrong"), "not found in columns of `inputs`") 
   expect_error(evsi(chemo_nb, chemo_pars, study="binary", method="is", pars = "p_wrong"), "not found in columns of `inputs`") 
 })
+
+test_that("Input parameter validation for built in EVSI",{
+  pars_wrong <- chemo_pars
+  pars_wrong$p_side_effects_t1[1] <- -1
+  expect_error(evsi(chemo_nb, pars_wrong, study="binary", pars="p_side_effects_t1"),
+                 "less than 0")
+})