r - 以网格格式绘制脉冲响应函数

Question

我已经从 R 中的 VAR 模型运行了以下脉冲响应函数

debtarg_1 <- irf(var.est.debt_arg,response="pfdebt_arg",impulse="sp",n.ahead=40,ortho=TRUE,boot=TRUE)
plot(debtarg_1) # response of pfdebt to s&p shock

debtarg_2 <- irf(var.est.debt_arg,response="pfdebt_arg",impulse="m1_us",n.ahead=40,ortho=TRUE,boot=TRUE)
plot(debtarg_2) # response of pfdebt to us M1 Shock

debtarg_3 <- irf(var.est.debt_arg,response="pfdebt_arg",impulse="m1_arg",n.ahead=40,ortho=TRUE,boot=TRUE)
plot(debtarg_3) # response of pfdebt to a domestic m1 shock

debtarg_4 <- irf(var.est.debt_arg,response="pfdebt_arg",impulse="eq_arg",n.ahead=40,ortho=TRUE,boot=TRUE)
plot(debtarg_4) # response of pfdebt to equity market price shock

debtarg_5 <- irf(var.est.debt_arg,response="pfdebt_arg",impulse="pfequity_arg",n.ahead=40,ortho=TRUE,boot=TRUE)
plot(debtarg_5) # response of pfdebt to pfequity shocks

我想使用 ggplot 和 gridextra 以网格格式为论文绘制所有这些。有没有人对如何以网格格式重现它有任何建议？在将数据从 Excel 文件读入 R 之前，我已经以网格格式绘制了数据，但是我不确定如何使用我运行的 5 个单独的 IRF 来解决这个问题。我将附上我之前制作的网格图的代码，希望有人可以帮助我调整此代码以在网格中绘制这 5 个 IRF？

library(tidyverse)
library(tidyselect)
library(xtable)
library(readxl)
library(ggthemes)
library(ggsci)
library(gridExtra)

currentdata <- read_excel(path = "./data/current_gdp.xlsx",
                            col_names = T)

currentdata <- currentdata %>% gather(key = Countries, value = ca, -Date)


g1 <- ggplot(data = currentdata) + 
geom_line(aes(x = Date, y = ca, group = 1, colour = Countries), size = 1.3) + 
theme(plot.title = element_text(hjust = 0.5), axis.text.x = element_text(angle = 90, hjust = 1)) +
scale_x_discrete(breaks = seq(1980, 2018, by = 5)) +  
labs(caption = "Source - World Bank (2019)", x = "", y = "Current Account (as a % of GDP)") + 
    facet_wrap(~Countries, scales = "free") + guides(color = FALSE)


print(g1)

更新 - 我在下面包含了我的数据集 (debt_arg) 的示例。

   sp    m1_us     m1_arg   eq_arg  pfdebt_arg pfequity_arg
 [1,]  43.090997 414955.4   1538.701   270.48   326000000            0
 [2,]  26.979045 410044.9   2398.424   265.24    21000000            0
 [3,]  16.967093 403034.4   2392.100   652.73    11000000            0
 [4,]  29.505141 412023.8   4133.943   800.62  7869000000            0
 [5,]   4.173189 422013.3   3777.726   747.79   862806000    321395635
 [6,]  -4.848764 418102.8   4867.334   660.42   538167500    -27163752
 [7,] -24.060716 435092.2   4108.552   419.80   476328500    578208609
 [8,] 755.186270 717496.6 -29574.420 33461.77 -1071543954   -130885582
 [9,] 363.624318 716186.1 -23324.997 30292.55  -728949104   -187033565
[10,] 664.462366 728275.5 -32336.032 33466.03   519284161    195110656

由此，我使用以下代码行运行了一个 VAR 模型。

var.est.debt_arg <- VAR(debt_arg,p=1,type="both",season=NULL)
summary(var.est.debt_arg)

我想在同一行的顶部绘制 5 个 IRF

由此

谢谢!

Answer 1

您使用脉冲模型生成的图使用基础 R。以下是一个可能的解决方案。我无法适应你的例子，所以我使用了包中的一些东西:

library(vars)
library(cowplot)
library(gridExtra)

使用加拿大示例数据并运行 VAR:

data(Canada)
var.est.debt_arg <- VAR(Canada, p = 2, type = "both",season=NULL)

定义响应和脉冲变量

RESPONSE = "prod"
IMPULSE = c("e","U","rw")

将您的所有搭配收集到一个列表中:

fits = lapply(IMPULSE,function(i){
irf(var.est.debt_arg,response=RESPONSE,impulse=i,
n.ahead=40,ortho=TRUE,boot=TRUE)
})
names(fits) = IMPULSE

迭代拟合，生成绘图并使用 as_grob 捕获它

P = lapply(fits,function(i)as_grob(~plot(i,cex.main=0.7,mar=c(0.5,0.5,0.5,0.5))))
grid.arrange(grobs=P,ncol=3)

如果要使用 ggplot，则:

plotdf = lapply(names(fits),function(i){
data.frame(
  index = 1:nrow(fits[[i]]$irf[[1]]),
  value=fits[[i]]$irf[[1]][,1],
  Lower=fits[[i]]$Lower[[1]][,1],
  Upper=fits[[i]]$Upper[[1]][,1],
  Impulse = i)
})
plotdf=do.call(rbind,plotdf)

ggplot(plotdf,aes(x=index,y=value)) + 
geom_line() +facet_wrap(~Impulse) + 
geom_ribbon(aes(ymin=Lower,ymax=Upper),fill=NA,col="salmon",linetype="dashed") + 
geom_hline(yintercept=0,col="salmon") + theme_bw()