diff --git a/R/sim_all.R b/R/sim_all.R index 7b7a81cb96db7d8914220cd5455e99c09b333cf7..a6f23796460aabba869da6c5c283271a295a083a 100644 --- a/R/sim_all.R +++ b/R/sim_all.R @@ -27,6 +27,11 @@ sim_all <- function(nosim=2, resps, destype="ngene", designpath, u){ stop(" 'resps' must be provided and must be an integer indicating the number of respondents per run.") } + if (!dir.exists(designpath)) { + stop(" The folder where your designs are stored does not exist. \n Check if designpath is correctly specified") + } + + designfile<-list.files(designpath,full.names = T) designname <- stringr::str_remove_all(list.files(designpath,full.names = F), diff --git a/R/simulate_choices.R b/R/simulate_choices.R index 670e08ac2194f040598995ea1f329bd11a474574..b1fbfad0c36a3d8b53e5c8f613367805614cd56d 100644 --- a/R/simulate_choices.R +++ b/R/simulate_choices.R @@ -8,7 +8,7 @@ #' @export #' #' @examples \dontrun{simulate_choices(datadet, utils,setspp)} -simulate_choices <- function(data=datadet, utility =utils, setspp, destype) { #the part in dataset that needs to be repeated in each run +simulate_choices <- function(data, utility, setspp, destype) { #the part in dataset that needs to be repeated in each run @@ -19,6 +19,7 @@ simulate_choices <- function(data=datadet, utility =utils, setspp, destype) { # dplyr::transmute(!!formula.tools::lhs(equation) := !!formula.tools::rhs(equation) ) } +# Here one can add additional case-specific data cat(" \n does sou_gis exist: ", exists("sou_gis"), "\n") if (exists("sou_gis") && is.function(sou_gis)) { diff --git a/man/simulate_choices.Rd b/man/simulate_choices.Rd index f10c00ad025903f6fec561cc649e8df28a3f08d4..b9cb87d2184e3be878e8eaa36ce1c4541d7e7a98 100644 --- a/man/simulate_choices.Rd +++ b/man/simulate_choices.Rd @@ -4,7 +4,7 @@ \alias{simulate_choices} \title{Simulate choices based on a dataframe with a design} \usage{ -simulate_choices(data = datadet, utility = utils, setspp, destype) +simulate_choices(data, utility, setspp, destype) } \arguments{ \item{data}{a dataframe that includes a design repeated for the number of observations} diff --git a/tests/manual-tests/Rbookfull.R b/tests/manual-tests/Rbookfull.R index e2df748a65333c96a37cbf58bfab23f7b1fd86f7..34bd8ace893bb8e88cfce873ab83cf5452f5fd9a 100644 --- a/tests/manual-tests/Rbookfull.R +++ b/tests/manual-tests/Rbookfull.R @@ -3,7 +3,7 @@ rm(list=ls()) devtools::load_all() - +set.seed(3393) designpath<- system.file("extdata","Rbook" ,package = "simulateDCE") diff --git a/tests/testthat/test-readdesign.R b/tests/testthat/test-readdesign.R index 23f49cfc08a21712f072589f518360813361261a..849f213e02cf98cff3340f755f855da0490dd9d4 100644 --- a/tests/testthat/test-readdesign.R +++ b/tests/testthat/test-readdesign.R @@ -11,7 +11,7 @@ test_that("file does not exist", { "does not exist in current working directory") }) -test_that("all is correct, but gives a warning", { +test_that("all is correct", { expect_no_error(readdesign(design = design_path, designtype = "ngene")) }) diff --git a/tests/testthat/test-sim_all.R b/tests/testthat/test-sim_all.R index c0980ce480acdf6a8c4003da0c192d9efcf5df5e..31d02c2692c9892bd19504eb13c5c092107fc4b0 100644 --- a/tests/testthat/test-sim_all.R +++ b/tests/testthat/test-sim_all.R @@ -6,7 +6,7 @@ designpath<- system.file("extdata","Rbook" ,package = "simulateDCE") notes <- "No Heuristics" -resps =240 # number of respondents +resps =40 # number of respondents nosim=2 # number of simulations to run (about 500 is minimum) #betacoefficients should not include "-" @@ -47,3 +47,60 @@ test_that("no value provided for utility", { designpath = designpath), "must be provided and must be a list containing ") }) + + +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'.") +}) + + +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) + , + "The folder where your designs are stored 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) + + 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) + + 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) + + + result2 <- sim_all(nosim = nosim, resps = resps, destype = destype, designpath = designpath, u = ul) + + expect_failure(expect_identical(result1[["summaryall"]], result2[["summaryall"]])) +}) +