多元统计分析填空题_多元统计分析上机题之R语言实现（多元正态分布）

发布时间：2016-11-27 11:22

  本文关键词：多元统计分析课程，由笔耕文化传播整理发布。

引言

本学期也开了一门多元统计分析课程，也趁机想把课后上机题实现一遍，以增强理解。

教材使用的是约翰逊的《多元统计分析》第六版，中英文版教材、数据集、讲义见
还参考了王斌会老师的《多元统计分析及R语言建模》

本文内容主要为第4章多元正态分布的上机题，图略。
[rmd文档见](）
可以直接用Rstudio打开（之前先安装knitr包）

4.28 data_4.28<-read.table("E:\\研究生\\应用多元统计\\JohnsonWichern Data sets\\T1-5.DAT") #正态Q-Q图 qqnorm(data_4.28$V2) #正态性检验 #原始数据排序 new_data<-sort(data_4.28$V2) length(new_data) #对应概率值 prob<-((i-0.5)/n) } all_pro<-sapply(1:42,prob)#所有概率值 #对应的标准正态分位数 all_q<-qnorm(all_pro) #Q-Q图的相关系数 rq<-cor(new_data,all_q) #由于Q-Q图的相关系数rq为0.9693258，小于表4-2中n=40对应的临界点，，所以拒绝正态性假设。 4.29 #(a) #计算样本协方差矩阵 s<-cov(data_4.28[,5:6]) #s的逆 s_solve<-solve(s) x_bar<-apply(data_4.28[,5:6],MARGIN=2,mean)#两列平均数 x_bar<-matrix(as.vector(x_bar),42,2,by=2) two_col<-t(data_4.28[,5:6]-x_bar)#两列x-x_bar #计算所用统计距离dis dis<-c() for(i in 1:length(two_col[1,])){ dis[i]<-t(two_col[,i])%*%s_solve%*%two_col[,i] } chisq_num<-qchisq(0.5,2) #所占比例 pro<-length(which(dis<chisq_num))/length(dis) sort_data<-sort(dis) #概率密度为4.28中的all_pro #对应的自由度为2的卡方分位数 all_chiisq<-sapply(all_pro,qchisq,df=2)#所有概率值 #画出卡方图 也就是(all_chiisq,sort_data)对应的散点图 library(ggplot2) qplot(all_chiisq, sort_data, geom='point') 4.30 #读入数据 data_4.30_x1<-c(1:9,11) data_4.30_x2<-c(18.95,19.00,17.95,15.54,14.00,12.95,8.94,7.49,6.00,3.99) #构建幂变化函数 ##幂类变化函数(Box-Cox) box_cox<-function (x,λ){ if (λ==0) { return(log(x)) }else{ return((x^λ-1)/λ) } } l_value<-function(X,lamda){ x_new<-sapply(X,box_cox,λ=lamda) x_bar<-mean(x_new) l_val<-log(mean((x_new-x_bar)^2))*(-length(x_new)/2)+(lamda-1)*sum(log(X)) return(l_val) } #生成多个λ，求使l_value最大的λ_hat值 λ<-seq(-1,2,0.1) all_l<-c() for(n in 1:length(λ)){ all_l[n]<-l_value(data_4.30_x1,lamda=λ[n]) } #取使变化后的l_value最大的λ值 max_λ<-λ[which(all_l==max(all_l))] #进行数据幂变化 new_data<-sapply(data_4.30_x1,box_cox,λ=max_λ) #变化后的Q-Q图 qqnorm(new_data) λ<-seq(-1,2,0.1) all_l<-c() for(n in 1:length(λ)){ all_l[n]<-l_value(data_4.30_x2,lamda=λ[n]) } #取使变化后的l_value最大的λ值 max_λ<-λ[which(all_l==max(all_l))] #进行数据幂变化 new_data<-sapply(data_4.30_x2,box_cox,λ=max_λ) #变化后的Q-Q图 qqnorm(new_data) 4.39 data_4.] norm_test<-function(data){ #原始数据排序 new_data<-sort(data) len_data<-length(new_data) prob<-function(i,n){#构建一个概率值的函数 return((i-0.5)/n) } #对应概率值 all_pro<-sapply(all_q<-qnorm(all_pro) #Q-Q图的相关系数 return(cor(new_data,all_q)) } ##对于独立性 #Q-Q图 qqnorm(data_4.39$V1)#大部分在一条直线上 norm_test(data_4.39$V1) qqnorm(data_4.39$V2)#大部分在一条直线上 norm_test(data_4.39$V2) #在显著性水平为0.05的情况下，当n=150时，0.989小于表4.2中的0.9913拒绝正态性假定 ##对于仁爱心 qqnorm(data_4.39$V3)#大部分在一条直线上 norm_test(data_4.39$V3) #在显著性水平为0.05的情况下，当n=150时，0.993大于表4.2中的0.9913不拒绝正态性假定 #对于顺从性 qqnorm(data_4.39$V4)#大部分在一条直线上 norm_test(data_4.39$V4) #在显著性水平为0.05的情况下，当n=150时，0.993大于表4.2中的0.9913 不拒绝正态性假定 #对于领导能力 qqnorm(data_4.39$V5)#大部分在一条直线上 norm_test(data_4.39$V5) chis_chart<-function(x){ #计算样本协方差矩阵 s<-cov(x) #s的逆 s_solve<-solve(s) x_bar<-apply(x,MARGIN=2,mean)#两列平均数 two_col<-t(x-x_bar)#两列x-x_bar #计算所用统计距离dis dis<-c() (two_col[1,])){ dis[i]<-t(two_col[,i])%*%s_solve%*%two_col[,i] } #对广义平方距离dis进行排序 sort_data<-sort(dis) #prob在题4.28中构造 all_pro<-sapply(all_chiisq<-sapply(all_pro,qchisq,df=5)#所有概率值 #画出卡方图 也就是(all_chiisq,sort_data)对应的散点图 library(ggplot2) qplot(all_chiisq, sort_data, geom='point') } chis_chart(data_4.39) λ<-seq(-1,2,0.1) all_l<-c() (λ)){ all_l[n]<-l_value(data_4.39$V1,lamda=λ[n]) } #取使变化后的l_value最大的λ值 max_λ<-λ[which(all_l==max(all_l))] #进行数据幂变化 new_data<-sapply(data_4.39$V1,box_cox,λ=max_λ) #变化后的Q-Q图 qqnorm(new_data) ##对于支撑力 all_l<-c() (λ)){ all_l[n]<-l_value(data_4.39$V2,lamda=λ[n]) } #取使变化后的l_value最大的λ值 max_λ<-λ[which(all_l==max(all_l))] #进行数据幂变化 new_data<-sapply(data_4.39$V2,box_cox,λ=max_λ) #变化后的Q-Q图 qqnorm(new_data) ##对于领导力 all_l<-c() (λ)){ all_l[n]<-l_value(data_4.39$V5,lamda=λ[n]) } #取使变化后的l_value最大的λ值 max_λ<-λ[which(all_l==max(all_l))] #进行数据幂变化 new_data<-sapply(data_4.39$V5,box_cox,λ=max_λ) #变化后的Q-Q图 qqnorm(new_data) 4.40 data_4.40<-read.table("E:\\研究生\\应用多元统计\\JohnsonWichern Data sets\\T1-11.DAT") library(ggplot2) #散点图检查 qplot(data_4.40$V1, data_4.40$V2, geom='point') #从散点图可以看出在x轴和y轴分别有一个离群值 #标准化值来检查 cen_data<-scale(data_4.40) #每一列的最大离群值为 apply(abs(cen_data),2,max) #与取标准化数据比较，第一列第13行，第二列第7行与其他数据存在较大偏离 #(b)(c)略4.40略

  本文关键词：多元统计分析课程，由笔耕文化传播整理发布。

本文编号：195424