线性模型视角

统计检验即线性模型

统计建模篇

心理学专业的同学最喜欢的统计方法，估计是方差分析(ANOVA) 和它的堂兄协变量分析 (ANCOVA)，事实上常用的统计检验本质上都是线性模型，所以你学了线性模型，就可以不用学统计检验了，是不是很开心？

本章，我们将通过几个案例展示统计检验与线性模型的等价性，因此我们这里只关注代码本身，不关注模型的好坏以及模型的解释。部分代码和思想来自 Jonas Kristoffer Lindeløv

experim是一个模拟的数据集，这个虚拟的研究目的是，考察两种不同类型的干预措施对帮助学生应对即将到来的统计学课程的焦虑的影响。实验方案如下：

首先，学生完成一定数量的量表(量表1)，包括对统计学课程的害怕(fost)，自信(confid)，抑郁(depress)指标
然后，学生被等分成两组，组1 进行技能提升训练；组2进行信心提升训练。训练结束后，完成相同的量表(量表2)
三个月后，他们再次完成相同的量表(量表3)

也就说，相同的指标在不同的时期测了三次，目的是考察期间的干预措施对若干指标的影响。

library(tidyverse)
library(knitr)
library(kableExtra)

edata <- read_csv("./demo_data/Experim.csv")  %>%
  mutate(group = if_else(group == "maths skills", 1, 2)) %>% 
  mutate(
    across(c(sex, id, group), as.factor)
    )
edata

glimpse(edata)

t检验

首先，我们想检验第一次测量的抑郁得分（depress1）的分布，是否明显偏离正态分布（均值为0），这里的零假设就是正态分布且均值为0；备选假设就是均值不为0

# Run t-test
model_1_t <- t.test(edata$depress1, mu = 0)
model_1_t

输出结果显示，p-value很小接近0，拒绝零假设，也就说均值不大可能为0。事实上，通过密度图可以看到depress1的分布均值在42附近，与0相距很远。

edata %>%
  ggplot(aes(x = depress1)) +
  geom_density()

先不管做这个假设有没有意义，我们用线性回归的方法做一遍，

t.test(depress1 ~ 1, data = edata)

# Run equivalent linear model
model_1_lm <- lm(depress1 ~ 1, data = edata)
summary(model_1_lm)

这个语法lm(y ~ 1)是不是感觉有点点怪怪的呢？左边是响应变量y，右边只有一个1，没有其他预测变量，这里的意思就是用截距预测响应变量y。事实上，也可以看作是检验y变量的均值是否显著偏离0.

为了方便比较两个模型，我们通过broom宏包将两个结果规整在一起，发现两个模型的t-value, estimate 和p.value都是一样的，这与和Jonas Kristoffer Lindeløv表中期望的一样。

library(broom)

# tidy() gets model outputs we usually use to report our results
model_1_t_tidy <- tidy(model_1_t) %>% mutate(model = "t.test(y)")
model_1_lm_tidy <- tidy(model_1_lm) %>% mutate(model = "lm(y ~ 1)")

results <- bind_rows(model_1_t_tidy, model_1_lm_tidy) %>%
  select(model, estimate, statistic, p.value)

上面例子，我们用不同的方法完成了相同的检验。事实上，在R语言t.test()内部会直接调用lm()函数，其函数语句和我们的这里代码也是一样的。

绝大部分时候，我们想考察实验中的干预是否有效，换句话说，基线得分 depress1 和干预后得分 depress3 是否存在显著差异？这就需要进行配对样本t检验。

# run paired t-test testing depression from g1 against g2
model_2_t <- t.test(edata$depress1, edata$depress3, paired = TRUE)
model_2_t_tidy <- tidy(model_2_t) %>% mutate(model = "t.test(x, y, paired = TRUE")
model_2_t

写成线性模型为lm(depress1 - depress3 ~ 1)，即先让两个变量相减，然后去做回归

# run linear model
model_2_lm <- lm(depress1 - depress3 ~ 1, data = edata)
model_2_lm_tidy <- tidy(model_2_lm) %>% mutate(model = "lm(y-x ~ 1)")
summary(model_2_lm)

# we combine the two model outputs, rowwise
results <- bind_rows(model_2_t_tidy, model_2_lm_tidy) %>%
  select(model, estimate, statistic, p.value)

haha，通过这个等价的线性模型，我们似乎可以窥探到配对样本t检验是怎么样工作的。它depress1 和 depress3一一对应相减后得到新的一列，用新的一列做单样本t检验

# run paired t-test testing depression from g1 against g2
model_2_t2 <- t.test(edata$depress1 - edata$depress3)
model_2_t2_tidy <- tidy(model_2_t2) %>% mutate(model = "t.test(x - y")
model_2_t2

既然是原理这样，那么在回归模型之前，可以在数据框中用depress1 - depress3构建新的一列

# calculate the difference between baseline and tp3 depression
edata <- edata %>%
  mutate(
    dep_slope = depress1 - depress3
  )

model_2_lm2 <- lm(dep_slope ~ 1, data = edata)
model_2_lm2_tidy <- tidy(model_2_lm2) %>% mutate(model = "lm(delta ~ 1)")

最后，把四个模型放在一起

# we combine the three model outputs, rowwise
results <- bind_rows(model_2_t_tidy, model_2_t2_tidy) %>% 
  bind_rows(model_2_lm_tidy) %>%
  bind_rows(model_2_lm2_tidy) %>%
  select(model, estimate, statistic, p.value)

我们看到，四个模型给出了相同的结果。

关联

两个变量的关联检验，用的也比较常见。比如两个连续型变量，我们可能想知道它们之间的关联，以及这种关联是否显著。

# Run correlation test
model_3_cor <- cor.test(edata$depress3, edata$depress1, method = "pearson")
model_3_cor_tidy <- tidy(model_3_cor) %>% mutate(model = "cor.test(x, y)")
model_3_cor

# Run equivalent linear model
model_3_lm <- lm(depress3 ~ depress1, data = edata)
model_3_lm_tidy <- tidy(model_3_lm) %>% mutate(model = "lm(y ~ x)")
summary(model_3_lm)

# we combine the two model outputs, rowwise
results <- bind_rows(model_3_cor_tidy, model_3_lm_tidy) %>%
  select(model, term, estimate, statistic, p.value)

喔袄，这次的表格有点不一样了。那是因为，线性模型会不仅输出系数，而且还输出了模型的截距，因此两个模型的系数会不一样，但在 t-statistic 和 p.value 是一样的。

单因素方差分析

我们现在想看看两组（组1=技能提升组；组2=信心提升组）在第一次量表中depress1得分是否有显著区别？

# Run one-way anova
model_4_anova <- aov(depress1 ~ group, data = edata)
model_4_anova_tidy <- tidy(model_4_anova) %>% mutate(model = "aov(y ~ factor(x))")
summary(model_4_anova)

# Run equivalent linear model
model_4_lm <- lm(depress1 ~ group, data = edata)
model_4_lm_tidy <- tidy(model_4_lm) %>% mutate(model = "lm(y ~ factor(x))")
summary(model_4_lm)

# we combine the two model outputs, rowwise
results <- bind_rows(model_4_anova_tidy, model_4_lm_tidy) %>%
  select(model, term, estimate, statistic, p.value)

这两个模型输出结果不一样了，且模型的区别似乎有点不好理解。aov评估group变量整体是否有效应，如果group中的任何一个水平都显著偏离基线水平，那么说明group变量是显著的。

在lm()中，是将group1视为基线, 依次比较其它因子水平（比如group2）与基线group1的之间的偏离，并评估每次这种偏离的显著性；

而aov评估group变量整体是否有效应，即如果group中的任何一个因子水平都显著偏离基线水平，那么说明group变量是显著的。

也就说，aov给出了整体的评估；而lm给出了因子水平之间的评估。

在本案例中，由于group的因子水平只有两个，因此，我们看到两个模型的结论是一致的，p.value = 0.756, 即group分组之间没有显著差异。

同时，我们看到aov没有返回beta系数的估计值，F-value (statistic)值也高于lm线性模型给出的t-statistic。那是因为统计值的计算方法是不一样的造成的，如果将aov给出F-statustic值的开方，那么就等于lm给出的t-statistic值（限定分组变量只有因子水平时）

# take the square root of the anova stat
sqrt(model_4_anova_tidy$statistic[1])
# same as stat from lm
model_4_lm_tidy$statistic[2]

# or, square the lm stat
model_4_lm_tidy$statistic[2]^2
# same as anova stat
model_4_anova_tidy$statistic[1]

单因素协变量分析

在上面的模型中增加confid1这个指标，考察信心得分是否会影响干预的成功？此时，模型有一个离散变量group，和一个连续变量confid1，这就需要用到协变量分析。

# Run one-way anova
model_5_ancova <- aov(dep_slope ~ group + confid1, data = edata)
model_5_ancova_tidy <- tidy(model_5_ancova) %>% mutate(model = "aov(y ~ x + z)")
summary(model_5_ancova)

# Run equivalent linear model
model_5_lm <- lm(dep_slope ~ group + confid1, data = edata)
model_5_lm_tidy <- tidy(model_5_lm) %>% mutate(model = "lm(y ~ x + z)")
summary(model_5_lm)

# we combine the two model outputs, rowwise
results <- bind_rows(model_5_ancova_tidy, model_5_lm_tidy) %>%
  select(model, term, estimate, statistic, p.value)

和单因素方差分析一样，输出结果有一点点不同，但模型输出告诉我们，两个结果是相同的。

aov模型中，group整体的p-value是 ~0.088， lm模型中检验group2偏离group1的p.value是0.086. confidence 这个变量p.value都是0.56993。

唯一不同的地方是aov模型中confidence有一个正的statistic值0.3315 但lm是负的0.5758. 究其原因，可能是它们都很接近0，那么即使数学上很小的差别都会导致结果从0的一边跳到0的另一边。事实上，和单因素方差分析一样，我们将lm模型的confidence的统计值做平方计算，发现与aov的结果是一样样的

# or, square the lm stat
model_5_lm_tidy$statistic[-1]^2
# same as anova stat
model_5_ancova_tidy$statistic

双因素方差分析

如果我们考察组内性别差异是否会导致depression的变化，那么就需要双因素方差分析，而且两个预测子之间还有相互作用项。

# Run anova
model_6_anova <- aov(dep_slope ~ group * sex, data = edata)
model_6_anova_tidy <- tidy(model_6_anova) %>% mutate(model = "aov(y ~ x * z)")
summary(model_6_anova)

# Run equivalent linear model
model_6_lm <- lm(dep_slope ~ group * sex, data = edata)
model_6_lm_tidy <- tidy(model_6_lm) %>% mutate(model = "lm(y ~ x * z)")
summary(model_6_lm)

# we combine the two model outputs, rowwise
results <- bind_rows(model_6_anova_tidy, model_6_lm_tidy) %>%
  select(model, term, estimate, statistic, p.value)

aov()和lm() 公式写法是一样，输出结果又一次不一样，但结论是相同的（尤其是分组变量只有两个水平时候）

aov评估的是（这些变量作为整体），是否对Y产生差异；而lm 模型，我们评估的是分类变量中的某个因子水平是否与基线水平之间是否有著差异。

最后，为了更好地演示aov与lm之间的等价性，给group弄成一个有多个水平（>2）的因子, 具体过程如下

edata_mock <- edata %>%
  # Add 2 to numeric version of groups
  mutate(group = as.numeric(group) + 2) %>%
  # bind this by row to the origincal eData (with group as numeric)
  bind_rows(edata %>%
    mutate(group = as.numeric(group))) %>%
  # make group a factor again so the correct test is applied
  mutate(group = as.factor(group))

数据没有改，只是复制了一遍，复制出来的数据，因子水平改为3和4，那么新的数据edata_mock中，group就有四个因子水平（1，2，3，4）

# Run  anova
model_7_anova <- aov(dep_slope ~ group * sex, data = edata_mock)
model_7_anova_tidy <- tidy(model_7_anova) %>% mutate(model = "aov(y ~ x * z)")
summary(model_7_anova)

# Run equivalent linear model
model_7_lm <- lm(dep_slope ~ group * sex, data = edata_mock)
model_7_lm_tidy <- tidy(model_7_lm) %>% mutate(model = "lm(y ~ x * z)")
summary(model_7_lm)

# we combine the two model outputs, rowwise
results <- bind_rows(model_7_anova_tidy, model_7_lm_tidy) %>%
  select(model, term, estimate, statistic, p.value)

样本大小翻倍，因此统计值和p-values不一样了。注意到lm模型，这里现在又两个多余的分组。因为group3和基线group1完全一样，因此统计为0，p-value 为1；而group 2和group4也是一样的，因此相对基线group1而言，结果是一样的。

所以，相比于做统计检验，我倾向于线性模型，因为lm()除了给出变量作为整体是否对响应变量产生影响外，还提供了更多的因子之间的信息。

edata %>%
  mutate(`sex:group` = interaction(sex, group, sep = ":")) %>%
  ggplot(aes(
    x = sex:group,
    y = dep_slope,
    colour = sex:group
  )) +
  geom_jitter(width = .2) +
  geom_boxplot(width = .3, alpha = .2) +
  labs(
    y = "Depression difference",
    title = "Depression difference between baseline and EOS",
    subtitle = "Divided by intervention group and sex"
  )

# remove the objects
# rm(list=ls())
rm(edata, edata_mock, model_1_lm, model_1_lm_tidy, model_1_t, model_1_t_tidy, model_2_lm, model_2_lm_tidy, model_2_lm2, model_2_lm2_tidy, model_2_t, model_2_t_tidy, model_2_t2, model_2_t2_tidy, model_3_cor, model_3_cor_tidy, model_3_lm, model_3_lm_tidy, model_4_anova, model_4_anova_tidy, model_4_lm, model_4_lm_tidy, model_5_ancova, model_5_ancova_tidy, model_5_lm, model_5_lm_tidy, model_6_anova, model_6_anova_tidy, model_6_lm, model_6_lm_tidy, model_7_anova, model_7_anova_tidy, model_7_lm, model_7_lm_tidy, results)

pacman::p_unload(pacman::p_loaded(), character.only = TRUE)