计算 R 中的传输熵

机器算法验证 r 数理统计 信息论
2022-04-02 14:46:51

从信息论出发,传递熵是衡量两个变量之间单向信息依赖性的一种有效方法。一个很好的高级摘要在这里: http: //lizier.me/joseph/presentations/20060503-Schreiber-MeasuringInfoTransfer.pdf

我看到有一个熵和信息估计包(http://strimmerlab.org/software/entropy/),但不是单向传输度量。

在 R 中计算这个的有效方法是什么?也许我可以使用互信息包中的图表输出或度量作为起点。

4个回答

与来自同一页面的上述相同http://users.utu.fi/attenka/trent.R

###############################
###############################
## FUNCTION TRANSFER ENTROPY ##
###############################
###############################

# 070527 (ver. 081126), Atte Tenkanen
# s, time shift
trent<-function(Y,X,s=1){

    #---------------------------------#
    # Transition probability vectors: #
    #---------------------------------#

    L4=L1=length(X)-s # Lengths of vector Xn+1.
    L3=L2=length(X) # Lengths of vector Xn (and Yn).

    #-------------------#
    # 1. p(Xn+s,Xn,Yn): #
    #-------------------#

    TPvector1=rep(0,L1) # Init.

    for(i in 1:L1)
    {
            TPvector1[i]=paste(c(X[i+s],"i",X[i],"i",Y[i]),collapse="") # "addresses"
    }

    TPvector1T=table(TPvector1)/length(TPvector1) # Table of probabilities.

    #-----------#
    # 2. p(Xn): #
    #-----------#

    TPvector2=X
    TPvector2T=table(X)/sum(table(X))

    #--------------#
    # 3. p(Xn,Yn): #
    #--------------#

    TPvector3=rep(0,L3)

    for(i in 1:L3)
    {
            TPvector3[i]=paste(c(X[i],"i",Y[i]),collapse="") # addresses
    }

    TPvector3T=table(TPvector3)/length(TPvector2)

    #----------------#
    # 4. p(Xn+s,Xn): #
    #----------------#

    TPvector4=rep(0,L4)

    for(i in 1:L4)
    {
            TPvector4[i]=paste(c(X[i+s],"i",X[i]),collapse="") # addresses
    }

    TPvector4T=table(TPvector4)/length(TPvector4)

    #--------------------------#
    # Transfer entropy T(Y->X) #
    #--------------------------#

    SUMvector=rep(0,length(TPvector1T))
    for(n in 1:length(TPvector1T))
    {
        SUMvector[n]=TPvector1T[n]*log10((TPvector1T[n]*TPvector2T[(unlist(strsplit(names(TPvector1T)[n],"i")))[2]])/(TPvector3T[paste((unlist(strsplit(names(TPvector1T)[n],"i")))[2],"i",(unlist(strsplit(names(TPvector1T)[n],"i")))[3],sep="",collapse="")]*TPvector4T[paste((unlist(strsplit(names(TPvector1T)[n],"i")))[1],"i",(unlist(strsplit(names(TPvector1T)[n],"i")))[2],sep="",collapse="")]))
    }
    return(sum(SUMvector))
} # End of the trent-function.

JIDT工具包是我在原始问题中链接的高级摘要中的 Matlab 代码的继承者,它提供了离散和连续数据的传输熵估计器,包括连续数据的各种估计器(高斯、盒核、克拉斯科夫)。

它可以用来计算R中的传递熵;这是通过标准 rJava 包(R-to-Java 接口)执行的。

JIDT wiki 页面描述了如何开始在 R 中使用 JIDT 并提供了几个代码示例。

还有一个RTransferEntropy包,它允许计算 Shannon 和 Renyi TE 度量并提供显着性度量。该软件包在C++内部使用,因此它应该相当快。

transfer_entropy(x, y)使用x->y 和 y->x 方向以及显着性水平的函数也很容易使用。如果只想获取 x->y 方向,可以使用更短的calc_te(x, y)函数。

更多示例可以在包的GitHub 页面上找到。

(免责声明,我是该软件包的作者之一)。

请参阅 Ramnath 在评论部分找到的 .pdf:http: //users.utu.fi/attenka/TEpresentation081128.pdf

在此处输入图像描述