\documentclass[a4paper, 10.5pt, twoside, openany]{book} \usepackage{amsfonts} \usepackage{array} \usepackage{boxedminipage, fancybox} \usepackage{caption} \usepackage{color} \usepackage[colorlinks,linkcolor=blue]{hyperref} \usepackage{ctex} \usepackage{datetime} \usepackage[dvipsnames]{xcolor} \usepackage{enumerate} \usepackage{epsfig,graphicx,subfigure} \usepackage{extarrows} \usepackage{fancyheadings} \usepackage{float} \usepackage{geometry} \usepackage{listings} \usepackage{longtable} \usepackage{makeidx} \usepackage{mathrsfs} \usepackage{multirow} \usepackage{natbib} \usepackage{pifont} \usepackage{rotating} \usepackage{setspace} \usepackage{shadow} \usepackage{stmaryrd, amssymb, amsmath} \usepackage{tabularx} \usepackage{url} \usepackage{varioref} \usepackage{verbatim} \usepackage{wrapfig} \usepackage{xcolor} \geometry{left=2.0cm, right=2.0cm, top=2.5cm, bottom=2.5cm} \linespread{1.5} \definecolor{mygray}{rgb}{0.85, 0.85, 0.85} \newcommand{\codeinline}[1]{\colorbox{mygray}{\lstinline|#1|}} %% ---------------------------------------------------------------------------------------------------------------------------------------------------------------------- \title{\Huge \bf 《多元统计分析》课后作业} \author{\kaishu 姓名：\underline{\quad 李倩倩 \quad} \\[5mm] \kaishu 学号：\underline{\quad 2024017349 \quad} \\[5mm] \kaishu 班级：\underline{\quad 统计 24-1 班 \quad} \\[50mm] \kaishu 中国石油大学（北京）克拉玛依校区文理学院数学与统计系 } \date{\today} \begin{document} % -------------------------------------------- 封面页 -------------------------------------------- \frontmatter \maketitle % -------------------------------------------- 作业要求 -------------------------------------------- \chapter{作业要求} \begin{enumerate} \item 可以和其他同学讨论作业当中的问题，但应当自己独立完成作业 \item 计算、证明等要有过程，要有主要步骤的说明 \item 请将计算、绘图所用的 R 代码以及生成的结果和图像一并添加在作业文件当中 \item 请使用 \LaTeX 编辑并生成 PDF 格式的文件，第 X 周作业文件命名方式：学号-姓名-X.pdf \item 评分标准：每一问得分 $\in \left\{ 2 ,\, 1 ,\, 0 \right\}$ \begin{itemize} \item 2:~ 按时完成并上交作业，且答案基本正确 \item 1:~ 按时完成并上交作业，且答案部分正确 \item 0:~ 答案完全错误，或者迟交作业(规定时间72小时之后) \end{itemize} \item 请将完成的 PDF 格式的作业文件发送至邮箱：xiaolei@cup.edu.cn \item 每位同学可以有一次迟交作业的机会，但不得晚于规定时间三日之后 \item 第 10 周作业截止时间：2026年5月22日24:00 \end{enumerate} \tableofcontents % -------------------------------------------- 正文部分 -------------------------------------------- \mainmatter % -------------------------------------------- 第 10 周作业 -------------------------------------------- \chapter{第 10 周作业} {\kaishu \color{blue} 第 10 周作业截止时间：} 2026年5月22日24:00 {\kaishu \color{blue} 第 10 周作业完成时间：} \today \space \currenttime % 请勿编辑、删除本行！ \lstset{ language=R, basicstyle=\small\ttfamily, backgroundcolor=\color{mygray}, breaklines=true, frame=single, keywordstyle=\color{blue}, commentstyle=\color{olive}, showstringspaces=false, columns=fullflexible, keepspaces=true } \begin{enumerate} \item 数据文件 \codeinline{2018-Mean Expenditure of Urban Residents.csv} 包含了 2018 年中国 31 个省 (市) 的城镇居民人均生活费用，各变量的含义如下： Province 省市名称，Food 食品，Cloth 衣着， Residential 居住， Expenditure 生活用品与服务，Trans-Com (交通通讯), Education (教育娱乐), Healthcare (医疗保健), and Others (其它). 作上述变量的因子分析. \begin{enumerate} \item {\color{TealBlue} [2 分]} 读入数据，从相关矩阵出发作因子分析. {\color{red} \heiti 【解】} 读入数据后，取除 \codeinline{Province} 以外的 8 个支出变量作因子分析. 以下代码默认在数据文件所在目录运行；若在其它目录运行，将文件名替换为题目给出的绝对路径即可. 由于各变量量纲相同但数值水平差异较大，下面从相关矩阵出发作最大似然因子分析，并使用方差最大正交旋转. \begin{lstlisting} exp_file <- "2018_Mean Expenditure of Urban Residents.csv" exp_dat <- read.csv(exp_file, stringsAsFactors = FALSE) rownames(exp_dat) <- exp_dat$Province X1 <- exp_dat[, -1] R1 <- cor(X1) round(R1, 3) fa1 <- factanal(covmat = R1, factors = 2, n.obs = nrow(X1), rotation = "varimax") L1 <- unclass(loadings(fa1)) ord1 <- order(colSums(L1^2), decreasing = TRUE) L1 <- L1[, ord1] for (j in seq_len(ncol(L1))) { if (L1[which.max(abs(L1[, j])), j] < 0) L1[, j] <- -L1[, j] } colnames(L1) <- c("F1", "F2") scores1 <- as.matrix(scale(X1)) %*% solve(R1) %*% L1 colnames(scores1) <- c("F1", "F2") \end{lstlisting} 相关矩阵为： \begin{lstlisting}[language={}] Food Cloth Residential Expenditure Trans_Com Education Healthcare Others Food 1.000 0.580 0.834 0.460 0.850 0.820 0.582 0.865 Cloth 0.580 1.000 0.667 0.463 0.801 0.678 0.798 0.808 Residential 0.834 0.667 1.000 0.281 0.869 0.900 0.738 0.912 Expenditure 0.460 0.463 0.281 1.000 0.493 0.376 0.441 0.470 Trans_Com 0.850 0.801 0.869 0.493 1.000 0.861 0.776 0.914 Education 0.820 0.678 0.900 0.376 0.861 1.000 0.843 0.922 Healthcare 0.582 0.798 0.738 0.441 0.776 0.843 1.000 0.857 Others 0.865 0.808 0.912 0.470 0.914 0.922 0.857 1.000 \end{lstlisting} \item {\color{TealBlue} [2 分]} 确定公共因子数量并给出理由. {\color{red} \heiti 【解】} 先计算相关矩阵的特征根和累计贡献率： \begin{lstlisting} lambda1 <- eigen(R1)$values prop1 <- lambda1 / sum(lambda1) eig_tab1 <- data.frame(No = 1:length(lambda1), Eigenvalue = lambda1, Proportion = prop1, Cumulative = cumsum(prop1)) round(eig_tab1, 4) plot(lambda1, type = "b", pch = 19, xlab = "Component", ylab = "Eigenvalue", main = "Urban Residents: Scree Plot") abline(h = 1, lty = 2, col = "gray50") \end{lstlisting} 输出结果为： \begin{lstlisting}[language={}] No Eigenvalue Proportion Cumulative 1 1 6.0870 0.7609 0.7609 2 2 0.8250 0.1031 0.8640 3 3 0.5497 0.0687 0.9327 4 4 0.2711 0.0339 0.9666 5 5 0.0986 0.0123 0.9789 6 6 0.0858 0.0107 0.9897 7 7 0.0562 0.0070 0.9967 8 8 0.0265 0.0033 1.0000 \end{lstlisting} 第 1 个特征根解释了 $76.09\%$ 的信息，第 1、2 个特征根累计解释了 $86.40\%$ 的信息；从碎石图看，第 2 个特征根之后下降趋缓. 因此本文保留 2 个公共因子. 其中 Kaiser 准则只会保留 1 个公共因子，但为刻画第二类支出结构差异，并与后续公共因子平面和第 2 公共因子排序相一致，取公共因子数为 $m=2$. 运行上述代码即可得到城镇居民生活费用数据的碎石图. \begin{figure}[H] \centering \includegraphics[width=0.8\textwidth]{C:/Users/35297/Documents/Rplot.png} \caption{城镇居民生活费用数据的碎石图} \label{fig:kde} \end{figure} \item {\color{TealBlue} [2 分]} 给出因子旋转之后的因子载荷矩阵. {\color{red} \heiti 【解】} 旋转后的因子载荷矩阵如下，其中 $h^2$ 为共同度，$u^2$ 为特殊方差. \begin{lstlisting} load_tab1 <- data.frame(L1, h2 = rowSums(L1^2), u2 = 1 - rowSums(L1^2)) round(load_tab1, 3) colSums(L1^2) colSums(L1^2) / ncol(X1) \end{lstlisting} \begin{table}[H] \centering \caption{城镇居民生活费用数据旋转后的因子载荷矩阵.} \setlength{\extrarowheight}{1mm} \begin{tabular}{lrrrr} \hline 变量 & $F_1$ & $F_2$ & $h^2$ & $u^2$ \\ \hline Food & 0.902 & 0.302 & 0.904 & 0.096 \\ Cloth & 0.451 & 0.691 & 0.680 & 0.320 \\ Residential & 0.777 & 0.512 & 0.865 & 0.135 \\ Expenditure & 0.315 & 0.357 & 0.227 & 0.773 \\ Trans\_Com & 0.746 & 0.562 & 0.873 & 0.127 \\ Education & 0.678 & 0.656 & 0.890 & 0.110 \\ Healthcare & 0.330 & 0.941 & 0.995 & 0.005 \\ Others & 0.740 & 0.651 & 0.971 & 0.029 \\ \hline \end{tabular} \end{table} 两个因子的方差贡献分别为 $3.3910/8=42.39\%$ 和 $3.0145/8=37.68\%$，累计解释约 $80.07\%$ 的相关矩阵总变异. \item {\color{TealBlue} [2 分]} 作变量在公共因子平面上的散点图，对公共因子作出解释. {\color{red} \heiti 【解】} \begin{lstlisting} plot(L1[, 1], L1[, 2], pch = 19, xlab = "Factor 1", ylab = "Factor 2", main = "Urban Residents: Variable Loadings") abline(h = 0, v = 0, col = "gray70") text(L1[, 1], L1[, 2], labels = rownames(L1), pos = 4, cex = 0.8) \end{lstlisting} 从载荷看，$F_1$ 在 Food、Residential、Trans\_Com、Education、Others 上均有较高正载荷，反映城镇居民总体消费水平，尤其与食品、居住、交通通讯、教育娱乐及其它消费支出关系较强，可解释为“综合生活消费水平因子”. $F_2$ 在 Healthcare、Cloth、Education、Others 上载荷较高，反映医疗保健、衣着以及文教娱乐等改善型或服务型支出的相对水平，可解释为“医疗衣着与发展型消费因子”. \begin{figure}[H] \centering \includegraphics[width=0.8\textwidth]{C:/Users/35297/Documents/Rplot02.png} \caption{变量在第 1、第 2 公共因子平面上的散点图.} \label{fig:kde} \end{figure} \item {\color{TealBlue} [2 分]} 利用因子得分，作观测数据在公共因子平面上的散点图. {\color{red} \heiti 【解】} 利用回归法估计因子得分： \[ \widehat{\boldsymbol{F}} = \boldsymbol{Z} R^{-1} \widehat{\Lambda}, \] 其中 $\boldsymbol{Z}$ 为标准化后的观测矩阵，$R$ 为相关矩阵，$\widehat{\Lambda}$ 为旋转后的载荷矩阵. \begin{lstlisting} score_dat1 <- data.frame(Province = exp_dat$Province, scores1) plot(score_dat1$F1, score_dat1$F2, pch = 19, xlab = "Factor score 1", ylab = "Factor score 2", main = "Urban Residents: Factor Scores") abline(h = 0, v = 0, col = "gray70") text(score_dat1$F1, score_dat1$F2, labels = score_dat1$Province, pos = 4, cex = 0.65) \end{lstlisting} 运行上述代码即可得到 31 个省 (市) 在第 1、第 2 公共因子平面上的散点图. \begin{figure}[H] \centering \includegraphics[width=0.8\textwidth]{C:/Users/35297/Documents/Rplot03.png} \caption{31 个省 (市) 在第 1、第 2 公共因子平面上的散点图.} \label{fig:kde} \end{figure} \item {\color{TealBlue} [2 分]} 利用第 1 个公共因子的得分对我国 31 个省 (市) 进行排序并作简要分析. {\color{red} \heiti 【解】} \begin{lstlisting} rank_F1 <- score_dat1[order(-score_dat1$F1), c("Province", "F1")] rank_F1$Rank <- seq_len(nrow(rank_F1)) rank_F1 <- rank_F1[, c("Rank", "Province", "F1")] rank_F1$F1 <- round(rank_F1$F1, 3) rank_F1 \end{lstlisting} 排序结果如下： \begin{lstlisting}[language={}] Rank Province F1 1 Shanghai 3.019 2 Guangdong 1.820 3 Fujian 1.375 4 Zhejiang 1.337 5 Beijing 1.261 6 Tianjin 1.059 7 Hainan 0.460 8 Jiangsu 0.405 9 Xizang 0.388 10 Jiangxi 0.328 11 Anhui 0.185 12 Chongqing -0.056 13 Neimenggu -0.089 14 Liaoning -0.131 15 Sichuan -0.145 16 Shandong -0.293 17 Guizhoou -0.333 18 Hubei -0.404 19 Xinjiang -0.458 20 Hunan -0.506 21 Hebei -0.576 22 Yunnan -0.586 23 Guangxi -0.602 24 Ningxia -0.647 25 Qinghai -0.779 26 Jilin -0.824 27 Henan -0.947 28 Gansu -0.954 29 Shaanxi -0.979 30 Shanxi -1.026 31 Heilongjiang -1.302 \end{lstlisting} 第 1 公共因子主要反映总体生活消费水平. 上海、广东、福建、浙江、北京、天津得分较高，说明这些地区城镇居民在食品、居住、交通通讯、教育娱乐等方面的总体支出水平较高；山西、黑龙江、陕西、甘肃、河南等地得分偏低，说明综合消费水平相对较低. \item {\color{TealBlue} [2 分]} 利用第 2 个公共因子的得分对我国 31 个省 (市) 进行排序并作简要分析. {\color{red} \heiti 【解】} \begin{lstlisting} rank_F2 <- score_dat1[order(-score_dat1$F2), c("Province", "F2")] rank_F2$Rank <- seq_len(nrow(rank_F2)) rank_F2 <- rank_F2[, c("Rank", "Province", "F2")] rank_F2$F2 <- round(rank_F2$F2, 3) rank_F2 \end{lstlisting} 排序结果如下： \begin{lstlisting}[language={}] Rank Province F2 1 Beijing 2.430 2 Shanghai 1.456 3 Tianjin 1.388 4 Heilongjiang 1.377 5 Liaoning 1.036 6 Jilin 0.818 7 Qinghai 0.477 8 Hubei 0.465 9 Jiangsu 0.390 10 Shaanxi 0.374 11 Neimenggu 0.270 12 Ningxia 0.236 13 Shanxi 0.193 14 Zhejiang 0.148 15 Hunan 0.128 16 Gansu 0.041 17 Henan -0.016 18 Shandong -0.079 19 Xinjiang -0.080 20 Chongqing -0.115 21 Hebei -0.141 22 Sichuan -0.259 23 Guangxi -0.477 24 Yunnan -0.645 25 Anhui -0.989 26 Guangdong -1.016 27 Guizhoou -1.059 28 Hainan -1.083 29 Fujian -1.390 30 Jiangxi -1.435 31 Xizang -2.446 \end{lstlisting} 第 2 公共因子可解释为医疗衣着与发展型消费因子. 北京、上海、天津以及东北地区的黑龙江、辽宁、吉林得分较高，说明这些地区在医疗保健、衣着等方面相对支出较突出；西藏、江西、福建、海南、贵州等地区得分较低，说明该类支出在其消费结构中的相对水平较弱. \item {\color{TealBlue} [2 分]} 利用第 1、第 2 两个公共因子的得分对我国 31 个省 (市) 城镇居民人均生活费用进行综合排序，并作简要分析. {\color{red} \heiti 【解】} 以两个公共因子旋转后的方差贡献作为权数： \[ w_1 = \frac{3.3910}{3.3910+3.0145}=0.5294,\qquad w_2 = \frac{3.0145}{3.3910+3.0145}=0.4706. \] 综合得分为 \[ F = 0.5294F_1 + 0.4706F_2. \] \begin{lstlisting} ss1 <- colSums(L1^2) w1 <- ss1 / sum(ss1) score_dat1$Composite <- as.vector(as.matrix(score_dat1[, c("F1", "F2")]) %*% w1) rank_all1 <- score_dat1[order(-score_dat1$Composite), c("Province", "F1", "F2", "Composite")] rank_all1$Rank <- seq_len(nrow(rank_all1)) rank_all1 <- rank_all1[, c("Rank", "Province", "F1", "F2", "Composite")] rank_all1[, c("F1", "F2", "Composite")] <- round(rank_all1[, c("F1", "F2", "Composite")], 3) rank_all1 \end{lstlisting} 综合排序结果如下： \begin{lstlisting}[language={}] Rank Province F1 F2 Composite 1 Shanghai 3.019 1.456 2.283 2 Beijing 1.261 2.430 1.811 3 Tianjin 1.059 1.388 1.214 4 Zhejiang 1.337 0.148 0.777 5 Guangdong 1.820 -1.016 0.486 6 Liaoning -0.131 1.036 0.418 7 Jiangsu 0.405 0.390 0.398 8 Neimenggu -0.089 0.270 0.080 9 Fujian 1.375 -1.390 0.074 10 Hubei -0.404 0.465 0.005 11 Heilongjiang -1.302 1.377 -0.041 12 Jilin -0.824 0.818 -0.051 13 Chongqing -0.056 -0.115 -0.084 14 Qinghai -0.779 0.477 -0.188 15 Shandong -0.293 -0.079 -0.193 16 Sichuan -0.145 -0.259 -0.199 17 Hunan -0.506 0.128 -0.208 18 Ningxia -0.647 0.236 -0.231 19 Hainan 0.460 -1.083 -0.266 20 Xinjiang -0.458 -0.080 -0.280 21 Shaanxi -0.979 0.374 -0.342 22 Anhui 0.185 -0.989 -0.367 23 Hebei -0.576 -0.141 -0.371 24 Shanxi -1.026 0.193 -0.452 25 Gansu -0.954 0.041 -0.486 26 Jiangxi 0.328 -1.435 -0.502 27 Henan -0.947 -0.016 -0.509 28 Guangxi -0.602 -0.477 -0.543 29 Yunnan -0.586 -0.645 -0.614 30 Guizhoou -0.333 -1.059 -0.674 31 Xizang 0.388 -2.446 -0.945 \end{lstlisting} 综合排序中上海、北京、天津位居前三，说明直辖市城镇居民人均生活费用整体较高；浙江、广东、江苏等东部沿海省份也处于前列. 西藏、贵州、云南、广西、河南等地区综合得分较低，说明总体消费水平和发展型消费水平相对偏低. 个别地区如广东第 1 因子得分很高但第 2 因子得分偏低，因此综合名次低于北京、天津；辽宁第 1 因子不高但第 2 因子较高，综合名次有所上升. \end{enumerate} \item 有 48 人申请到某公司就业. 该公司对申请者的 15 项指标进行打分，这 15 项指标分别是： FL (求职信的形式)，APP (外貌)，AA (专业能力)，LA (讨人喜欢程度)，SC (自信心)，LC (洞察力)，HON (诚实度)， SMS (推销能力)，EXP (经验)，DRV (驾驶水平)，AMB (事业心)，GSP (理解能力)，POT (潜在能力)， KJ (社交能力)，SUIT (适应能力). 结果见数据文件 \codeinline{Applicants.csv}. \begin{enumerate} \item {\color{TealBlue} [2 分]} 读入数据，从相关矩阵出发作因子分析. {\color{red} \heiti 【解】} 读入 48 名申请者的 15 项指标评分，以 15 个评分变量的相关矩阵作为因子分析的出发点. 以下代码默认在数据文件所在目录运行；若在其它目录运行，将文件名替换为题目给出的绝对路径即可. 数据文件中 ID=2 的 AA 取值为 56，下面按原始数据记录直接参与计算. \begin{lstlisting} app_file <- "Applicants.csv" app_dat <- read.csv(app_file, stringsAsFactors = FALSE) rownames(app_dat) <- app_dat$ID X2 <- app_dat[, -1] R2 <- cor(X2) round(R2, 3) fa2 <- factanal(covmat = R2, factors = 3, n.obs = nrow(X2), rotation = "varimax") L2 <- unclass(loadings(fa2)) ord2 <- order(colSums(L2^2), decreasing = TRUE) L2 <- L2[, ord2] for (j in seq_len(ncol(L2))) { if (L2[which.max(abs(L2[, j])), j] < 0) L2[, j] <- -L2[, j] } colnames(L2) <- c("F1", "F2", "F3") scores2 <- as.matrix(scale(X2)) %*% solve(R2) %*% L2 colnames(scores2) <- c("F1", "F2", "F3") \end{lstlisting} 数据维数为 $48 \times 15$，后续最大似然因子分析、因子旋转和因子得分均基于相关矩阵 $R_2$ 完成. \item {\color{TealBlue} [2 分]} 确定公共因子数量并给出理由. {\color{red} \heiti 【解】} 计算相关矩阵 $R_2$ 的特征根： \begin{lstlisting} lambda2 <- eigen(R2)$values prop2 <- lambda2 / sum(lambda2) eig_tab2 <- data.frame(No = 1:length(lambda2), Eigenvalue = lambda2, Proportion = prop2, Cumulative = cumsum(prop2)) round(eig_tab2, 4) plot(lambda2, type = "b", pch = 19, xlab = "Component", ylab = "Eigenvalue", main = "Applicants: Scree Plot") abline(h = 1, lty = 2, col = "gray50") \end{lstlisting} 输出结果为： \begin{lstlisting}[language={}] No Eigenvalue Proportion Cumulative 1 1 7.5628 0.5042 0.5042 2 2 1.9923 0.1328 0.6370 3 3 1.3939 0.0929 0.7299 4 4 0.9721 0.0648 0.7947 5 5 0.7203 0.0480 0.8428 6 6 0.5860 0.0391 0.8818 7 7 0.4209 0.0281 0.9099 8 8 0.3445 0.0230 0.9329 9 9 0.2900 0.0193 0.9522 10 10 0.2394 0.0160 0.9681 11 11 0.1665 0.0111 0.9792 12 12 0.1128 0.0075 0.9868 13 13 0.0943 0.0063 0.9931 14 14 0.0670 0.0045 0.9975 15 15 0.0372 0.0025 1.0000 \end{lstlisting} 前三个特征根均大于 1，累计贡献率为 $72.99\%$；从碎石图看，第 3 个特征根之后曲线明显趋缓，第 4 个特征根已小于 1. 因此取公共因子数 $m=3$. 运行上述代码即可得到申请者评分数据的碎石图. \begin{figure}[H] \centering \includegraphics[width=0.8\textwidth]{C:/Users/35297/Documents/Rplot04.png} \caption{申请者评分数据的碎石图.} \label{fig:kde} \end{figure} \item {\color{TealBlue} [2 分]} 给出因子旋转之后的因子载荷矩阵. {\color{red} \heiti 【解】} \begin{lstlisting} load_tab2 <- data.frame(L2, h2 = rowSums(L2^2), u2 = 1 - rowSums(L2^2)) round(load_tab2, 3) colSums(L2^2) colSums(L2^2) / ncol(X2) \end{lstlisting} 旋转后的因子载荷矩阵如下： \begin{table}[H] \centering \caption{申请者评分数据旋转后的因子载荷矩阵.} \setlength{\extrarowheight}{1mm} \begin{tabular}{lrrrrr} \hline 变量 & $F_1$ & $F_2$ & $F_3$ & $h^2$ & $u^2$ \\ \hline FL & 0.070 & 0.586 & 0.120 & 0.362 & 0.638 \\ APP & 0.468 & 0.285 & 0.279 & 0.377 & 0.623 \\ AA & 0.177 & 0.164 & 0.031 & 0.059 & 0.941 \\ LA & 0.175 & 0.224 & 0.956 & 0.995 & 0.005 \\ SC & 0.915 & -0.101 & 0.172 & 0.877 & 0.123 \\ LC & 0.828 & 0.114 & 0.326 & 0.806 & 0.194 \\ HON & 0.241 & -0.182 & 0.674 & 0.545 & 0.455 \\ SMS & 0.874 & 0.264 & 0.156 & 0.858 & 0.142 \\ EXP & 0.095 & 0.782 & -0.053 & 0.623 & 0.377 \\ DRV & 0.765 & 0.380 & 0.183 & 0.763 & 0.237 \\ AMB & 0.890 & 0.159 & 0.162 & 0.843 & 0.157 \\ GSP & 0.790 & 0.276 & 0.318 & 0.801 & 0.199 \\ POT & 0.717 & 0.359 & 0.418 & 0.818 & 0.182 \\ KJ & 0.428 & 0.253 & 0.578 & 0.581 & 0.419 \\ SUIT & 0.350 & 0.845 & 0.080 & 0.842 & 0.158 \\ \hline \end{tabular} \end{table} 三个因子的方差贡献分别为 $36.41\%$、$15.94\%$、$15.33\%$，累计贡献约为 $67.67\%$. \item {\color{TealBlue} [2 分]} 作变量在公共因子平面上的散点图，对公共因子作出解释. {\color{red} \heiti 【解】} \begin{lstlisting} plot(L2[, 1], L2[, 2], pch = 19, xlab = "Factor 1", ylab = "Factor 2", main = "Applicants: Variable Loadings") abline(h = 0, v = 0, col = "gray70") text(L2[, 1], L2[, 2], labels = rownames(L2), pos = 4, cex = 0.8) \end{lstlisting} 由载荷矩阵可知，$F_1$ 在 SC、LC、SMS、DRV、AMB、GSP、POT 上载荷较高，主要反映自信心、洞察力、推销能力、驾驶水平、事业心、理解能力和潜在能力，可解释为“综合职业能力与进取性因子”. $F_2$ 在 SUIT、EXP、FL 上载荷较高，同时 DRV、POT 也有一定正载荷，可解释为“经验与适应表达因子”. $F_3$ 在 LA、HON、KJ 上载荷较高，可解释为“人际评价与品格因子”. 公共因子平面图展示的是 $F_1$ 与 $F_2$，其中 SC、SMS、AMB、LC、GSP 等变量集中在 $F_1$ 高载荷方向，SUIT、EXP、FL 集中在 $F_2$ 高载荷方向. \begin{figure}[H] \centering \includegraphics[width=0.8\textwidth]{C:/Users/35297/Documents/Rplot05.png} \caption{申请者评分变量在第 1、第 2 公共因子平面上的散点图.} \label{fig:kde} \end{figure} \item {\color{TealBlue} [2 分]} 该公司准备录用其中 6 人，利用公共因子得分对该公司的录用结果给出建议. {\color{red} \heiti 【解】} 以三个公共因子旋转后的方差贡献作为权数： \[ w_1=0.5380,\qquad w_2=0.2355,\qquad w_3=0.2265. \] 综合得分为 \[ F = 0.5380F_1+0.2355F_2+0.2265F_3. \] \begin{lstlisting} score_dat2 <- data.frame(ID = app_dat$ID, scores2) ss2 <- colSums(L2^2) w2 <- ss2 / sum(ss2) score_dat2$Composite <- as.vector(as.matrix(score_dat2[, c("F1", "F2", "F3")]) %*% w2) rank_app <- score_dat2[order(-score_dat2$Composite), c("ID", "F1", "F2", "F3", "Composite")] rank_app$Rank <- seq_len(nrow(rank_app)) rank_app <- rank_app[, c("Rank", "ID", "F1", "F2", "F3", "Composite")] round(head(rank_app, 12), 3) plot(score_dat2$F1, score_dat2$F2, pch = 19, xlab = "Factor score 1", ylab = "Factor score 2", main = "Applicants: Factor Scores") abline(h = 0, v = 0, col = "gray70") text(score_dat2$F1, score_dat2$F2, labels = score_dat2$ID, pos = 4, cex = 0.65) \end{lstlisting} 综合得分前 12 名如下： \begin{lstlisting}[language={}] Rank ID F1 F2 F3 Composite 1 40 0.919 1.226 0.975 1.004 2 39 0.782 1.259 0.995 0.942 3 2 1.076 0.755 0.312 0.827 4 8 0.874 1.189 0.251 0.807 5 23 1.023 0.242 0.821 0.793 6 22 1.079 0.280 0.435 0.745 7 24 0.633 0.375 1.231 0.708 8 7 0.615 1.298 0.271 0.698 9 10 1.955 0.247 -1.945 0.670 10 9 0.352 1.176 0.350 0.546 11 16 0.545 0.985 -0.016 0.522 12 3 0.867 0.499 -0.324 0.510 \end{lstlisting} 运行上述代码即可得到 48 名申请者在第 1、第 2 公共因子平面上的散点图. \begin{figure}[H] \centering \includegraphics[width=0.8\textwidth]{C:/Users/35297/Documents/Rplot06.png} \caption{48 名申请者在第 1、第 2 公共因子平面上的散点图} \label{fig:kde} \end{figure} 因此建议录用综合得分排名前 6 的申请者： \[ \boxed{40,\ 39,\ 2,\ 8,\ 23,\ 22}. \] 其中 40 号和 39 号在三个因子上表现都较好，综合优势最明显；2 号、8 号、23 号、22 号在综合职业能力与进取性因子上得分较高，也具有较好的录用价值. 24 号、7 号可作为候补人选. 需要注意的是，10 号虽然 $F_1$ 得分很高，但 $F_3$ 得分较低，说明其职业能力指标突出而人际评价与品格类指标相对不足，综合排序未进入前 6. \end{enumerate} \end{enumerate} \end{document}