R語(yǔ)言-實(shí)現(xiàn)按日期分組求皮爾森相關(guān)系數(shù)矩陣

更新時(shí)間：2021年04月17日 10:47:29 作者：大貓__0

這篇文章主要介紹了R語(yǔ)言-實(shí)現(xiàn)按日期分組求皮爾森相關(guān)系數(shù)矩陣，具有很好的參考價(jià)值，希望對(duì)大家有所幫助。一起跟隨小編過來(lái)看看吧

R語(yǔ)言按日期分組求相關(guān)系數(shù)

前幾天得到了3700+支股票一周內(nèi)的波動(dòng)率，想要計(jì)算每周各個(gè)股票之間的相關(guān)系數(shù)并將其可視化。最終結(jié)果保存在制定文件夾中。

部分?jǐn)?shù)據(jù)如下：

先讀取數(shù)據(jù)

data<-read.csv("D:/data/stock_day_close_price_week_series.csv",
               header = TRUE,blank.lines.skip = TRUE)

利用mice包處理缺失值：

library(lattice)
library(MASS)
library(mice)
aggr(data,prop=FALSE,numbers=TRUE,sortVars=TRUE)#查看缺失值
imp<-mice(data[,3:7],1)#用鏈?zhǔn)椒匠谭ㄌ钛a(bǔ)缺失值
stripplot(imp,pch=20,cex=1.2)#查看填補(bǔ)結(jié)果
data1<-complete(imp,action = 1)

缺失值比例圖如下：

2

分組計(jì)算并分組保存：

d<-unlist(levels(factor(dat[,2])))#得到各個(gè)開始日期
mydata<-list()
mydatap<-list()
xg<-list()
for (i in 1:11 ) {#修改組數(shù)有多少個(gè)開始日期
  mydata[[i]] <- filter(dat,Start_date==d[[i]])#按照開始日期對(duì)數(shù)據(jù)分組
  mydatap[[i]] <- mydata[[i]][1:nrow(mydata[[i]]),3:7]
  xg[[i]]<- cor(t(mydatap[[i]]))#計(jì)算相關(guān)系數(shù)矩陣
  rownames(xg[[i]])=mydata[[i]][,1]
  colnames(xg[[i]])=mydata[[i]][,1]
  dat<-filter(dat,Start_date!=d[[i]])
  write.csv (xg[[i]],file=paste0('D:/data/','relation_graph_',d[[i]],'.csv'))#將相關(guān)系數(shù)矩陣存到文件中
}

部分計(jì)算結(jié)果：

總代碼如下：

data<-read.csv("D:/data/stock_day_close_price_week_series.csv",
               header = TRUE,blank.lines.skip = TRUE)
library(colorspace)
library(grid)
library(lattice)
library(mice)
library(data.table)
library(VIM)
library(dplyr)
library(corrplot)
matrixplot(data)
aggr(data,prop=FALSE,numbers=TRUE,sortVars=TRUE)#查看缺失值

imp<-mice(data[,3:7],1)#用鏈?zhǔn)椒匠谭ㄌ钛a(bǔ)缺失值
stripplot(imp,pch=20,cex=1.2)
data1<-complete(imp,action = 1)
dat<-cbind(data[,1:2],data1)
d<-unlist(levels(factor(dat[,2])))#得到各個(gè)開始日期
mydata<-list()
mydatap<-list()
xg<-list()
for (i in 1:11 ) {#修改組數(shù)有多少個(gè)開始日期
  mydata[[i]] <- filter(dat,Start_date==d[[i]])#按照開始日期對(duì)數(shù)據(jù)分組
  mydatap[[i]] <- mydata[[i]][1:nrow(mydata[[i]]),3:7]
  xg[[i]]<- cor(t(mydatap[[i]]))#計(jì)算相關(guān)系數(shù)矩陣
  rownames(xg[[i]])=mydata[[i]][,1]
  colnames(xg[[i]])=mydata[[i]][,1]
  dat<-filter(dat,Start_date!=d[[i]])
  write.csv (xg[[i]],file=paste0('D:/data/','relation_graph_',d[[i]],'.csv'))#將相關(guān)系數(shù)矩陣存到文件中
}

補(bǔ)充：Pearson相關(guān)系數(shù)R代碼實(shí)現(xiàn)

Pearson相關(guān)系數(shù)（Pearson Correlation Coefficient）

Pearson's r，稱為皮爾遜相關(guān)系數(shù)（Pearson correlation coefficient），用來(lái)反映兩個(gè)隨機(jī)變量之間的線性相關(guān)程度。

要理解皮爾遜相關(guān)系數(shù)，首先要理解協(xié)方差(Covariance)。協(xié)方差可以反映兩個(gè)隨機(jī)變量之間的關(guān)系，如果一個(gè)變量跟隨著另一個(gè)變量一起變大或者變小，那么這兩個(gè)變量的協(xié)方差就是正值，就表示這兩個(gè)變量之間呈正相關(guān)關(guān)系，反之相反。

如果協(xié)方差的值是個(gè)很大的正數(shù)，我們可以得到兩個(gè)可能的結(jié)論：

（1）兩個(gè)變量之間呈很強(qiáng)的正相關(guān)性

（2）兩個(gè)變量之間并沒有很強(qiáng)的正相關(guān)性，協(xié)方差的值很大是因?yàn)閄或Y的標(biāo)準(zhǔn)差很大

那么到底哪個(gè)結(jié)論正確呢？只要把X和Y變量的標(biāo)準(zhǔn)差，從協(xié)方差中剔除不就知道了嗎？

協(xié)方差能告訴我們兩個(gè)隨機(jī)變量之間的關(guān)系，但是卻沒法衡量變量之間相關(guān)性的強(qiáng)弱。

因此，為了更好地度量?jī)蓚€(gè)隨機(jī)變量之間的相關(guān)程度，引入了皮爾遜相關(guān)系數(shù)。

可以看到，皮爾遜相關(guān)系數(shù)就是用協(xié)方差除以兩個(gè)變量的標(biāo)準(zhǔn)差得到的。

代碼如下：

> setwd("F:\\CSDN\\blog")
> states <- state.x77[,1:5]
> cov(states) #計(jì)算方差和協(xié)方差
              Population      Income   Illiteracy     Life Exp      Murder
Population 19931683.7588 571229.7796  292.8679592 -407.8424612 5663.523714
Income       571229.7796 377573.3061 -163.7020408  280.6631837 -521.894286
Illiteracy      292.8680   -163.7020    0.3715306   -0.4815122    1.581776
Life Exp       -407.8425    280.6632   -0.4815122    1.8020204   -3.869480
Murder         5663.5237   -521.8943    1.5817755   -3.8694804   13.627465
> cor(states) #計(jì)算Pearson積差相關(guān)系數(shù)
            Population     Income Illiteracy    Life Exp     Murder
Population  1.00000000  0.2082276  0.1076224 -0.06805195  0.3436428
Income      0.20822756  1.0000000 -0.4370752  0.34025534 -0.2300776
Illiteracy  0.10762237 -0.4370752  1.0000000 -0.58847793  0.7029752
Life Exp   -0.06805195  0.3402553 -0.5884779  1.00000000 -0.7808458
Murder      0.34364275 -0.2300776  0.7029752 -0.78084575  1.0000000
> cor(states,method = "spearman") #計(jì)算spearman等級(jí)相關(guān)系數(shù)
           Population     Income Illiteracy   Life Exp     Murder
Population  1.0000000  0.1246098  0.3130496 -0.1040171  0.3457401
Income      0.1246098  1.0000000 -0.3145948  0.3241050 -0.2174623
Illiteracy  0.3130496 -0.3145948  1.0000000 -0.5553735  0.6723592
Life Exp   -0.1040171  0.3241050 -0.5553735  1.0000000 -0.7802406
Murder      0.3457401 -0.2174623  0.6723592 -0.7802406  1.0000000
> cor.test(states[,3],states[,5]) #進(jìn)行相關(guān)性系數(shù)

	Pearson's product-moment correlation

data:  states[, 3] and states[, 5]
t = 6.8479, df = 48, p-value = 1.258e-08
alternative hypothesis: true correlation is not equal to 0
95 percent confidence interval:
 0.5279280 0.8207295
sample estimates:
      cor 
0.7029752 

> #cor.test()只能檢驗(yàn)一種相關(guān)關(guān)系，psych包提供了更多的選擇
> #install.packages("psych")
> library(psych)
> corr.test(states,use = "complete")
Call:corr.test(x = states, use = "complete")
Correlation matrix 
           Population Income Illiteracy Life Exp Murder
Population       1.00   0.21       0.11    -0.07   0.34
Income           0.21   1.00      -0.44     0.34  -0.23
Illiteracy       0.11  -0.44       1.00    -0.59   0.70
Life Exp        -0.07   0.34      -0.59     1.00  -0.78
Murder           0.34  -0.23       0.70    -0.78   1.00
Sample Size 
[1] 50
Probability values (Entries above the diagonal are adjusted for multiple tests.) 
           Population Income Illiteracy Life Exp Murder
Population       0.00   0.44       0.91     0.91   0.09
Income           0.15   0.00       0.01     0.09   0.43
Illiteracy       0.46   0.00       0.00     0.00   0.00
Life Exp         0.64   0.02       0.00     0.00   0.00
Murder           0.01   0.11       0.00     0.00   0.00

 To see confidence intervals of the correlations, print with the short=FALSE option

以上為個(gè)人經(jīng)驗(yàn)，希望能給大家一個(gè)參考，也希望大家多多支持腳本之家。如有錯(cuò)誤或未考慮完全的地方，望不吝賜教。

您可能感興趣的文章: