forked from perlatex/R_for_Data_Science
-
Notifications
You must be signed in to change notification settings - Fork 0
/
tidystats_tests_as_linear.Rmd
500 lines (307 loc) · 15.6 KB
/
tidystats_tests_as_linear.Rmd
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
# 统计检验与线性模型的等价性 {#tidystats-tests-as-linear}
心理学专业的同学最喜欢的统计方法,估计是方差分析(ANOVA) 和它的堂兄协变量分析 (ANCOVA),事实上[常用的统计检验本质上都是线性模型](https://lindeloev.github.io/tests-as-linear/),所以你学了线性模型,就可以不用学统计检验了,是不是很开心?
本章,我们将通过几个案例展示统计检验与线性模型的等价性,因此我们这里只关注代码本身,不关注模型的好坏以及模型的解释。部分[代码](https://drmowinckels.io/blog/2020-06-24-the-linear-regression-family-in-r/)和思想来自 [Jonas Kristoffer Lindeløv](https://lindeloev.github.io/tests-as-linear/)
```{r tests-as-linear-1, out.width = '100%', echo = FALSE}
knitr::include_graphics("images/linear_tests_cheat_sheet.png")
```
[experim](https://www.kaggle.com/ivanmusebe/experim-analysis-in-r)是一个模拟的数据集,这个虚拟的研究目的是,考察两种不同类型的干预措施对帮助学生应对即将到来的统计学课程的焦虑的影响。实验方案如下:
- 首先,学生完成一定数量的量表(量表1),包括对统计学课程的害怕(fost),自信(confid),抑郁(depress)指标
- 然后,学生被等分成两组,组1 进行技能提升训练;组2进行信心提升训练。训练结束后,完成相同的量表(量表2)
- 三个月后,他们再次完成相同的量表(量表3)
也就说,相同的指标在不同的时期测了三次,目的是考察期间的干预措施对若干指标的影响。
```{r tests-as-linear-2}
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
```
```{r tests-as-linear-3}
glimpse(edata)
```
## t检验
首先,我们想`检验`第一次测量的抑郁得分(depress1)的分布,是否明显偏离正态分布(均值为0),这里的零假设就是正态分布且均值为0; 备选假设就是均值不为0
```{r tests-as-linear-4}
# Run t-test
model_1_t <- t.test(edata$depress1, mu = 0)
model_1_t
```
输出结果显示,p-value很小接近0,拒绝零假设,也就说均值不大可能为0。事实上,通过密度图可以看到depress1的分布均值在42附近,与0相距很远。
```{r tests-as-linear-5}
edata %>%
ggplot(aes(x = depress1)) +
geom_density()
```
先不管做这个假设有没有意义,我们用线性回归的方法做一遍,
```{r tests-as-linear-6}
t.test(depress1 ~ 1, data = edata)
```
```{r tests-as-linear-7}
# 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](https://lindeloev.github.io/tests-as-linear/)表中期望的一样。
```{r tests-as-linear-8}
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 tests-as-linear-9, echo = FALSE}
kable(results) %>%
collapse_rows(1)
```
上面例子,我们用不同的方法完成了相同的检验。事实上,在R语言`t.test()`内部会直接调用`lm()`函数,其函数语句和我们的这里代码也是一样的。
绝大部分时候,我们想考察实验中的**干预**是否有效,换句话说,基线得分 depress1 和 干预后得分 depress3 是否存在显著差异?这就需要进行`配对样本t检验`。
```{r tests-as-linear-10}
# 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)`,即先让两个变量相减,然后去做回归
```{r tests-as-linear-11}
# 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)
```
```{r tests-as-linear-12}
# we combine the two model outputs, rowwise
results <- bind_rows(model_2_t_tidy, model_2_lm_tidy) %>%
select(model, estimate, statistic, p.value)
```
```{r tests-as-linear-13, echo = FALSE}
kable(results) %>%
collapse_rows(1)
```
haha,通过这个等价的线性模型,我们似乎可以窥探到`配对样本t检验`是怎么样工作的。
它`depress1` 和 `depress3`一一对应相减后得到新的一列,用新的一列做**单样本t检验**
```{r tests-as-linear-14}
# 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`构建新的一列
```{r tests-as-linear-15}
# 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)")
```
最后,把四个模型放在一起
```{r tests-as-linear-16}
# 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)
```
```{r tests-as-linear-17, echo = FALSE}
kable(results) %>%
collapse_rows(1)
```
我们看到,四个模型给出了相同的结果。
## 关联
两个变量的关联检验,用的也比较常见。比如两个连续型变量,我们可能想知道它们之间的关联,以及这种关联是否显著。
```{r tests-as-linear-18}
# 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
```
```{r tests-as-linear-19}
# 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)
```
```{r tests-as-linear-20}
# 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)
```
```{r tests-as-linear-21, echo = FALSE}
kable(results) %>%
collapse_rows(1)
```
喔袄,这次的表格有点不一样了。那是因为,线性模型会不仅输出系数,而且还输出了模型的截距,因此两个模型的系数会不一样,但在 t-statistic 和 p.value 是一样的。
## 单因素方差分析
我们现在想看看两组(组1=技能提升组;组2=信心提升组)在第一次量表中`depress1`得分是否有显著区别?
```{r tests-as-linear-22, eval=FALSE, include=FALSE}
t.test(depress1 ~ group, data = edata)
a <- edata %>% filter(group == 1) %>% pull(depress1)
b <- edata %>% filter(group == 2) %>% pull(depress1)
t.test(a, b, paired = FALSE)
lm(depress1 ~ group, data = edata)
```
```{r tests-as-linear-23}
# 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)
```
```{r tests-as-linear-24}
# 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)
```
```{r tests-as-linear-25}
# 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)
```
```{r tests-as-linear-26, echo = FALSE}
kable(results) %>%
collapse_rows(1)
```
这两个模型输出结果不一样了,且模型的区别似乎有点不好理解。`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值(限定分组变量只有因子水平时)
```{r tests-as-linear-27}
# 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`,这就需要用到协变量分析。
```{r tests-as-linear-28}
# 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)
```
```{r tests-as-linear-29}
# 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)
```
```{r tests-as-linear-30}
# 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)
```
```{r tests-as-linear-31, echo = FALSE}
kable(results) %>%
collapse_rows(1)
```
和单因素方差分析一样,输出结果有一点点不同,但模型输出告诉我们,两个结果是相同的。
`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`的结果是一样样的
```{r tests-as-linear-32}
# or, square the lm stat
model_5_lm_tidy$statistic[-1]^2
# same as anova stat
model_5_ancova_tidy$statistic
```
## 双因素方差分析
如果我们考察组内性别差异是否会导致depression的变化,那么就需要**双因素方差分析**,而且两个预测子之间还有相互作用项。
```{r tests-as-linear-33}
# 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)
```
```{r tests-as-linear-34}
# 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)
```
```{r tests-as-linear-35}
# 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)
```
```{r tests-as-linear-36, echo = FALSE}
kable(results) %>%
collapse_rows(1)
```
`aov()`和`lm()`
公式写法是一样,输出结果又一次不一样,但结论是相同的(尤其是分组变量只有两个水平时候)
`aov`评估的是 (这些变量作为整体),是否对Y产生差异;而`lm` 模型,我们评估的是分类变量中的某个因子水平是否与基线水平之间是否有著差异。
最后,为了更好地演示`aov`与`lm`之间的等价性,给group弄成一个有多个水平(>2)的因子, 具体过程如下
```{r tests-as-linear-37}
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)
```{r tests-as-linear-38}
# 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)
```
```{r tests-as-linear-39}
# 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)
```
```{r tests-as-linear-40}
# 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)
```
```{r tests-as-linear-41, echo = FALSE}
kable(results) %>%
collapse_rows(1)
```
样本大小翻倍,因此统计值和p-values不一样了。 注意到`lm`模型,这里现在又两个多余的分组。
因为group3和基线group1完全一样,因此统计为0,p-value 为1;而group 2和group4也是一样的,因此相对基线group1而言,结果是一样的。
所以,相比于做统计检验,我倾向于线性模型,因为`lm()`除了给出变量作为整体是否对响应变量产生影响外,还提供了更多的因子之间的信息。
```{r tests-as-linear-42}
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"
)
```
```{r tests-as-linear-43, echo = F}
# 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)
```
```{r tests-as-linear-44, echo = F, message = F, warning = F, results = "hide"}
pacman::p_unload(pacman::p_loaded(), character.only = TRUE)
```