-
Notifications
You must be signed in to change notification settings - Fork 0
/
Comparison_InfoDes.R
145 lines (120 loc) · 4.64 KB
/
Comparison_InfoDes.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
#' ---
#' title: "Pruebas de comparacion entre funciones"
#' author: "Daniel Gil"
#' date: "`Sep 2018"
#' output: github_document
#' ---
#'
# Remove all elements
rm(list = ls())
# Load packages
library(microbenchmark)
library(profvis)
library(Rcpp)
library(RcppArmadillo)
library(shiny)
# Load functions
source("seqDB.R")
source("seqDB2.R")
source("seqDB3.R")
source("Derr.R")
source("InfoDes.R")
source("DBerrS.R")
source("DerrS.R")
sourceCpp("InfoDes_cpp.cpp")
sourceCpp("DerrS_cpp.cpp")
#----
set.seed(123)
cs <- idefix::Profiles(lvls = c(4, 3, 2), coding = c("E", "E", "E"))
# Sepcify prior for each respondent
m <- c(0.5, 0.5, 1, -0.3, -0.7, 0.7)
v <- diag(length(m))
ps <- MASS::mvrnorm(n = 10, mu = m, Sigma = v)
# Generate DB optimal design: 8 choice sets with 2 alternatives each
init.des <- idefix::Modfed(cand.set = cs, n.sets = 8, n.alts = 2,
alt.cte = c(0, 0), par.draws = ps)$design
init.des
#' Simulate choice data for the initial design
#' True individual preference parameter
truePREF <- c(0.8, 1, 1.2, -0.4, -0.8, 1.3)
#' Simulate choices on the logit model
#' In this case, for the first five choice sets the second alternative is
#' chosen, whereas for the last three the first alternative is chosen.
set.seed(123)
y.sim <- idefix::RespondMNL(par = truePREF, des = init.des, n.alts = 2)
y.sim
#' Updating prior distribution
set.seed(123)
draws <- idefix::ImpsampMNL(prior.mean = m, prior.covar = v,
des = init.des, n.alts = 2, y = y.sim, m = 6)
draws
#' Selecting optimal choice
#' minimizing DB-error
dr <- draws$sample
w <- draws$weights
set <- SeqDB(des = init.des, cand.set = cs, n.alts = 2,
par.draws = dr, prior.covar = v, weights = w)
set2 <- SeqDB2(des = init.des, cand.set = cs, n.alts = 2,
par.draws = dr, prior.covar = v, weights = w)
set3 <- SeqDB3(des = init.des, cand.set = cs, n.alts = 2,
par.draws = dr, prior.covar = v, weights = w)
set;set2;set3
profvis({SeqDB(des = init.des, cand.set = cs, n.alts = 2,
par.draws = dr, prior.covar = v, weights = w)})
profvis({SeqDB2(des = init.des, cand.set = cs, n.alts = 2,
par.draws = dr, prior.covar = v, weights = w)})
profvis({SeqDB3(des = init.des, cand.set = cs, n.alts = 2,
par.draws = dr, prior.covar = v, weights = w)})
#----
# Example from paper
#' Discrete choice experiment without any adaptive sets.
# data("example_design")
load("C:/Users/danie/Documents/Daniel Gil/KULeuven/Stage 2/Thesis/Scripts/idefix/data/example_design.RData")
xdes <- example_design
xdes
# getwd()
source("SurveyApp.R")
source("Decode.R")
source("Charbin.R")
source("Profiles.R")
source("ImpsampMNL.R")
n.sets <- 8
alternatives <- c("Alternative A", "Alternative B")
attributes <- c("Price", "Time", "Comfort")
labels <- vector(mode = "list", length(attributes))
labels[[1]] <- c("$10", "$5", "$1")
labels[[2]] <- c("20 min", "12 min", "3 min")
labels[[3]] <- c("bad", "average", "good")
code <- c("D", "D", "D")
b.text <- "Please choose the alternative you prefer"
i.text <- "Welcome, here are some instructions ... good luck!"
e.text <- "Thanks for taking the survey"
# SurveyApp (des = xdes, n.total = n.sets, alts = alternatives,
# atts = attributes, lvl.names = labels, coding = code,
# buttons.text = b.text, intro.text = i.text, end.text = e.text,
# data.dir = NULL)
# Discrete choice experiment containing adaptive sets.
n.sets <- 12
p.mean <- c(0.3, 0.7, 0.3, 0.7, 0.3, 0.7)
p.var <- diag(length(p.mean))
levels <- c(3, 3, 3)
code <- c("D", "D", "D")
cand <- idefix::Profiles(lvls = levels, coding = code)
dataDir = "C:/Users/danie/Documents/Daniel Gil/KULeuven/Stage 2/Thesis/Scripts/Output_test"
SurveyApp(des = xdes, n.total = n.sets, alts = alternatives,
atts = attributes, lvl.names = labels, coding = code,
buttons.text = b.text, intro.text = i.text,
end.text = e.text, data.dir = dataDir, crit= "KL",
prior.mean = p.mean, prior.covar = p.var,
cand.set = cand, m = 6)
# Without initial design
SurveyApp (des = NULL, n.total = n.sets, alts = alternatives,
atts = attributes, lvl.names = labels, coding = code,
buttons.text = b.text, intro.text = i.text,
end.text = e.text, data.dir = dataDir, crit = "KL",
prior.mean = p.mean, prior.covar = p.var,
cand.set = cand, m = 6)
runApp(SurveyApp (des = xdes, n.total = n.sets,
alts = alternatives, atts = attributes, lvl.names = labels,
coding = code, buttons.text = b.text, intro.text = i.text,
end.text = e.text, data.dir = tempdir()))