with option tto use different utility functions for different respondents

.gitignore

-.Rproj.user
-.Rhistory
-.RData
-.Ruserdata
-dce_simulation_tool.Rproj
-modeloutput/
-*.html
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata
+dce_simulation_tool.Rproj
+modeloutput/
+*.html
\ No newline at end of file
+simulation_output_files/
\ No newline at end of file

Projects/Agora/parameters_agora.R

@@ -28,7 +28,9 @@ bcomp = 0.02
 
 
 #place your utility functions here
-u<-list(
+u<-list( u1 =
+  list(
   v1=V.1 ~ basc + baction*alt1.b + badvisory * alt1.c + bpartner * alt1.d + bcomp * alt1.p , #Utility of alternative 1
   v2=V.2 ~ basc2 + baction*alt2.b + badvisory * alt2.c + bpartner * alt2.d + bcomp * alt2.p ,  #Utility of alternative 2
   v3=V.3 ~ 0)
+)
\ No newline at end of file

Projects/IP2/parameters_ip2.R

@@ -16,7 +16,9 @@ for (ano in 1:length(priors)) {
 }
 
 #place your utility functions here
-u<-list(
+u<- list(u1=
+  list(
   v1 =V.1~  bascgemeinschaft +bgroesse*alt1.groesse+ bentfernung * alt1.entfernung + bgemeinschaft * alt1.gemeinschaft + bkultur * alt1.kultur + bumweltbildung*alt1.umweltbildung + bzugang * alt1.zugang+ bgestaltung*alt1.gestaltung + bbeitrag*alt1.beitrag  ,
   v2 =V.2~  bascklein        +bgroesse*alt2.groesse+ bentfernung * alt2.entfernung + bgemeinschaft * alt2.gemeinschaft + bkultur * alt2.kultur + bumweltbildung*alt2.umweltbildung + bzugang * alt2.zugang+ bgestaltung*alt2.gestaltung + bbeitrag*alt2.beitrag,
   v3 =V.3~ 0)
+)
\ No newline at end of file

Projects/Parks/parameters_ip2_parks.R

@@ -16,9 +16,9 @@ for (ano in 1:length(priors)) {
 }
 
 #place your utility functions here
-u<-list(
+u<-list( u1 =list(
   v1 =V.1~  basc        +bgroesse*alt1.groesse+ bentfernung * alt1.entfernung + bgemeinschaft * alt1.gemeinschaft + bkultur * alt1.kultur + bumweltbildung*alt1.umweltbildung + btoiletten * alt1.toiletten+ bspiel*alt1.spiel + bpflegeint*alt1.pflegeint+bpflegeziele*alt1.pflegeziele+ bbeitrag*alt1.beitrag  ,
   v2 =V.2~  basc        +bgroesse*alt2.groesse+ bentfernung * alt2.entfernung + bgemeinschaft * alt2.gemeinschaft + bkultur * alt2.kultur + bumweltbildung*alt2.umweltbildung + btoiletten * alt2.toiletten+ bspiel*alt2.spiel + bpflegeint*alt2.pflegeint+bpflegeziele*alt2.pflegeziele+ bbeitrag*alt2.beitrag,
   v3 =V.3~ 0)
-
+)
 

Projects/SE_AGRI/parameters_SE Design-Agri.R

@@ -31,9 +31,9 @@ manipulations = list(alt1.professional=     expr(alt1.initiator==1),
 
 
 #place your utility functions here
-u<-list(
+u<- list(u1= 
+  list(
   v1 =V.1 ~  bprof*alt1.professional+ bexp * alt1.expert + bdomestic * alt1.domestic + bforeign * alt1.foreign + bdamage*alt1.damage + bprice * alt1.compensation,
   v2 =V.2 ~  bprof*alt2.professional + bexp * alt2.expert + bdomestic * alt2.domestic + bforeign * alt2.foreign + bdamage*alt2.damage + bprice * alt2.compensation,
   v3 =V.3 ~ basc)
-
-remotes::
+)
\ No newline at end of file

Projects/SE_DRIVE/parameters_SE_DRIVE.R

@@ -17,6 +17,8 @@ nosim= 2 # number of simulations to run (about 500 is minimum)
 # bwarte = -0.049
 
 
+decisiongroups=c(0,0.7,1)
+
 # wrong parameters
 
 # 
@@ -32,7 +34,15 @@ manipulations = list(alt1.x2=     expr(alt1.x2/10),
 
 
 #place your utility functions here
-u<-list(
+u<-list( u1 =
+  
+  list(
   v1 =V.1~  bpreis * alt1.x1 + blade*alt1.x2 + bwarte*alt1.x3   ,
   v2 =V.2~  bpreis * alt2.x1 + blade*alt2.x2 + bwarte*alt2.x3  
 )
+
+,
+u2 = list(  v1 =V.1~  bpreis * alt1.x1    ,
+             v2 =V.2~  bpreis * alt2.x1)
+
+)

Projects/ValuGaps/parameters_valugaps.R

@@ -113,11 +113,11 @@ expr(across(.cols=matches("HNV|protected"),.fns =  ~.x^2, .names = "{.col}{'sq'}
 
 #place your utility functions here
 
-u<-list(
+u<-list( u1= list(
   v1 =V.1~ basc + bb * alt1.protected +  bb2 * alt1.protectedsq + bc * alt1.HNV + bc2 * alt1.HNVsq + bp * alt1.p , 
   v2 =V.2~ basc + bb * alt2.protected +  bb2 * alt2.protectedsq + bc * alt2.HNV + bc2 * alt2.HNVsq + bp * alt2.p ,
   v3 =V.3~        bb * alt3.protected +  bb2 * alt3.protectedsq + bc * alt3.HNV + bc2 * alt3.HNVsq )
-
+)
 
 
 

functions.R

-sim_choice <- function(designfile, no_sim=10, respondents=330, mnl_U,utils=u ) {
+sim_choice <- function(designfile, no_sim=10, respondents=330, mnl_U,utils=u[[1]] ) {
  
   
   require("tictoc")
@@ -18,7 +18,7 @@ sim_choice <- function(designfile, no_sim=10, respondents=330, mnl_U,utils=u ) {
   require("rlang")
    
   
-  mnl_U <-paste(map_chr(u,as.character,keep.source.attr = TRUE),collapse = "",";") %>%
+  mnl_U <-paste(map_chr(utils,as.character,keep.source.attr = TRUE),collapse = "",";") %>%
     str_replace_all( c( "priors\\[\"" = "" , "\"\\]" = "" ,  "~" = "=", "\\." = "_" , " b" = " @b"  , "V_"="U_", " alt"="$alt"))
   
  cat("mixl \n") 
@@ -42,14 +42,12 @@ sim_choice <- function(designfile, no_sim=10, respondents=330, mnl_U,utils=u ) {
 
   
   simulate_choices <- function(data=datadet) {  #the part in dataset that needs to be repeated in each run
-cat("does sou_gis exist: ")
-   print( exists("sou_gis"))
-   # browser()    
- 
+cat(" \n does sou_gis exist: ", exists("sou_gis"), "\n")
+
     if (exists("sou_gis") && is.function(sou_gis)) {
       sou_gis()
       
-      cat("source of gis has been done")
+      cat("\n source of gis has been done \n")
     }    
        
    # source("Projects/ValuGaps/code/GIS_data.R")
@@ -59,29 +57,57 @@ cat("does sou_gis exist: ")
     n=seq_along(1:length(utils))    # number of utility functions
 
     
-    
+#browser()    
 
 
-    print(exists("final_set"))
+    cat("\n dataset final_set exists: ",exists("final_set"), "\n")
+    
+    if(exists("final_set")) data = left_join(data,final_set, by = "ID")   
     
-    if(exists("final_set")) data = left_join(data,final_set, by = "ID")     
+    cat("\n decisiongroups exists: " ,exists("decisiongroups"))  
     
-      data <-  data %>% 
+    if(exists("decisiongroups"))  {     ### create a new variable to classify decision groups.
+      data = mutate(data,group = as.numeric(cut(row_number(), 
+                                 breaks = decisiongroups * n(), 
+                                 labels = seq_along(decisiongroups[-length(decisiongroups)]),
+                                 include.lowest = TRUE)))
+      
+      print(table(data$group))
+    } else {
+      
+      data$group=1
+    }
+   
+
+       data<- data %>% 
       group_by(ID) %>% 
-      mutate(!!! manipulations ,
-             map_dfc(utils,by_formula)) %>%    #our functions to create utility variables. They need to be entered as a formula list as an argument
-      rename_with(~ stringr::str_replace(.,pattern = "\\.","_"), everything()) %>% 
+      mutate(!!! manipulations) 
+             
+
+          
+subsets<- split(data,data$group)     
+   
+subsets <-  map2(.x = seq_along(u),.y = subsets,
+                 ~ mutate(.y,map_dfc(u[[.x]],by_formula)))
+ 
+data <-bind_rows(subsets)           
+ 
+   data<- data %>%       
+     rename_with(~ stringr::str_replace(.,pattern = "\\.","_"), everything()) %>% 
         mutate(across(.cols=n,.fns = ~ rgumbel(setpp,loc=0, scale=1), .names = "{'e'}_{n}" ), 
          across(starts_with("V_"), .names = "{'U'}_{n}") + across(starts_with("e_")) ) %>% ungroup() %>% 
          mutate(CHOICE=max.col(.[,grep("U_",names(.))])
       )   %>% 
       as.data.frame()
 
+       
+       
     
-print("data has been made")
+print("\n data has been made \n")
 
-cat(head(data$CHOICE))
-    
+cat("\n First few observations \n ") 
+print(head(data))
+ cat("\n \n ")   
     return(data)
     
   } 
@@ -107,7 +133,7 @@ cat(head(data$CHOICE))
                        escape_double = FALSE,
                        trim_ws = TRUE  , 
                        col_select = c(-Design, -starts_with("...")) ,
-                       name_repair = "universal") %>% 
+                       name_repair = "universal" , show_col_types = FALSE) %>% 
     filter(!is.na(Choice.situation)) 
   
   

generatemd.R

@@ -2,7 +2,7 @@
 rm(list=ls())
 
 #file <- "Projects/ValuGaps/parameters_valugaps.R"
-  file <- "Projects/SE_DRIVE/parameters_SE_DRIVE.R"
+  file <- "Projects/SE_AGRI/parameters_SE Design-Agri.R"
 
 
 rmarkdown::render("simulation_output.rmd",