R/MultipleTSsimulation.R

In VLTimeCausality: Variable-Lag Time Series Causality Inference Framework

#' @title  MultipleSimulationVLtimeseries
#'
#' @description
#'
#' MultipleSimulationVLtimeseries is a support function for generating a set of time series \code{TS[,1],...TS[,10]}.
#' TS[,1],TS[,2],TS[,3] are causes \code{X} time series that are generated independently.
#' The rest of time series are \code{Y} time series that are effects of some causes TS[,1],TS[,2],TS[,3].
#' TS[,1] causes TS[,4],TS[,7],TS[,8], and TS[,10].
#' TS[,2] causes TS[,5],TS[,7],TS[,9], and TS[,10].
#' TS[,3] causes TS[,6],TS[,8],TS[,9], and TS[,10].
#'
#' @param n is length of time series.
#' @param lag is a time lag between \code{X} and \code{Y} s.t. \code{Y[t]} is approximately \code{X[t-lag]}.
#' @param YstFixInx is the starting point of variable lag part.
#' @param YfnFixInx is the end point of variable lag part.
#' @param XpointFixInx is a point in X s.t. \code{ Y[YstFixInx:YfnFixInx]= X[XpointFixInx] }.
#' @param arimaFlag is ARMA model flag. If it is true, then \code{X} is generated by ARMA model.
#' If it is false, then  \code{X} is generated by sampling of the standard normal distribution.
#' @param seedVal is a seed parameter for generating random noise.
#'
#' @return This function returns a list of time series \code{TS}.
#'
#' @examples
#' # Generate simulation data
#' TS <- MultipleSimulationVLtimeseries()
#'
#' @importFrom stats runif
#'
#'@export
MultipleSimulationVLtimeseries<-function(n=200,lag=5,YstFixInx=110,YfnFixInx=170, XpointFixInx=100,arimaFlag=TRUE,seedVal=-1)
{
  TS<-matrix(0,n,10) # 10 time series
  if(seedVal ==-1)
  {
    seeds<-numeric(3)-1
  }
  else
  {
    set.seed(seedVal)
    seeds<-runif(3,1000,250000)
  }
  A<-SimpleSimulationVLtimeseries(n=n,lag=lag,YstFixInx=YstFixInx,YfnFixInx=YfnFixInx, XpointFixInx=XpointFixInx,arimaFlag=arimaFlag,seedVal=seeds[1])
  B<-SimpleSimulationVLtimeseries(n=n,lag=lag+5,YstFixInx=YstFixInx,YfnFixInx=YfnFixInx, XpointFixInx=XpointFixInx,arimaFlag=arimaFlag,seedVal=seeds[2])
  C<-SimpleSimulationVLtimeseries(n=n,lag=lag+8,YstFixInx=YstFixInx,YfnFixInx=YfnFixInx, XpointFixInx=XpointFixInx,arimaFlag=arimaFlag,seedVal=seeds[3])
  TS[,1]<-A$X
  TS[,2]<-B$X
  TS[,3]<-C$X
  TS[,4]<-A$Y
  TS[,5]<-B$Y
  TS[,6]<-C$Y
  TS[,7]<-A$Y+B$Y
  TS[,8]<-A$Y + C$Y
  TS[,9]<-C$Y + B$Y
  TS[,10]<-A$Y+B$Y+C$Y
  return(TS)
}

#' @title  checkMultipleSimulationVLtimeseries
#'
#' @description
#'
#' checkMultipleSimulationVLtimeseries is a support function that can compare two adjacency matrices: groundtruth and inferred matrices.
#' It re
#' @param trueAdjMat a groundtruth matrix.
#' @param adjMat an inferred matrix.
#'
#' @return This function returns a list of precision \code{prec}, recall \code{rec}, and F1 score \code{F1} of inferred vs. groundtruth matrices.
#'
#' @examples
#' ## Generate simulation data
#' #G<-matrix(FALSE,10,10) # groundtruth
#' #G[1,c(4,7,8,10)]<-TRUE
#' #G[2,c(5,7,9,10)]<-TRUE
#' #G[3,c(6,8,9,10)]<-TRUE
#' #TS <- MultipleSimulationVLtimeseries()
#' #out<-multipleVLGrangerFunc(TS)
#' #checkMultipleSimulationVLtimeseries(trueAdjMat=G,adjMat=out$adjMat)
#'
#'@export
checkMultipleSimulationVLtimeseries<-function(trueAdjMat,adjMat)
{
  TP<-0
  FP<-0
  FN<-0
  for(i in seq(10))
    for(j in seq(10))
    {
      if(trueAdjMat[i,j] && adjMat[i,j])
        TP<-TP+1
      else if( (!trueAdjMat[i,j]) && adjMat[i,j])
        FP<-FP+1
      else if(trueAdjMat[i,j] && (!adjMat[i,j]) )
        FN<-FN+1
    }
  prec<-TP/(TP+FP)
  rec<-TP/(TP+FN)
  F1<-2*prec*rec/(prec+rec)
  return(list(prec=prec,rec=rec,F1=F1))
}