专题五、相关和回归
Wei Wei
2022-10-19
教学目标：
- 掌握散点图的画法，皮尔逊积差相关、斯皮尔曼等级相关的计算方法
- 掌握多元线性回归的层次回归方法
- 掌握简单中介和调节作用的检验方法
皮尔逊积差相关
# 连续变量、大样本，大致线性关系，大致正态分布（中间高，两头低）
library(haven)
math_data <- read_sav("https://gitee.com/vv_victorwei/r-language-data-analysis/raw/master/%E7%9B%B8%E5%85%B3%E5%88%86%E6%9E%90/regression.sav")
head(math_data)## # A tibble: 6 × 3
## age intelligence maths
## <dbl> <dbl> <dbl>
## 1 61 4 17
## 2 60 12 17
## 3 60 4 19
## 4 69 5 20
## 5 67 13 21
## 6 64 10 21# 绘制散点图
library(ggplot2)
library(showtext)## Loading required package: sysfonts## Loading required package: showtextdbggplot(math_data, aes(x=age, y=maths)) + geom_point()
#添加回归线,geom_smooth(method=lm)
ggplot(math_data, aes(x=age, y=maths)) + geom_point()+ geom_smooth(method=lm)## `geom_smooth()` using formula 'y ~ x'
# 不想要阴影的置信区间，geom_smooth(method=lm, se=FALSE)
ggplot(math_data, aes(x=age, y=maths)) + geom_point()+ geom_smooth(method=lm, se=FALSE)## `geom_smooth()` using formula 'y ~ x'
# 皮尔逊相关分析
cor(math_data, method ='pearson')## age intelligence maths
## age 1.0000000 0.3444980 0.3009685
## intelligence 0.3444980 1.0000000 0.5297613
## maths 0.3009685 0.5297613 1.0000000#p值计算
library(psych)##
## Attaching package: 'psych'## The following objects are masked from 'package:ggplot2':
##
## %+%, alphacorr.test(math_data)## Call:corr.test(x = math_data)
## Correlation matrix
## age intelligence maths
## age 1.00 0.34 0.30
## intelligence 0.34 1.00 0.53
## maths 0.30 0.53 1.00
## Sample Size
## [1] 173
## Probability values (Entries above the diagonal are adjusted for multiple tests.)
## age intelligence maths
## age 0 0 0
## intelligence 0 0 0
## maths 0 0 0
##
## To see confidence intervals of the correlations, print with the short=FALSE option# 直接生成apa相关矩阵表格,filename后面更换为自己想要保存的位置和文件名，如果没有位置，默认保存在r环境里
library(apaTables)
apa.cor.table(math_data, filename="Table2_APA.doc", table.number=1)##
##
## Table 1
##
## Means, standard deviations, and correlations with confidence intervals
##
##
## Variable M SD 1 2
## 1. age 67.46 3.92
##
## 2. intelligence 18.51 5.42 .34**
## [.21, .47]
##
## 3. maths 42.42 11.23 .30** .53**
## [.16, .43] [.41, .63]
##
##
## Note. M and SD are used to represent mean and standard deviation, respectively.
## Values in square brackets indicate the 95% confidence interval.
## The confidence interval is a plausible range of population correlations
## that could have caused the sample correlation (Cumming, 2014).
## * indicates p < .05. ** indicates p < .01.
## # 保存符合apa格式的表格（有95%置信区间）
#利用psych图示散点图和相关系数以及分布直方图
library(psych)
pairs.panels(math_data)
# 使用corrgram标识相关强弱
library(corrgram)
corrgram(math_data,upper.panel=panel.cor)## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
## Warning in par(usr): argument 1 does not name a graphical parameter
#再漂亮一点
dat <- mtcars[, c(1, 3:7)]
corrplot2 <- function(data,
method = "pearson",
sig.level = 0.05,
order = "original",
diag = FALSE,
type = "upper",
tl.srt = 90,
number.font = 1,
number.cex = 1,
mar = c(0, 0, 0, 0)) {
library(corrplot)
data_incomplete <- data
data <- data[complete.cases(data), ]
mat <- cor(data, method = method)
cor.mtest <- function(mat, method) {
mat <- as.matrix(mat)
n <- ncol(mat)
p.mat <- matrix(NA, n, n)
diag(p.mat) <- 0
for (i in 1:(n - 1)) {
for (j in (i + 1):n) {
tmp <- cor.test(mat[, i], mat[, j], method = method)
p.mat[i, j] <- p.mat[j, i] <- tmp$p.value
}
}
colnames(p.mat) <- rownames(p.mat) <- colnames(mat)
p.mat
}
p.mat <- cor.mtest(data, method = method)
col <- colorRampPalette(c("#BB4444", "#EE9988", "#FFFFFF", "#77AADD", "#4477AA"))
corrplot(mat,
method = "color", col = col(200), number.font = number.font,
mar = mar, number.cex = number.cex,
type = type, order = order,
addCoef.col = "black", # add correlation coefficient
tl.col = "black", tl.srt = tl.srt, # rotation of text labels
# combine with significance level
p.mat = p.mat, sig.level = sig.level, insig = "blank",
# hide correlation coefficiens on the diagonal
diag = diag
)
}
corrplot2(
data = dat,
method = "pearson",
sig.level = 0.05,
order = "original",
diag = FALSE,
type = "upper",
tl.srt = 75
)## corrplot 0.92 loaded
#斯皮尔曼等级相关
# 小样本或者顺序变量,Spearman等级相关
library(haven)
edu_rate_data <- read_sav("https://gitee.com/vv_victorwei/r-language-data-analysis/raw/master/%E7%9B%B8%E5%85%B3%E5%88%86%E6%9E%90/4.8%20E1%20education%20and%20rate.sav")
head(edu_rate_data)## # A tibble: 6 × 2
## education rate
## <dbl+lbl> <dbl+lbl>
## 1 1 [中专及以下] 1 [差]
## 2 1 [中专及以下] 2 [及格]
## 3 2 [大专] 2 [及格]
## 4 2 [大专] 1 [差]
## 5 2 [大专] 3 [良]
## 6 2 [大专] 3 [良]#相关系数 spearman's rho
cor.test(edu_rate_data$education, edu_rate_data$rate, method ='spearman')## Warning in cor.test.default(edu_rate_data$education, edu_rate_data$rate, :
## Cannot compute exact p-value with ties##
## Spearman's rank correlation rho
##
## data: edu_rate_data$education and edu_rate_data$rate
## S = 186.74, p-value = 0.02649
## alternative hypothesis: true rho is not equal to 0
## sample estimates:
## rho
## 0.5895715回归分析
# 年龄可以预测数学表现吗？
library(haven)
math_data <- read_sav("https://gitee.com/vv_victorwei/r-language-data-analysis/raw/master/%E7%9B%B8%E5%85%B3%E5%88%86%E6%9E%90/regression.sav")
head(math_data)## # A tibble: 6 × 3
## age intelligence maths
## <dbl> <dbl> <dbl>
## 1 61 4 17
## 2 60 12 17
## 3 60 4 19
## 4 69 5 20
## 5 67 13 21
## 6 64 10 21# 建立线性模型
age_model<-lm(maths~age,data = math_data)
summary(age_model)##
## Call:
## lm(formula = maths ~ age, data = math_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -23.744 -7.061 -0.607 6.846 24.436
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -15.8287 14.1366 -1.120 0.264
## age 0.8634 0.2092 4.127 5.73e-05 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 10.74 on 171 degrees of freedom
## Multiple R-squared: 0.09058, Adjusted R-squared: 0.08526
## F-statistic: 17.03 on 1 and 171 DF, p-value: 5.731e-05# 查看残差的qq图，残差分布（点）要接近正态分布（线）
age_model_res <- resid(age_model)
qqnorm(age_model_res)
qqline(age_model_res)
# 残差图显示残差和拟合模型的关系，随机分散最好，不要出现喇叭形的分布（说明受到估计值的影响）
#produce residual vs. fitted plot
plot(fitted(age_model), age_model_res)
#add a horizontal line at 0
abline(0,0)
# 加入智力会预测得更好吗？或者说，控制了年龄，智力对数学的预测有独特贡献吗？
age_iq_model<-lm(maths~age+intelligence,data = math_data)
summary(age_iq_model)##
## Call:
## lm(formula = maths ~ age + intelligence, data = math_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -22.666 -7.038 -1.287 7.298 23.233
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.1438 12.6194 -0.170 0.8653
## age 0.3856 0.1966 1.962 0.0514 .
## intelligence 1.0020 0.1420 7.056 4.16e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 9.476 on 170 degrees of freedom
## Multiple R-squared: 0.2966, Adjusted R-squared: 0.2883
## F-statistic: 35.84 on 2 and 170 DF, p-value: 1.032e-13# 比较两个模型，如果两个模型有显著差异，则说明较大模型（自变量多的）更好
anova(age_model,age_iq_model)## Analysis of Variance Table
##
## Model 1: maths ~ age
## Model 2: maths ~ age + intelligence
## Res.Df RSS Df Sum of Sq F Pr(>F)
## 1 171 19734
## 2 170 15264 1 4470 49.782 4.16e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1# 标准化回归系数
age_iq_model_s<-lm(scale(maths)~scale(age)+scale(intelligence),data = math_data)
summary(age_iq_model_s)##
## Call:
## lm(formula = scale(maths) ~ scale(age) + scale(intelligence),
## data = math_data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.0180 -0.6266 -0.1146 0.6498 2.0684
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -9.773e-17 6.414e-02 0.000 1.0000
## scale(age) 1.344e-01 6.852e-02 1.962 0.0514 .
## scale(intelligence) 4.835e-01 6.852e-02 7.056 4.16e-11 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8436 on 170 degrees of freedom
## Multiple R-squared: 0.2966, Adjusted R-squared: 0.2883
## F-statistic: 35.84 on 2 and 170 DF, p-value: 1.032e-13# 另一种方法，用psych库的setCor可以输出标准化回归系数
library(psych)
age_model<-setCor(maths~age,data = math_data)
age_model## Call: setCor(y = maths ~ age, data = math_data)
##
## Multiple Regression from raw data
##
## DV = maths
## slope se t p lower.ci upper.ci VIF Vy.x
## (Intercept) 0.0 0.07 0.00 1.0e+00 -0.14 0.14 1 0.00
## age 0.3 0.07 4.13 5.7e-05 0.16 0.44 1 0.09
##
## Residual Standard Error = 0.96 with 171 degrees of freedom
##
## Multiple Regression
## R R2 Ruw R2uw Shrunken R2 SE of R2 overall F df1 df2 p
## maths 0.3 0.09 0.3 0.09 0.09 0.04 17.03 1 171 5.73e-05age_iq_model<-setCor(maths~age+intelligence,data = math_data)
age_iq_model## Call: setCor(y = maths ~ age + intelligence, data = math_data)
##
## Multiple Regression from raw data
##
## DV = maths
## slope se t p lower.ci upper.ci VIF Vy.x
## (Intercept) 0.00 0.06 0.00 1.0e+00 -0.13 0.13 1.00 0.00
## age 0.13 0.07 1.96 5.1e-02 0.00 0.27 1.13 0.04
## intelligence 0.48 0.07 7.06 4.2e-11 0.35 0.62 1.13 0.26
##
## Residual Standard Error = 0.84 with 170 degrees of freedom
##
## Multiple Regression
## R R2 Ruw R2uw Shrunken R2 SE of R2 overall F df1 df2 p
## maths 0.54 0.3 0.51 0.26 0.29 0.06 35.84 2 170 1.03e-13anova(age_model,age_iq_model)## Model 1 = setCor(y = maths ~ age, data = math_data)
## Model 2 = setCor(y = maths ~ age + intelligence, data = math_data)## $maths
## Res Df Res SS Diff df Diff SS F Pr(F > )
## 1 171 156.4199 NA NA NA NA
## 2 170 120.9897 1 35.43015 49.78211 4.160161e-11简单中介作用
- 可以用psych的mediate函数
# 年龄影响智力发展，智力发展影响数学？智力在年龄和数学之间起着中介作用？
mediation_model<- mediate(maths ~ age + (intelligence), data =math_data)
mediation_model##
## Mediation/Moderation Analysis
## Call: mediate(y = maths ~ age + (intelligence), data = math_data)
##
## The DV (Y) was maths . The IV (X) was age . The mediating variable(s) = intelligence .
##
## Total effect(c) of age on maths = 0.86 S.E. = 0.21 t = 4.13 df= 171 with p = 5.7e-05
## Direct effect (c') of age on maths removing intelligence = 0.39 S.E. = 0.2 t = 1.96 df= 170 with p = 0.051
## Indirect effect (ab) of age on maths through intelligence = 0.48
## Mean bootstrapped indirect effect = 0.48 with standard error = 0.12 Lower CI = 0.26 Upper CI = 0.74
## R = 0.54 R2 = 0.3 F = 35.84 on 2 and 170 DF p-value: 5.33e-18
##
## To see the longer output, specify short = FALSE in the print statement or ask for the summary#如果有多个中介因子，可以继续添加+（）中介和调节效应（利用PROCESS by Hayes）
- 需要下载r代码，导入process系列函数
- 下载地址： https://gitee.com/vv_victorwei/r-language-data-analysis/blob/master/%E7%9B%B8%E5%85%B3%E5%88%86%E6%9E%90/process.R
- 需要耐心等待
# 简单中介效应
process(data = math_data, y = "maths", x = "age", m ="intelligence", model = 4)##
## ********************* PROCESS for R Version 4.1.1 *********************
##
## Written by Andrew F. Hayes, Ph.D. www.afhayes.com
## Documentation available in Hayes (2022). www.guilford.com/p/hayes3
##
## ***********************************************************************
##
## Model : 4
## Y : maths
## X : age
## M : intelligence
##
## Sample size: 173
##
## Random seed: 50998
##
##
## ***********************************************************************
## Outcome Variable: intelligence
##
## Model Summary:
## R R-sq MSE F df1 df2 p
## 0.3445 0.1187 26.0337 23.0269 1.0000 171.0000 0.0000
##
## Model:
## coeff se t p LLCI ULCI
## constant -13.6570 6.7143 -2.0340 0.0435 -26.9105 -0.4034
## age 0.4768 0.0994 4.7986 0.0000 0.2807 0.6729
##
## ***********************************************************************
## Outcome Variable: maths
##
## Model Summary:
## R R-sq MSE F df1 df2 p
## 0.5446 0.2966 89.7908 35.8367 2.0000 170.0000 0.0000
##
## Model:
## coeff se t p LLCI ULCI
## constant -2.1438 12.6194 -0.1699 0.8653 -27.0548 22.7671
## age 0.3856 0.1966 1.9618 0.0514 -0.0024 0.7736
## intelligence 1.0020 0.1420 7.0556 0.0000 0.7217 1.2824
##
## ***********************************************************************
## Bootstrapping progress:
##
|
| | 0%
|
| | 1%
|
|> | 1%
|
|> | 2%
|
|>> | 2%
|
|>> | 3%
|
|>> | 4%
|
|>>> | 4%
|
|>>> | 5%
|
|>>> | 6%
|
|>>>> | 6%
|
|>>>> | 7%
|
|>>>>> | 7%
|
|>>>>> | 8%
|
|>>>>> | 9%
|
|>>>>>> | 9%
|
|>>>>>> | 10%
|
|>>>>>>> | 10%
|
|>>>>>>> | 11%
|
|>>>>>>> | 12%
|
|>>>>>>>> | 12%
|
|>>>>>>>> | 13%
|
|>>>>>>>> | 14%
|
|>>>>>>>>> | 14%
|
|>>>>>>>>> | 15%
|
|>>>>>>>>>> | 15%
|
|>>>>>>>>>> | 16%
|
|>>>>>>>>>> | 17%
|
|>>>>>>>>>>> | 17%
|
|>>>>>>>>>>> | 18%
|
|>>>>>>>>>>> | 19%
|
|>>>>>>>>>>>> | 19%
|
|>>>>>>>>>>>> | 20%
|
|>>>>>>>>>>>>> | 20%
|
|>>>>>>>>>>>>> | 21%
|
|>>>>>>>>>>>>> | 22%
|
|>>>>>>>>>>>>>> | 22%
|
|>>>>>>>>>>>>>> | 23%
|
|>>>>>>>>>>>>>>> | 23%
|
|>>>>>>>>>>>>>>> | 24%
|
|>>>>>>>>>>>>>>> | 25%
|
|>>>>>>>>>>>>>>>> | 25%
|
|>>>>>>>>>>>>>>>> | 26%
|
|>>>>>>>>>>>>>>>> | 27%
|
|>>>>>>>>>>>>>>>>> | 27%
|
|>>>>>>>>>>>>>>>>> | 28%
|
|>>>>>>>>>>>>>>>>>> | 28%
|
|>>>>>>>>>>>>>>>>>> | 29%
|
|>>>>>>>>>>>>>>>>>> | 30%
|
|>>>>>>>>>>>>>>>>>>> | 30%
|
|>>>>>>>>>>>>>>>>>>> | 31%
|
|>>>>>>>>>>>>>>>>>>>> | 31%
|
|>>>>>>>>>>>>>>>>>>>> | 32%
|
|>>>>>>>>>>>>>>>>>>>> | 33%
|
|>>>>>>>>>>>>>>>>>>>>> | 33%
|
|>>>>>>>>>>>>>>>>>>>>> | 34%
|
|>>>>>>>>>>>>>>>>>>>>> | 35%
|
|>>>>>>>>>>>>>>>>>>>>>> | 35%
|
|>>>>>>>>>>>>>>>>>>>>>> | 36%
|
|>>>>>>>>>>>>>>>>>>>>>>> | 36%
|
|>>>>>>>>>>>>>>>>>>>>>>> | 37%
|
|>>>>>>>>>>>>>>>>>>>>>>> | 38%
|
|>>>>>>>>>>>>>>>>>>>>>>>> | 38%
|
|>>>>>>>>>>>>>>>>>>>>>>>> | 39%
|
|>>>>>>>>>>>>>>>>>>>>>>>> | 40%
|
|>>>>>>>>>>>>>>>>>>>>>>>>> | 40%
|
|>>>>>>>>>>>>>>>>>>>>>>>>> | 41%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>> | 41%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>> | 42%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>> | 43%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>> | 43%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>> | 44%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 44%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 45%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 46%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 46%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 47%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 48%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 48%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 49%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 49%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 50%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 51%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 51%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 52%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 52%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 53%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 54%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 54%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 55%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 56%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 56%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 57%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 57%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 58%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 59%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 59%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 60%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 60%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 61%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 62%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 62%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 63%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 64%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 64%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 65%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 65%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 66%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 67%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 67%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 68%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 69%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 69%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 70%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 70%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 71%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 72%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 72%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 73%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 73%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 74%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 75%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 75%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 76%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 77%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 77%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 78%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 78%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 79%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 80%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 80%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 81%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 81%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 82%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 83%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 83%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 84%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 85%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 85%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 86%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 86%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 87%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 88%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 88%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 89%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 90%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 90%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 91%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 91%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 92%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 93%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 93%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 94%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 94%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 95%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 96%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 96%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 97%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 98%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 98%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> | 99%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>| 99%
|
|>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>| 100%
##
## **************** DIRECT AND INDIRECT EFFECTS OF X ON Y ****************
##
## Direct effect of X on Y:
## effect se t p LLCI ULCI
## 0.3856 0.1966 1.9618 0.0514 -0.0024 0.7736
##
## Indirect effect(s) of X on Y:
## Effect BootSE BootLLCI BootULCI
## intelligence 0.4778 0.1254 0.2625 0.7446
##
## ******************** ANALYSIS NOTES AND ERRORS ************************
##
## Level of confidence for all confidence intervals in output: 95
##
## Number of bootstraps for percentile bootstrap confidence intervals: 5000# 简单调节作用
library(haven)
muscle_data<-read_sav("https://gitee.com/vv_victorwei/r-language-data-analysis/raw/master/%E7%9B%B8%E5%85%B3%E5%88%86%E6%9E%90/muscle-percent-males-interaction.sav")
head(muscle_data)## # A tibble: 6 × 6
## id sex age thours mperc age_group
## <dbl> <dbl+lbl> <dbl> <dbl> <dbl> <dbl+lbl>
## 1 2015013 1 [Male] 20.2 4 39 1 [young]
## 2 2015056 1 [Male] 20.4 3.25 38.5 1 [young]
## 3 2017021 1 [Male] 20.4 2.75 37.5 1 [young]
## 4 2018030 1 [Male] 20.4 5 37 1 [young]
## 5 2015030 1 [Male] 20.4 3 36.5 1 [young]
## 6 2017062 1 [Male] 20.5 4.25 40.5 1 [young]muscle_data$age_group[muscle_data$age_group==2]<-0
# 检查交互项的显著性
library(psych)
muscle_model<-setCor(mperc~age_group*thours,data = muscle_data)
muscle_model## Call: setCor(y = mperc ~ age_group * thours, data = muscle_data)
##
## Multiple Regression from raw data
##
## DV = mperc
## slope se t p lower.ci upper.ci VIF Vy.x
## (Intercept) 0.00 0.06 0.00 1.0e+00 -0.11 0.11 1.00 0.00
## age_group 0.30 0.06 4.95 1.4e-06 0.18 0.42 1.10 0.06
## thours 0.38 0.06 6.14 3.5e-09 0.26 0.50 1.13 0.09
## age_group*thours 0.24 0.06 4.10 5.6e-05 0.13 0.36 1.02 0.05
##
## Residual Standard Error = 0.9 with 239 degrees of freedom
##
## Multiple Regression
## R R2 Ruw R2uw Shrunken R2 SE of R2 overall F df1 df2 p
## mperc 0.45 0.2 0.43 0.19 0.19 0.04 19.86 3 239 1.57e-11# 调节模型
process(data = muscle_data, y = "mperc", x = "thours", w ="age_group", model = 1)##
## ********************* PROCESS for R Version 4.1.1 *********************
##
## Written by Andrew F. Hayes, Ph.D. www.afhayes.com
## Documentation available in Hayes (2022). www.guilford.com/p/hayes3
##
## ***********************************************************************
##
## Model : 1
## Y : mperc
## X : thours
## W : age_group
##
## Sample size: 243
##
##
## ***********************************************************************
## Outcome Variable: mperc
##
## Model Summary:
## R R-sq MSE F df1 df2 p
## 0.4467 0.1996 2.7213 19.8630 3.0000 239.0000 0.0000
##
## Model:
## coeff se t p LLCI ULCI
## constant 36.9519 0.6895 53.5942 0.0000 35.5936 38.3101
## thours 0.1869 0.1412 1.3231 0.1871 -0.0914 0.4651
## age_group -2.6635 0.9438 -2.8222 0.0052 -4.5227 -0.8043
## Int_1 0.8549 0.2083 4.1042 0.0001 0.4446 1.2652
##
## Product terms key:
## Int_1 : thours x age_group
##
## Test(s) of highest order unconditional interaction(s):
## R2-chng F df1 df2 p
## X*W 0.0564 16.8443 1.0000 239.0000 0.0001
## ----------
## Focal predictor: thours (X)
## Moderator: age_group (W)
##
## Conditional effects of the focal predictor at values of the moderator(s):
## age_group effect se t p LLCI ULCI
## 0.0000 0.1869 0.1412 1.3231 0.1871 -0.0914 0.4651
## 1.0000 1.0418 0.1531 6.8041 0.0000 0.7401 1.3434
##
## ******************** ANALYSIS NOTES AND ERRORS ************************
##
## Level of confidence for all confidence intervals in output: 95