Effect size computation: mayetal2010practicalinterestsrelevant

library(readxl)
library(esc)
library(metafor)

Loading required package: Matrix

Loading required package: metadat

Loading required package: numDeriv

Loading the 'metafor' package (version 4.8-0). For an
introduction to the package please type: help(metafor)

Shared helpers

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)

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

New names:
• `` -> `...18`
• `` -> `...20`
• `` -> `...21`
• `` -> `...22`
• `` -> `...23`

hs_na <- read_excel(file_between, sheet = "v.6.0b2 (HS-NA)")

New names:
• `` -> `...18`
• `` -> `...20`
• `` -> `...21`
• `` -> `...22`
• `` -> `...23`

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

$n_low
[1] 60

$n_high
[1] 61

$mean_low
[1] 5.333333

$mean_high
[1] 5.065574

$sd_low
[1] 1.791379

$sd_high
[1] 1.691832

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

                              paper_key study_id effect_id           design
1 mayetal2010practicalinterestsrelevant        1     s1_e1 Between-Subjects
     method_used computed_from_suggested
1 between_groups                  groups
                                                                                                                                                                                      inputs_used
1 method=between_groups, sign_convention=d = mean(low) - mean(high), n_low=60, n_high=61, mean_low=5.33333333333333, mean_high=5.0655737704918, sd_low=1.79137923065514, sd_high=1.69183187166078
          d          v         g        v_g
1 0.1537171 0.03315775 0.1527462 0.03315775
                                                                                              notes_on_assumptions
1 Group summaries computed from provided XLS raw data (Agree? column); effect size computed with esc::esc_mean_sd.
  imputed_flag needs_sensitivity
1        FALSE              TRUE

cat(res_s1_e1$yaml_snippet)

effect_size:\n  metric: SMD\n  d: 0.153717086218\n  v: 0.033157749548\n  computed_from: groups\n  needs_review: false\n  notes: "method=between_groups, sign_convention=d = mean(low) - mean(high), n_low=60, n_high=61, mean_low=5.33333333333333, mean_high=5.0655737704918, sd_low=1.79137923065514, sd_high=1.69183187166078"\n

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

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

New names:
• `` -> `...18`
• `` -> `...20`
• `` -> `...21`
• `` -> `...22`
• `` -> `...23`

hs_a <- read_excel(file_between, sheet = "v.6.0b1 (HS-A)")

New names:
• `` -> `...18`
• `` -> `...20`
• `` -> `...21`
• `` -> `...22`
• `` -> `...23`

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

$n_low
[1] 60

$n_high
[1] 60

$mean_low
[1] 5.3

$mean_high
[1] 4.6

$sd_low
[1] 1.825432

$sd_high
[1] 1.879416

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

                              paper_key study_id effect_id           design
1 mayetal2010practicalinterestsrelevant        1     s1_e2 Between-Subjects
     method_used computed_from_suggested
1 between_groups                  groups
                                                                                                                                                             inputs_used
1 method=between_groups, sign_convention=d = mean(low) - mean(high), n_low=60, n_high=60, mean_low=5.3, mean_high=4.6, sd_low=1.82543238434912, sd_high=1.87941570436945
          d          v         g        v_g
1 0.3778431 0.03392819 0.3754365 0.03392819
                                                                                              notes_on_assumptions
1 Group summaries computed from provided XLS raw data (Agree? column); effect size computed with esc::esc_mean_sd.
  imputed_flag needs_sensitivity
1        FALSE              TRUE

cat(res_s1_e2$yaml_snippet)

effect_size:\n  metric: SMD\n  d: 0.377843131602\n  v: 0.033928189300\n  computed_from: groups\n  needs_review: false\n  notes: "method=between_groups, sign_convention=d = mean(low) - mean(high), n_low=60, n_high=60, mean_low=5.3, mean_high=4.6, sd_low=1.82543238434912, sd_high=1.87941570436945"\n

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)

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

New names:
• `` -> `...30`
• `` -> `...32`
• `` -> `...33`
• `` -> `...34`
• `` -> `...35`
• `` -> `...36`
• `` -> `...37`
• `` -> `...38`
• `` -> `...39`
• `` -> `...40`
• `` -> `...41`

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

New names:
• `Age-Y` -> `Age-Y...8`
• `Age-O` -> `Age-O...9`
• `Sex-M` -> `Sex-M...10`
• `Sex-F` -> `Sex-F...11`
• `Ethn-C` -> `Ethn-C...12`
• `Ethn-O` -> `Ethn-O...13`
• `Phil-0` -> `Phil-0...14`
• `Phil-1-2` -> `Phil-1-2...15`
• `Phil-3+` -> `Phil-3+...16`
• `Epist-N` -> `Epist-N...17`
• `Epist-Y` -> `Epist-Y...18`
• `Age-Y` -> `Age-Y...19`
• `Age-O` -> `Age-O...20`
• `Sex-M` -> `Sex-M...21`
• `Sex-F` -> `Sex-F...22`
• `Ethn-C` -> `Ethn-C...23`
• `Ethn-O` -> `Ethn-O...24`
• `Phil-0` -> `Phil-0...25`
• `Phil-1-2` -> `Phil-1-2...26`
• `Phil-3+` -> `Phil-3+...27`
• `Epist-N` -> `Epist-N...28`
• `Epist-Y` -> `Epist-Y...29`
• `` -> `...30`
• `` -> `...32`
• `` -> `...33`
• `` -> `...34`
• `` -> `...35`
• `` -> `...36`
• `` -> `...37`
• `` -> `...38`
• `` -> `...39`
• `` -> `...40`
• `` -> `...41`

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

$n_total
[1] 298

$mean_low
[1] 5.134228

$mean_high
[1] 4.416107

$sd_low
[1] 1.749104

$sd_high
[1] 1.942267

$r_within
[1] 0.6188014

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

                              paper_key study_id effect_id          design
1 mayetal2010practicalinterestsrelevant        2     s2_e1 Within-Subjects
     method_used computed_from_suggested
1 within_smcrp_r                  groups
                                                                                                                                                                                                          inputs_used
1 method=within_smcrp_r, sign_convention=d = mean(low) - mean(high), n_total=298, mean_low=5.13422818791946, mean_high=4.41610738255034, sd_low=1.74910354382301, sd_high=1.9422666169519, r_within=0.618801374157319
          d           v         g         v_g
1 0.3885493 0.002733531 0.3878704 0.002732919
                                                                                                                                                                        notes_on_assumptions
1 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').
  imputed_flag needs_sensitivity
1        FALSE              TRUE

cat(res_s2_e1$yaml_snippet)

effect_size:\n  metric: SMD\n  d: 0.388549287526\n  v: 0.002733530591\n  computed_from: groups\n  needs_review: false\n  notes: "method=within_smcrp_r, sign_convention=d = mean(low) - mean(high), n_total=298, mean_low=5.13422818791946, mean_high=4.41610738255034, sd_low=1.74910354382301, sd_high=1.9422666169519, r_within=0.618801374157319"\n

Audit table (all effects)

audits <- rbind(res_s1_e1$audit, res_s1_e2$audit, res_s2_e1$audit)
audits

                              paper_key study_id effect_id           design
1 mayetal2010practicalinterestsrelevant        1     s1_e1 Between-Subjects
2 mayetal2010practicalinterestsrelevant        1     s1_e2 Between-Subjects
3 mayetal2010practicalinterestsrelevant        2     s2_e1  Within-Subjects
     method_used computed_from_suggested
1 between_groups                  groups
2 between_groups                  groups
3 within_smcrp_r                  groups
                                                                                                                                                                                                          inputs_used
1                     method=between_groups, sign_convention=d = mean(low) - mean(high), n_low=60, n_high=61, mean_low=5.33333333333333, mean_high=5.0655737704918, sd_low=1.79137923065514, sd_high=1.69183187166078
2                                              method=between_groups, sign_convention=d = mean(low) - mean(high), n_low=60, n_high=60, mean_low=5.3, mean_high=4.6, sd_low=1.82543238434912, sd_high=1.87941570436945
3 method=within_smcrp_r, sign_convention=d = mean(low) - mean(high), n_total=298, mean_low=5.13422818791946, mean_high=4.41610738255034, sd_low=1.74910354382301, sd_high=1.9422666169519, r_within=0.618801374157319
          d           v         g         v_g
1 0.1537171 0.033157750 0.1527462 0.033157750
2 0.3778431 0.033928189 0.3754365 0.033928189
3 0.3885493 0.002733531 0.3878704 0.002732919
                                                                                                                                                                        notes_on_assumptions
1                                                                           Group summaries computed from provided XLS raw data (Agree? column); effect size computed with esc::esc_mean_sd.
2                                                                           Group summaries computed from provided XLS raw data (Agree? column); effect size computed with esc::esc_mean_sd.
3 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').
  imputed_flag needs_sensitivity
1        FALSE              TRUE
2        FALSE              TRUE
3        FALSE              TRUE