多元统计分析
实验报告
实验课程名称多元统计分析
实验项目名称多元统计理论的计算机实现 年级 2013 专业应用统计学 学生姓名侯杰 成绩
理学院
实验时间：2015 年05月07日
学生所在学院：理学院专业：应用统计学班级：9131137001
姓名 实验时间 实验项目名称 侯杰 16.05.07 学号 指导教师 913113700124 李建军 实验组 多元统计理论的计算机实现 实验目的及要求： 目的：熟悉R（或SPSS）软件，掌握多元统计分析中多元正态分布均值向量和协差阵的检验，判别方法，聚类分析，主成分分析，因子分析，相应分析内容。 要求：程序要有注释，尽量体现多元统计分析多元正态分布均值向量和协差阵的检验，判别方法，聚类分析，主成分分析，因子分析，相应分析内容内容的基本原理。 实验硬件及软件平台： 计算机、R、网络 实验内容（包括实验具体内容、算法分析、源代码等等）： 指导教师意见： 签名：年月日
1
代码及运行结果分析
1、均值检验
问题重述：某医生观察了16名正常人的24小时动态心电图，分析出早晨3小时各小时的低
频心电频谱值（LF）、高频心电频谱值（HF），数据见压缩包，试分析这两个指标的各次重复测定均值向量是否有显著差异。
代码如下：
Tsq.test<-function(data,alpha=0.05){
data<-as.matrix(read.table(\ #读取数据 xdat<-data[,2:4];
xbar<-apply(xdat,2,mean); #计算LF指标的均值 ydat<-data[,5:7];
ybar<-apply(ydat,2,mean); #计算HF指标数据 xcov<-cov(xdat); #计算LF样本协差阵 ycov<-cov(ydat); #计算HF样本协差阵 sinv<-solve(xcov+ycov);#求逆矩阵 Tsq<-(16+16-2)*t(sqrt(16*16/(16+16)*(xbar-ybar)))%*%sinv%*%sqrt(16*16/(16+16)*(xbar-ybar)); #计算T统计量
Fstat<-((16+16-2)-3+1)/((16+16-2)*3)*Tsq; #计算F统计量 pvalue<-as.numeric(1-pf(Fstat,3,16+16-3-1)); cat(\值=\
if(pvalue>0.05) #结果输出 cat('均值向量不存在差异') else
cat('均值向量存在差异'); }
运行结果及分析：
通过运行程序，我们可以得到如下结果： >Tsq.test()
p值= 1.632028e-14 均值向量存在差异
即LF与HF这两个指标的各次重复测定均值向量存在显著差异。
2、判别分析
问题重述：银行的贷款部门需要判别每个客户的信用好坏（是否未履行还贷责任），以决定
2
是否给予贷款。可以根据贷款申请人的年龄（）、受教育程度（）、现在所从事工作的年数（）、未变更住址的年数（）、收入（）、负债收入比例（）、信用卡债务（）、其它债务（）等来判断其信用情况。数据见压缩包。⑴根据样本资料分别用距离判别法、Bayes判别法和Fisher判别法建立判别函数和判别规则。⑵某客户的如上情况资料为（53，1，9，18，50，11.20，2.02，3.58），对其进行信用好坏的判别。
代码如下：
#距离判别法
discrim.dist<-function(x){
data<-read.csv(\ #读取数据 G1<-data[1:5,]; G2<-data[6:10,];
u1<-apply(G1,2,mean); #计算信用好的样本数据均值 u2<-apply(G2,2,mean); #计算信用不好的样本数据均值 s1<-cov(G1); s2<-cov(G2); s<-s1+s2; xbar<-(u1+u2)/2;
alpha<-solve(s)%*%(u1-u2); #计算判别系数alpha w<-t(alpha)%*%(x-xbar); #构造判别函数 if(w>=0) #结果输出
cat(\该客户属于信用好的一类\ else
cat(\该客户属于信用坏的一类\}
#费希尔判别法
fisher.test<-function(x){
data<-read.csv(\ #读取数据 G1<-data[1:5,]; G2<-data[6:10,]; n1<-nrow(G1); n2<-nrow(G2);
u1<-apply(G1,2,mean); #计算信用好的一组的数据均值
u2<-apply(G2,2,mean); #计算信用不好的一组的样本数据均值 s1<-cov(G1); s2<-cov(G2); E<-s1+s2;
B<-n1*n2*(u1-u2)%*%t(u1-u2)/(n1+n1); alpha<-eigen(solve(E)%*%B);
vector<-alpha$vectors[,1]; #提取费希尔判别函数系数
d1<-abs(t(vector)%*%x-t(vector)%*%u1); #计算样本到第一组的费希尔判别函数值
3
d2<-abs(t(vector)%*%x-t(vector)%*%u2); #计算样本到第二组的费希尔判别函数值 if(d1 cat(\该客户属于信用好的一类\ else cat(\该客户属于信用坏的一类\} 运行结果及分析： 注：由于在本题的情形下，距离判别与贝叶斯判别等价，故在此处仅选取距离判别进行编程。 距离判别的运行结果： > x<-c(53,1,9,18,50,11.20,2.02,3.58) >discrim.dist(x) 该客户属于信用好的一类 费希尔判别的运行结果： > x<-c(53,1,9,18,50,11.20,2.02,3.58) >fisher.test(x) 该客户属于信用好的一类 从上面的运行结果可以看出该客户属于信用好的一类，即已履行还贷责任。 3、聚类分析 问题重述：下表（数据见压缩包）是某年我国16个地区农民支出情况的抽样调查数据，每个 地区调查了反映每人平均生活消费支出情况的六个经济指标。试使用系统聚类法和K均值法对这些地区进行聚类分析，并对结果进行分析比较。 代码如下： #系统聚类法 data<-read.csv(\ #读取数据 Cludata<-data[,2:7]; Dismatrix<-dist(Cludata,method=\ #计算样本间的欧几里得距离 Clu1<-hclust(d=Dismatrix,method=\ #最短距离法 Clu2<-hclust(d=Dismatrix,method=\ #最长距离法 Clu3<-hclust(d=Dismatrix,method=\ #重心法 Clu4<-hclust(d=Dismatrix,method=\ #离差平方和法 ###绘出四种方法情况下的谱系图和聚类情况 opar<-par(mfrow=c(2,2)); plot(Clu1,labels=data[,1]);re1<-rect.hclust(Clu1,k=5,border=\ 4