作业7
2024-12-24
数据处理
setwd("D:/桌面/多元统计分析数据data") # 设定工作路径
case7.1 <- read.csv("case7.1.csv", header = TRUE) #case7.1.xls中的数据读入到R中
data<-case7.1[,-1]
name<-case7.1[,1]
da<-scale(data)
dat<-cor(da)
dat## x1 x2 x3 x4 x5 x6
## x1 1.00000000 0.608661931 0.58947060 0.09053822 -0.2843693 -0.069306629
## x2 0.60866193 1.000000000 0.92147919 0.24088930 -0.1316852 0.007508128
## x3 0.58947060 0.921479190 1.00000000 0.21192221 -0.2129252 -0.039329247
## x4 0.09053822 0.240889296 0.21192221 1.00000000 0.6776357 0.855226472
## x5 -0.28436926 -0.131685164 -0.21292519 0.67763574 1.0000000 0.851567015
## x6 -0.06930663 0.007508128 -0.03932925 0.85522647 0.8515670 1.000000000
## x7 0.01364721 0.236915648 0.15475471 0.82195700 0.7697468 0.896056873
## x8 0.26189269 0.506892663 0.44369218 0.82052037 0.5694569 0.732129001
## x9 0.24549351 0.238633994 0.15593649 0.52917899 0.4828813 0.637953909
## x10 0.23735981 0.244965246 0.15212406 0.55578193 0.5226647 0.660032176
## x11 0.29673784 0.305663291 0.27768545 0.51170635 0.3286049 0.539324412
## x12 0.20859956 0.149535772 0.12208860 0.38518366 0.3278747 0.455056527
## x7 x8 x9 x10 x11 x12
## x1 0.01364721 0.2618927 0.2454935 0.2373598 0.2967378 0.2085996
## x2 0.23691565 0.5068927 0.2386340 0.2449652 0.3056633 0.1495358
## x3 0.15475471 0.4436922 0.1559365 0.1521241 0.2776855 0.1220886
## x4 0.82195700 0.8205204 0.5291790 0.5557819 0.5117063 0.3851837
## x5 0.76974677 0.5694569 0.4828813 0.5226647 0.3286049 0.3278747
## x6 0.89605687 0.7321290 0.6379539 0.6600322 0.5393244 0.4550565
## x7 1.00000000 0.8738672 0.6546178 0.6649649 0.5690159 0.3808832
## x8 0.87386720 1.0000000 0.6796509 0.7062190 0.6517245 0.4093588
## x9 0.65461779 0.6796509 1.0000000 0.9847536 0.9230638 0.8459829
## x10 0.66496486 0.7062190 0.9847536 1.0000000 0.8954067 0.8291282
## x11 0.56901593 0.6517245 0.9230638 0.8954067 1.0000000 0.8004992
## x12 0.38088318 0.4093588 0.8459829 0.8291282 0.8004992 1.0000000主成分法
options(repos = c(CRAN = "https://cloud.r-project.org/"))
install.packages("psych")## 将程序包安装入'C:/Users/33880/AppData/Local/R/win-library/4.4'
## (因为'lib'没有被指定)## 程序包'psych'打开成功，MD5和检查也通过
##
## 下载的二进制程序包在
## C:\Users\33880\AppData\Local\Temp\RtmpqKm3hb\downloaded_packages里library(psych)
fa_result <- fa(data, nfactors = 3, rotate = "varimax") ## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.fa_result## Factor Analysis using method = minres
## Call: fa(r = data, nfactors = 3, rotate = "varimax")
## Standardized loadings (pattern matrix) based upon correlation matrix
## MR1 MR3 MR2 h2 u2 com
## x1 -0.11 0.23 0.64 0.47 0.5260 1.3
## x2 0.12 0.08 0.94 0.91 0.0877 1.0
## x3 0.06 0.03 0.94 0.90 0.1044 1.0
## x4 0.84 0.24 0.16 0.78 0.2163 1.2
## x5 0.82 0.21 -0.30 0.80 0.1978 1.4
## x6 0.90 0.34 -0.12 0.94 0.0639 1.3
## x7 0.91 0.30 0.10 0.92 0.0809 1.2
## x8 0.78 0.35 0.42 0.90 0.0965 2.0
## x9 0.39 0.91 0.12 1.00 0.0024 1.4
## x10 0.43 0.88 0.12 0.97 0.0317 1.5
## x11 0.31 0.85 0.24 0.87 0.1280 1.4
## x12 0.17 0.85 0.06 0.76 0.2439 1.1
##
## MR1 MR3 MR2
## SS loadings 4.09 3.53 2.60
## Proportion Var 0.34 0.29 0.22
## Cumulative Var 0.34 0.64 0.85
## Proportion Explained 0.40 0.35 0.25
## Cumulative Proportion 0.40 0.75 1.00
##
## Mean item complexity = 1.3
## Test of the hypothesis that 3 factors are sufficient.
##
## df null model = 66 with the objective function = 18.65 with Chi Square = 1010.1
## df of the model are 33 and the objective function was 1.81
##
## The root mean square of the residuals (RMSR) is 0.02
## The df corrected root mean square of the residuals is 0.03
##
## The harmonic n.obs is 60 with the empirical chi square 3.04 with prob < 1
## The total n.obs was 60 with Likelihood Chi Square = 94.52 with prob < 7.6e-08
##
## Tucker Lewis Index of factoring reliability = 0.864
## RMSEA index = 0.175 and the 90 % confidence intervals are 0.136 0.22
## BIC = -40.59
## Fit based upon off diagonal values = 1主因子法
library(psych)
fa_result <- principal(data, nfactors = 3, rotate = "none")
fa_result## Principal Components Analysis
## Call: principal(r = data, nfactors = 3, rotate = "none")
## Standardized loadings (pattern matrix) based upon correlation matrix
## PC1 PC2 PC3 h2 u2 com
## x1 0.24 0.78 -0.07 0.67 0.333 1.2
## x2 0.36 0.83 0.29 0.91 0.090 1.6
## x3 0.29 0.85 0.30 0.90 0.097 1.5
## x4 0.81 -0.15 0.40 0.85 0.155 1.5
## x5 0.67 -0.59 0.25 0.86 0.142 2.3
## x6 0.84 -0.41 0.23 0.93 0.070 1.6
## x7 0.87 -0.22 0.34 0.93 0.075 1.4
## x8 0.89 0.13 0.33 0.92 0.081 1.3
## x9 0.90 0.03 -0.41 0.97 0.029 1.4
## x10 0.91 0.01 -0.37 0.96 0.043 1.3
## x11 0.84 0.16 -0.40 0.90 0.099 1.5
## x12 0.72 0.05 -0.59 0.87 0.133 1.9
##
## PC1 PC2 PC3
## SS loadings 6.50 2.65 1.50
## Proportion Var 0.54 0.22 0.12
## Cumulative Var 0.54 0.76 0.89
## Proportion Explained 0.61 0.25 0.14
## Cumulative Proportion 0.61 0.86 1.00
##
## Mean item complexity = 1.6
## Test of the hypothesis that 3 components are sufficient.
##
## The root mean square of the residuals (RMSR) is 0.03
## with the empirical chi square 9.42 with prob < 1
##
## Fit based upon off diagonal values = 1极大似然估计法
factanal(data,factors=3,rotation="none")##
## Call:
## factanal(x = data, factors = 3, rotation = "none")
##
## Uniquenesses:
## x1 x2 x3 x4 x5 x6 x7 x8 x9 x10 x11 x12
## 0.538 0.079 0.080 0.196 0.213 0.077 0.077 0.103 0.005 0.025 0.131 0.245
##
## Loadings:
## Factor1 Factor2 Factor3
## x1 0.244 0.587 -0.241
## x2 0.267 0.922
## x3 0.183 0.941
## x4 0.591 0.103 0.667
## x5 0.528 -0.326 0.634
## x6 0.688 -0.188 0.644
## x7 0.708 0.648
## x8 0.733 0.338 0.495
## x9 0.994
## x10 0.987
## x11 0.919 -0.124
## x12 0.829 -0.251
##
## Factor1 Factor2 Factor3
## SS loadings 5.799 2.364 2.071
## Proportion Var 0.483 0.197 0.173
## Cumulative Var 0.483 0.680 0.853
##
## Test of the hypothesis that 3 factors are sufficient.
## The chi square statistic is 91.48 on 33 degrees of freedom.
## The p-value is 2.12e-07利用主成分法进行因子分析
library(psych)
fa_result <- fa(data, nfactors = 3, rotate = "varimax") ## Warning in fa.stats(r = r, f = f, phi = phi, n.obs = n.obs, np.obs = np.obs, :
## The estimated weights for the factor scores are probably incorrect. Try a
## different factor score estimation method.# 绘制因子载荷图
plot(fa_result$loadings[,1:2], type="n", xlab="Factor1", ylab="Factor2")
text(fa_result$loadings[,1:2], paste("x", 1:nrow(fa_result$loadings), sep=""), cex=1.5)
# 获取因子得分
fac_scores <- fa_result$scores
rank(fac_scores)## [1] 39.0 157.0 141.0 146.0 3.0 128.0 34.0 125.5 156.0 54.0 137.0 152.0
## [13] 135.0 105.0 45.0 178.0 14.0 90.0 37.0 158.0 29.0 119.0 27.0 115.0
## [25] 99.0 75.0 120.0 19.0 28.0 118.0 73.0 77.0 116.0 150.0 102.0 154.0
## [37] 168.0 2.0 53.0 94.0 114.0 134.0 109.0 79.0 169.0 103.0 30.0 1.0
## [49] 172.0 170.0 40.0 155.0 67.0 10.0 125.5 145.0 86.0 108.0 97.0 23.0
## [61] 48.0 106.0 78.0 15.0 127.0 43.0 175.0 87.5 66.0 52.0 38.0 117.0
## [73] 35.0 58.0 131.0 153.0 17.0 33.0 44.0 18.0 165.0 56.0 60.0 139.0
## [85] 110.0 159.0 122.0 113.0 51.0 91.0 61.0 50.0 107.0 12.0 132.0 72.0
## [97] 9.0 71.0 93.0 89.0 164.0 95.0 179.0 98.0 180.0 76.0 96.0 112.0
## [109] 20.0 136.0 46.0 83.0 41.0 177.0 87.5 68.0 26.0 80.0 101.0 55.0
## [121] 124.0 25.0 130.0 162.0 13.0 69.0 47.0 148.5 21.0 65.0 70.0 92.0
## [133] 59.0 32.0 167.0 8.0 22.0 140.0 138.0 7.0 133.0 11.0 63.0 42.0
## [145] 176.0 163.0 81.0 142.0 104.0 100.0 31.0 174.0 82.0 121.0 161.0 85.0
## [157] 144.0 4.0 166.0 171.0 123.0 143.0 24.0 129.0 6.0 16.0 147.0 5.0
## [169] 49.0 151.0 74.0 62.0 84.0 173.0 148.5 57.0 111.0 36.0 160.0 64.0# 假设原始数据的行名是data的行名
rownames(fac_scores) <- rownames(data)
plot(fac_scores[,1], fac_scores[,2], xlab="Factor1", ylab="Factor2")
text(fac_scores[,1], fac_scores[,2], labels=rownames(fac_scores), cex=1.5)
# 绘制双标图
biplot(fac_scores, fa_result$loadings[,1:2])
##：从盈利能力来看，排在前面的分别是新坐标、浙江仙通、岱美股份、继峰股份；从股东回报来看，排在前面的分别是兆丰股份、苏威孚Ｂ、华域汽车、越博动力；从运营能力来看,排在前面的分别是亚普股份、东风科技、华域汽车、众泰汽车．