# 通径分析
目前只完成了代码部分,后续还有待完善。
## 加载工具包
```{r}
#| warning: false
library(tidyverse)
library(agricolae)
library(knitr)
```
以R自带数据集为例,进行通径分析。
## 相关分析
```{r}
#| label: tbl-correlation
#| tbl-cap: 相关分析
#| tbl-subcap: ["影响因子相关系数","影响因子相关分析显著性","响应变量同影响因子间相关系数","响应变量同影响因子间相关分析显著性"]
data(haynes)
X <- haynes %>% dplyr::select(FL, MI, ME)
Y <- haynes$WI
# correlation analysis ---------------------------------------
corr.x <- correlation(X, X)
corr.y <- correlation(Y, X)
corr.x$correlation %>% as.data.frame()
corr.x$pvalue %>% as.data.frame()
corr.y$correlation %>% as.data.frame()
corr.y$pvalue %>% as.data.frame()
```
## 通径分析
利用相关系数进行通径分析
```{r}
#| message: false
#| warning: false
#| results: hide
# Path Analysis -----------------------------------------------
result <- path.analysis(corr.x$correlation, corr.y$correlation)
## 直接作用
DEffect <- diag(result$Coeff)
## 间接作用
diag(result$Coeff) <- 0
IEffect <- rowSums(result$Coeff)
# print results of path analysis -----------------------------------------------
result1 <- result$Coeff %>% as.data.frame %>%
mutate(
'总间接作用' = IEffect,
'直接作用' = DEffect,
'总作用' = corr.y$correlation %>% as.numeric(),
'贡献率(%)' = (corr.y$correlation %>% as.numeric())^2*DEffect
)
rownames(result1) <- DEffect %>% names
```
```{r}
#| label: tbl-path.analysis
#| tbl-cap: "通径分析"
result1
```
```{r}
sprintf("Residual Effect^2 = %2.3f\n",
result$Residual) %>% cat
```