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

```{r}
library(dplyr)
library(esc)
```

## 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_,
    mean_high = NA_real_,
    mean_low = NA_real_,
    sd_high = NA_real_,
    sd_low = 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_

  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")

    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 {
    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),
      sprintf("n_low=%s", n_low),
      sprintf("n_high=%s", n_high),
      sprintf("mean_low=%s", mean_low),
      sprintf("mean_high=%s", mean_high),
      sprintf("sd_low=%s", sd_low),
      sprintf("sd_high=%s", sd_high)
    ),
    collapse = ", "
  )

  audit <- data.frame(
    paper_key = paper_key,
    study_id = study_id,
    effect_id = effect_id,
    design = "Between-Subjects",
    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)
}
```

## Source Data

The unpublished draft describes Experiment 3 as a Train/Flight extension of the retraction
design. The effect-size computation below follows the author-sent Qualtrics exports
`data/Finished_Responses.csv` and `data/Unfinished_Responses.csv`. Combining these files
reproduces the manuscript's reported Train/Flight Neutral and Stakes group descriptives more
closely than the timestamped export alone. The first two Qualtrics metadata rows are removed
by filtering to consenting responses with usable scenario data.

```{r}
read_qualtrics <- function(file) {
  dat <- read.csv(
    file.path("../data", file),
    na.strings = c("", "NA"),
    check.names = FALSE
  )
  dat$source_file <- file
  dat
}

raw <- bind_rows(
  read_qualtrics("Finished_Responses.csv"),
  read_qualtrics("Unfinished_Responses.csv")
)

dat <- raw %>%
  filter(Consent == "I voluntarily agree to participate in this research study.")

data.frame(
  physical_rows_after_header = nrow(raw),
  consenting_rows = nrow(dat)
)
```

## Composite Scores

Composite scores follow the draft and author analysis script: `I do` is coded as `+1`,
`I don't` as `-1`, multiplied by confidence from 1 to 7.

```{r}
make_composite <- function(response, confidence) {
  response_sign <- case_when(
    response == "I do" ~ 1,
    response == "I don't" ~ -1,
    TRUE ~ NA_real_
  )
  response_sign * as.numeric(confidence)
}

extract_condition <- function(dat, prefix, scenario, condition, condition_label) {
  response_col <- paste0(prefix, "_", condition, "_A")
  confidence_col <- paste0(prefix, "_", condition, "_B_1")

  data.frame(
    scenario = scenario,
    condition = condition_label,
    response = dat[[response_col]],
    confidence = suppressWarnings(as.numeric(dat[[confidence_col]])),
    composite = make_composite(dat[[response_col]], dat[[confidence_col]])
  ) %>%
    filter(!is.na(composite))
}

train_positive <- "The guy knows that the train stops at Kensington"
train_negative <- "The guy does not know that the train stops at Kensington"
flight_positive <- "The woman knows that the flight takes 14 hours"
flight_negative <- "The woman does not know that the flight takes 14 hours"

train_assigned <- dat %>% filter(TR_SU %in% c(train_positive, train_negative))
flight_assigned <- dat %>% filter(FL_SU %in% c(flight_positive, flight_negative))

train_valid <- train_assigned %>%
  filter(TR_SU == train_positive, TR_AT == "Kensington")

flight_valid <- flight_assigned %>%
  filter(FL_SU == flight_positive, FL_AT == "Tokyo")

screening_counts <- data.frame(
  scenario = c("Train", "Flight"),
  assigned = c(nrow(train_assigned), nrow(flight_assigned)),
  initial_knowledge_endorsers = c(nrow(filter(train_assigned, TR_SU == train_positive)), nrow(filter(flight_assigned, FL_SU == flight_positive))),
  initial_knowledge_skeptics = c(nrow(filter(train_assigned, TR_SU == train_negative)), nrow(filter(flight_assigned, FL_SU == flight_negative))),
  valid_knowledge_endorsers = c(nrow(train_valid), nrow(flight_valid)),
  attention_failures_among_endorsers = c(
    nrow(filter(train_assigned, TR_SU == train_positive, is.na(TR_AT) | TR_AT != "Kensington")),
    nrow(filter(flight_assigned, FL_SU == flight_positive, is.na(FL_AT) | FL_AT != "Tokyo"))
  )
)

screening_counts
```

```{r}
composites <- bind_rows(
  extract_condition(train_valid, "TR", "Train", "N", "Neutral"),
  extract_condition(train_valid, "TR", "Train", "S", "Stakes"),
  extract_condition(train_valid, "TR", "Train", "E", "Evidence"),
  extract_condition(flight_valid, "FL", "Flight", "N", "Neutral"),
  extract_condition(flight_valid, "FL", "Flight", "S", "Stakes"),
  extract_condition(flight_valid, "FL", "Flight", "E", "Evidence")
)

group_stats <- composites %>%
  group_by(scenario, condition) %>%
  summarise(
    n = n(),
    retract_n = sum(response == "I don't"),
    retract_rate = retract_n / n,
    mean = mean(composite),
    sd = sd(composite),
    .groups = "drop"
  )

group_stats
```

## Effect Computations

Only the Stakes vs Neutral contrasts are extracted as primary stakes effects. The Evidence
condition is retained above as a manipulation check and contextual comparison, but it is not
the focal low-vs-high stakes comparison.

```{r}
paper_key <- "shurakov2023trainflightretraction"
study_id <- 1

compute_from_stats <- function(effect_id, scenario_name) {
  low <- group_stats[group_stats$scenario == scenario_name & group_stats$condition == "Neutral", ]
  high <- group_stats[group_stats$scenario == scenario_name & group_stats$condition == "Stakes", ]

  compute_effect_size(
    paper_key = paper_key,
    study_id = study_id,
    effect_id = effect_id,
    method_used = "between_groups",
    n_high = high$n,
    n_low = low$n,
    mean_high = high$mean,
    mean_low = low$mean,
    sd_high = high$sd,
    sd_low = low$sd,
    notes_on_assumptions = "Computed from author-sent Finished and Unfinished Qualtrics exports after excluding non-consent, initial knowledge non-endorsers, and attention-check failures; effect size computed with esc::esc_mean_sd."
  )
}

res_s1_e1 <- compute_from_stats("s1_e1", "Train")
res_s1_e2 <- compute_from_stats("s1_e2", "Flight")
```

### Effect s1_e1: Train, Stakes vs Neutral

```{r}
res_s1_e1$audit
cat(res_s1_e1$yaml_snippet)
```

### Effect s1_e2: Flight, Stakes vs Neutral

```{r}
res_s1_e2$audit
cat(res_s1_e2$yaml_snippet)
```

## Audit Table

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