R实现主成分分析并且直接导出论文可用的三线表

R实现主成分分析并且直接导出论文可用的三线表，

下面是实现代码：

# 安装并加载必要的包
if (!require(readxl)) install.packages("readxl")
if (!require(psych)) install.packages("psych")
if (!require(knitr)) install.packages("knitr")
if (!require(kableExtra)) install.packages("kableExtra")
if (!require(officer)) install.packages("officer")
if (!require(flextable)) install.packages("flextable")
library(kableExtra)
library(readxl)
library(psych)
library(knitr)
library(officer)
library(flextable)

# 设置工作路径到文件所在目录
setwd("/Volumes/Louis's HUB/SynologyDrive/Documents/R")

# 读取Excel文件
data <- read_excel("全国数据汇总.xlsx")
head(data)

# 提取投入和产出指标
inputs <- data[, c("生均公共财政预算教育事业费（小学）", "本科及以上学历教师比例（小学）","校舍建筑面积（小学）")]
outputs <- data[, c("毕业生数（小学）", "毕业率（小学）","小学招生数（小学）","在校生数（小学）")]

# 标准化数据
inputs_scaled <- scale(inputs)
outputs_scaled <- scale(outputs)

# 计算 KMO 值和巴特利特球度检验
kmo_inputs <- KMO(inputs_scaled)
kmo_outputs <- KMO(outputs_scaled)

bartlett_inputs <- cortest.bartlett(cor(inputs_scaled))
bartlett_outputs <- cortest.bartlett(cor(outputs_scaled))

# 进行主成分分析
pca_inputs <- prcomp(inputs_scaled, center = TRUE, scale. = TRUE)
pca_outputs <- prcomp(outputs_scaled, center = TRUE, scale. = TRUE)

# 提取特征值和贡献率
eigenvalues_inputs <- pca_inputs$sdev^2
eigenvalues_outputs <- pca_outputs$sdev^2

cumulative_variance_inputs <- cumsum(eigenvalues_inputs) / sum(eigenvalues_inputs) * 100
cumulative_variance_outputs <- cumsum(eigenvalues_outputs) / sum(eigenvalues_outputs) * 100

# 创建表格数据框
table_data <- data.frame(
  指标 = c(
    "生均公共财政预算教育事业费（小学）", "本科及以上学历教师比例（小学）","校舍建筑面积（小学）","毕业生数（小学）", "毕业率（小学）","小学招生数（小学）","在校生数（小学）"
  ),
  KMO值 = round(c(rep(kmo_inputs$MSA, length(inputs)), rep(kmo_outputs$MSA, length(outputs))), 3),
  巴特利特球度检验 = round(c(rep(bartlett_inputs$p.value, length(inputs)), rep(bartlett_outputs$p.value, length(outputs))), 3),
  特征值 = round(c(eigenvalues_inputs, eigenvalues_outputs), 3),
  主成分累积贡献率 = round(c(cumulative_variance_inputs, cumulative_variance_outputs), 3)
)

# 打印检查数据框
print(table_data)

# 使用 flextable 创建三线表
ft <- flextable(table_data)
ft <- set_header_labels(ft, 
                        KMO值 = "KMO", 
                        巴特利特球度检验 = "Bartlett's Test", 
                        特征值 = "Eigenvalues", 
                        主成分累积贡献率 = "Cumulative Variance")
ft <- theme_booktabs(ft)
ft <- autofit(ft)

# 创建 Word 文档并添加表格
doc <- read_docx()
doc <- body_add_flextable(doc, value = ft)
print(doc, target = "三线表.docx")