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