buckwalter2014themysterofstakes
/data/papers/buckwalter2014themysterofstakes/analysis/effect_sizes.qmd
---
title: "Effect size computations: buckwalter2014themysterofstakes"
format:
  html:
    toc: true
execute:
  echo: true
  warning: true
  message: false
---

Computes standardized mean differences (`d`) and sampling variances (`v`) for
`papers/buckwalter2014themysterofstakes/buckwalter2014themysterofstakes.yaml`.

All effects below use the analyst-authorized equal-cell assumption.

- Study 1 is a `2 x 2 x 2` between-subjects design. The paper reports `N = 215`
  before exclusions, states that `30` participants were removed for failed
  comprehension checks, and reports omnibus tests with denominator `df = 177`.
  These are consistent with an analyzed `N = 185`, so equal allocation across
  the 8 cells implies `23.125` participants per cell.
- Study 2 is a `2 x 2` between-subjects design. The paper reports `100`
  participants and `10` removals, and the omnibus ANOVA denominator `df = 86`
  implies an analyzed `N = 90`. Equal allocation across the 4 cells implies
  `22.5` participants per cell.

## Inputs and methods

```{r}
paper_key <- "buckwalter2014themysterofstakes"
sign_convention <- "d = mean(low) - mean(high)"

effects <- list(
  list(
    study_id = 1,
    effect_id = "s1_e1",
    method_used = "between_groups",
    n_low = 185 / 8,
    n_high = 185 / 8,
    mean_low = 3.48,
    sd_low = 1.62,
    mean_high = 4.15,
    sd_high = 1.05,
    notes_on_assumptions = "Bank denial, low error. Equal-cell approximation in 2x2x2 design: analyzed N=185 implies 23.125 per cell."
  ),
  list(
    study_id = 1,
    effect_id = "s1_e2",
    method_used = "between_groups",
    n_low = 185 / 8,
    n_high = 185 / 8,
    mean_low = 4.27,
    sd_low = 1.08,
    mean_high = 3.92,
    sd_high = 1.12,
    notes_on_assumptions = "Bank denial, high error. Equal-cell approximation in 2x2x2 design: analyzed N=185 implies 23.125 per cell."
  ),
  list(
    study_id = 1,
    effect_id = "s1_e3",
    method_used = "between_groups",
    n_low = 185 / 8,
    n_high = 185 / 8,
    mean_low = 4.70,
    sd_low = 0.56,
    mean_high = 4.48,
    sd_high = 0.59,
    notes_on_assumptions = "Bank assertion, low error. Equal-cell approximation in 2x2x2 design: analyzed N=185 implies 23.125 per cell."
  ),
  list(
    study_id = 1,
    effect_id = "s1_e4",
    method_used = "between_groups",
    n_low = 185 / 8,
    n_high = 185 / 8,
    mean_low = 4.05,
    sd_low = 1.30,
    mean_high = 4.33,
    sd_high = 0.73,
    notes_on_assumptions = "Bank assertion, high error. Equal-cell approximation in 2x2x2 design: analyzed N=185 implies 23.125 per cell."
  ),
  list(
    study_id = 2,
    effect_id = "s2_e1",
    method_used = "between_groups",
    n_low = 90 / 4,
    n_high = 90 / 4,
    mean_low = 2.61,
    sd_low = 0.89,
    mean_high = 5.12,
    sd_high = 3.42,
    notes_on_assumptions = "Typo knowledge probe. Equal-cell approximation in 2x2 design: analyzed N=90 implies 22.5 per cell."
  )
)
```

## Computation

```{r}
if (!requireNamespace("esc", quietly = TRUE)) {
  stop("Package 'esc' is required for this template. Install with install.packages('esc').", call. = FALSE)
}
suppressPackageStartupMessages(library(esc))

stop_if_missing <- function(x, name) {
  if (is.na(x)) stop(sprintf("Missing required input: %s", name), call. = FALSE)
}

extract_esc <- function(x) {
  list(
    d = as.numeric(x$es),
    v = as.numeric(x$var)
  )
}

compute_with_esc <- function(fun, ...) {
  d_obj <- fun(..., es.type = "d")
  g_obj <- fun(..., es.type = "g")
  d_out <- extract_esc(d_obj)
  g_out <- extract_esc(g_obj)
  list(d = d_out$d, v = d_out$v, g = g_out$d, v_g = g_out$v)
}

compute_effect <- function(effect_inputs) {
  study_id <- effect_inputs$study_id
  effect_id <- effect_inputs$effect_id
  method_used <- effect_inputs$method_used
  n_high <- effect_inputs$n_high
  n_low <- effect_inputs$n_low
  mean_high <- effect_inputs$mean_high
  mean_low <- effect_inputs$mean_low
  sd_high <- effect_inputs$sd_high
  sd_low <- effect_inputs$sd_low
  notes_on_assumptions <- effect_inputs$notes_on_assumptions

  if (method_used != "between_groups") {
    stop(sprintf("This paper uses between_groups only; got method_used=%s", method_used), call. = FALSE)
  }

  stop_if_missing(n_high, "n_high")
  stop_if_missing(n_low, "n_low")
  stop_if_missing(mean_high, "mean_high")
  stop_if_missing(mean_low, "mean_low")
  stop_if_missing(sd_high, "sd_high")
  stop_if_missing(sd_low, "sd_low")

  res <- compute_with_esc(
    esc::esc_mean_sd,
    grp1m = mean_low,
    grp1sd = sd_low,
    grp1n = n_low,
    grp2m = mean_high,
    grp2sd = sd_high,
    grp2n = n_high
  )

  inputs_used <- paste(
    c(
      sprintf("method=%s", method_used),
      sprintf("sign_convention=%s", sign_convention),
      sprintf("n_low=%s", n_low),
      sprintf("n_high=%s", n_high),
      sprintf("mean_low=%s", mean_low),
      sprintf("sd_low=%s", sd_low),
      sprintf("mean_high=%s", mean_high),
      sprintf("sd_high=%s", sd_high)
    ),
    collapse = ", "
  )

  data.frame(
    paper_key = paper_key,
    study_id = study_id,
    effect_id = effect_id,
    design = "Between-Subjects",
    method_used = method_used,
    computed_from_suggested = "groups",
    inputs_used = inputs_used,
    d = res$d,
    v = res$v,
    g = res$g,
    v_g = res$v_g,
    notes_on_assumptions = notes_on_assumptions,
    stringsAsFactors = FALSE
  )
}

audit <- do.call(rbind, lapply(effects, compute_effect))
audit
```

## Paste-ready YAML snippets

```{r}
for (i in seq_len(nrow(audit))) {
  row <- audit[i, ]
  cat(sprintf("\n# %s (study_id=%s)\n", row$effect_id, row$study_id))
  cat(sprintf(
    "effect_size:\n  metric: SMD\n  d: %.12f\n  v: %.12f\n  computed_from: %s\n  needs_review: false\n  notes: \"%s\"\n",
    row$d,
    row$v,
    row$computed_from_suggested,
    gsub("\"", "'", row$inputs_used)
  ))
}
```