This vignette shows how to add triggers to a model. A trigger is a named absence-probability parameter. All members in one trigger call share the same absence draw. Separate trigger calls create independent absence draws.
We use two lognormal accumulators and one shared trigger. The trigger
parameter is named shared_trigger.
model <- race_spec() |>
add_accumulator("go1", "lognormal") |>
add_accumulator("go2", "lognormal") |>
add_outcome("R1", "go1") |>
add_outcome("R2", "go2") |>
add_trigger("shared_trigger", members = c("go1", "go2")) |>
set_parameters(separate = list(m = TRUE, s = TRUE)) |>
finalize_model()
true_params <- c(
go1.m = log(0.30),
go1.s = 0.18,
go2.m = log(0.35),
go2.s = 0.18,
shared_trigger = 0.15
)The trigger probability is supplied in the same parameter vector as the timing parameters.
Failed trigger trials appear as missing responses and missing response times.
set.seed(123456)
n_trials <- 1500
params_df <- build_param_matrix(model, true_params, n_trials = n_trials)
sim <- simulate(model, params_df)
data_df <- data.frame(
trials = sim$trials,
R = factor(sim$R),
rt = sim$rt,
stringsAsFactors = FALSE
)
table(data_df$R, useNA = "ifany")##
## R1 R2 <NA>
## 924 361 215
We prepare the data, build a model context, and evaluate the shared-trigger model under the true parameter values.
prepared <- prepare_data(model, data_df)
ctx <- make_context(model)
params_df_true <- build_param_matrix(
model,
true_params,
n_trials = n_trials
)
ll_true <- as.numeric(log_likelihood(ctx, prepared, params_df_true))
ll_true## [1] 785.4287
To see why trigger grouping matters, compare that with independent trigger absence draws. This uses two separate trigger calls, one for each accumulator.
model_independent <- race_spec() |>
add_accumulator("go1", "lognormal") |>
add_accumulator("go2", "lognormal") |>
add_outcome("R1", "go1") |>
add_outcome("R2", "go2") |>
add_trigger("go1_trigger", members = "go1") |>
add_trigger("go2_trigger", members = "go2") |>
set_parameters(
separate = list(m = TRUE, s = TRUE),
share = list(shared_trigger = c("go1_trigger", "go2_trigger"))
) |>
finalize_model()
independent_prepared <- prepare_data(model_independent, data_df)
independent_ctx <- make_context(model_independent)
params_df_independent <- build_param_matrix(
model_independent,
true_params,
n_trials = n_trials
)
ll_independent <- as.numeric(log_likelihood(
independent_ctx,
independent_prepared,
params_df_independent
))
ll_independent## [1] 513.7229
The same syntax can also be used when only one accumulator has a trigger.
optim()We estimate go1.m, go1.s,
go2.m, and go2.s, while keeping the trigger
probability fixed in the parameter vector passed to the likelihood.
neg_loglik <- function(theta) {
est <- true_params
est["go1.m"] <- theta[["go1.m"]]
est["go1.s"] <- exp(theta[["log_go1.s"]])
est["go2.m"] <- theta[["go2.m"]]
est["go2.s"] <- exp(theta[["log_go2.s"]])
params_df <- build_param_matrix(
model,
est,
n_trials = n_trials
)
ll <- log_likelihood(ctx, prepared, params_df)
-as.numeric(ll)
}
start <- c(
go1.m = log(0.25),
log_go1.s = log(0.12),
go2.m = log(0.42),
log_go2.s = log(0.12)
)
fit <- optim(
start,
neg_loglik,
method = "Nelder-Mead",
control = list(maxit = 4000, reltol = 1e-9)
)
fit_params <- c(
go1.m = fit$par[["go1.m"]],
go1.s = exp(fit$par[["log_go1.s"]]),
go2.m = fit$par[["go2.m"]],
go2.s = exp(fit$par[["log_go2.s"]])
)
target <- true_params[c("go1.m", "go1.s", "go2.m", "go2.s")]
data.frame(true = target, recovered = fit_params, miss = abs(target - fit_params))Use one trigger call when several accumulators share an absence
event. Use separate trigger calls when absence draws are independent;
group those trigger parameters with set_parameters() if
they should have the same probability.