如果说，魔法世界的一切看起来都深邃、神秘，那一定是因为我们还没能接近魔法力量诞生的本质。探寻魔法力量的本质，或者一切超自然力量的本质，必然在那个魔法世界中是一个永恒的课题。魔法的能量来自哪里？魔法与物质世界的交互机制是什么？不同施法者的施法效果是否受他的主观感受、性格差异或者情绪状态影响？我愿把这门学科命名为魔法科学。
好了，假设我们现在是一名魔法科学的研究者。随着魔法生产力的逐渐提高，我们和星球上其他部分的科研交流更加密切了起来。一个有意思的超自然研究领域得到了我们的关注，那就是修真。与魔法施法者与魔法元素直接沟通排序施放不同，东方独立发展出了另一套“修真”的超自然体系，在这一体系下，人们的超自然力量需要经过修炼。即先通过身体吸纳身边的魔法元素（也被称为灵气），进而使用灵气改造身体成为施法仪式的一部分。在这样的修炼体系下，人们发现一些人对某种或某几种魔法元素的吸纳效果显著高于其他魔法元素和其他人，这样的人被认为身具“灵根”。
作为一个训练有素的魔法科学研究者，相信你一定会敏锐地察觉到，既然“灵根”与魔法元素的吸纳有关，而且是人与人修真能力评价个体差异的组成部分之一，那么它是否会影响我们一直关注的魔法天赋分数呢？
为了探索这个课题，首先，我们还是要获得我们的数据。
## 设定随机种子，保证你能用这段代码得到跟我一样的结果
set.seed(233)
## 生成被试ID
ID <- c(1:500)
## 我们的老朋友自我性别认同
iden <- as.factor(c(rep("武装直升机",250),rep("某品牌塑料袋",250)))
## 这次直接生成对应自我性别认同的哑变量编码
iden_n <- c(rep(0,250),rep(1,250))
## 灵根变量
spirit_root <- as.factor(c(rep("无灵根",125),rep("有灵根",125),rep("无灵根",125),rep("有灵根",125)))
## 灵根的哑变量编码
spirit_root_n <- c(rep(0,125),rep(1,125),rep(0,125),rep(1,125))
## 生成魔法天赋
magic_score <- 70 + 10*iden_n + 10*spirit_root_n -10*iden_n*spirit_root_n + rnorm(n = 500, mean = 0, sd = 5)
## 因为第一个数据框我们命名为df1,这里我们就命名为df2了
df2.1 <- df2 <- data.frame(ID,iden,iden_n,spirit_root,spirit_root_n,magic_score)
## 看看数据框长啥样
head (df2.1)
ID iden iden_n spirit_root spirit_root_n magic_score
1 1 武装直升机 0 无灵根 0 74.48066
2 2 武装直升机 0 无灵根 0 73.66222
3 3 武装直升机 0 无灵根 0 68.45923
4 4 武装直升机 0 无灵根 0 65.24286
5 5 武装直升机 0 无灵根 0 68.21877
6 6 武装直升机 0 无灵根 0 76.58066
ID iden iden_n spirit_root spirit_root_n magic_score
495 495 某品牌塑料袋 1 有灵根 1 81.46580
496 496 某品牌塑料袋 1 有灵根 1 77.61641
497 497 某品牌塑料袋 1 有灵根 1 72.54162
498 498 某品牌塑料袋 1 有灵根 1 78.00396
499 499 某品牌塑料袋 1 有灵根 1 82.09529
500 500 某品牌塑料袋 1 有灵根 1 83.61281
ggplot(df2.1, aes(x = iden, y = magic_score, fill = spirit_root)) +
geom_violin(trim = FALSE, alpha = 0.7, position = position_dodge(0.8)) +
geom_boxplot(width = 0.1, position = position_dodge(0.8), show.legend = FALSE) +
scale_fill_manual(values = c("#66c2a5", "#fc8d62")) + # 颜色自定义
labs(
title = "自我性别认同与灵根对魔法天赋的交互作用",
x = "自我性别认同",
y = "魔法天赋",
fill = "灵根状态"
) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"))
Attaching package: 'dplyr'
The following objects are masked from 'package:stats':
filter, lag
The following objects are masked from 'package:base':
intersect, setdiff, setequal, union
# 计算均值
df2_summary <- df2 %>%
group_by(iden, spirit_root) %>%
summarise(mean_magic = mean(magic_score, na.rm = TRUE),
.groups = 'drop')
# 方法1: 使用ggplot2绘制交互作用折线图
p_ggplot <- ggplot(df2_summary, aes(x = spirit_root,
y = mean_magic,
color = iden,
group = iden)) +
geom_line(linewidth = 1) +
geom_point(size = 3) +
labs(title = "交互作用折线图: 灵根与自我性别认同对魔法天赋的影响",
x = "灵根",
y = "平均魔法天赋分数",
color = "自我性别认同") +
theme_minimal(base_size = 14)
两因素方差分析
lm5.1 <- lm(magic_score~iden+spirit_root,df2.1)
summary(lm5.1)
Call:
lm(formula = magic_score ~ iden + spirit_root, data = df2.1)
Residuals:
Min 1Q Median 3Q Max
-15.4039 -3.5213 -0.0971 3.3806 16.3095
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 78.1812 0.4139 188.89 <2e-16 ***
iden武装直升机 -5.3483 0.4779 -11.19 <2e-16 ***
spirit_root有灵根 4.5354 0.4779 9.49 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 5.343 on 497 degrees of freedom
Multiple R-squared: 0.3022, Adjusted R-squared: 0.2994
F-statistic: 107.6 on 2 and 497 DF, p-value: < 2.2e-16
aov5.1 <- aov(magic_score~iden*spirit_root,df2.1)
summary(aov5.1)
Df Sum Sq Mean Sq F value Pr(>F)
iden 1 3576 3576 154.3 <2e-16 ***
spirit_root 1 2571 2571 111.0 <2e-16 ***
iden:spirit_root 1 2700 2700 116.5 <2e-16 ***
Residuals 496 11490 23
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Anova Table (Type II tests)
Response: magic_score
Sum Sq Df F value Pr(>F)
iden 3575.5 1 154.35 < 2.2e-16 ***
spirit_root 2571.2 1 110.99 < 2.2e-16 ***
iden:spirit_root 2699.9 1 116.55 < 2.2e-16 ***
Residuals 11490.0 496
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
交互作用的构造
正交；axb=0；a*b*c=0,axb=0,axc=0,bxc=0
## 设定随机种子，保证你能用这段代码得到跟我一样的结果
set.seed(233)
## 生成被试ID
ID <- c(1:500)
## 我们的老朋友自我性别认同
iden <- as.factor(c(rep("武装直升机",250),rep("某品牌塑料袋",250)))
## 这次直接生成对应自我性别认同的哑变量编码
iden_n <- c(rep(0,250),rep(1,250))
## 灵根变量
spirit_root <- as.factor(c(rep("无灵根",125),rep("有灵根",125),rep("无灵根",125),rep("有灵根",125)))
## 灵根的哑变量编码
spirit_root_n <- c(rep(0,125),rep(1,125),rep(0,125),rep(1,125))
## 生成魔法天赋
magic_score <- 70 + 10*iden_n + 10*spirit_root_n + rnorm(n = 500, mean = 0, sd = 5)
## 因为第一个数据框我们命名为df1,这里我们就命名为df2了
df2.2 <- data.frame(ID,iden,iden_n,spirit_root,spirit_root_n,magic_score)
ggplot(df2.2, aes(x = iden, y = magic_score, fill = spirit_root)) +
geom_violin(trim = FALSE, alpha = 0.7, position = position_dodge(0.8)) +
geom_boxplot(width = 0.1, position = position_dodge(0.8), show.legend = FALSE) +
scale_fill_manual(values = c("#66c2a5", "#fc8d62")) + # 颜色自定义
labs(
title = "自我性别认同与灵根对魔法天赋的交互作用",
x = "自我性别认同",
y = "魔法天赋",
fill = "灵根状态"
) +
theme_minimal() +
theme(plot.title = element_text(hjust = 0.5, face = "bold"))
lm5.2 <- lm(magic_score~iden*spirit_root,df2.2)
summary(lm5.2)
Call:
lm(formula = magic_score ~ iden * spirit_root, data = df2.2)
Residuals:
Min 1Q Median 3Q Max
-13.1330 -3.0943 -0.1403 3.2467 13.9858
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 80.5050 0.4305 187.007 <2e-16 ***
iden武装直升机 -9.9958 0.6088 -16.419 <2e-16 ***
spirit_root有灵根 9.8879 0.6088 16.241 <2e-16 ***
iden武装直升机:spirit_root有灵根 -0.7050 0.8610 -0.819 0.413
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 4.813 on 496 degrees of freedom
Multiple R-squared: 0.6831, Adjusted R-squared: 0.6812
F-statistic: 356.4 on 3 and 496 DF, p-value: < 2.2e-16
简单效应检验
lm5.2 <- lm(magic_score~iden_n*spirit_root_n,df2.1)
summary(lm5.2)
Call:
lm(formula = magic_score ~ iden_n * spirit_root_n, data = df2.1)
Residuals:
Min 1Q Median 3Q Max
-13.1330 -3.0943 -0.1403 3.2467 13.9858
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 70.5092 0.4305 163.79 <2e-16 ***
iden_n 9.9958 0.6088 16.42 <2e-16 ***
spirit_root_n 9.1828 0.6088 15.08 <2e-16 ***
iden_n:spirit_root_n -9.2950 0.8610 -10.80 <2e-16 ***
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 4.813 on 496 degrees of freedom
Multiple R-squared: 0.435, Adjusted R-squared: 0.4316
F-statistic: 127.3 on 3 and 496 DF, p-value: < 2.2e-16
aov2.1 <- lm(magic_score~iden*spirit_root,df2.1)
car::Anova(aov2.1)
Anova Table (Type II tests)
Response: magic_score
Sum Sq Df F value Pr(>F)
iden 3575.5 1 154.35 < 2.2e-16 ***
spirit_root 2571.2 1 110.99 < 2.2e-16 ***
iden:spirit_root 2699.9 1 116.55 < 2.2e-16 ***
Residuals 11490.0 496
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Loading required package: car
Loading required package: carData
The following object is masked from 'package:dplyr':
recode
testInteractions(aov5.1, fixed="iden", across = "spirit_root", adjsutment="none")
F Test:
P-value adjustment method: holm
Value SE Df Sum of Sq F Pr(>F)
某品牌塑料袋 0.1121 0.60881 1 0.8 0.0339 0.8539
武装直升 -9.1828 0.60881 1 5270.3 227.5063 <2e-16 ***
Residuals 496 11490.0
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
testInteractions(aov5.1, fixed="spirit_root", across = "iden", adjsutment="none")
F Test:
P-value adjustment method: holm
Value SE Df Sum of Sq F Pr(>F)
无灵根 9.9958 0.60881 1 6244.7 269.5705 <2e-16 ***
有灵根 0.7008 0.60881 1 30.7 1.3251 0.2502
Residuals 496 11490.0
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
更多因素、更多水平，尽在多因素方差分析
大五灵根模型。
