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

Computes standardized mean differences (`d`) and sampling variances (`v`) for the
extraction YAML `papers/spatansemenescundfeelingcertaintyshiftiness/spatansemenescundfeelingcertaintyshiftiness.yaml`.

## Data source

Group descriptive statistics from Table 5 (knowledge ascription means/SDs and Ns):  
`papers/spatansemenescundfeelingcertaintyshiftiness/out/tables/camelot_stream_p10_t1.csv`.

## Shared helpers

```{r}
paper_key <- "spatansemenescundfeelingcertaintyshiftiness"

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

# Exact small-sample correction factor used by metafor (.cmicalc).
hedges_correction <- function(df) {
  ifelse(df <= 1, NA_real_, exp(lgamma(df/2) - log(sqrt(df/2)) - lgamma((df - 1)/2)))
}

pooled_sd <- function(n_high, n_low, sd_high, sd_low) {
  sqrt(((n_high - 1) * sd_high^2 + (n_low - 1) * sd_low^2) / (n_high + n_low - 2))
}

d_from_groups_independent <- function(n_high, n_low, mean_high, mean_low, sd_high, sd_low) {
  s <- pooled_sd(n_high, n_low, sd_high, sd_low)
  (mean_low - mean_high) / s
}

var_d_independent <- function(d, n_high, n_low) {
  n <- n_high + n_low
  (n / (n_high * n_low)) + (d^2 / (2 * (n - 2)))
}

compute_effect_size_between_groups <- function(
    paper_key,
    study_id,
    effect_id,
    n_low,
    n_high,
    mean_low,
    mean_high,
    sd_low,
    sd_high,
    sign_convention = "d = mean(low) - mean(high)",
    notes_on_assumptions = ""
) {
  stop_if_missing(n_low, "n_low")
  stop_if_missing(n_high, "n_high")
  stop_if_missing(mean_low, "mean_low")
  stop_if_missing(mean_high, "mean_high")
  stop_if_missing(sd_low, "sd_low")
  stop_if_missing(sd_high, "sd_high")

  d <- d_from_groups_independent(
    n_high = n_high,
    n_low = n_low,
    mean_high = mean_high,
    mean_low = mean_low,
    sd_high = sd_high,
    sd_low = sd_low
  )
  v <- var_d_independent(d = d, n_high = n_high, n_low = n_low)

  df_used <- n_high + n_low - 2
  J <- hedges_correction(df_used)
  g <- J * d
  v_g <- (J^2) * v

  inputs_used <- sprintf(
    "method=between_groups, sign_convention=%s, n_low=%s, n_high=%s, mean_low=%s, mean_high=%s, sd_low=%s, sd_high=%s",
    sign_convention, n_low, n_high, mean_low, mean_high, sd_low, sd_high
  )

  audit <- data.frame(
    paper_key = paper_key,
    study_id = study_id,
    effect_id = effect_id,
    computed_from_suggested = "groups",
    inputs_used = inputs_used,
    d = d,
    v = v,
    g = g,
    v_g = v_g,
    notes_on_assumptions = notes_on_assumptions
  )

  yaml_snippet <- sprintf(
    "effect_size:\\n  metric: SMD\\n  d: %.12f\\n  v: %.12f\\n  computed_from: groups\\n  needs_review: false\\n  notes: \"%s\"\\n",
    d, v, gsub(pattern = "\"", replacement = "'", x = inputs_used)
  )

  list(audit = audit, yaml_snippet = yaml_snippet)
}
```

## Study 1: Error × Stakes × Certainty (between-subjects)

### Effect s1_e1: Uncertain, low error (Con 1: U_LE_LS vs Con 3: U_LE_HS)

```{r}
res_s1_e1 <- compute_effect_size_between_groups(
  paper_key = paper_key,
  study_id = 1,
  effect_id = "s1_e1",
  n_low = 96,
  n_high = 96,
  mean_low = 5.41,
  mean_high = 5.63,
  sd_low = 1.23,
  sd_high = 1.15,
  notes_on_assumptions = "Between-subjects stakes contrast within uncertain participants; low-error vignette (no explicit error possibility)."
)
res_s1_e1$audit
cat(res_s1_e1$yaml_snippet)
```

### Effect s1_e2: Uncertain, high error (Con 4: U_HE_LS vs Con 2: U_HE_HS)

```{r}
res_s1_e2 <- compute_effect_size_between_groups(
  paper_key = paper_key,
  study_id = 1,
  effect_id = "s1_e2",
  n_low = 105,
  n_high = 96,
  mean_low = 5.20,
  mean_high = 5.04,
  sd_low = 1.39,
  sd_high = 1.38,
  notes_on_assumptions = "Between-subjects stakes contrast within uncertain participants; high-error vignette (explicit map-mistake possibility)."
)
res_s1_e2$audit
cat(res_s1_e2$yaml_snippet)
```

### Effect s1_e3: Certain, low error (Con 5: C_LE_LS vs Con 7: C_LE_HS)

```{r}
res_s1_e3 <- compute_effect_size_between_groups(
  paper_key = paper_key,
  study_id = 1,
  effect_id = "s1_e3",
  n_low = 123,
  n_high = 126,
  mean_low = 6.93,
  mean_high = 6.92,
  sd_low = 0.33,
  sd_high = 0.27,
  notes_on_assumptions = "Between-subjects stakes contrast within certain participants; low-error vignette (no explicit error possibility)."
)
res_s1_e3$audit
cat(res_s1_e3$yaml_snippet)
```

### Effect s1_e4: Certain, high error (Con 8: C_HE_LS vs Con 6: C_HE_HS)

```{r}
res_s1_e4 <- compute_effect_size_between_groups(
  paper_key = paper_key,
  study_id = 1,
  effect_id = "s1_e4",
  n_low = 117,
  n_high = 124,
  mean_low = 6.87,
  mean_high = 6.86,
  sd_low = 0.88,
  sd_high = 0.40,
  notes_on_assumptions = "Between-subjects stakes contrast within certain participants; high-error vignette (explicit map-mistake possibility)."
)
res_s1_e4$audit
cat(res_s1_e4$yaml_snippet)
```

## Combined audit table

```{r}
audits <- do.call(rbind, list(res_s1_e1$audit, res_s1_e2$audit, res_s1_e3$audit, res_s1_e4$audit))
audits
```