diff --git a/R/sim_all.R b/R/sim_all.R index ebb7d06d80faeb51d86ef5e41c2046b0096abd0a..cf9bb8ec64985063668aa2a0ce2430043dea4984 100644 --- a/R/sim_all.R +++ b/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) diff --git a/R/sim_choice.R b/R/sim_choice.R index fed4fec773f91886f833acaf261518a56c70fe2d..1972fe1f2be082d3cddd5426bbf123fcfd222095 100644 --- a/R/sim_choice.R +++ b/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 diff --git a/R/simulate_choices.R b/R/simulate_choices.R index 5a0d322145f85f82b00841e3c7aaf8f0be7f25c6..92cb295a8cd4a440ee7c3e93902daa4de4f06b54 100644 --- a/R/simulate_choices.R +++ b/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 diff --git a/tests/testthat/Rplots.pdf b/tests/testthat/Rplots.pdf new file mode 100644 index 0000000000000000000000000000000000000000..9003f1bdf3d2ade490ac90fe7301a5db6f49d843 Binary files /dev/null and b/tests/testthat/Rplots.pdf differ diff --git a/tests/testthat/test-sim_all.R b/tests/testthat/test-sim_all.R index 31d02c2692c9892bd19504eb13c5c092107fc4b0..283ef565a904e164fc3f2ca40b657de0b77e45b5 100644 --- a/tests/testthat/test-sim_all.R +++ b/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"]])) })