Draft hierarchical implementation cpt

JAGS/cpt_hierarchical.txt

+model
+{
+
+  # specify hierarchical priors for CPT parameters: parameters are estimated for each synthetic agent j (agent level) and across agents (group level)
+  ## alpha, gamma, delta: link group- and agent-level via probit transformation (cf. Rouder & Lu, 2005)
+  ## rho: link group- and agent-level via log transformation (cf. Nilsson et al., 2011)
+
+  for (j in n_agents)
+  {
+
+  # agent level
+  ## draw transformed agent-level parameters from group-level normal distributions
+
+	alpha.prob[j] ~ dnorm(mu.alpha.prob, tau.alpha.prob) T(-3, 3)
+	gamma.prob[j] ~ dnorm(mu.gamma.prob, tau.gamma.prob) T(-3, 3)
+	delta.prob[j] ~ dnorm(mu.delta.prob, tau.delta.prob) T(-3, 3)
+	rho.log[j]   ~ dnorm(mu.rho.log, tau.rho.log)
+
+	## retransform parameters to original scale and use link function to extend the range (cf. Scheibehenne & Pachur, 2015)
+
+	alpha[j] <- 2*phi(alpha.prob[j])
+	gamma[j] <- 2*phi(gamma.prob[j])
+	delta[j] <- 5*phi(delta.prob[j])
+  rho[j]   <- exp(rho.log[j])
+  }
+
+  # group level
+  ## specify group-level priors on transformed parameters such that they are uninformative on the original scale
+
+  ## alpha
+
+  mu.alpha.prob ~ dnorm(0, 1)
+  tau.alpha.prob <- pow(sigma.alpha.prob, -2)
+  sigma.alpha.prob ~ dunif(0, 10)
+
+  ## gamma
+
+  mu.gamma.prob ~ dnorm(0, 1)
+  tau.gamma.prob <- pow(sigma.gamma.prob, -2)
+  sigma.gamma.prob ~ dunif(0, 10)
+
+  ## delta
+
+  mu.delta.prob ~ dnorm(0, 1)
+  tau.delta.prob <- pow(sigma.delta.prob, -2)
+  sigma.delta.prob ~ dunif(0, 10)
+
+  ## rho
+
+  mu.rho.log ~ dunif(-2.3, 1.61)
+  tau.rho.log <- pow(sigma.rho.log, -2)
+  sigma.rho.log ~ dunif(0, 1.13)
+
+  ## retransfrom group level means to original scale
+
+  mu.alpha <- 2*phi(mu.alpha.prob)
+  mu.gamma <- 2*phi(mu.gamma.prob)
+  mu.delta <- 5*phi(mu.delta.prob)
+  mu.rho <- exp(mu.rho.log)
+
+  # define CPT model
+
+  for (j in n_agents)
+  {
+
+    for (i in start:stop)
+	  {
+
+    # value function
+
+	  v.a.o1[j, i] <- pow(a_o1[j, i], alpha[j])
+	  v.a.o2[j, i] <- pow(a_o2[j, i], alpha[j])
+	  v.b.o1[j, i] <- pow(b_o1[j, i], alpha[j])
+  	v.b.o2[j, i] <- pow(b_o2[j, i], alpha[j])
+
+	  # weighting function (cf. Prelec, 1998)
+
+	  w.a.p2[j, i] <- (delta[j] * (pow(a_p2_exp[j, i], gamma[j]))) / (delta[j] * (pow(a_p2_exp[j, i], gamma[j])) + pow(a_p1_exp[j, i], gamma[j]))
+	  w.a.p1[j, i] <- 1-w.a.p2[j, i]
+	  w.b.p1[j, i] <- (delta[j] * (pow(b_p1[j, i], gamma[j]))) / (delta[j] * (pow(b_p1[j, i], gamma)) + pow(b_p2[j, i], gamma[j]))
+	  w.b.p2[j, i] <- 1-w.b.p1[j, i]
+
+	  Vf.a[j, i]  <- w.a.p1[j, i] * v.a.o1[j, i] + w.a.p2[j, i] * v.a.o2[j, i]
+	  Vf.b[j, i]  <- w.b.p1[j, i] * v.b.o1[j, i] + w.b.p2[j, i] * v.b.o2[j, i]
+
+	  # rescale subjective values to alleviate possible parameter intercorrelations (cf. Krefeld-Schwalb et al., 2021)
+
+	  Vf.a.re[j, i] <- pow(Vf.a[j, i], (1/alpha[j]))
+	  Vf.b.re[j, i] <- pow(Vf.b[i, i], (1/alpha[j]))
+
+	  # stochastic choice rule
+
+	  binval[j, i] <- (1)/(1+exp((-1*rho[j])*(Vf.a.re[j, i]-Vf.b.re[j, i])))
+	  choice[j, i] ~ dbern(binval[j, i])
+	  }
+  }
+}
+
+