passing bcoefficients as a list argument to sim_all through to simulate_choices

R/sim_all.R

@@ -15,7 +15,7 @@
 #'  resps =240  # number of respondents
 #'  nosim=2 # number of simulations to run (about 500 is minimum)
 #'
-sim_all <- function(nosim=2, resps, destype="ngene", designpath, u){
+sim_all <- function(nosim=2, resps, destype="ngene", designpath, u, bcoeff){
 
 
 
@@ -41,7 +41,7 @@ sim_all <- function(nosim=2, resps, destype="ngene", designpath, u){
   tictoc::tic()
 
   all_designs<- purrr::map(designfile, sim_choice,
-                           no_sim= nosim,respondents = resps,  destype=destype, ut=u) %>%  ## iterate simulation over all designs
+                           no_sim= nosim,respondents = resps,  destype=destype, ut=u, bcoefficients = bcoeff) %>%  ## iterate simulation over all designs
     stats::setNames(designname)
 
 

R/sim_choice.R

@@ -20,7 +20,7 @@
 #' @examples \dontrun{  simchoice(designfile="somefile", no_sim=10, respondents=330,
 #'  mnl_U,ut=u[[1]] ,destype="ngene")}
 #'
-sim_choice <- function(designfile, no_sim=10, respondents=330,ut ,destype=destype) {
+sim_choice <- function(designfile, no_sim=10, respondents=330,ut ,destype=destype, bcoefficients) {
 
 
 
@@ -38,12 +38,12 @@ sim_choice <- function(designfile, no_sim=10, respondents=330,ut ,destype=destyp
 
     cat("This is Run number ", run)
 
-    database <- simulate_choices(datadet, utility = ut, setspp=setpp )
+    database <- simulate_choices(datadet, utility = ut, setspp=setpp, bcoefficients = bcoefficients)
 
 
     cat("This is the utility functions \n" , mnl_U)
 
-    model<-mixl::estimate(model_spec,start_values = est, availabilities = availabilities, data= database,)
+    model<-mixl::estimate(model_spec,start_values = est, availabilities = availabilities, data= database)
 
     return(model)
 
@@ -92,7 +92,7 @@ designs_all <- list()
     dplyr::relocate(ID,`Choice.situation`) %>%
     as.data.frame()
 
-  database <- simulate_choices(data=datadet, utility = ut, setspp = setpp)
+  database <- simulate_choices(data=datadet, utility = ut, setspp = setpp, bcoefficients = bcoefficients)
 
 
 # specify model for mixl estimation

R/simulate_choices.R

@@ -8,7 +8,16 @@
 #' @export
 #'
 #' @examples \dontrun{simulate_choices(datadet, ut,setspp)}
-simulate_choices <- function(data, utility, setspp, destype) {  #the part in dataset that needs to be repeated in each run
+simulate_choices <- function(data, utility, setspp, destype, bcoefficients) {  #the part in dataset that needs to be repeated in each run
+  ### unpack the bcoeff list
+  bsq <- bcoefficients$bsq
+  bredkite <- bcoefficients$bredkite
+  bdistance <- bcoefficients$bdistance
+  bcost <- bcoefficients$bcost
+  bfarm2 <- bcoefficients$bfarm2
+  bfarm3 <- bcoefficients$bfarm3
+  bheight2 <- bcoefficients$bheight2
+  bheight3 <- bcoefficients$bheight3
 
 
 

tests/testthat/test-sim_all.R

@@ -19,6 +19,14 @@ bfarm3=0.50
 bheight2=0.25
 bheight3=0.50
 
+bcoeff <-list(bsq=0.00,
+              bredkite=-0.05,
+              bdistance=0.50,
+              bcost=-0.05,
+              bfarm2=0.25,
+              bfarm3=0.50,
+              bheight2=0.25,
+              bheight3=0.50)
 
 destype <- "spdesign"
 
@@ -67,26 +75,26 @@ test_that("folder does not exist", {
 
 test_that("seed setting makes code reproducible", {
   set.seed(3333)
-  bsq=0.00
-  bredkite=-0.05
-  bdistance=0.50
-  bcost=-0.05
-  bfarm2=0.25
-  bfarm3=0.50
-  bheight2=0.25
-  bheight3=0.50
-  result1 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul)
+  bcoeff <-list(bsq=0.00,
+    bredkite=-0.05,
+    bdistance=0.50,
+    bcost=-0.05,
+    bfarm2=0.25,
+    bfarm3=0.50,
+    bheight2=0.25,
+    bheight3=0.50)
+  result1 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff)
 
   set.seed(3333)
-  bsq=0.00
-  bredkite=-0.05
-  bdistance=0.50
-  bcost=-0.05
-  bfarm2=0.25
-  bfarm3=0.50
-  bheight2=0.25
-  bheight3=0.50
-  result2 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul)
+  bcoeff <-list(bsq=0.00,
+          bredkite=-0.05,
+          bdistance=0.50,
+          bcost=-0.05,
+          bfarm2=0.25,
+          bfarm3=0.50,
+          bheight2=0.25,
+          bheight3=0.50)
+  result2 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff)
 
   expect_identical(result1[["summaryall"]], result2[["summaryall"]])
 })
@@ -96,10 +104,10 @@ test_that("seed setting makes code reproducible", {
 
 test_that("No seed setting makes code results different", {
 
-  result1 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul)
+  result1 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff)
 
 
-  result2 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul)
+  result2 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul, bcoeff = bcoeff)
 
   expect_failure(expect_identical(result1[["summaryall"]], result2[["summaryall"]]))
 })