1"predict.vec2var" <- 2function(object, ..., n.ahead = 10, ci = 0.95, dumvar = NULL){ 3 n.ahead <- as.integer(n.ahead) 4 K <- object$K 5 p <- object$p 6 obs <- object$obs 7 data.all <- object$datamat 8 ynames <- colnames(object$y) 9 Z <- object$datamat[, -c(1 : K)] 10 B <- object$deterministic 11 for(i in 1:object$p){ 12 B <- cbind(B, object$A[[i]]) 13 } 14 ## Deterministic and lagged y's 15 ## Retrieval of A in matrix (whole) 16 Zdet <- matrix(rep(1, n.ahead), nrow = n.ahead, ncol = 1) 17 rownames(Zdet) <- seq(nrow(data.all) + 1, length = n.ahead) 18 if(eval(object$vecm@ecdet) == "trend"){ 19 trendf <- seq(obs + p, length = n.ahead) 20 Zdet <- cbind(Zdet, trendf) 21 } 22 if(!is.null(eval(object$vecm@season))){ 23 season <- eval(object$vecm@season) 24 seas.names <- paste("sd", 1:(season-1), sep = "") 25 cycle <- tail(data.all[, seas.names], season) 26 seasonal <- matrix(cycle, nrow = season, ncol = season - 1) 27 if(nrow(seasonal) >= n.ahead){ 28 seasonal <- matrix(cycle[1:n.ahead, ], nrow = n.ahead, ncol = season -1 ) 29 } else { 30 while(nrow(seasonal) < n.ahead){ 31 seasonal <- rbind(seasonal, cycle) 32 } 33 seasonal <- seasonal[1:n.ahead, ] 34 } 35 rownames(seasonal) <- seq(nrow(data.all) + 1, length = n.ahead) 36 Zdet <- cbind(Zdet, seasonal) 37 } 38 if(!is.null(eval(object$vecm@dumvar))){ 39 if(is.null(dumvar)){ 40 stop(paste("\nPlease, provide a matrix x for argument 'dumvar' with", n.ahead, "rows.\n", sep = " ")) 41 } 42 if(!identical(nrow(dumvar), n.ahead)){ 43 stop("\nNumber of rows of 'dumvar' is not equal to 'n.ahead'.\n") 44 } 45 testsum <- sum((colnames(dumvar) %in% colnames(B))) 46 if(!(testsum == ncol(dumvar))){ 47 stop("\nColumn names of 'dumvar' do not match with column names in 'object$datamat'.\n") 48 } 49 Zdet <- cbind(Zdet, dumvar) 50 } 51 exogen.cols <- which(colnames(data.all) %in% colnames(object$deterministic)) 52 Zy <- data.all[, -exogen.cols] 53 yse <- matrix(NA, nrow = n.ahead, ncol = K) 54 sig.y <- .fecovvec2var(x = object, n.ahead = n.ahead) 55 for(i in 1 : n.ahead){ 56 yse[i, ] <- sqrt(diag(sig.y[, , i])) 57 } 58 yse <- -1 * qnorm((1 - ci) / 2) * yse 59 colnames(yse) <- paste(ci, "of", ynames) 60 ## forecast recursion 61 forecast <- matrix(NA, ncol = K, nrow = n.ahead) 62 lasty <- c(Zy[nrow(Zy), ]) 63 for(i in 1 : n.ahead){ 64 lasty <- lasty[1 : (K * p)] 65 Z <- c(Zdet[i, ], lasty) 66 forecast[i, ] <- B %*% Z 67 temp <- forecast[i, ] 68 lasty <- c(temp, lasty) 69 } 70 colnames(forecast) <- paste(ynames, ".fcst", sep="") 71 lower <- forecast - yse 72 colnames(lower) <- paste(ynames, ".lower", sep="") 73 upper <- forecast + yse 74 colnames(upper) <- paste(ynames, ".upper", sep="") 75 forecasts <- list() 76 for(i in 1 : K){ 77 forecasts[[i]] <- cbind(forecast[, i], lower[, i], upper[, i], yse[, i]) 78 colnames(forecasts[[i]]) <- c("fcst", "lower", "upper", "CI") 79 } 80 names(forecasts) <- ynames 81 result <- list(fcst = forecasts, endog = object$y, model = object, exo.fcst = dumvar) 82 class(result) <- "varprd" 83 return(result) 84} 85 86