Nothing
knitr::opts_chunk$set(fig.width=6, fig.height=6)
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,]<-NA
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<-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"]] <- mE2
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
dat <- stats::na.omit(data) model <- VAR(dat, p=max.lag, include.mean = F, fixed = mE2) print(model$coef) VARpred(model,1)
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.