##读取数据，求财务指标间的相关系数矩阵
case7.1<-read.csv("C:\\Users\\86167\\Desktop\\课堂练习07_case7.1.csv")
data<-case7.1[, -1]
name<-case7.1[,1]
da<-scale(data)
dat<-cor(da)
print(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##由上面的相关系数矩阵可知，财务指标之间存在较强的线性相关关系 ##主成分法
library(psych)
fac <- principal(da,3)
print(fac)## Principal Components Analysis
## Call: principal(r = da, nfactors = 3)
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC3 RC2 h2 u2 com
## x1 -0.15 0.26 0.76 0.67 0.333 1.3
## x2 0.13 0.07 0.94 0.91 0.090 1.1
## x3 0.08 0.02 0.95 0.90 0.097 1.0
## x4 0.88 0.22 0.16 0.85 0.155 1.2
## x5 0.85 0.21 -0.32 0.86 0.142 1.4
## x6 0.89 0.35 -0.12 0.93 0.070 1.3
## x7 0.91 0.30 0.10 0.93 0.075 1.2
## x8 0.79 0.34 0.42 0.92 0.081 1.9
## x9 0.40 0.89 0.12 0.97 0.029 1.4
## x10 0.43 0.87 0.12 0.96 0.043 1.5
## x11 0.31 0.87 0.23 0.90 0.099 1.4
## x12 0.15 0.92 0.04 0.87 0.133 1.1
##
## RC1 RC3 RC2
## SS loadings 4.25 3.64 2.77
## Proportion Var 0.35 0.30 0.23
## Cumulative Var 0.35 0.66 0.89
## Proportion Explained 0.40 0.34 0.26
## Cumulative Proportion 0.40 0.74 1.00
##
## Mean item complexity = 1.3
## 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##主因子法
library(psych)
# 使用主成分法进行因子分析（不旋转）
pc_fa <- principal(da, nfactors = 3, rotate = "none", method = "pc")
print(pc_fa)## Principal Components Analysis
## Call: principal(r = da, nfactors = 3, rotate = "none", method = "pc")
## 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# 使用主成分法进行因子分析并进行方差最大化旋转
pc_fa_rotated <- principal(da, nfactors = 3, rotate = "varimax", method = "pc")
print(pc_fa_rotated)## Principal Components Analysis
## Call: principal(r = da, nfactors = 3, rotate = "varimax", method = "pc")
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC3 RC2 h2 u2 com
## x1 -0.15 0.26 0.76 0.67 0.333 1.3
## x2 0.13 0.07 0.94 0.91 0.090 1.1
## x3 0.08 0.02 0.95 0.90 0.097 1.0
## x4 0.88 0.22 0.16 0.85 0.155 1.2
## x5 0.85 0.21 -0.32 0.86 0.142 1.4
## x6 0.89 0.35 -0.12 0.93 0.070 1.3
## x7 0.91 0.30 0.10 0.93 0.075 1.2
## x8 0.79 0.34 0.42 0.92 0.081 1.9
## x9 0.40 0.89 0.12 0.97 0.029 1.4
## x10 0.43 0.87 0.12 0.96 0.043 1.5
## x11 0.31 0.87 0.23 0.90 0.099 1.4
## x12 0.15 0.92 0.04 0.87 0.133 1.1
##
## RC1 RC3 RC2
## SS loadings 4.25 3.64 2.77
## Proportion Var 0.35 0.30 0.23
## Cumulative Var 0.35 0.66 0.89
## Proportion Explained 0.40 0.34 0.26
## Cumulative Proportion 0.40 0.74 1.00
##
## Mean item complexity = 1.3
## 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(da,factors=3,rotation="none")##
## Call:
## factanal(x = da, 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-07factanal(da,factors=3,rotation= "varimax")##
## Call:
## factanal(x = da, factors = 3, rotation = "varimax")
##
## 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.111 0.235 0.628
## x2 0.114 0.949
## x3 0.957
## x4 0.862 0.196 0.150
## x5 0.812 0.221 -0.281
## x6 0.892 0.336 -0.122
## x7 0.901 0.317 0.105
## x8 0.771 0.363 0.412
## x9 0.389 0.911 0.119
## x10 0.424 0.884 0.118
## x11 0.312 0.847 0.233
## x12 0.161 0.851
##
## Factor1 Factor2 Factor3
## SS loadings 4.090 3.549 2.594
## Proportion Var 0.341 0.296 0.216
## Cumulative Var 0.341 0.637 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)
fac<-principal(da,3)
print(fac)## Principal Components Analysis
## Call: principal(r = da, nfactors = 3)
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC3 RC2 h2 u2 com
## x1 -0.15 0.26 0.76 0.67 0.333 1.3
## x2 0.13 0.07 0.94 0.91 0.090 1.1
## x3 0.08 0.02 0.95 0.90 0.097 1.0
## x4 0.88 0.22 0.16 0.85 0.155 1.2
## x5 0.85 0.21 -0.32 0.86 0.142 1.4
## x6 0.89 0.35 -0.12 0.93 0.070 1.3
## x7 0.91 0.30 0.10 0.93 0.075 1.2
## x8 0.79 0.34 0.42 0.92 0.081 1.9
## x9 0.40 0.89 0.12 0.97 0.029 1.4
## x10 0.43 0.87 0.12 0.96 0.043 1.5
## x11 0.31 0.87 0.23 0.90 0.099 1.4
## x12 0.15 0.92 0.04 0.87 0.133 1.1
##
## RC1 RC3 RC2
## SS loadings 4.25 3.64 2.77
## Proportion Var 0.35 0.30 0.23
## Cumulative Var 0.35 0.66 0.89
## Proportion Explained 0.40 0.34 0.26
## Cumulative Proportion 0.40 0.74 1.00
##
## Mean item complexity = 1.3
## 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# 使用主成分法进行因子分析并进行方差最大化旋转
fac1<-principal(da,3,rotate="varimax")
print(fac1)## Principal Components Analysis
## Call: principal(r = da, nfactors = 3, rotate = "varimax")
## Standardized loadings (pattern matrix) based upon correlation matrix
## RC1 RC3 RC2 h2 u2 com
## x1 -0.15 0.26 0.76 0.67 0.333 1.3
## x2 0.13 0.07 0.94 0.91 0.090 1.1
## x3 0.08 0.02 0.95 0.90 0.097 1.0
## x4 0.88 0.22 0.16 0.85 0.155 1.2
## x5 0.85 0.21 -0.32 0.86 0.142 1.4
## x6 0.89 0.35 -0.12 0.93 0.070 1.3
## x7 0.91 0.30 0.10 0.93 0.075 1.2
## x8 0.79 0.34 0.42 0.92 0.081 1.9
## x9 0.40 0.89 0.12 0.97 0.029 1.4
## x10 0.43 0.87 0.12 0.96 0.043 1.5
## x11 0.31 0.87 0.23 0.90 0.099 1.4
## x12 0.15 0.92 0.04 0.87 0.133 1.1
##
## RC1 RC3 RC2
## SS loadings 4.25 3.64 2.77
## Proportion Var 0.35 0.30 0.23
## Cumulative Var 0.35 0.66 0.89
## Proportion Explained 0.40 0.34 0.26
## Cumulative Proportion 0.40 0.74 1.00
##
## Mean item complexity = 1.3
## 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##营业利润率、毛利率、成本费用利润率、总资产报酬率、净资产收益率-加权(扣除非经常性损益) 在因子 上的载荷分别是0.88、0.85、0.89、0.91、0.79，这五个财务指标都是反映企业盈利能力的，因此我f1命名为企业盈利能力因子；每股收益、扣除非经常性损益每股收益、每股未分配利润、每股净资产在因子上的载荷分别是0.89、0.87、0.87、0.92，这四个财务指标都是反映股东回报的，因此我们将f2命名为股东回报因子；存货周转率、总资产周转率、流动资产周转率在因子上的载荷分别是0.76、0.94、0.95，这三个财务指标都是反映企业运营能力的，因此我们将f3命名为企业运营能力因子． ##绘制前两个因子载荷、得分及信息重叠图
plot(fac1$loadings,type="n",xlab="Factor1",ylab="Factor2") #输出因子载荷图
text(fac1$loadings,paste("x",1:12,sep=""),cex=1.5)
fac1_plotdata<-fac1$scores
rownames(fac1_plotdata)<-unlist(name)
fac1_plotdata <- fac1$scores
rownames(fac1_plotdata) <- unlist(name)
plot(fac1_plotdata[, 1], fac1_plotdata[, 2], type = "n", xlab = "Factor1", ylab = "Factor2")
text(fac1_plotdata[, 1], fac1_plotdata[, 2], labels = rownames(fac1_plotdata), cex = 1.5)
biplot(fac1_plotdata,fac1$loadings) #输出信息重叠图
##由因子得分图可知，新坐标的盈利能力和兆丰股份、苏威孚Ｂ、华域汽车的股东回报大大领先于其他企业．