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

```{r}
library(dplyr)
library(tidyr)
library(data.table)
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")

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

## Source Data

The thesis is used for the study description and materials. Numerical extraction follows the
cleaned 2025 analysis in `data/analiza_2025_bm.Rmd`.

```{r}
recode_likert <- function(x) {
  dplyr::recode(
    x,
    `A1` = 1, `A2` = 2, `A3` = 3, `A4` = 4,
    `A5` = 5, `A6` = 6, `A7` = 7
  )
}

read_survey <- function(file) read.csv(file.path("../data", file), na.strings = "")

demografia <- read.csv("../data/demo/625672.csv", na.strings = "")
end <- distinct(read.csv("../data/end/255249.csv", na.strings = ""), uid, step)
demografia <- demografia[!(duplicated(demografia$uid) | duplicated(demografia$uid, fromLast = TRUE)), ]
demografia <- demografia[demografia$uid %in% end$uid, ]
setnames(demografia, c("p01", "p02", "p03", "p04"), c("plec", "rok", "wyksztalcenie", "filo"))
```

## Prepare Scenarios

```{r}
rename_pair <- function(dat, first, second) {
  setnames(dat, c("PytanieWiedza1.SQ001.", "PytanieWiedza2.SQ001."), c(first, second))
  dat
}

rename_both <- function(dat, first, second) {
  setnames(dat, c("PytanieWiedza11.SQ001.", "PytanieWiedza12.SQ001."), c(first, second))
  dat
}

Biedronka1_MpP <- rename_pair(read_survey("445154.csv"), "MICHAL", "PIOTR")
Biedronka1_PpM <- rename_pair(read_survey("223631.csv"), "PIOTR", "MICHAL")
Biedronka2_PpM <- rename_pair(read_survey("734581.csv"), "PIOTR", "MICHAL")
Biedronka2_MpP <- rename_pair(read_survey("715275.csv"), "MICHAL", "PIOTR")
Biedronka1_oba <- rename_both(read_survey("627626.csv")[, c(1, 2, 3, 4, 5, 7, 8, 9, 10, 11)], "MICHAL", "PIOTR")

Bank1_ApZ <- rename_pair(read_survey("928725.csv"), "ALA", "ZOSIA")
Bank1_ZpA <- rename_pair(read_survey("137416.csv"), "ZOSIA", "ALA")
Bank2_ZpA <- rename_pair(read_survey("581937.csv"), "ZOSIA", "ALA")
Bank2_ApZ <- rename_pair(read_survey("516534.csv"), "ALA", "ZOSIA")
Bank1_oba <- rename_both(read_survey("267519.csv")[, c(1, 2, 3, 4, 5, 7, 8, 9, 10, 11)], "ALA", "ZOSIA")

Orzeszki1_ZpM <- rename_pair(read_survey("929928.csv"), "ZUZA", "MARTA")
Orzeszki1_MpZ <- rename_pair(read_survey("464781.csv"), "MARTA", "ZUZA")
Orzeszki2_MpZ <- rename_pair(read_survey("695972.csv"), "MARTA", "ZUZA")
Orzeszki2_ZpM <- rename_pair(read_survey("479826.csv"), "ZUZA", "MARTA")
Orzeszki1_oba <- rename_both(read_survey("654951.csv")[, c(1, 2, 3, 4, 5, 7, 8, 9, 10, 11)], "ZUZA", "MARTA")

prep_scenario <- function(dfs, typ, high_name, low_name, histories, presentation, evidence_holder, correct_control) {
  tagged <- Map(
    function(dat, history, pres, holder) {
      dat$Typ_historyjki <- typ
      dat$Historyjka <- history
      dat$Sposob_prezentacji <- pres
      dat$Posiadacz_swiadectw <- holder
      dat
    },
    dfs, histories, presentation, evidence_holder
  )

  dat <- rbindlist(tagged, fill = TRUE)
  dat <- dat[!(duplicated(uid) | duplicated(uid, fromLast = TRUE)) & !is.na(uid) & !is.na(shorturl)]
  dat <- left_join(as.data.frame(dat), demografia, by = "uid")
  dat <- dat[dat$PytanieKontrolne == correct_control, ]
  dat$Wysoka <- recode_likert(dat[[high_name]])
  dat$Niska <- recode_likert(dat[[low_name]])

  long <- pivot_longer(dat, cols = c("Wysoka", "Niska"), names_to = "Stawka", values_to = "Wiedza")
  long %>%
    mutate(Swiadectwa = case_when(
      Stawka == "Wysoka" & Posiadacz_swiadectw == "High" ~ "Tak",
      Stawka == "Niska" & Posiadacz_swiadectw == "Low" ~ "Tak",
      Stawka == "Wysoka" & Posiadacz_swiadectw == "Low" ~ "Nie",
      Stawka == "Niska" & Posiadacz_swiadectw == "High" ~ "Nie"
    ))
}

bank <- prep_scenario(
  list(Bank1_ApZ, Bank1_ZpA, Bank1_oba, Bank2_ApZ, Bank2_ZpA),
  "Bank", "ALA", "ZOSIA",
  c("Bank1ApZ", "Bank1ZpA", "Bank1oba", "Bank2ApZ", "Bank2ZpA"),
  c("High-first", "Low-first", "Both", "High-first", "Low-first"),
  c("High", "High", "High", "Low", "Low"),
  "A2"
)

biedronka <- prep_scenario(
  list(Biedronka1_MpP, Biedronka1_PpM, Biedronka1_oba, Biedronka2_PpM, Biedronka2_MpP),
  "Biedronka", "MICHAL", "PIOTR",
  c("Biedronka1MpP", "Biedronka1PpM", "Biedronka1oba", "Biedronka2PpM", "Biedronka2MpP"),
  c("High-first", "Low-first", "Both", "Low-first", "High-first"),
  c("High", "High", "High", "Low", "Low"),
  "A1"
)

orzeszki <- prep_scenario(
  list(Orzeszki1_MpZ, Orzeszki1_ZpM, Orzeszki1_oba, Orzeszki2_ZpM, Orzeszki2_MpZ),
  "Orzeszki", "MARTA", "ZUZA",
  c("Orzeszki1MpZ", "Orzeszki1ZpM", "Orzeszki1oba", "Orzeszki2ZpM", "Orzeszki2MpZ"),
  c("High-first", "Low-first", "Both", "Low-first", "High-first"),
  c("Low", "Low", "Low", "High", "High"),
  "A1"
)

full_data <- bind_rows(bank, biedronka, orzeszki)

data.frame(
  scenario = c("Bank", "Biedronka", "Orzeszki"),
  cleaned_scenario_records = c(n_distinct(bank$uid), n_distinct(biedronka$uid), n_distinct(orzeszki$uid))
)
```

## Inputs

```{r}
stats_all <- full_data %>%
  group_by(Typ_historyjki, Swiadectwa, Stawka) %>%
  summarise(M = mean(Wiedza), SD = sd(Wiedza), N = n(), .groups = "drop") %>%
  pivot_wider(names_from = Stawka, values_from = c(M, SD, N))

stats <- stats_all %>%
  filter(Swiadectwa == "Tak") %>%
  mutate(
    effect_id = case_when(
      Typ_historyjki == "Bank" ~ "s1_e2",
      Typ_historyjki == "Biedronka" ~ "s1_e4",
      Typ_historyjki == "Orzeszki" ~ "s1_e6"
    )
  ) %>%
  arrange(match(effect_id, c("s1_e2", "s1_e4", "s1_e6")))

stats
```

## Effect Computations

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

compute_from_row <- function(effect_id) {
  inp <- stats[stats$effect_id == effect_id, ]
  compute_effect_size(
    paper_key = paper_key,
    study_id = study_id,
    effect_id = effect_id,
    method_used = "between_groups",
    n_high = inp$N_Wysoka,
    n_low = inp$N_Niska,
    mean_high = inp$M_Wysoka,
    mean_low = inp$M_Niska,
    sd_high = inp$SD_Wysoka,
    sd_low = inp$SD_Niska,
    notes_on_assumptions = "Group summaries computed from cleaned raw survey files following analiza_2025_bm.Rmd; effect size computed with esc::esc_mean_sd."
  )
}

res_s1_e2 <- compute_from_row("s1_e2")
res_s1_e4 <- compute_from_row("s1_e4")
res_s1_e6 <- compute_from_row("s1_e6")
```

### Effect s1_e2: Bank, Swiadectwa = Tak

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

### Effect s1_e4: Biedronka, Swiadectwa = Tak

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

### Effect s1_e6: Orzeszki, Swiadectwa = Tak

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

## Audit Table

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

audits
```