require(sparsevar)
require(fsMTS)
require(plot.matrix)
require(svMisc)
require(MTS)k <- 5
max.lag <- 3
N <- 512
show.progress = F
genM <- function(k, sparsity_lag = 0.2){
nonzero <- round(sparsity_lag*k*k)
m = diag(k)*runif(k*k, min = 0, max=0.1)
size <- k
samples <- nonzero
vals <- sample.int(size ^ 2, samples)
pair<-cbind(vals %/% size + 1, vals %% size+1)
pair[pair>k]<-k
m[pair] <- runif(nonzero, min = -0.2, max=0.2)
return(m)
}
set.seed(9)
pars <- list()
for (i in 1:max.lag){
pars[[paste0("l",i)]] <- genM(k)
}
res<-data.frame()
for (i in pars){
res <-rbind(res,i)
}
mreal<-as.matrix(res)
plot(abs(mreal), digits=2, col=rev(heat.colors(10)), key=NULL,
main="Real structure of dependencies",
xlab="Variables")
mts.sim <- simulateVAR(N=k, p=max.lag, nobs=N,fixedMat=pars)
data <- mts.sim$series
colnames(data)<-paste0("V",1:ncol(data))shortest <- matrix(rexp(k*k, rate = 0.2), nrow=k)
shortest <- shortest-diag(k)*shortest
colnames(shortest)<-colnames(data)
rownames(shortest)<-colnames(data)
plot(shortest, digits=2, col=rev(heat.colors(10)), key=NULL,
main="Shortest distances between nodes")
data <- scale(data)
data[5,]<-NAmIndep<-fsMTS(data, max.lag=max.lag, method="ownlags")
plot(mIndep, digits=2, col=rev(heat.colors(10)), key=NULL,
main="Only own lags")
mCCF<-fsMTS(data, max.lag=max.lag, method="CCF",show.progress=show.progress)
plot(mCCF, digits=2, col=rev(heat.colors(10)), key=NULL,
main="Cross-correlations")
mDistance<-fsMTS(data, max.lag=max.lag, method="distance", shortest = shortest, step = 1)
plot(mDistance, digits=2, col=rev(heat.colors(10)), key=NULL,
main="Distance-based feature selection")
mGLASSO.localized<-fsMTS(data, max.lag=max.lag,method="GLASSO", rho = 0.1,show.progress=show.progress, localized= TRUE)
plot(mGLASSO.localized, digits=2, col=rev(heat.colors(10)), key=NULL,
main="Graphical LASSO-based (localized) feature selection")
mGLASSO.global<-fsMTS(data, max.lag=max.lag,method="GLASSO", rho = 0.1,show.progress=show.progress, localized = FALSE)
plot(mGLASSO.global, digits=2, col=rev(heat.colors(10)), key=NULL,
main="Graphical LASSO-based (global) feature selection")
mLARS<-fsMTS(data, max.lag=max.lag,method="LARS",show.progress=show.progress)
plot(mLARS, digits=2, col=rev(heat.colors(10)), key=NULL,
main="Least angle regression-based feature selection")
mRF.localized<-fsMTS(data, max.lag=max.lag,method="RF",show.progress=show.progress, localized = TRUE)
plot(mRF.localized, digits=2, col=rev(heat.colors(10)), key=NULL,
main="Random forest-based (localized) feature selection")
mRF.global<-fsMTS(data, max.lag=max.lag,method="RF",show.progress=show.progress, localized = FALSE)
plot(mRF.global, digits=2, col=rev(heat.colors(10)), key=NULL,
main="Random forest-based (global) feature selection")
mMI.localized<-fsMTS(data, max.lag=max.lag,method="MI",show.progress=show.progress, localized= TRUE)
plot(mMI.localized, digits=2, col=rev(heat.colors(10)), key=NULL,
main="Mutual information-based (localized) feature selection")
mMI.global<-fsMTS(data, max.lag=max.lag,method="MI",show.progress=show.progress, localized= FALSE)
plot(mMI.global, digits=2, col=rev(heat.colors(10)), key=NULL,
main="Mutual information-based (global) feature selection")
mPSC<-fsMTS(data, max.lag=max.lag,method="PSC",show.progress=show.progress)
plot(mPSC, digits=2, col=rev(heat.colors(10)), key=NULL,
main="PSC-based (global) feature selection")
mlist <- list(Independent = mIndep,
Distance = mDistance,
CCF = mCCF,
GLASSO.localized = mGLASSO.localized,
GLASSO.global=mGLASSO.global,
LARS = mLARS,
RF.localized = mRF.localized,
RF.global = mRF.global,
MI.localized = mMI.localized,
MI.global = mMI.global,
PSC=mPSC)
th<-0.1
mE1 <- fsEnsemble(mlist, threshold = th, method="ranking")
plot(mE1, digits=2, col=rev(heat.colors(10)), key=NULL,
main="Ensemble feature selection using Ranking")
mlist[["EnsembleRank"]] <- mE1
mE2 <- fsEnsemble(mlist, threshold = th, method="majority")
plot(mE2, digits=2, col=rev(heat.colors(10)), key=NULL,
main="Ensemble feature selection using Majority Voting")
mlist[["EnsembleMajV"]] <- mE2mlist[["Real"]] <- ifelse(mreal!=0,1,0)
msimilarity <- fsSimilarityMatrix(mlist, threshold=th, method="Kuncheva")
plot(msimilarity, digits=2, col=rev(heat.colors(ncol(msimilarity))), key=NULL,
main="Pairwise comparison of feature sets", cex.axis=0.7)
Use obtained features for model estimation and prediction
dat <- stats::na.omit(data)
model <- VAR(dat, p=max.lag, include.mean = F, fixed = mE2)## AR coefficient matrix
## AR( 1 )-matrix
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0 0.000 0 -0.00352 0.0000
## [2,] 0 0.235 0 0.00000 0.0000
## [3,] 0 0.000 0 0.00000 0.0000
## [4,] 0 0.000 0 0.00000 -0.0544
## [5,] 0 0.000 0 0.00000 0.0000
## standard error
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0 0.000 0 0.0448 0.0000
## [2,] 0 0.043 0 0.0000 0.0000
## [3,] 0 0.000 0 0.0000 0.0000
## [4,] 0 0.000 0 0.0000 0.0446
## [5,] 0 0.000 0 0.0000 0.0000
## AR( 2 )-matrix
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0 0 0 0.000 0
## [2,] 0 0 0 0.000 0
## [3,] 0 0 0 0.000 0
## [4,] 0 0 0 0.134 0
## [5,] 0 0 0 0.000 0
## standard error
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0 0 0 0.0000 0
## [2,] 0 0 0 0.0000 0
## [3,] 0 0 0 0.0000 0
## [4,] 0 0 0 0.0444 0
## [5,] 0 0 0 0.0000 0
## AR( 3 )-matrix
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0 0 0 0.0000 0
## [2,] 0 0 0 0.0000 0
## [3,] 0 0 0 0.0000 0
## [4,] 0 0 0 0.0000 0
## [5,] 0 0 0 -0.0136 0
## standard error
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0 0 0 0.0000 0
## [2,] 0 0 0 0.0000 0
## [3,] 0 0 0 0.0000 0
## [4,] 0 0 0 0.0000 0
## [5,] 0 0 0 0.0442 0
##
## Residuals cov-mtx:
## resi
## 1.0023482 0.5013753 0.2252566 0.1214393 0.1070205
## 0.5013753 0.9368659 0.4514411 0.2163830 0.1840746
## resi 0.2252566 0.4514411 0.9987328 0.4199933 0.3350474
## 0.1214393 0.2163830 0.4199933 0.9649700 0.4220635
## 0.1070205 0.1840746 0.3350474 0.4220635 0.9908030
##
## det(SSE) = 0.3285515
## AIC = -1.093492
## BIC = -1.05204
## HQ = -1.077242print(model$coef)## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.000000000 0.000000 0 0.00000000 0.00000000
## [2,] 0.000000000 0.235388 0 0.00000000 0.00000000
## [3,] 0.000000000 0.000000 0 0.00000000 0.00000000
## [4,] -0.003523185 0.000000 0 0.00000000 0.00000000
## [5,] 0.000000000 0.000000 0 -0.05440679 0.00000000
## [6,] 0.000000000 0.000000 0 0.00000000 0.00000000
## [7,] 0.000000000 0.000000 0 0.00000000 0.00000000
## [8,] 0.000000000 0.000000 0 0.00000000 0.00000000
## [9,] 0.000000000 0.000000 0 0.13366447 0.00000000
## [10,] 0.000000000 0.000000 0 0.00000000 0.00000000
## [11,] 0.000000000 0.000000 0 0.00000000 0.00000000
## [12,] 0.000000000 0.000000 0 0.00000000 0.00000000
## [13,] 0.000000000 0.000000 0 0.00000000 0.00000000
## [14,] 0.000000000 0.000000 0 0.00000000 -0.01360898
## [15,] 0.000000000 0.000000 0 0.00000000 0.00000000VARpred(model,1)## orig 511
## Forecasts at origin: 511
## V1 V2 V3 V4 V5
## 0.0042468 -0.1575328 0.0000000 0.1612303 -0.0007172
## Standard Errors of predictions:
## resi
## 1.0012 0.9679 0.9994 0.9823 0.9954
## Root mean square errors of predictions:
## resi
## 1.0158 0.9820 1.0139 0.9966 1.0099