diff --git a/.gitignore b/.gitignore
index 6ea650685bf06878a3d192de47e5a11bc2c1617d..6fd03d417c9befde090a46304b230dbb422c2141 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,7 +1,8 @@
-.Rproj.user
-.Rhistory
-.RData
-.Ruserdata
-dce_simulation_tool.Rproj
-modeloutput/
-*.html
\ No newline at end of file
+.Rproj.user
+.Rhistory
+.RData
+.Ruserdata
+dce_simulation_tool.Rproj
+modeloutput/
+*.html
+simulation_output_files/
\ No newline at end of file
diff --git a/Projects/Agora/parameters_agora.R b/Projects/Agora/parameters_agora.R
index 230833d21b044e24ce134a22f1d588e39802c0ee..fb6d198a45ecbf87e376906ab82cdb2d5091d053 100644
--- a/Projects/Agora/parameters_agora.R
+++ b/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
diff --git a/Projects/IP2/parameters_ip2.R b/Projects/IP2/parameters_ip2.R
index 865da17ea3d66624664e3b2afdd8bca616c7b196..4b1758e0c3da12276c360e4f54665c1a280c4051 100644
--- a/Projects/IP2/parameters_ip2.R
+++ b/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
diff --git a/Projects/Parks/parameters_ip2_parks.R b/Projects/Parks/parameters_ip2_parks.R
index 9d3f52b06b1169005c339d969ee4f6039fd12c75..38f84bb7061d98611324ba7c12a285adb2aa4832 100644
--- a/Projects/Parks/parameters_ip2_parks.R
+++ b/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)
-
+)
diff --git a/Projects/SE_AGRI/parameters_SE Design-Agri.R b/Projects/SE_AGRI/parameters_SE Design-Agri.R
index 4942c18403d95dd552bd4ece02c4fb4eaa7aac14..4ecf79a098d5108cb1ca42e806c7d60fb22761ff 100644
--- a/Projects/SE_AGRI/parameters_SE Design-Agri.R
+++ b/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
+)
diff --git a/Projects/SE_DRIVE/parameters_SE_DRIVE.R b/Projects/SE_DRIVE/parameters_SE_DRIVE.R
index c372cfd8a8dce037d485b83f1468c6f1806f9a25..2672dc0b34dcfeee5e5f87a1e5b5d5ed8571aeca 100644
--- a/Projects/SE_DRIVE/parameters_SE_DRIVE.R
+++ b/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)
+
+)
diff --git a/Projects/ValuGaps/parameters_valugaps.R b/Projects/ValuGaps/parameters_valugaps.R
index 5ad0969c4d4a7afb015851e29bd179ab84ff41b6..8e3e7fce927cd0a00f1c9c66cb18fb86ddb71598 100644
--- a/Projects/ValuGaps/parameters_valugaps.R
+++ b/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 )
-
+)
diff --git a/functions.R b/functions.R
index 9302e8d7c425c18ea28f1d63fe9b471d392eefae..0f2ce8cd562812264e9137ebea29b2686abbc056 100644
--- a/functions.R
+++ b/functions.R
@@ -1,4 +1,4 @@
-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))
diff --git a/generatemd.R b/generatemd.R
index 76d97fc1aa895e0bd90206ac6844aa29f4ed9bdf..5808e8bc81acb2d410945c73d35b034f173dc641 100644
--- a/generatemd.R
+++ b/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",