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)
))
}
```