# 11 第十三章：效应量和元分析

## 11.1 效应量简介

- r-family（correlation family）：如Pearson r, $$R^2$$, $$\eta^2$$, $$\omega^2$$, & f
- OR-family（categorical family）：如odds ratio (OR), risk ratio(RR)

2011年General of Experimental Psychology General杂志专门回顾了发表的文章中报告的效应量。其中发现了一个非常有趣的效应，报告最多的其实是Partial $$\eta$$ Squared，即$$\eta^{2}_{p}$$，很重要的原因是SPSS输出这个效应量。
Lakens, D. (2013). Calculating and reporting effect sizes to facilitate cumulative science: A practical primer for t-tests and ANOVAs. Frontiers in Psychology, 4, 863. 这篇文章报告了各种不同Cohen’s d的计算方式

- SPSS提供$$\eta^{2}_{p}$$
- JASP提供Cohen’s d$$\eta^{2}_{p}$$$$\eta^{2}_{G}$$ Lakens(Lakens,2013)提供了基于excel的计算程序，帮助心理学家方便的得到不同的效应量及其置信区间。 Gpower也可以计算效应量，但其输出的$$\eta^{2}_{p}$$与SPSS是不一样的，需要转换。

## 11.2 算法实现

$Cohen's \ d_s = \frac{X_1 - X_2}{\sqrt{SD_{pool}}} = \frac{X_1 - X_2}{\sqrt{\frac{(n_1 -1)SD_1^2 + (n_2-1)SD_2^2)}{n_1+n2-2}}}$ $Hedges's \ g_s = Cohen's \ d_s \times (1 - \frac{3}{4(n_1 + n_2) - 9})$

$Cohen's \ d_{rm} = \frac{M_{diff}}{\sqrt{SD_1^2 + SD_2^2 -2 \times r \times SD_1 \times SD_2}} \times \sqrt{2(1-r)}$ $Cohen's \ d_{av} = \sqrt{ \frac {M_{diff}} {(SD_1 + SD_2)/2}}$

rm(list = ls())
if (!requireNamespace("pacman", quietly = TRUE)) {
install.packages("pacman") }   # # 检查是否已安装 pacman, 如果未安装，则安装包

header = T, sep=",", stringsAsFactors = FALSE)

# from chapter 11, Chunk 3
df.mt.rt.subj <- df.mt.raw %>%
dplyr::filter(ACC == 1 & RT > 0.2) %>%
tidyr::extract(Shape, into = c("Valence", "Identity"),
regex = "(moral|immoral)(Self|Other)", remove = FALSE) %>%
dplyr::mutate(Valence = case_when(Valence == "moral" ~ "Good",
RT_ms = RT * 1000) %>%
dplyr::mutate(Valence = factor(Valence, levels = c("Good", "Bad")),
Identity = factor(Identity, levels = c("Self", "Other"))) %>%
dplyr::group_by(Sub, Match, Identity, Valence) %>%
dplyr::summarise(RT_mean = mean(RT_ms)) %>%
dplyr::ungroup()

head(df.mt.rt.subj, 5)
## # A tibble: 5 × 5
##     Sub Match    Identity Valence RT_mean
##   <int> <chr>    <fct>    <fct>     <dbl>
## 1  7302 match    Self     Good       694.
## 2  7302 match    Self     Bad        702.
## 3  7302 match    Other    Good       598.
## 4  7302 match    Other    Bad        666.
## 5  7302 mismatch Self     Good       755.

# from chapter 11, Chunk 3
df.mt.rt.subj.effect <- df.mt.rt.subj %>%
dplyr::filter(Match == "match" & Valence == "Good") %>%
dplyr::group_by(Identity) %>%
dplyr::summarise(mean = mean(RT_mean),
sd = sd(RT_mean))

df.mt.rt.subj.effect.wide <- df.mt.rt.subj %>%
dplyr::filter(Match == "match" & Valence == "Good") %>%
tidyr::pivot_wider(names_from = "Identity", values_from = "RT_mean")

corr_est <- cor(df.mt.rt.subj.effect.wide$Self, df.mt.rt.subj.effect.wide$Other)

Cohens_d_manu <- ((df.mt.rt.subj.effect$mean[1] - df.mt.rt.subj.effect$mean[2])/sqrt(df.mt.rt.subj.effect$sd[1]**2 + df.mt.rt.subj.effect$sd[2]**2 - 2*corr_est*df.mt.rt.subj.effect$sd[1]*df.mt.rt.subj.effect$sd[2]))*sqrt(2*(1-corr_est))
Cohens_d_manu
## [1] -0.5676815

SelfOther_diff <- t.test(df.mt.rt.subj.effect.wide$Self, df.mt.rt.subj.effect.wide$Other, paired = TRUE)

effectsize::effectsize(SelfOther_diff, paired = TRUE)
## Cohen's d |         95% CI
## --------------------------
## -0.48     | [-0.79, -0.16]

## 11.5 元分析实现

subjs <- unique(df.mt.rt.subj$Sub) set.seed(1234) subj_ls1 <- sample(subjs, 21) df.mt.rt.subj.ls1 <- df.mt.rt.subj %>% dplyr::filter(Sub %in% subj_ls1) df.mt.rt.subj.ls2 <- df.mt.rt.subj %>% dplyr::filter(!(Sub %in% subj_ls1)) 假定两组数据分别为实验1a与实验1b，并计算两个实验同样条件下的效应量。 与上文中计算效应量的方式一致，首先计算均值等所需变量： ## effect size of group 1 df.mt.rt.subj.effect.ls1 <- df.mt.rt.subj.ls1 %>% dplyr::filter(Match == "match" & Valence == "Good") %>% dplyr::group_by(Identity) %>% dplyr::summarise(mean = mean(RT_mean), sd = sd(RT_mean)) %>% dplyr::ungroup() %>% tidyr::pivot_wider(names_from = Identity, values_from = c(mean, sd)) colnames(df.mt.rt.subj.effect.ls1) <- c("Self_RT_M_mean","Other_RT_M_mean", "Self_RT_M_sd", "Other_RT_M_sd") df.mt.rt.subj.effect.ls1.wide <- df.mt.rt.subj.ls1 %>% dplyr::filter(Match == "match" & Valence == "Good") %>% tidyr::pivot_wider(names_from = "Identity", values_from = "RT_mean") corr_est.ls1 <- cor(df.mt.rt.subj.effect.ls1.wide$Self, df.mt.rt.subj.effect.ls1.wide$Other) df.mt.rt.subj.effect.ls1$Sample_size <- length(unique(df.mt.rt.subj.ls1$Sub)) df.mt.rt.subj.effect.ls1$ri <- corr_est.ls1
## effect size of group 2
df.mt.rt.subj.effect.ls2 <- df.mt.rt.subj.ls2 %>%
dplyr::filter(Match == "match" & Valence == "Good") %>%
dplyr::group_by(Identity) %>%
dplyr::summarise(mean = mean(RT_mean),
sd = sd(RT_mean)) %>%
dplyr::ungroup() %>%
tidyr::pivot_wider(names_from = Identity,
values_from = c(mean, sd))

colnames(df.mt.rt.subj.effect.ls2) <- c("Self_RT_M_mean","Other_RT_M_mean",
"Self_RT_M_sd", "Other_RT_M_sd")

df.mt.rt.subj.effect.ls2.wide <- df.mt.rt.subj.ls2  %>%
dplyr::filter(Match == "match" & Valence == "Good") %>%
tidyr::pivot_wider(names_from = "Identity", values_from = "RT_mean")

corr_est.ls2 <- cor(df.mt.rt.subj.effect.ls2.wide$Self, df.mt.rt.subj.effect.ls2.wide$Other)
df.mt.rt.subj.effect.ls2$Sample_size <- length(unique(df.mt.rt.subj.ls2$Sub))
df.mt.rt.subj.effect.ls2\$ri <- corr_est.ls2

# and nrow with 1
df.mt.meta <- rbind(df.mt.rt.subj.effect.ls1, df.mt.rt.subj.effect.ls2)

df.es <- metafor::escalc(
measure = "SMCRH",
#standardized mean change using raw score standardization with heteroscedastic population variances at the two measurement occasions (Bonett, 2008)
m1i = Self_RT_M_mean,
m2i = Other_RT_M_mean,
sd1i = Self_RT_M_sd,
sd2i = Other_RT_M_sd,
ni = Sample_size,
ri = ri,
data = df.mt.meta
)  %>%
dplyr::mutate(unique_ID = c("study1a", "study1b"))

# 随机效果模型
rma1 <- metafor::rma(yi, vi, data = df.es)

- 如果自己手中有许多实验，对这些实验进行效应量计算的工作，能使得实验更加准确（mini metaanalysis）
- 在做预实验时发现效应不够显著，又做了正式实验，可以通过元分析的方式将样本量增加，也能通过元分析判断效应量是否稳定。