Skip to content

Commit ac43df8

Browse files
committed
add models from Heuristic Decision Making chapter
1 parent 19eb201 commit ac43df8

File tree

7 files changed

+526
-0
lines changed

7 files changed

+526
-0
lines changed
Lines changed: 118 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,118 @@
1+
# clears workspace:
2+
rm(list=ls())
3+
4+
# Set working directory!
5+
6+
library(rstan)
7+
8+
####################
9+
# Zakladam to spis na Jags verzi - neohraniceny normal na stmp. Puvodne byla
10+
# Jags stmp[i,1] <- 1, ale toto delalo v Jags nejakou chybu, ktera zmizela po
11+
# odstraneni tohoto.
12+
# Hlavne je problem, ze nemuzu prevest intereg values mezi bloky.
13+
#
14+
# - zmenit comment znak okolo modelu
15+
#########
16+
17+
model <- '
18+
// Individual Search Orders
19+
data {
20+
int ns;
21+
int nq;
22+
int nc;
23+
int y[ns,nq];
24+
int m[83,nc];
25+
int p[nq,2];
26+
}
27+
parameters {
28+
real<lower=.5,upper=1> gamma;
29+
vector[nc] stmp[ns];
30+
}
31+
transformed parameters {
32+
vector<lower=0,upper=1>[3] ttb;
33+
real<lower=0,upper=3> t[ns,nq];
34+
real s[ns,nc];
35+
36+
// One Reason Model, With Different Search Order Per Subject
37+
for (i in 1:ns) {
38+
39+
// Cue Search Order From Ranking stmp
40+
s[i] <- sort_indices_asc(stmp[i]);
41+
42+
for (q in 1:nq) {
43+
vector[nc] tmp1;
44+
real tmp2;
45+
int tmp3;
46+
47+
// Add Cue Contributions To Mimic TTB Decision
48+
for (j in 1:nc)
49+
tmp1[j] <- (m[p[q,1],j] - m[p[q,2],j]) * 2 ^ (s[i,j] - 1);
50+
51+
// Find if Cue Favors First, Second, or Neither Stimulus
52+
tmp2 <- sum(tmp1);
53+
tmp3 <- -1 * int_step(-tmp2) + int_step(tmp2);
54+
t[i,q] <- tmp3 + 2;
55+
}
56+
}
57+
// Choose TTB Decision With Probability Gamma, or Guess
58+
ttb[1] <- 1 - gamma;
59+
ttb[2] <- .5;
60+
ttb[3] <- gamma;
61+
}
62+
model {
63+
for (i in 1:ns)
64+
stmp[i] ~ normal(0,inv_sqrt(.001));
65+
66+
// Data
67+
for (q in 1:nq)
68+
for (i in 1:ns)
69+
if (t[i,q] == 1.0)
70+
y[i,q] ~ bernoulli(ttb[1]);
71+
else if (t[i,q] == 2.0)
72+
y[i,q] ~ bernoulli(ttb[2]);
73+
else if (t[i,q] == 3.0)
74+
y[i,q] ~ bernoulli(ttb[3]);
75+
else
76+
print("Error with indexing y");
77+
78+
generated quantities {
79+
int<lower=0,upper=1> ypred[ns,nq];
80+
81+
82+
for (q in 1:nq)
83+
for (i in 1:ns)
84+
if (t[i,q] == 1.0)
85+
ypred[i,q] <- bernoulli_rng(ttb[1]);
86+
else if (t[i,q] == 2.0)
87+
ypred[i,q] <- bernoulli_rng(ttb[2]);
88+
else if (t[i,q] == 3.0)
89+
ypred[i,q] <- bernoulli_rng(ttb[3]);
90+
else
91+
print("Error with indexing ypred");
92+
93+
}'
94+
95+
load("StopSearchData.RData") # Load all data for the model
96+
97+
data <- list(nc=nc, nq=nq, ns=ns, p=p, m=m, y=y) # To be passed on to Stan
98+
99+
myinits <- list(
100+
list(gamma=.75))
101+
102+
parameters <- c("gamma", "s", "ypred") # Parameters to be monitored
103+
104+
# For a detailed description type "?stan".
105+
samples <- stan(model_code=model,
106+
data=data,
107+
# init=myinits, # If not specified, gives random inits
108+
pars=parameters,
109+
iter=1100,
110+
chains=1,
111+
thin=1,
112+
warmup=100, # Stands for burn-in; Default = iter/2
113+
# seed=123 # Setting seed; Default is random seed
114+
)
115+
# Now the values for the monitored parameters are in the "samples" object,
116+
# ready for inspection.
117+
118+
print(samples, digits=3)
Lines changed: 126 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,126 @@
1+
# clears workspace:
2+
rm(list=ls())
3+
4+
# Set working directory!
5+
6+
library(rstan)
7+
8+
####################
9+
# Zakladam to spis na Jags verzi - neohraniceny normal na stmp. Puvodne byla
10+
# Jags stmp[i,1] <- 1, ale toto delalo v Jags nejakou chybu, ktera zmizela po
11+
# odstraneni tohoto.
12+
# Hlavne je problem, ze nemuzu prevest intereg values mezi bloky.
13+
#
14+
# - zmenit comment znak okolo modelu
15+
#########
16+
17+
model <- '
18+
// Individual Search Orders
19+
data {
20+
int ns;
21+
int nq;
22+
int nc;
23+
int y[ns,nq];
24+
int m[83,nc];
25+
int p[nq,2];
26+
# vector[nc] v;
27+
}
28+
parameters {
29+
real<lower=.5,upper=1> gamma;
30+
vector[nc] stmp[ns];
31+
}
32+
transformed parameters {
33+
vector<lower=0,upper=1>[3] ttb;
34+
# real<lower=1,upper=nc> s[ns,nc];
35+
matrix[ns,nq] tmp2;
36+
37+
// Cue Search Order From Ranking stmp
38+
# for (i in 1:ns)
39+
# s[i] <- sort_indices_asc(stmp[i]);
40+
41+
// One Reason Model, With Different Search Order Per Subject
42+
for (i in 1:ns) {
43+
for (q in 1:nq) {
44+
vector[nc] tmp1;
45+
46+
// Add Cue Contributions To Mimic TTB Decision
47+
for (j in 1:nc) {
48+
int s;
49+
s <- rank(stmp[i], j) + 1;
50+
tmp1[j] <- (m[p[q,1],j] - m[p[q,2],j]) * 2 ^ (s - 1);
51+
}
52+
// Find if Cue Favors First, Second, or Neither Stimulus
53+
tmp2[i,q] <- sum(tmp1);
54+
}
55+
}
56+
// Choose TTB Decision With Probability Gamma, or Guess
57+
ttb[1] <- 1 - gamma;
58+
ttb[2] <- .5;
59+
ttb[3] <- gamma;
60+
}
61+
model {
62+
for (i in 1:ns)
63+
stmp[i] ~ normal(0,sqrt(1000));
64+
65+
for (i in 1:ns) {
66+
for (q in 1:nq) {
67+
int t;
68+
t <- -1 * int_step(-tmp2[i,q]) + int_step(tmp2[i,q]) + 2;
69+
y[i,q] ~ bernoulli(ttb[t]);
70+
}
71+
}
72+
// One Reason Model, With Different Search Order Per Subject
73+
# for (i in 1:ns)
74+
# for (q in 1:nq)
75+
# if (tmp2[i,q] < 0)
76+
# y[i,q] ~ bernoulli(ttb[1]);
77+
# else if (tmp2[i,q] > 0)
78+
# y[i,q] ~ bernoulli(ttb[3]);
79+
# else
80+
# y[i,q] ~ bernoulli(ttb[3]);
81+
82+
}
83+
generated quantities {
84+
# int<lower=0,upper=1> ypred[ns,nq];
85+
86+
87+
# for (q in 1:nq)
88+
# for (i in 1:ns)
89+
# if (t[i,q] == 1.0)
90+
# ypred[i,q] <- bernoulli_rng(ttb[1]);
91+
# else if (t[i,q] == 2.0)
92+
# ypred[i,q] <- bernoulli_rng(ttb[2]);
93+
# else if (t[i,q] == 3.0)
94+
# ypred[i,q] <- bernoulli_rng(ttb[3]);
95+
# else
96+
# print("Error with indexing ypred");
97+
98+
# for (q in 1:nq)
99+
# for (i in 1:ns)
100+
# ypred[i,q] <- bernoulli_rng(ttb[t[i,q]]);
101+
}'
102+
103+
load("StopSearchData.RData") # Load all data for the model
104+
105+
data <- list(nc=nc, nq=nq, ns=ns, v=v, p=p, m=m, y=y) # To be passed on to Stan
106+
107+
myinits <- list(
108+
list(gamma=.75))
109+
110+
parameters <- c("gamma", "s") # Parameters to be monitored
111+
112+
# For a detailed description type "?stan".
113+
samples <- stan(model_code=model,
114+
data=data,
115+
# init=myinits, # If not specified, gives random inits
116+
pars=parameters,
117+
iter=110,
118+
chains=1,
119+
thin=1,
120+
warmup=10, # Stands for burn-in; Default = iter/2
121+
# seed=123 # Setting seed; Default is random seed
122+
)
123+
# Now the values for the monitored parameters are in the "samples" object,
124+
# ready for inspection.
125+
126+
print(samples, digits=3)
Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
# Unfortunately, this model is not implemented!
2+
3+
# Search "Search model from Lee & Wagenmakers, 2014" on Stan's mailing list
4+
# to find out why.
5+
# If you have some suggestions about the model, let us know!
Lines changed: 5 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,5 @@
1+
# Unfortunately, this model is not implemented!
2+
3+
# Search "Search model from Lee & Wagenmakers, 2014" on Stan's mailing list
4+
# to find out why.
5+
# If you have some suggestions about the model, let us know!
Binary file not shown.

0 commit comments

Comments
 (0)