From f9165c0f9fc483be994867baa6f048197847d359 Mon Sep 17 00:00:00 2001
From: dj44vuri <julian.sagebiel@idiv.de>
Date: Sat, 25 Nov 2023 01:07:55 +0100
Subject: [PATCH] with option tto use different utility functions for different
respondents
---
.gitignore | 15 ++---
Projects/Agora/parameters_agora.R | 4 +-
Projects/IP2/parameters_ip2.R | 4 +-
Projects/Parks/parameters_ip2_parks.R | 4 +-
Projects/SE_AGRI/parameters_SE Design-Agri.R | 6 +-
Projects/SE_DRIVE/parameters_SE_DRIVE.R | 12 +++-
Projects/ValuGaps/parameters_valugaps.R | 4 +-
functions.R | 62 ++++++++++++++------
generatemd.R | 2 +-
9 files changed, 77 insertions(+), 36 deletions(-)
diff --git a/.gitignore b/.gitignore
index 6ea6506..6fd03d4 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 230833d..fb6d198 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 865da17..4b1758e 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 9d3f52b..38f84bb 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 4942c18..4ecf79a 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 c372cfd..2672dc0 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 5ad0969..8e3e7fc 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 9302e8d..0f2ce8c 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 76d97fc..5808e8b 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",
--
GitLab