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")
mIndep<-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.localized<-fsMTS(data, max.lag=max.lag,method="PSC",show.progress=show.progress, localized= TRUE)
plot(mPSC.localized, digits=2, col=rev(heat.colors(10)), key=NULL,
main="PSC-based (localized) feature selection")
mPSC.global<-fsMTS(data, max.lag=max.lag,method="PSC",show.progress=show.progress, localized= FALSE)
plot(mPSC.global, 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.localized = mPSC.localized,
PSC.global=mPSC.global)
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[["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
## AR coefficient matrix
## AR( 1 )-matrix
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0 0.000 0.000 -0.0154 0.000
## [2,] 0 0.238 0.000 0.0000 0.000
## [3,] 0 0.000 0.101 0.0000 0.000
## [4,] 0 0.000 0.000 0.0000 -0.048
## [5,] 0 0.000 0.000 0.0000 0.000
## standard error
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0 0.000 0.0000 0.0447 0.0000
## [2,] 0 0.043 0.0000 0.0000 0.0000
## [3,] 0 0.000 0.0442 0.0000 0.0000
## [4,] 0 0.000 0.0000 0.0000 0.0446
## [5,] 0 0.000 0.0000 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.139 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.0443 0
## [5,] 0 0 0 0.0000 0
## AR( 3 )-matrix
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0 0 0 0 0
## [2,] 0 0 0 0 0
## [3,] 0 0 0 0 0
## [4,] 0 0 0 0 0
## [5,] 0 0 0 0 0
## standard error
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0 0 0 0 0
## [2,] 0 0 0 0 0
## [3,] 0 0 0 0 0
## [4,] 0 0 0 0 0
## [5,] 0 0 0 0 0
##
## Residuals cov-mtx:
## resi
## 1.0002443 0.4992775 0.2257219 0.1218766 0.1043605
## 0.4992775 0.9373719 0.4546629 0.2139220 0.1843263
## 0.2257219 0.4546629 0.9870607 0.4140811 0.3449485
## 0.1218766 0.2139220 0.4140811 0.9643505 0.4190355
## resi 0.1043605 0.1843263 0.3449485 0.4190355 0.9892089
##
## det(SSE) = 0.3218895
## AIC = -1.114016
## BIC = -1.072626
## HQ = -1.097791## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.00000000 0.0000000 0.0000000 0.00000000 0
## [2,] 0.00000000 0.2382814 0.0000000 0.00000000 0
## [3,] 0.00000000 0.0000000 0.1008299 0.00000000 0
## [4,] -0.01536725 0.0000000 0.0000000 0.00000000 0
## [5,] 0.00000000 0.0000000 0.0000000 -0.04802507 0
## [6,] 0.00000000 0.0000000 0.0000000 0.00000000 0
## [7,] 0.00000000 0.0000000 0.0000000 0.00000000 0
## [8,] 0.00000000 0.0000000 0.0000000 0.00000000 0
## [9,] 0.00000000 0.0000000 0.0000000 0.13880677 0
## [10,] 0.00000000 0.0000000 0.0000000 0.00000000 0
## [11,] 0.00000000 0.0000000 0.0000000 0.00000000 0
## [12,] 0.00000000 0.0000000 0.0000000 0.00000000 0
## [13,] 0.00000000 0.0000000 0.0000000 0.00000000 0
## [14,] 0.00000000 0.0000000 0.0000000 0.00000000 0
## [15,] 0.00000000 0.0000000 0.0000000 0.00000000 0## orig 512
## Forecasts at origin: 512
## V1 V2 V3 V4 V5
## 0.01852 -0.15947 -0.08880 0.15269 0.00000
## Standard Errors of predictions:
## resi
## 1.0001 0.9682 0.9935 0.9820 0.9946
## Root mean square errors of predictions:
## resi
## 1.0147 0.9823 1.0080 0.9963 1.0091