Nothing
#' @title multipleVLTransferEntropy
#'
#' @description
#'
#' multipleVLTransferEntropy is a function that infers Variable-lag Transfer Entropy of all pairwises of \code{m} time series \code{TS[,1],...TS[,m]}.
#'
#'
#'@param TS is a numerical time series of effect where \code{TS[t,k]} is an element at time \code{t} of \code{k}th time series.
#'@param maxLag is a maximum possible time delay. The default is 0.2*length(Y).
#'@param nboot is a number of times of bootstrapping for RTransferEntropy::transfer_entropy() function.
#'@param lx,ly are lag parameters of RTransferEntropy::transfer_entropy().
#'@param autoLagflag is a flag for enabling the automatic lag inference function. The default is true.
#'If it is set to be true, then maxLag is set automatically using cross-correlation.
#'Otherwise, if it is set to be false, then the function takes the maxLag value to infer Granger causality.
#'@param VLflag is a flag of Granger causality choice: either \code{VLflag=TRUE} for VL-Granger or \code{VLflag=FALSE} for Granger causality.
#'@param alpha is a significant-level threshold for TE bootstrapping by Dimpfl and Peter (2013).
#'
#'@return This function returns of a list of an adjacency matrix of causality where \code{adjMat[i,j]} is true if \code{TS[,i]} causes \code{TS[,j]}.
#'
#'@examples
#' ## Generate simulation data
#' #out1<-SimpleSimulationVLtimeseries()
#' #TS<-cbind(out1$X,out1$Y)
#' ## Run the function
#'#out2<-multipleVLTransferEntropy(TS,maxLag=1)
#'
#'
#'@export
multipleVLTransferEntropy<-function(TS,maxLag,nboot=0,lx=1,ly=1,VLflag=TRUE,autoLagflag=TRUE,alpha=0.05)
{
m<-min(dim(TS))
n<-max(dim(TS))
if(missing(maxLag))
maxLag<-0.2*length(TS[,1])
adjMat<-matrix(FALSE,m,m) # row cause col
for(i in seq(m-1))
for(j in seq(i+1,m))
{
outij<-VLTransferEntropy(Y=TS[,j],X=TS[,i], maxLag=maxLag,nboot=nboot,lx=lx,ly=ly,VLflag=VLflag,autoLagflag=autoLagflag,alpha=alpha)
if(outij$XgCsY_trns)
{
adjMat[i,j]<-outij$XgCsY_trns
adjMat[j,i]<-FALSE
}else
{
adjMat[i,j]<-FALSE
TEratio<-1/outij$TEratio
if(!is.na(TEratio))
if( TEratio >1)
adjMat[j,i]<-TRUE
}
}
res<-list(adjMat=adjMat)
return(res)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.