Optimization/Profiling_seqDB_shiny.R at master · danielgils/Optimization · GitHub

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
#' ---
#' title: "Profilling seqDBApp function"
#' author: "Daniel Gil"
#' date: "`Sep 2018"
#' output: github_document
#' ---
#'

# Remove all elements
rm(list = ls())

# Load packages
library(shiny)
# library(microbenchmark)
# library(profvis)
# library(Rcpp)
# library(RcppArmadillo)

#----
source("SurveyApp.R")
source("Decode.R")
source("Profiles.R")
source("Charbin.R")
source("ImpsampMNL.R")
source("Lattice_mvt.R")


#----
#'   Real surveys with idefix
#'   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

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 <- 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)
debug(ImpsampMNL)

#----
#   Without initial design
# Hay dos versiones de ImpsampMNL, tener cuidado
# Me pide log_post: Creo que es mejor trabajar con el nuevo programa y pedir ejemplos a Frits

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 = "DB",
           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()))

# dataDir <- getwd()
data <- LoadData(data.dir = dataDir, type = "num")
data
help(package="idefix")