1"plot.varirf" <- 2function (x, plot.type = c("multiple", "single"), names = NULL, 3 main = NULL, sub = NULL, lty = NULL, lwd = NULL, col = NULL, ylim = NULL, 4 ylab = NULL, xlab = NULL, nc, mar.multi = c(0, 4, 0, 4), 5 oma.multi = c(6, 4, 6, 4), adj.mtext = NA, padj.mtext = NA, col.mtext = NA, ...) 6{ 7 op <- par(no.readonly = TRUE) 8 on.exit(par(op)) 9 ## 10 ## Checking of arguments 11 ## 12 plot.type <- match.arg(plot.type) 13 inames <- x$impulse 14 rnames <- x$response 15 if (is.null(names)) { 16 names <- inames 17 } 18 else { 19 names <- as.character(names) 20 if (!(all(names %in% inames))) { 21 warning("\nInvalid variable name(s) supplied, using first variable.\n") 22 inames <- inames[1] 23 } 24 else { 25 inames <- names 26 } 27 } 28 nvi <- length(inames) 29 nvr <- length(rnames) 30 ## 31 ## Presetting certain plot-argument 32 ## 33 ifelse(is.null(lty), lty <- c(1, 1, 2, 2), lty <- rep(lty, 4)[1:4]) 34 ifelse(is.null(lwd), lwd <- c(1, 1, 1, 1), lwd <- rep(lwd, 4)[1:4]) 35 ifelse(is.null(col), col <- c("black", "gray", "red", "red"), col <- rep(col, 4)[1:4]) 36 ## 37 ## Extract data from object for plotting per iname 38 ## 39 dataplot <- function(x, iname){ 40 impulses <- x$irf[[iname]] 41 range <- range(impulses) 42 upper <- NULL 43 lower <- NULL 44 if(x$boot){ 45 upper <- x$Upper[[iname]] 46 lower <- x$Lower[[iname]] 47 range <- range(cbind(impulses, upper, lower)) 48 } 49 if ((x$model == "varest") || (x$model == "vec2var")) { 50 if (x$ortho) { 51 text1 <- paste("Orthogonal Impulse Response from", iname, sep = " ") 52 } else { 53 text1 <- paste("Impulse Response from", iname, sep = " ") 54 } 55 } else if (x$model == "svarest") { 56 text1 <- paste("SVAR Impulse Response from", iname, sep = " ") 57 } else if (x$model == "svecest") { 58 text1 <- paste("SVECM Impulse Response from", iname, sep = " ") 59 } 60 if (x$cumulative) text1 <- paste(text1, "(cumulative)", sep = " ") 61 text2 <- "" 62 if (x$boot) text2 <- paste((1 - x$ci) * 100, "% Bootstrap CI, ", x$runs, "runs") 63 64 result <- list(impulses = impulses, upper = upper, lower = lower, range = range, text1 = text1, text2 = text2) 65 return(result) 66 } 67 ## 68 ## Plot function for irf per impulse and response 69 ## 70 plot.single <- function(x, iname, rname, ...) { 71 ifelse(is.null(main), main <- x$text1, main <- main) 72 ifelse(is.null(sub), sub <- x$text2, sub <- sub) 73 xy <- xy.coords(x$impulse[, rname]) 74 ifelse(is.null(ylab), ylabel <- rname, ylabel <- ylab) 75 ifelse(is.null(xlab), xlabel <- "", xlabel <- xlab) 76 ifelse(is.null(ylim), ylim <- x$range, ylim <- ylim) 77 plot(xy, type = "l", ylim = ylim, col = col[1], lty = lty[1], lwd = lwd[1], axes = FALSE, ylab = paste(ylabel), xlab = paste(xlab), ...) 78 title(main = main, sub = sub, ...) 79 axis(1, at = xy$x, labels = c(0:(length(xy$x) - 1))) 80 axis(2, ...) 81 box() 82 if (!is.null(x$upper)) lines(x$upper[, rname], col = col[3], lty = lty[3], lwd = lwd[3]) 83 if (!is.null(x$lower)) lines(x$lower[, rname], col = col[3], lty = lty[3], lwd = lwd[3]) 84 abline(h = 0, col = col[2], lty = lty[2], lwd = lwd[2]) 85 } 86 ## 87 ## Plot function per impulse 88 ## 89 plot.multiple <- function(dp, nc = nc, ...){ 90 x <- dp$impulses 91 y <- dp$upper 92 z <- dp$lower 93 ifelse(is.null(main), main <- dp$text1, main <- main) 94 ifelse(is.null(sub), sub <- dp$text2, sub <- sub) 95 ifelse(is.null(ylim), ylim <- dp$range, ylim <- ylim) 96 range <- range(c(x, y, z)) 97 nvr <- ncol(x) 98 if (missing(nc)) { 99 nc <- ifelse(nvr > 4, 2, 1) 100 } 101 nr <- ceiling(nvr/nc) 102 par(mfrow = c(nr, nc), mar = mar.multi, oma = oma.multi) 103 if(nr > 1){ 104 for(i in 1:(nvr - nc)){ 105 ifelse(is.null(ylab), ylabel <- colnames(x)[i], ylabel <- ylab) 106 xy <- xy.coords(x[, i]) 107 plot(xy, axes = FALSE, type = "l", ylab = ylabel, ylim = ylim, col = col[1], lty = lty[1], lwd = lwd[1], ...) 108 axis(2, at = pretty(range)[-1]) 109 abline(h = 0, col = "red") 110 if(!is.null(y)) lines(y[, i], col = col[3], lty = lty[3], lwd = lwd[3]) 111 if(!is.null(z)) lines(z[, i], col = col[3], lty = lty[3], lwd = lwd[3]) 112 box() 113 } 114 for(j in (nvr - nc + 1):nvr){ 115 ifelse(is.null(ylab), ylabel <- colnames(x)[j], ylabel <- ylab) 116 xy <- xy.coords(x[, j]) 117 plot(xy, axes = FALSE, type = "l", ylab = ylabel, ylim = ylim, col = col[1], lty = lty[1], lwd = lwd[1], ...) 118 axis(2, at = pretty(range)[-1]) 119 axis(1, at = 1:(nrow(x)), labels = c(0:(nrow(x) - 1))) 120 box() 121 abline(h = 0, col = "red") 122 if(!is.null(y)) lines(y[, j], col = col[3], lty = lty[3], lwd = lwd[3]) 123 if(!is.null(z)) lines(z[, j], col = col[3], lty = lty[3], lwd = lwd[3]) 124 } 125 mtext(main, 3, line = 2, outer = TRUE, adj = adj.mtext, padj = padj.mtext, col = col.mtext, ...) 126 mtext(sub, 1, line = 4, outer = TRUE, adj = adj.mtext, padj = padj.mtext, col = col.mtext, ...) 127 } else { 128 for(j in 1:nvr){ 129 ifelse(is.null(ylab), ylabel <- colnames(x)[j], ylabel <- ylab) 130 xy <- xy.coords(x[, j]) 131 plot(xy, type = "l", ylab = ylabel, ylim = ylim, col = col[1], lty = lty[1], lwd = lwd[1], ...) 132 if(!is.null(y)) lines(y[, j], col = col[3], lty = lty[3], lwd = lwd[3]) 133 if(!is.null(z)) lines(z[, j], col = col[3], lty = lty[3], lwd = lwd[3]) 134 abline(h = 0, col = "red") 135 } 136 mtext(main, 3, line = 2, outer = TRUE, adj = adj.mtext, padj = padj.mtext, col = col.mtext, ...) 137 mtext(sub, 1, line = 4, outer = TRUE, adj = adj.mtext, padj = padj.mtext, col = col.mtext, ...) 138 } 139 } 140 ## 141 ## Plot for type = single 142 ## 143 if (plot.type == "single") { 144 for(i in 1:nvi){ 145 dp <- dataplot(x, iname = inames[i]) 146 for(j in 1:nvr){ 147 plot.single(dp, iname = inames[i], rname = rnames[j], ...) 148 if (nvr > 1) par(ask = TRUE) 149 } 150 } 151 } 152 ## 153 ## Plot for type = multiple 154 ## 155 if (plot.type == "multiple") { 156 for (i in 1:nvi) { 157 dp <- dataplot(x, iname = inames[i]) 158 plot.multiple(dp, nc = nc, ...) 159 if (nvi > 1) par(ask = TRUE) 160 } 161 } 162} 163 164 165