WIP on main: 11286e16 added some arguments to sim_all function

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)
 
 

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")

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)
 

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)