---
title: "Shared Absence Triggers"
output: rmarkdown::html_vignette
vignette: >
  %\VignetteIndexEntry{Shared Absence Triggers}
  %\VignetteEngine{knitr::rmarkdown}
  %\VignetteEncoding{UTF-8}
---

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.

```{r}
library(AccumulatR)
```

## Define the model

We use two lognormal accumulators and one shared trigger. The trigger parameter
is named `shared_trigger`.

```{r}
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.

## Simulate data

Failed trigger trials appear as missing responses and missing response times.

```{r}
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")
```

## Evaluate the likelihood

We prepare the data, build a model context, and evaluate the shared-trigger
model under the true parameter values.

```{r}
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
```

To see why trigger grouping matters, compare that with independent trigger
absence draws. This uses two separate trigger calls, one for each accumulator.

```{r}
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
```

The same syntax can also be used when only one accumulator has a trigger.

```{r}
model_single_q <- race_spec() |>
  add_accumulator("go1", "lognormal") |>
  add_accumulator("go2", "lognormal") |>
  add_outcome("R1", "go1") |>
  add_outcome("R2", "go2") |>
  add_trigger("go1_trigger", members = "go1") |>
  finalize_model()
```

## Estimate parameters with `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.

```{r eval=FALSE}
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.