---
title: "Effect size computation: mayetal2010practicalinterestsrelevant"
format:
  html:
    toc: true
execute:
  echo: true
  warning: true
  message: false
---

```{r}
library(readxl)
library(esc)
library(metafor)
```

## Shared helpers

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

compute_effect_size <- function(
    paper_key,
    study_id,
    effect_id,
    method_used,
    sign_convention = "d = mean(low) - mean(high)",
    n_high = NA_integer_,
    n_low = NA_integer_,
    n_total = NA_integer_,
    mean_high = NA_real_,
    mean_low = NA_real_,
    sd_high = NA_real_,
    sd_low = NA_real_,
    r_within = NA_real_,
    notes_on_assumptions = "",
    imputed_flag = FALSE,
    needs_sensitivity = TRUE
) {
  d <- NA_real_
  v <- NA_real_
  g <- NA_real_
  v_g <- NA_real_
  computed_from_suggested <- NA_character_
  design_used <- if (startsWith(method_used, "between_")) "Between-Subjects" else if (startsWith(method_used, "within_")) "Within-Subjects" else NA_character_

  if (method_used == "between_groups") {
    computed_from_suggested <- "groups"
    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")

    # Established package workflow for between-subjects SMD.
    # esc_mean_sd computes grp1 - grp2, so use grp1=low, grp2=high
    # to preserve sign convention d = mean(low) - mean(high).
    es_d <- esc::esc_mean_sd(
      grp1m = mean_low, grp1sd = sd_low, grp1n = n_low,
      grp2m = mean_high, grp2sd = sd_high, grp2n = n_high,
      es.type = "d"
    )
    es_g <- esc::esc_mean_sd(
      grp1m = mean_low, grp1sd = sd_low, grp1n = n_low,
      grp2m = mean_high, grp2sd = sd_high, grp2n = n_high,
      es.type = "g"
    )

    d <- as.numeric(es_d$es)
    v <- as.numeric(es_d$var)
    g <- as.numeric(es_g$es)
    v_g <- as.numeric(es_g$var)
  } else if (method_used == "within_smcrp_r") {
    computed_from_suggested <- "groups"
    stop_if_missing(n_total, "n_total")
    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")
    stop_if_missing(r_within, "r_within")
    if (abs(r_within) > 1) stop("r_within must be between -1 and 1", call. = FALSE)

    # Established package workflow for within-subject SMCRP.
    # m1i-m2i corresponds to mean(low)-mean(high), matching sign convention.
    es_d <- metafor::escalc(
      measure = "SMCRP",
      m1i = mean_low, m2i = mean_high,
      sd1i = sd_low, sd2i = sd_high,
      ri = r_within, ni = n_total,
      correct = FALSE
    )
    es_g <- metafor::escalc(
      measure = "SMCRP",
      m1i = mean_low, m2i = mean_high,
      sd1i = sd_low, sd2i = sd_high,
      ri = r_within, ni = n_total,
      correct = TRUE
    )

    d <- as.numeric(es_d$yi)
    v <- as.numeric(es_d$vi)
    g <- as.numeric(es_g$yi)
    v_g <- as.numeric(es_g$vi)
  } else {
    stop(sprintf("Unknown method_used: %s", method_used), call. = FALSE)
  }

  inputs_used <- paste(
    c(
      sprintf("method=%s", method_used),
      sprintf("sign_convention=%s", sign_convention),
      if (!is.na(n_low)) sprintf("n_low=%s", n_low) else NULL,
      if (!is.na(n_high)) sprintf("n_high=%s", n_high) else NULL,
      if (!is.na(n_total)) sprintf("n_total=%s", n_total) else NULL,
      if (!is.na(mean_low)) sprintf("mean_low=%s", mean_low) else NULL,
      if (!is.na(mean_high)) sprintf("mean_high=%s", mean_high) else NULL,
      if (!is.na(sd_low)) sprintf("sd_low=%s", sd_low) else NULL,
      if (!is.na(sd_high)) sprintf("sd_high=%s", sd_high) else NULL,
      if (!is.na(r_within)) sprintf("r_within=%s", r_within) else NULL
    ),
    collapse = ", "
  )

  audit <- data.frame(
    paper_key = paper_key,
    study_id = study_id,
    effect_id = effect_id,
    design = design_used,
    method_used = method_used,
    computed_from_suggested = computed_from_suggested,
    inputs_used = inputs_used,
    d = d,
    v = v,
    g = g,
    v_g = v_g,
    notes_on_assumptions = notes_on_assumptions,
    imputed_flag = imputed_flag,
    needs_sensitivity = needs_sensitivity
  )

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

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

## Study 1 (Between-Subjects): Stakes × Alternatives

Raw data file: `papers/mayetal2010practicalinterestsrelevant/data/May et al. KPI Data - Between-Subjects (Exp 1).xls`

### Effect s1_e1: No Alternative (LS-NA vs HS-NA)

```{r}
paper_key <- "mayetal2010practicalinterestsrelevant"
study_id <- 1
effect_id <- "s1_e1"

file_between <- "../data/May et al. KPI Data - Between-Subjects (Exp 1).xls"
ls_na <- read_excel(file_between, sheet = "v.6.0a2 (LS-NA)")
hs_na <- read_excel(file_between, sheet = "v.6.0b2 (HS-NA)")

x_low <- ls_na[["Agree?"]]
x_high <- hs_na[["Agree?"]]

inputs <- list(
  n_low = sum(!is.na(x_low)),
  n_high = sum(!is.na(x_high)),
  mean_low = mean(x_low, na.rm = TRUE),
  mean_high = mean(x_high, na.rm = TRUE),
  sd_low = sd(x_low, na.rm = TRUE),
  sd_high = sd(x_high, na.rm = TRUE)
)
inputs
```

```{r}
res_s1_e1 <- compute_effect_size(
  paper_key = paper_key,
  study_id = study_id,
  effect_id = effect_id,
  method_used = "between_groups",
  n_high = inputs$n_high,
  n_low = inputs$n_low,
  mean_high = inputs$mean_high,
  mean_low = inputs$mean_low,
  sd_high = inputs$sd_high,
  sd_low = inputs$sd_low,
  notes_on_assumptions = "Group summaries computed from provided XLS raw data (Agree? column); effect size computed with esc::esc_mean_sd."
)
res_s1_e1$audit
cat(res_s1_e1$yaml_snippet)
```

### Effect s1_e2: Alternative Mentioned (LS-A vs HS-A)

```{r}
paper_key <- "mayetal2010practicalinterestsrelevant"
study_id <- 1
effect_id <- "s1_e2"

file_between <- "../data/May et al. KPI Data - Between-Subjects (Exp 1).xls"
ls_a <- read_excel(file_between, sheet = "v.6.0a1 (LS-A)")
hs_a <- read_excel(file_between, sheet = "v.6.0b1 (HS-A)")

x_low <- ls_a[["Agree?"]]
x_high <- hs_a[["Agree?"]]

inputs <- list(
  n_low = sum(!is.na(x_low)),
  n_high = sum(!is.na(x_high)),
  mean_low = mean(x_low, na.rm = TRUE),
  mean_high = mean(x_high, na.rm = TRUE),
  sd_low = sd(x_low, na.rm = TRUE),
  sd_high = sd(x_high, na.rm = TRUE)
)
inputs
```

```{r}
res_s1_e2 <- compute_effect_size(
  paper_key = paper_key,
  study_id = study_id,
  effect_id = effect_id,
  method_used = "between_groups",
  n_high = inputs$n_high,
  n_low = inputs$n_low,
  mean_high = inputs$mean_high,
  mean_low = inputs$mean_low,
  sd_high = inputs$sd_high,
  sd_low = inputs$sd_low,
  notes_on_assumptions = "Group summaries computed from provided XLS raw data (Agree? column); effect size computed with esc::esc_mean_sd."
)
res_s1_e2$audit
cat(res_s1_e2$yaml_snippet)
```

## Study 2 (Within-Subjects): Stakes and Order (both orders combined)

Raw data file: `papers/mayetal2010practicalinterestsrelevant/data/May et al. KPI Data - Within-Subjects (Exp 2).xls`

### Effect s2_e1: LS-NA vs HS-A (within-subject; pooled across orders)

```{r}
paper_key <- "mayetal2010practicalinterestsrelevant"
study_id <- 2
effect_id <- "s2_e1"

file_within <- "../data/May et al. KPI Data - Within-Subjects (Exp 2).xls"

ls_hs <- read_excel(file_within, sheet = "v.1.0 (LS-HS)")
hs_ls <- read_excel(file_within, sheet = "v.1.0 (HS-LS)")

within_pairs <- rbind(
  data.frame(
    low = ls_hs[["Agree Q1(LS)?"]],
    high = ls_hs[["Agree Q2(HS)?"]]
  ),
  data.frame(
    low = hs_ls[["Agree Q2(LS)?"]],
    high = hs_ls[["Agree Q1(HS)?"]]
  )
)

inputs <- list(
  n_total = nrow(within_pairs),
  mean_low = mean(within_pairs$low, na.rm = TRUE),
  mean_high = mean(within_pairs$high, na.rm = TRUE),
  sd_low = sd(within_pairs$low, na.rm = TRUE),
  sd_high = sd(within_pairs$high, na.rm = TRUE),
  r_within = cor(within_pairs$low, within_pairs$high, use = "complete.obs")
)
inputs
```

```{r}
res_s2_e1 <- compute_effect_size(
  paper_key = paper_key,
  study_id = study_id,
  effect_id = effect_id,
  method_used = "within_smcrp_r",
  n_total = inputs$n_total,
  mean_high = inputs$mean_high,
  mean_low = inputs$mean_low,
  sd_high = inputs$sd_high,
  sd_low = inputs$sd_low,
  r_within = inputs$r_within,
  notes_on_assumptions = "Within-subject summaries computed from provided XLS raw data; orders pooled by aligning low vs high responses per participant; effect size computed with metafor::escalc(measure='SMCRP')."
)
res_s2_e1$audit
cat(res_s2_e1$yaml_snippet)
```

## Audit table (all effects)

```{r}
audits <- rbind(res_s1_e1$audit, res_s1_e2$audit, res_s2_e1$audit)
audits
```