additional unit tests for bcoeff and reasonability of results

R/sim_all.R

@@ -4,8 +4,8 @@
 #' @param resps Number of respondents you want to simulate
 #' @param destype Is it a design created with ngene or with spdesign. Ngene desings should be stored as the standard .ngd output. spdesign should be the spdesign object design$design
 #' @param designpath The path to the folder where the designs are stored. For example "c:/myfancydec/Designs"
-#' @param u A list with utility functions. The list can incorporate as many decision rule groups as you want. However, each group must be in a list in this list. If you just use one group (the normal),  this  group still  has to be in a list in  the u list.
-#' @param bcoefficients List of coefficients for the utility function. List content/length can vary based on application, but item names should be in namespace: {bsq, bredkite, bdistance, bcost, bfarm2, bfarm3, bheight2, bheight3}
+#' @param u A list with utility functions. The list can incorporate as many decision rule groups as you want. However, each group must be in a list in this list. If you just use one group (the normal),  this  group still  has to be in a list in  the u list. As a convention name betacoefficients starting with a lower case "b"
+#' @param bcoefficients List of coefficients for the utility function. List content/length can vary based on application, but should all begin with b and be the same as those entered in the utility functions
 #'
 #' @return A list, with all information on the simulation. This list an be easily processed by the user and in the rmarkdown template.
 #' @export
@@ -28,7 +28,7 @@
 sim_all <- function(nosim=2, resps, destype="ngene", designpath, u, bcoeff){
 
 
-
+  ########### validate the utility function ########
   if (missing(u) || !(is.list(u) && any(sapply(u, is.list)))){
     stop(" 'u' must be provided and must be a list containing at least one list element.")
   }
@@ -40,9 +40,44 @@ sim_all <- function(nosim=2, resps, destype="ngene", designpath, u, bcoeff){
   if (!dir.exists(designpath)) {
     stop(" The folder where your designs are stored does not exist. \n Check if designpath is correctly specified")
   }
-
-
-
+  
+  ########## validate the bcoeff list ################
+  # Check if bcoeff is provided
+  if (missing(bcoeff)) {
+    stop("Argument 'bcoeff' is required.")
+  }
+  
+  # Check if bcoeff is a list
+  if (!is.list(bcoeff)) {
+    stop("Argument 'bcoeff' must be a list.")
+  }
+  
+  # Check if values in bcoeff are numeric
+  if (!all(sapply(bcoeff, is.numeric))) {
+    stop("Values in 'bcoeff' must be numeric.")
+  }
+  
+  #### check that all the coefficients in utility function have a cooresponding value in bcoeff ####
+    # Extract coefficients from utility function starting with "b"
+  coeff_names_ul <- unique(unlist(lapply(u, function(u) {
+    formula_strings <- unlist(u)
+    coef_names <- unique(unlist(lapply(formula_strings, function(f) {
+      # Parse the formula to extract coefficient names
+      all_vars <- all.vars(as.formula(f))
+      coef_vars <- all_vars[grep("^b", all_vars)]
+      return(coef_vars)
+    })))
+    return(coef_names)
+  })))
+  
+  # Check if all utility function coefficients starting with "b" are covered in bcoeff list
+  missing_coeffs <- coeff_names_ul[!(coeff_names_ul %in% names(bcoeff))]
+  if (length(missing_coeffs) > 0) {
+    stop(paste("Missing coefficients in 'bcoeff':", paste(missing_coeffs, collapse = ", "), ". Perhaps there is a typo?"))
+  }
+  
+  ### end input validation tests ##
+  
   designfile<-list.files(designpath,full.names = T)
   designname <- stringr::str_remove_all(list.files(designpath,full.names = F),
                                "(.ngd|_|.RDS)")  ## Make sure designnames to not contain file ending and "_", as the may cause issues when replace

tests/testthat/test-sim_all.R

@@ -36,35 +36,32 @@ ul<- list(u1= list(
 
 
 
-test_that("  u is not a list", {
+test_that("u is not a list of lists", {
   expect_error(sim_all(nosim = nosim, resps=resps, destype = destype,
-                       designpath = designpath, u=data.frame(u=" alp")),
-               "must be provided and must be a list containing ")
+                       designpath = designpath, u=data.frame(u=" alp"), bcoeff = bcoeff),
+               "must be provided and must be a list containing at least one list")
 })
 
 test_that("no value provided for  utility", {
   expect_error(sim_all(nosim = nosim, resps=resps, destype = destype,
-                       designpath = designpath),
-               "must be provided and must be a list containing ")
+                       designpath = designpath, bcoeff = bcoeff),
+               "must be provided and must be a list containing at least one list")
 })
 
 
 test_that("wrong designtype", {
   expect_error(sim_all(nosim = nosim, resps=resps, destype = "ng",
-                       designpath = designpath, u=ul),"Invalid value for design. Please provide either 'ngene' or 'spdesign'.")
+                       designpath = designpath, u=ul, bcoeff = bcoeff),"Invalid value for design. Please provide either 'ngene' or 'spdesign'.")
 })
 
 
 test_that("folder does not exist", {
   expect_error(sim_all(nosim = nosim, resps=resps, destype = destype,
-                       designpath = system.file("da/bullshit", package = "simulateDCE"), u=ul)
+                       designpath = system.file("da/bullshit", package = "simulateDCE"), u=ul, bcoeff = bcoeff)
     ,
                "The folder where your designs are stored does not exist.")
 })
 
-
-
-
 test_that("seed setting makes code reproducible", {
   set.seed(3333)
   bcoeff <-list(bsq=0.00,
@@ -91,9 +88,6 @@ test_that("seed setting makes code reproducible", {
   expect_identical(result1[["summaryall"]], result2[["summaryall"]])
 })
 
-
-
-
 test_that("No seed setting makes code results different", {
 
   result1 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff)
@@ -104,3 +98,43 @@ test_that("No seed setting makes code results different", {
   expect_failure(expect_identical(result1[["summaryall"]], result2[["summaryall"]]))
 })
 
+
+########### Additional Tests ##############
+test_that("bcoeff is provided", {
+    expect_error(sim_all(nosim = nosim, resps = resps, destype = destype,
+                         designpath = designpath, u = ul))
+})
+
+test_that("bcoeff contains valid values", {
+  expect_error(sim_all(nosim = nosim, resps = resps, destype = destype,
+                       designpath = designpath, u = ul, bcoeff = list(bsq = "invalid")))
+})
+
+test_that("bcoeff is a list", {
+  expect_error(sim_all(nosim = nosim, resps = resps, destype = destype,
+                       designpath = designpath, u = ul, bcoeff = "not a list")
+  )
+})
+
+test_that("B coefficients in the utility functions dont match those in the bcoeff list", {
+  expect_error(sim_all(nosim = nosim, resps=resps, destype = destype,
+                       designpath = designpath, u = ul, bcoeff <- list(bWRONG = 0.00)))
+})
+
+test_that("Utility functions are valid", {
+  expect_no_error(eval(ul$u1$v1))
+  expect_no_error(eval(ul$u1$v2))
+})
+
+test_that("Function behavior matches documentation", {
+  expect_true(sim_all %in% names(simulateDCE:::NAMESPACE))
+})
+
+test_that("Simulation results are reasonable", {
+  
+  result1 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff)
+  
+  expect_gt(result1$est_bsq, -1)
+  expect_lt(result1$est_bsq, 1)
+  
+})