1 |
x |
|
n |
|
shock.var |
|
shock.dir |
|
scal |
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 | ##---- Should be DIRECTLY executable !! ----
##-- ==> Define data, use random,
##-- or do help(data=index) for the standard data sets.
## The function is currently defined as
function (x, n=40, shock.var, shock.dir=-1,scal=FALSE){
endoN=sapply(x$we.vecms,function(x) x$n)
G <- x$G
U <- x$U
H.list <- x$H
H <- H.list[[1]]
p = x$arguments$p
q = x$arguments$q
l <- length(x$subsys)
if (x$arguments$exo.var) l <- l-1
if (max(p, q) > 1) {
for (i in 2:max(p, q)) {
H <- cbind(H, H.list[[i]])
}
I.n <- diag(ncol(H) - ncol(H.list[[max(p, q)]]))
Zeros <- matrix(0, nrow = ncol(H) - ncol(H.list[[max(p,
q)]]), ncol = ncol(H.list[[max(p, q)]]))
H <- rbind(H, cbind(I.n, Zeros))
G <- rbind(cbind(G, t(Zeros)), cbind(Zeros, I.n))
U <- rbind(U, matrix(0, nrow(Zeros), ncol(U)))
}
G_inv=solve(G)
Fmat <- G_inv %*% H
UtU= cov(t(U))
# P <- t(chol(t(UtU)))
# define shock / either in terms of sd or %
s.j <- rep(0, dim(U)[1])
ind.j <- rep(0, dim(U)[1])
sigma.il <- vector()
for (i in 1:length(shock.dir))
{
if (shock.var[[i]][1] == 1) {
j <- shock.var[[i]][2]
}
else {
j <- sum(endoN[1:(shock.var[[i]][1] - 1)]) + shock.var[[i]][2]
}
# define variables once
sigma.il[i] <- sqrt(UtU[j, j])
if(scal){
# shock=as.numeric(unlist(strsplit(shock.dir,"/sd"))[[1]])*cons*(1/G_inv[j,j])
shock <- shock.dir[[i]]*sigma.il[i]/(G_inv%*%UtU)[j,j]
}
else{
shock <- shock.dir[[i]]
}
if(!is.numeric(shock)){
stop("For the argument shock.dir please submit either a volume shock (e.g. shock.dir='0.003/sd') or a standard deviation shock (e.g. shock.dir='-1').")
}
s.j[j] <- shock
ind.j[j] <- 1
}
F.n <- list()
F.n[[1]] <- diag(nrow(Fmat))
for (i in 2:(n+1)) {
F.n[[i]] <- F.n[[i-1]] %*% Fmat
}
fevd.gi <- matrix(0,length(s.j),n+1)
fevd.oi <- matrix(0,length(s.j),n+1)
for (i in which(s.j==0)[1:(sum(endoN)-1)])
{
e.i <- rep(0,length(s.j))
e.i[i] <- 1
temp <- vector()
temp2 <- vector()
temp3 <- vector()
for (j in 1:(n+1))
{
temp[j] <- (t(e.i)%*%F.n[[j]]%*%UtU%*%s.j)^2
temp2[j] <- t(e.i)%*%F.n[[j]]%*%UtU%*%t(F.n[[j]])%*%e.i
# temp3[j] <- (t(e.i)%*%F.n[[j]]%*%P%*%s.j)^2
fevd.gi[i,j] <- 1/(t(e.i)%*%UtU%*%e.i)*sum(temp[1:j])/sum(temp2[1:j])
# fevd.oi[i,j] <- 1/(t(e.i)%*%UtU%*%e.i)*sum(temp3[1:j])/sum(temp2[1:j])
}
}
fevd.oi <- NULL
# psi <- list()
# psi[[1]] <- t(psi.m[1:endoN[1],])
# rownames(psi[[1]]) <- 0:n
# colnames(psi[[1]]) <- colnames(x$Data[[1]])
# for (i in 2:l)
# {
# psi[[i]] <- t(psi.m[(sum(endoN[1:(i-1)])+1):(sum(endoN[1:i])),])
# rownames(psi[[i]]) <- 0:n
# colnames(psi[[i]]) <- colnames(x$Data[[i]])
# }
# names(psi) <- x$subsys[1:l]
res <- list(fevd.gi = fevd.gi, fevd.oi = fevd.oi, Fmat = Fmat, G = G, H = H, U = U,shock.dir=shock.dir,sigma.il=sigma.il)
return(res)
}
|
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.