R/TSsimulation.R

In VLTimeCausality: Variable-Lag Time Series Causality Inference Framework

#' @title  SimpleSimulationVLtimeseries
#'
#' @description
#'
#' SimpleSimulationVLtimeseries is a support function for generating time series \code{X,Y} where \code{X} VL-Granger-causes \code{Y}.
#'
#' @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.
#' If it is not -1, then the rnorm is set the random seed with \code{seedVal}.
#' @param expflag is the flag to set the relation between \code{Y[i+lag]} and \code{X[i]}.
#' If it is false \code{Y,X} has a linear relation, otherwise, they have an exponential relation.
#' @param causalFlag is a flag. If it is true, then \code{X} causes \code{Y}. Otherwise, \code{X,Y} have no causal relation.
#'
#' @return This function returns a list of time series \code{X,Y} where \code{X} VL-Granger-causes \code{Y}.
#'
#' @examples
#' # Generate simulation data
#' TS <- SimpleSimulationVLtimeseries()
#'
#'@export
SimpleSimulationVLtimeseries<-function(n=200,lag=5,YstFixInx=110,YfnFixInx=170, XpointFixInx=100,arimaFlag=TRUE,seedVal=-1,expflag=FALSE,causalFlag=TRUE)
{
  X <- rep(0, n + lag)
  Y <- rep(0, n + lag)

  if(seedVal !=-1)
    set.seed(seedVal)
  rmat<-rnorm(n*2, 0, 1)
  rmat<-matrix(rmat,n,2, byrow = TRUE)

  for (i in seq(n)) {
    # X bussiness
    if(arimaFlag == FALSE) # using normal generator
    {
      X[i + 1] <- rmat[i,1]
    }
    else
      X[i + 1] <- 0.2 * X[i] + rmat[i,1]

    # Y bussiness
    if(causalFlag==TRUE)
      Y[i + lag] <- X[i]*(!expflag) + 0.1*rmat[i,2] +exp(X[i])*(expflag)
    else if(arimaFlag == FALSE)
      Y[i + 1] <- rmat[i,2]
    else
      Y[i + 1] <- 0.2 * Y[i] + rmat[i,2]
  }

  Y[YstFixInx:YfnFixInx]<-X[XpointFixInx]

  X <- X[-(1:lag)]
  Y <- Y[-(1:lag)]
  return(list(X=X,Y=Y))
}