计算Spearman等级相关系数的VBA函数

原创 2016年06月01日 09:31:48

公式:

ρ=16i=1nΔri2n3n

其中n是每组数据的个数;Δri 是对应的第i对数据在各自数组中的次序之差;

因为次序r的定义有不同可能,所以,得到的ρ可能有差异。

以下代码适用于Excel不同版本(老版本只提供了rank,不能取平均,2007以后功能得到了加强,有多选择),

Function Spearman(Rng1 As Range, Rng2 As Range) As Double
    Dim WF As WorksheetFunction
    Dim dSquared() As Long
    Dim r As Long
    Set WF = WorksheetFunction
    ReDim Preserve dSquared(1 To Rng1.Cells.Count)

    If Rng1.Columns.Count < 2 Then
      For r = LBound(dSquared) To UBound(dSquared)
         dSquared(r) = (WF.Rank(Rng1.Cells(r, 1), Rng1) - WF.Rank(Rng2.Cells(r, 1), Rng2)) ^ 2
      Next r
    Else
      For r = LBound(dSquared) To UBound(dSquared)
         dSquared(r) = (WF.Rank(Rng1.Cells(1, r), Rng1) - WF.Rank(Rng2.Cells(1, r), Rng2)) ^ 2
      Next r
    End If

    Spearman = 1 - ((6 * WF.Sum(dSquared)) / ((Rng1.Cells.Count ^ 3) - Rng1.Cells.Count))
End Function

Function SpearmanAvg(Rng1 As Range, Rng2 As Range) As Double

    Dim WF As WorksheetFunction
    Dim dSquared() As Double
    Dim r As Long
    Set WF = WorksheetFunction

    ReDim Preserve dSquared(1 To Rng1.Cells.Count)

    If Rng1.Columns.Count < 2 Then
        For r = LBound(dSquared) To UBound(dSquared)
            dSquared(r) = (WF.Rank_Avg(Rng1.Cells(r, 1), Rng1) - WF.Rank_Avg(Rng2.Cells(r, 1), Rng2)) ^ 2
        Next r
    Else
        For r = LBound(dSquared) To UBound(dSquared)
            dSquared(r) = (WF.Rank_Avg(Rng1.Cells(1, r), Rng1) - WF.Rank_Avg(Rng2.Cells(1, r), Rng2)) ^ 2
        Next r
    End If

    SpearmanAvg = 1 - ((6 * WF.Sum(dSquared)) / ((Rng1.Cells.Count ^ 3) - Rng1.Cells.Count))
End Function

Function SpearmanEq(Rng1 As Range, Rng2 As Range) As Double
    Dim WF As WorksheetFunction
    Dim dSquared() As Long
    Dim r As Long
    Set WF = WorksheetFunction
    ReDim Preserve dSquared(1 To Rng1.Cells.Count)

    If Rng1.Columns.Count < 2 Then
      For r = LBound(dSquared) To UBound(dSquared)
         dSquared(r) = (WF.Rank_Eq(Rng1.Cells(r, 1), Rng1) - WF.Rank_Eq(Rng2.Cells(r, 1), Rng2)) ^ 2
      Next r
    Else
      For r = LBound(dSquared) To UBound(dSquared)
         dSquared(r) = (WF.Rank_Eq(Rng1.Cells(1, r), Rng1) - WF.Rank_Eq(Rng2.Cells(1, r), Rng2)) ^ 2
      Next r
    End If

    SpearmanEq = 1 - ((6 * WF.Sum(dSquared)) / ((Rng1.Cells.Count ^ 3) - Rng1.Cells.Count))

End Function

以下为原始代码

Function Spearman(Rng1 As Range, Rng2 As Range) As Double
    Dim WF As WorksheetFunction
    Dim dSquared() As Long
    Dim r As Long
    Set WF = WorksheetFunction
    ReDim Preserve dSquared(1 To Rng1.Rows.Count)
    For r = LBound(dSquared) To UBound(dSquared)
       dSquared(r) = (WF.Rank(Rng1.Cells(r, 1), Rng1) - WF.Rank(Rng2.Cells(r, 1), Rng2)) ^ 2
    Next r
    Spearman = 1 - ((6 * WF.Sum(dSquared)) / ((Rng1.Rows.Count ^ 3) - Rng1.Rows.Count))
End Function

Function SpearmanAvg(Rng1 As Range, Rng2 As Range) As Double
    Dim WF As WorksheetFunction
    Dim dSquared() As Long
    Dim r As Long
    Set WF = WorksheetFunction
    ReDim Preserve dSquared(1 To Rng1.Rows.Count)
    For r = LBound(dSquared) To UBound(dSquared)
       dSquared(r) = (WF.Rank_Avg(Rng1.Cells(r, 1), Rng1) - WF.Rank_Avg(Rng2.Cells(r, 1), Rng2)) ^ 2
    Next r
    SpearmanAvg = 1 - ((6 * WF.Sum(dSquared)) / ((Rng1.Rows.Count ^ 3) - Rng1.Rows.Count))
End Function

Function SpearmanEq(Rng1 As Range, Rng2 As Range) As Double
    Dim WF As WorksheetFunction
    Dim dSquared() As Long
    Dim r As Long
    Set WF = WorksheetFunction
    ReDim Preserve dSquared(1 To Rng1.Rows.Count)
    For r = LBound(dSquared) To UBound(dSquared)
       dSquared(r) = (WF.Rank_Eq(Rng1.Cells(r, 1), Rng1) - WF.Rank_Eq(Rng2.Cells(r, 1), Rng2)) ^ 2
    Next r
    SpearmanEq = 1 - ((6 * WF.Sum(dSquared)) / ((Rng1.Rows.Count ^ 3) - Rng1.Rows.Count))
End Function
版权声明:我极少创造新知识,大部分情况下是个知识的二道贩子

相关文章推荐

相关性检验-Spearman秩相关系数和皮尔森相关系数

感谢原作者Orisun。介绍的很详细 皮尔逊相关系数(Pearson correlation coefficient)也叫皮尔森积差相关系数(Pearson product-moment coreel...
  • GcooQ
  • GcooQ
  • 2015年07月09日 15:31
  • 971

相关性检验--Spearman秩相关系数和皮尔森相关系数

本文给出两种相关系数,系数越大说明越相关。你可能会参考另一篇博客独立性检验。 皮尔森相关系数 皮尔森相关系数(Pearson correlation coefficient)也叫皮尔森积差相关系数...

相关性检验--Spearman秩相关系数和皮尔森相关系数

相关性检验--Spearman秩相关系数和皮尔森相关系数 原文:http://www.cnblogs.com/zhangchaoyang/articles/2631907.html 本文给出两种相...

【matlab】matlab相关系数计算公式(Pearson和Spearman,以及Kendall Rank)

原文地址:http://blog.sina.com.cn/s/blog_4a0824490100ync4.html Pearson相关系数用来衡量两个数据集合是否在一条线上面。其计算公式...

利用matlab计算Pearson和Spearman相关系数

Pearson相关系数 考察两个事物(在数据里我们称之为变量)之间的相关程度,简单来说就是衡量两个数据集合是否在一条线上面。其计算公式为: 或或 N表示变量取值的个数。   当两个变量的标准差都不为零...

MATLAB中的corrcoef函数求两个向量的相关系数。

想用MATLAB中的corrcoef函数求两个向量的相关系数。 举报违规检举侵权投诉|2011-02-23 21:32 匿名 | 分类:数学 | 浏览19891次 比如A=[1 2 3];B=[...

相关系数的计算方法

相关系数定义(截图自百度百科): 关于相关系数的计算有两个性质: 性质一: 性质二: 利用上述两个性质,可得到一种计算相关系数的方法:先对两个随机变量X和Y进行...

求解两个向量相关系数的程序

  • 2014年09月19日 09:49
  • 558B
  • 下载

【JAVA实现】基于皮尔逊相关系数的相似度计算

最近在看《集体智慧编程》,相比其他机器学习的书籍,这本书有许多案例,更贴近实际,而且也很适合我们这种准备学习machine learning的小白。        这本书我觉得不足之处在于,里面没有对...
  • C_son
  • C_son
  • 2015年02月18日 12:51
  • 5486

matlab中样本相关系数的计算与测试

1. 何谓相关系数?此处只列出相关系数的公式: r=Cov(X,Y)σxσy=E(X−μx)(Y−μy)σxσy r = \frac{ Cov(X,Y) } {\sigma_x \sigma_y} ...
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:计算Spearman等级相关系数的VBA函数
举报原因:
原因补充:

(最多只允许输入30个字)