## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse  = TRUE,
  comment   = "#>",
  fig.width  = 7,
  fig.height = 4
)
library(DecisionDrift)
set.seed(42)

## ----data---------------------------------------------------------------------
# Simulate a system that became more permissive after wave 4.
# Group A drifts faster than Group B.

n_units <- 80
n_waves <- 8

probs_A <- c(rep(0.20, 4), rep(0.60, 4))  # sharp increase at wave 5
probs_B <- c(rep(0.25, 4), rep(0.40, 4))  # modest increase at wave 5

dat <- data.frame(
  id       = rep(seq_len(n_units), each = n_waves),
  time     = rep(seq_len(n_waves), times = n_units),
  decision = c(
    rbinom(40 * n_waves, 1, rep(probs_A, 40)),
    rbinom(40 * n_waves, 1, rep(probs_B, 40))
  ),
  group    = rep(c("A", "B"), each = 40 * n_waves)
)

dp <- dd_build(dat, id, time, decision,
               group      = group,
               event_time = 5L)
print(dp)

## ----prevalence---------------------------------------------------------------
prev <- dd_prevalence(dp)
print(prev)
plot(prev)

## ----transition---------------------------------------------------------------
tr <- dd_transition(dp)
print(tr)
plot(tr)

## ----entropy------------------------------------------------------------------
et <- dd_entropy_trend(dp, window = 3L)
print(et)
plot(et)

## ----group--------------------------------------------------------------------
gd <- dd_group_drift(dp)
print(gd)
plot(gd)

## ----changepoint--------------------------------------------------------------
cp <- dd_changepoint(dp)
print(cp)
plot(cp)

## ----indices------------------------------------------------------------------
idx <- dd_indices(dp)
print(idx)

## ----audit--------------------------------------------------------------------
aud <- dd_audit(dp, include_robustness = TRUE, R = 199, seed = 1,
                thresholds = c(TDI = 0.05, NEC = 0.10), verbose = FALSE)
print(aud)

## ----masked-data--------------------------------------------------------------
masked <- dd_simulate(n = 600, waves = 6, scenario = "masked", seed = 11)
dpm <- dd_build(masked, id, time, decision)
round(tapply(masked$decision, masked$time, mean), 3)

## ----masked-flow--------------------------------------------------------------
fl <- dd_decompose(dpm, R = 199, seed = 2)
print(fl)
plot(fl)

## ----masked-test--------------------------------------------------------------
gt <- dd_global_test(dpm, R = 199, seed = 3)
print(gt)
plot(gt)

## ----masked-prev--------------------------------------------------------------
dd_prevalence(dpm)$trend$p_value

## ----masked-baseline----------------------------------------------------------
dd_global_test(dpm, contrast = "baseline", R = 199, seed = 3)$p_value

## ----composition--------------------------------------------------------------
comp <- dd_simulate(n = 600, waves = 6, scenario = "composition", seed = 12)
dpc  <- dd_build(comp, id, time, decision, group = group)
gdc  <- dd_group_decompose(dpc, R = 199, seed = 4)
print(gdc)
plot(gdc)

## ----group-masked-------------------------------------------------------------
gm  <- dd_simulate(n = 800, waves = 6, scenario = "group_masked", seed = 13)
dpg <- dd_build(gm, id, time, decision, group = group)
round(tapply(gm$decision, gm$time, mean), 3)   # pooled rate
gtg <- dd_global_test(dpg, components = "prevalence", by_group = TRUE,
                      contrast = "baseline", R = 199, seed = 5)
print(gtg)

## ----robustness---------------------------------------------------------------
rob <- dd_robustness(dp, variants = c("lopo", "min_waves"))
print(rob)
plot(rob)