【问题标题】:Using R to find correlation pairs使用 R 查找相关对
【发布时间】:2013-02-05 08:06:16
【问题描述】:
           VZ.Close CBOU.Close SBUX.Close   T.Close
VZ.Close   1.0000000  0.5804478  0.8872978 0.9480894
CBOU.Close 0.5804478  1.0000000  0.7876277 0.4988890
SBUX.Close 0.8872978  0.7876277  1.0000000 0.8143305
T.Close    0.9480894  0.4988890  0.8143305 1.0000000

所以,假设我在股票价格之间存在这些相关性。我想查看第一行并找到相关性最高的对。那将是 VZ 和 T。然后我想删除这 2 只股票作为期权。然后,在剩余的股票中找到相关性最高的对。依此类推,直到所有股票配对。在此示例中,显然是 CBOU 和 SBUX,因为它们是仅剩的 2 个,但我希望代码能够容纳任意数量的对。

【问题讨论】:

  • 为什么第一步只看第一行?你不想在所有行之间找到更高的相关性吗?
  • 这个问题有点模棱两可,需要更好的解释。您是否想将这两只股票作为第一行中的期权移除(即与第一行本身相关的股票和具有次大相关性的股票),然后从剩余的股票中返回,无论有多少,在第一行中具有最大相关性的两个(即本例中与 VZ.close 的最大相关性),并对每一行执行此操作?
  • 这个问题与股票无关:纯粹是评估矩阵行中的匹配项。我不确定这是对“相关性”一词的良好使用,因为您似乎只想找到给定行中彼此最接近的 2 个值。在这种情况下,@SimonO101 的答案看起来不错。

标签: r correlation


【解决方案1】:

如果您想查看每一步的最大相关性,这里有一个解决方案。所以第一步不会只看第一行,而是看整个矩阵。

样本数据:

d <- matrix(runif(36),ncol=6,nrow=6)
rownames(d) <- colnames(d) <- LETTERS[1:6]
diag(d) <- 1
d
           A          B         C          D         E          F
A 1.00000000 0.65209204 0.8520392 0.26980214 0.5844000 0.69335143
B 0.73531603 1.00000000 0.5499431 0.60511580 0.7483990 0.14788134
C 0.56433218 0.27242769 1.0000000 0.07952776 0.2147628 0.03711562
D 0.91756919 0.04853523 0.5554490 1.00000000 0.4344089 0.23381447
E 0.06897889 0.80740821 0.7974340 0.87425643 1.0000000 0.74546072
F 0.19961474 0.61665231 0.2829632 0.58110694 0.7433924 1.00000000

还有代码:

results <- data.frame(v1=character(0), v2=character(0), cor=numeric(0), stringsAsFactors=FALSE)
diag(d) <- 0
while (sum(d>0)>1) {
  maxval <- max(d)
  max <- which(d==maxval, arr.ind=TRUE)[1,]
  results <- rbind(results, data.frame(v1=rownames(d)[max[1]], v2=colnames(d)[max[2]], cor=maxval))
  d[max[1],] <- 0
  d[,max[1]] <- 0
  d[max[2],] <- 0
  d[,max[2]] <- 0
}

这给出了:

  v1 v2       cor
1  D  A 0.9175692
2  E  B 0.8074082
3  F  C 0.2829632

【讨论】:

  • 我使用了这种基本格式。每当我得到股票相关性时,对角线下方只是对角线上方的镜像。所以我也把矩阵的下三角形变成了零。有时,股票相关性是负数。因此,为了解决这个问题,我创建了一个在矩阵中查找最大值的函数,忽略所有零并使用它而不是 max(d)。然后我更改了while循环以迭代直到sum(d!= 0)> 0。它似乎达到了目的!谢谢!
【解决方案2】:

我认为这回答了你的问题,但我不能确定,因为原来的问题有点模棱两可......

# Construct toy example of symmentrical matrix
# nc is number of rows/columns in matrix, in the problem above it was 4, but let's try with 6
nc <- 6
mat <- diag( 1 , nc )
# Create toy correlation data for matrix
dat <- runif( ( (nc^2-nc)/2 ) )
# Fill both triangles of matrix so it is symmetric
mat[lower.tri( mat ) ] <- dat 
mat[upper.tri( mat ) ] <- dat

# Create vector of random string names for row/column names
names <- replicate( nc , expr = paste( sample( c( letters , LETTERS ) , 3 , replace = TRUE ) , collapse = "" ) )
dimnames(mat) <- list( names , names )

# Sanity check
mat
    SXK   llq   xFL   RVW   oYQ   Seb
SXK 1.000 0.973 0.499 0.585 0.813 0.751
llq 0.973 1.000 0.075 0.533 0.794 0.826
xFL 0.499 0.099 1.000 0.099 0.481 0.968
RVW 0.075 0.813 0.620 1.000 0.620 0.307
oYQ 0.585 0.794 0.751 0.968 1.000 0.682
Seb 0.533 0.481 0.826 0.307 0.682 1.000

# Ok - to problem at hand , you can just substitute your matrix into these lines:
# Clearly the diagonal in a correlation matrix will be 1 so this is excluded as per your problem
diag( mat ) <- NA
# Now find the next highest correlation in each row and set this to NA
mat <- t( apply( mat , 1 , function(x) { x[ which.max(x) ] <- NA ; return(x) } ) ) 

# Another sanity check...!
mat

      SXK   llq   xFL   RVW   oYQ   Seb
SXK    NA    NA 0.499 0.585 0.813 0.751
llq    NA    NA 0.075 0.533 0.794 0.826
xFL 0.499 0.099    NA 0.099 0.481    NA
RVW 0.075    NA 0.620    NA 0.620 0.307
oYQ 0.585 0.794 0.751    NA    NA 0.682
Seb 0.533 0.481    NA 0.307 0.682    NA


# Now return the two remaining columns with greatest correlation in that row
res <- t( apply( mat , 1 , function(x) { y <- names( sort(x , TRUE ) )[1:2] ; return( y ) } ) )

res


[,1]  [,2] 
SXK "oYQ" "Seb"
llq "Seb" "oYQ"
xFL "SXK" "oYQ"
RVW "xFL" "oYQ"
oYQ "llq" "xFL"
Seb "oYQ" "SXK"

这能回答你的问题吗?

【讨论】:

    猜你喜欢
    • 2015-09-03
    • 2021-07-10
    • 2023-03-09
    • 2014-11-23
    • 2013-05-17
    • 1970-01-01
    • 2012-02-02
    • 1970-01-01
    • 2022-01-28
    相关资源
    最近更新 更多