diff --git a/R/sim_all.R b/R/sim_all.R index 8be4da4b6a2a14882c724ec90a0e8bf17747129a..e74fd15235f7409b5d39b71616f9f5d9485ac802 100644 --- a/R/sim_all.R +++ b/R/sim_all.R @@ -14,10 +14,13 @@ #' 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){ +sim_all <- function(nosim=2, resps, destype="ngene", designpath, u){ + + if (missing(u) || !is.list(u)) { + stop("The 'u' must be provided and must be a list containing at least one list element.") + } -#browser() 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 @@ -26,7 +29,7 @@ sim_all <- function(nosim=2, resps, destype="ngene", designpath){ tictoc::tic() all_designs<- purrr::map(designfile, sim_choice, - no_sim= nosim,respondents = resps, mnl_U = mnl_U, destype=destype) %>% ## iterate simulation over all designs + no_sim= nosim,respondents = resps, destype=destype, utils=u) %>% ## iterate simulation over all designs stats::setNames(designname) diff --git a/R/sim_choice.R b/R/sim_choice.R index 5c03424b390a660594e35ba6f38712296445847e..d7d9d945971a10ded847cfefbe47d7fb106d04c9 100644 --- a/R/sim_choice.R +++ b/R/sim_choice.R @@ -11,7 +11,6 @@ #' @param designfile path to a file containing a design. #' @param no_sim Number of runs i.e. how often do you want the simulation to be repeated #' @param respondents Number of respondents. How many respondents do you want to simulate in each run. -#' @param mnl_U a list containing utility functions as formulas #' @param utils The first element of the utility function list #' @param destype Specify which type of design you use. Either ngene or spdesign #' @@ -21,18 +20,18 @@ #' @examples \dontrun{ simchoice(designfile="somefile", no_sim=10, respondents=330, #' mnl_U,utils=u[[1]] ,destype="ngene")} #' -sim_choice <- function(designfile, no_sim=10, respondents=330, mnl_U,utils=u[[1]] ,destype=destype) { +sim_choice <- function(designfile, no_sim=10, respondents=330,utils=u ,destype=destype) { #### Function that transforms user written utility for simulation into utility function for mixl. transform_util <- function() { - mnl_U <-paste(purrr::map_chr(utils,as.character,keep.source.attr = TRUE),collapse = "",";") %>% + mnl_U <-paste(purrr::map_chr(utils[[1]],as.character,keep.source.attr = TRUE),collapse = "",";") %>% stringr::str_replace_all( c( "priors\\[\"" = "" , "\"\\]" = "" , "~" = "=", "\\." = "_" , " b" = " @b" , "V_"="U_", " alt"="$alt")) } -#### Function to simulate and estimate +#### Function to simulate and estimate #### estimate_sim <- function(run=1) { #start loop @@ -50,7 +49,6 @@ sim_choice <- function(designfile, no_sim=10, respondents=330, mnl_U,utils=u[[1] } - # transform utility function to mixl format mnl_U <- transform_util() @@ -61,7 +59,7 @@ designs_all <- list() cat("Utility function used in simulation, ie the true utility: \n\n") - print(u) + print(utils) cat("Utility function used for Logit estimation with mixl: \n\n") diff --git a/R/simulate_choices.R b/R/simulate_choices.R index 379695098518d23e25a4ef0fa4e2101fc6a2e8b2..86b3a1645197f4a5883785735c09afb7069def61 100644 --- a/R/simulate_choices.R +++ b/R/simulate_choices.R @@ -57,12 +57,12 @@ simulate_choices <- function(data=datadet, utility =utils, setspp, destype) { # dplyr::group_by(ID) %>% dplyr::mutate(!!! manipulations) - +browser() subsets<- split(data,data$group) - subsets <- purrr::map2(.x = seq_along(u),.y = subsets, - ~ dplyr::mutate(.y,purrr::map_dfc(u[[.x]],by_formula))) + subsets <- purrr::map2(.x = seq_along(utility),.y = subsets, + ~ dplyr::mutate(.y,purrr::map_dfc(utility[[.x]],by_formula))) data <-dplyr::bind_rows(subsets) diff --git a/tests/manual-tests/Rbookfull.R b/tests/manual-tests/Rbookfull.R index 214f96361220a7a033357d6ebe9fff2db4e4d8ba..c79638168a20aec5e6c9265f089928030ed9b4ca 100644 --- a/tests/manual-tests/Rbookfull.R +++ b/tests/manual-tests/Rbookfull.R @@ -29,7 +29,7 @@ destype <- "spdesign" #place your utility functions here -u<- list(u1= list( +ul<- list(u1= list( v1 =V.1 ~ bsq * alt1.sq, v2 =V.2 ~ bfarm2 * alt2.farm2 + bfarm3 * alt2.farm3 + bheight2 * alt2.height2 + bheight3 * alt2.height3 + bredkite * alt2.redkite + bdistance * alt2.distance + bcost * alt2.cost, v3 =V.3 ~ bfarm2 * alt3.farm2 + bfarm3 * alt3.farm3 + bheight2 * alt3.height2 + bheight3 * alt3.height3 + bredkite * alt3.redkite + bdistance * alt3.distance + bcost * alt3.cost @@ -39,7 +39,7 @@ u<- list(u1= list( rbook <- sim_all(nosim = nosim, resps=resps, destype = destype, - designpath = designpath) + designpath = designpath, u=ul)