主成分分析
setwd("D:\\Rdownload\\lianxi\\sixth") #设定工作路径
ex6.5<-read.csv("ex6.5.csv",header=T) #读入数据
d6.5=ex6.5[,-1] #去掉第一列，只保留数值计算样本相关系数矩阵
rownames(d6.5)=ex6.5[,1] #对d6.5的行用中文行业名称重新命名
R=round(cor(d6.5),3) ; R #求样本相关系数矩阵，保留三位小数 ## x1 x2 x3 x4 x5 x6 x7 x8 x9
## x1 1.000 -0.327 -0.714 -0.336 0.309 0.408 0.790 0.156 0.744
## x2 -0.327 1.000 -0.035 0.644 0.420 0.255 0.009 -0.078 0.094
## x3 -0.714 -0.035 1.000 0.070 -0.740 -0.755 -0.930 -0.109 -0.924
## x4 -0.336 0.644 0.070 1.000 0.383 0.069 -0.046 -0.031 0.073
## x5 0.309 0.420 -0.740 0.383 1.000 0.734 0.672 0.098 0.747
## x6 0.408 0.255 -0.755 0.069 0.734 1.000 0.658 0.222 0.707
## x7 0.790 0.009 -0.930 -0.046 0.672 0.658 1.000 -0.030 0.890
## x8 0.156 -0.078 -0.109 -0.031 0.098 0.222 -0.030 1.000 0.290
## x9 0.744 0.094 -0.924 0.073 0.747 0.707 0.890 0.290 1.000PCAd6.5=princomp(d6.5,cor=T) #用样本相关系数矩阵做主成分分析
summary(PCAd6.5,loadings=T) #列出主成分分析结果## Importance of components:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5
## Standard deviation 2.158962 1.4455076 1.0212708 0.71233588 0.5614001
## Proportion of Variance 0.517902 0.2321658 0.1158882 0.05638027 0.0350189
## Cumulative Proportion 0.517902 0.7500678 0.8659561 0.92233634 0.9573552
## Comp.6 Comp.7 Comp.8 Comp.9
## Standard deviation 0.43887788 0.33821497 0.212900230 0.177406876
## Proportion of Variance 0.02140153 0.01270993 0.005036279 0.003497022
## Cumulative Proportion 0.97875677 0.99146670 0.996502978 1.000000000
##
## Loadings:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8 Comp.9
## x1 0.342 0.368 0.375 0.355 0.312 0.559 0.113 0.233
## x2 -0.614 -0.155 0.761 -0.110
## x3 -0.446 0.206 0.467 -0.203 -0.692
## x4 -0.601 0.598 -0.310 0.395 0.139
## x5 0.376 -0.307 -0.396 -0.508 0.580
## x6 0.379 -0.124 -0.122 -0.620 -0.154 0.638
## x7 0.432 0.246 0.148 -0.241 -0.777 -0.235
## x8 -0.950 -0.231
## x9 0.446 0.224 -0.136 -0.246 0.532 -0.613##前三个主成分累积方差贡献率为86.59%，取三个主成分（前两个为75.00%）
##z1= 0.342x1 + 0x2 - 0.446x3 + 0x4 + 0.376x5 + 0.379x6 + 0.432x7 + 0x8 + 0.446x9
##z2= 0.368x1 - 0.614x2 + 0x3 - 0.601x4 - 0.307x5 - 0.124x6 + 0x7 + 0x8 + 0x9
##z3= 0x1 + 0x2 + 0x3 + 0x4 + 0x5 - 0.122x6 + 0.246x7 - 0.950x8 + 0x9
screeplot (PCAd6.5, type="barplot") # 画碎石图,用直方图类型
##图为21个区9项指标数据的主成分碎石图
load=loadings(PCAd6.5) #提取主成分载荷矩阵
plot(load[,1:2],xlim=c(-0.5,0.9),ylim=c(-0.5,0.6)) #作散点图
rnames=c("人口密度","人均耕地面积","森林覆盖率","农民人均纯收入", "人均粮食产量","经济作物占农作物播面比例","耕地占土地面积比例","果园与林地面积之比","灌溉田占耕地面积比例") #用中文命名行
text(load[,1],load[,2],labels=rnames,adj=c(-0.2, 0.1),cex=0.7)
abline(h=0,v=0) #划分象限
##图为前两个主成分的载荷散点图
计算主成分得分和21个区综合得分及排名:
A=round(PCAd6.5$scores,3) #计算主成分得分，取3位小数
B=round(apply(A[,1:3],1,crossprod),2) #按行加总前三个主成分上的载荷平方的综合得分
cbind(A,"得分"=B,"排名"=rank(B)) #按列合并主成分得分、综合得分和排序## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8 Comp.9 得分 排名
## 1区 5.034 3.977 0.151 0.496 0.894 0.246 0.403 -0.134 0.066 41.18 21.0
## 2区 4.323 -2.340 -0.068 0.378 0.006 0.038 -0.461 0.125 -0.311 24.17 19.0
## 3区 -0.408 -0.324 -3.794 0.136 0.081 -0.159 0.370 0.380 0.037 14.67 18.0
## 4区 2.201 -0.927 -0.167 0.823 0.198 -0.449 -0.345 -0.254 0.299 5.73 14.0
## 5区 4.991 -2.348 0.520 -1.109 -0.689 -0.409 0.340 -0.010 0.073 30.69 20.0
## 6区 -1.793 -2.397 0.347 0.479 1.446 -0.009 0.202 -0.205 -0.080 9.08 17.0
## 7区 -1.419 0.257 0.383 0.068 -0.452 -0.619 0.812 -0.096 -0.124 2.23 8.0
## 8区 -1.582 -2.010 0.128 -0.296 0.507 0.696 0.295 0.002 0.091 6.56 16.0
## 9区 -1.215 0.409 0.288 -0.474 -0.141 0.361 0.051 -0.096 -0.330 1.73 6.5
## 10区 -1.013 0.359 0.324 -0.588 -0.339 0.352 0.243 -0.283 -0.104 1.26 5.0
## 11区 -0.657 1.489 0.425 -2.045 0.266 -0.601 -0.183 0.153 0.084 2.83 11.0
## 12区 -2.026 0.018 0.423 0.167 0.205 -0.662 -0.445 -0.018 -0.008 4.28 13.0
## 13区 -1.583 0.341 0.395 -0.015 -0.188 -0.266 -0.285 0.014 0.002 2.78 10.0
## 14区 -0.562 1.006 -2.227 -0.446 -0.323 0.131 -0.528 -0.526 -0.084 6.29 15.0
## 15区 -1.763 -0.470 0.284 0.161 -0.178 0.178 0.139 0.024 0.212 3.41 12.0
## 16区 -1.467 0.328 0.469 0.965 -0.607 -0.270 -0.019 0.027 0.336 2.48 9.0
## 17区 -0.735 0.317 0.361 0.778 -0.610 0.121 0.192 0.002 -0.089 0.77 3.0
## 18区 -0.249 1.189 0.501 0.340 0.200 -0.091 -0.188 0.441 -0.189 1.73 6.5
## 19区 -0.133 0.840 0.537 0.980 -0.397 -0.057 -0.133 0.107 -0.207 1.01 4.0
## 20区 -0.453 0.268 0.419 -0.603 0.892 0.305 -0.238 0.190 0.126 0.45 2.0
## 21区 0.508 0.016 0.298 -0.194 -0.770 1.164 -0.224 0.159 0.200 0.35 1.0biplot(PCAd6.5,scale = 0.5) #绘制21个区的双坐标散点图
##21区、20区、17区排名1、2、3； 2区、5区、1区排名19、20、21