R语言 相关分析和典型相关分析

@R语言相关分析与典型相关分析

#相关分析与典型相关分析
#pearson相关系数
a=c(1,3,5,7,9);b=c(1,4,6,9,10)
cor(a,b) #pearson相关系数
cor.test(a,b) #检验相关系数的显著性
cor(iris[1:4]) #相关系数,参数填数据集,则计算相关系数矩阵

#spearman相关系数,亦即秩相关系数
#spearman和kendall都是等级相关系数,亦即其值与两个相关变量的具体值无关,而仅仅与其值之间的大小关系有关。
#spearman相关系数,亦即秩相关系数,根据随机变量的等级而不是其原始值衡量相关性的一种方法。
m=c(1,2,4,3);n=c(100,101,102,103)
m1=c(30,31,35,34);n1=c(85,87,90,93)
cor(m,n);cor(m1,n1)
cor(m,n,method = “spearman”);cor(m1,n1,method = “spearman”)
cor.test(m,n,method = “spearman”);cor.test(m1,n1,method = “spearman”)
#spearman相关系数的计算可以由计算pearson系数的方法,只需要把原随机变量中的原始数据替换成其在随机变量中的等级顺序即可:

acf #自相关和协方差函数
acf(airmiles,type=‘correlation’,lag.max=10) #自相关
pacf(airmiles,lag.max=10) #偏自相关
pairs(~Sepal.Length+Sepal.Width+Petal.Length+Petal.Width,data=iris,
main=“Simple Scatterplot Matrix”) #散点图矩阵
install.packages(“scatterplot3d”) #3D散点图
library(scatterplot3d)
scatterplot3d(iris S e p a l . L e n g t h , i r i s Sepal.Length, iris Petal.Length, iris$Petal.Width)

install.packages(“corrgram”) #有兴趣的同学自己练习
library(corrgram)
#1、设置排序处理
corrgram(mtcars,order=TRUE)
#2、设置上下三角面板形状
corrgram(mtcars,order=TRUE,lower.panel=panel.shade,upper.panel=panel.pie)
#3、只显示下三角部分
corrgram(mtcars,order=TRUE,lower.panel=panel.shade,upper.panel=NULL)
#4、调整面板颜色
corrgram(mtcars,order=TRUE,lower.panel=panel.shade,upper.panel=panel.pie,
col.regions=colorRampPalette(c(“darkgoldenrod4”,“burlywood1”,“white”, “darkkhaki”,“darkgreen”)))
install.packages(“corrplot”)
library(corrplot)
#1、使用不同的method绘制相关矩阵图
methods<-c(“circle”,“square”,“ellipse”,“pie”,“shade”,“color”)
par(mfrow=c(2,3))
t0=mapply(function(x){corrplot(cor(mtcars), method=x,order=“AOE”)},methods)
par(mfrow=c(1,1))
#2、设置method=color绘制热力矩阵图
corrplot(cor(mtcars), method=“color”, order = “AOE”,tl.col=“black”,tl.srt=45,
addCoef.col=“black”,col=colorRampPalette(c("#7F0000",“red”,"#FF7F00",
“yellow”,“white”, “cyan”, “#007FFF”, “blue”,"#00007F"))(20))
#3、绘制上下三角及不同色彩的相关矩阵图
library(RColorBrewer)
par(mfrow=c(2,2))
corrplot(cor(mtcars),type=“lower”)
corrplot(cor(mtcars),type=“lower”,order=“hclust”,
col=brewer.pal(n=8,name=“RdYlBu”))
corrplot(cor(mtcars),type=“upper”,order=“AOE”,
col=c(“black”,“white”),bg=“lightblue”)
corrplot(cor(mtcars),type=“upper”,order=“FPC”,
col=brewer.pal(n=8, name=“PuOr”))
par(mfrow=c(1,1))

d<-sqrt(1-cor(mtcars)^2)
hc<-hclust(as.dist(d))
plot(hc)
rect.hclust(hc,k=3)

install.packages(“pvclust”)
library(pvclust)
cluster.bootstrap <- pvclust(mtcars, nboot=1000, method.dist=“correlation”)
plot(cluster.bootstrap)
pvrect(cluster.bootstrap) #自己练习部分结束

#典型相关:指两组变量之间的相关关系,不是两个变量之间相关关系,也不是两组变量之间两两组合的简单相关
#两组变量作为整体的相关性
#例如体育运动和身体状况的相关性,体育运动包括跑步,篮球,足球,乒乓球,游泳等变量,身体状况包括身高,体重,肺活量,血压等变量
#以R语言自带的iris为例
#1、提取iris的前4个数值列,并进行标准化处理
data0=scale(iris[1:4])
#2、计算这4个变量的协方差,由于经过标准化处理,这样得到的也是相关系数
M=cov(data0)
#3、将M进行分块,1:2两个变量一组,3:4是另外一组,并进行两两组合
X11=M[1:2,1:2]
X12=M[1:2,3:4]
X21=M[3:4,1:2]
X22=M[3:4,3:4]
#4、按公式求解矩阵A和B
A=solve(X11)%%X12%%solve(X22)%%X21
B=solve(X22)%
%X21%%solve(X11)%%X12
#5、使用eigen函数求解典型相关系数如下
eV=sqrt(eigen(A)$values)
eV

#6、进行验证
#…比较A与XΛX^(-1)是否相等
round(A-eigen(A) v e c t o r s vectors%*%diag(eigen(A) values)%*%solve(eigen(A)$vectors),3)

Sepal.Length Sepal.Width

Sepal.Length 0 0

Sepal.Width 0 0

#…比较B与YΛY^(-1)是否相等
round(B-eigen(B) v e c t o r s vectors%*%diag(eigen(B) values)%*%solve(eigen(B)$vectors),3)

#…求解A对应的特征向量并计算典型向量C1
C1=data0[,1:2]%*%eigen(A)$vectors
#…验证C1对应各变量的标准差是否为1,同时查看均差
apply(C1,2,sd)

扫描二维码关注公众号,回复: 5586095 查看本文章

[1] 1.041196 0.951045

apply(C1,2,mean)

[1] -4.880321e-16 -2.759430e-17

#…由于均值为0,标准差不为1,这里对特征向量进行伸缩变换
eA=eigen(A)$vectors%%diag(1/apply(C1,2,sd))
#…再次验证方差和均值
C1=data0[,1:2]%
%eA
apply(C1,2,sd)

[1] 1 1

apply(C1,2,mean)

[1] -4.667693e-16 -2.745503e-17

#…可见,特征向量已经满足要求,同理对B可得
C2=data0[,3:4]%*%eigen(B)$vectors
apply(C2,2,sd)

[1] 0.6291236 0.2003530

apply(C2,2,mean)

[1] -1.403572e-17 -9.859870e-18

eB=eigen(B)$vectors%%diag(1/apply(C2,2,sd))
C2=data0[,3:4]%
%eB
apply(C2,2,sd)

[1] 1 1

apply(C2,2,mean)

round(cor(cbind(C1,C2)),3)
#用cancor可以直接求解典型相关系数
x<-as.matrix(iris[,1:2])
y<-as.matrix(iris[,3:4])
cancor(x,y)

猜你喜欢

转载自blog.csdn.net/weixin_44723899/article/details/88654438