17  Aggregate Fluctuations

Note

This Chapter reproduces the VAR analysis from Chapter 10, using the CHIRPS precipitation data instead of the Piscop data.

library(tidyverse)
── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.4     ✔ readr     2.1.5
✔ forcats   1.0.0     ✔ stringr   1.5.1
✔ ggplot2   3.5.1     ✔ tibble    3.2.1
✔ lubridate 1.9.3     ✔ tidyr     1.3.1
✔ purrr     1.0.2     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(labelled)

The {seasonal} and {timetk} packages are needed in this chapter, for seasonal adjustment by X-13 ARIMA-SEATS. If these packages are not installed:

# Do not run
install.packages("seasonal")
install.packages("timetk")

We will need the theme_paper() function to add our theme to the plots made with ggplot2. This function is defined in the utils.R script.

source("../weatherperu/R/utils.R")

17.1 Synthetic measure of the weather

This section provides a detailed description of the methodology employed to create the synthetic measure of the weather.

We need to load the results from the estimations made in Chapter 16.

load("../R/output/resul_lp_chirps.rda")
# Data used in the local projections
load("../data/output/df_lp.rda")

The average price of each crop in the data, denoted hereafter \(p_c\):

average_price_crops <- 
  df |> group_by(product_eng) |> 
  summarise(price_crop = mean(Value_prices, na.rm = TRUE))
average_price_crops
# A tibble: 4 × 2
  product_eng price_crop
  <chr>            <dbl>
1 Cassava          0.550
2 Dent corn        0.680
3 Potato           0.578
4 Rice             0.671

Then, we can put the coefficients in a table, for each crop and each time horizon:

weather_variables <- c(
  "temp_max_dev", "precip_sum_dev"
  )
coefs_weather <- map(
  .x = resul_lp,
  .f = ~ .x$coefs |> 
    filter(name %in% weather_variables) |> 
    select(horizon, name, value)
)
names(coefs_weather) <- map_chr(resul_lp, "crop_name")
coefs_weather <- 
  list_rbind(coefs_weather, names_to = "crop")

Then, we follow a methodology consisting of several key steps.

17.1.1 Step 1: Weather Shock Contribution

The first step involves estimating the contribution of weather shocks at each time period (\(t\)) for the chosen crop (\(c\)) and time horizon (\(h\)). This contribution is determined by considering the weather variables, temperature (\(T_{i,t}\)) and precipitation (\(P_{i,t}\)), and their respective coefficients (\(\beta_{c,h}^{T}\) as well as \(\beta_{c,h}^{P}\)). The weather shock contribution (\(\Gamma_{c,i,t,h}\)) is obtained by multiplying these coefficients with the corresponding weather variables and summing them up:

\[\Gamma_{c,i,t,h} = \beta_{c,h}^{T} T_{i,t-h} + \beta_{c,h}^{P} P_{i,t-h} \tag{17.1}\]

This first step is performed, using two user-defined functions: weather_contrib_crop_h() which computes the contribution of the weather for a single crop and time horizon, and with contrib_weather_crop() which uses the former to compute the contribution of the weather for a single crop, for all horizons. We will consider 9 horizons:

nb_periods_wcal <- 8
coefs_weather <- coefs_weather |>
  filter(horizon <= nb_periods_wcal)
#' Computes the contribution of the weather for a single crop and time horizon
#'
#' @param lp_crop LP for a specific crop
#' @param h horizon (single value)
#' @param weather_variables vector of names of the weather variables
#' @param ic_conf confidence interval used to determine whether a shock has a
#'   significant effect (default to .95)
weather_contrib_crop_h <- function(lp_crop,
                                   h,
                                   weather_variables,
                                   ic_conf = .95) {
  # The data
  data_lp <- lp_crop$data_lp
  data_lp <- data_lp[[which(names(data_lp) == h)]] |> 
    select(region_id, date, product_eng, !!weather_variables) |> 
    ungroup()
  # The coefficients
  lp_coefs <- 
    lp_crop$coefs |> 
    filter(horizon == !!h, name %in% !!weather_variables) |> 
    mutate(
      value_lb = value - qnorm(1 - ((1 - ic_conf) / 2)) * std,
      value_ub = value + qnorm(1 - ((1 - ic_conf) / 2)) * std
    )
  
  # Keeping the values
  lp_coefs_value <- lp_coefs$value
  # The lower and upper bounds
  lp_coefs_value_lb <- lp_coefs$value_lb
  lp_coefs_value_ub <- lp_coefs$value_ub
  
  data_lp |> 
    nest(.by = c(date, region_id)) |> 
    mutate(
      contribution = map(
        .x = data,
        .f = ~ as.matrix(.x[, weather_variables]) %*% lp_coefs_value |> 
          sum()
      ),
      contribution_lb = map(
        .x = data,
        .f = ~ as.matrix(.x[, weather_variables]) %*% lp_coefs_value_lb |> 
          sum()
      ),
      contribution_ub = map(
        .x = data,
        .f = ~ as.matrix(.x[, weather_variables]) %*% lp_coefs_value_ub |> 
          sum()
      )
    ) |> 
    unnest(cols = c(contribution, contribution_lb, contribution_ub)) |> 
    select(-data) |> 
    mutate(
      significant = (contribution_lb > 0 & contribution_ub > 0) | (contribution_lb < 0 & contribution_ub < 0),
      significant = as.numeric(significant)
    ) |> 
    mutate(date = date + lubridate::period(str_c(!!h, " month")))
}
#' Computes the contribution of the weather for a single crop, for all horizons
#'
#' @param lp_crop LP for a specific crop
#' @param weather_variables vector of names of the weather variables
#' @param horizons vector of horizons. If `NULL`, uses all horizons in lp_crop
contrib_weather_crop <- function(lp_crop,
                                 weather_variables,
                                 horizons = NULL) {
  if (is.null(horizons)) horizons <- unique(lp_crop$coefs$horizon)
  
  map(
    .x = horizons,
    .f = ~weather_contrib_crop_h(
      lp_crop = lp_crop, 
      h = .x, 
      weather_variables = weather_variables
    ) |> 
      mutate(horizon = .x)
  ) |> 
    list_rbind() |> 
    # group_by(date) |> 
    # summarise(value = sum(contribution)) |> 
    mutate(crop = lp_crop$crop_name) |> 
    mutate(contribution_signif = contribution * significant)
}

Let us compute the \(\Gamma_{c,i,t,h}\) for each crop, region, date and horizon:

weather_measure_crop <- 
  map(
    .x = resul_lp,
    .f = ~contrib_weather_crop(
      lp_crop = .x, 
      weather_variables = weather_variables,
      horizons = 0:nb_periods_wcal
    )
  ) |> 
  list_rbind()

Let us add the monthly regional selling prices of the crops (df$Value_prices), as well as the average crop-specific prices computed earlier on the whole sample (average_price_crops$price_crop) which will be used as a weight when we will aggregate all crops.

weather_measure_crop <- 
  weather_measure_crop |> 
  left_join(
    df |> select(product_eng, region_id, date, y_new, Value_prices),
    by = c("date", "crop" = "product_eng", "region_id")
  ) |> 
  left_join(
    average_price_crops,
    by = c("crop" = "product_eng")
  )

weather_measure_crop
# A tibble: 123,552 × 12
   date       region_id contribution contribution_lb contribution_ub significant
   <date>     <fct>            <dbl>           <dbl>           <dbl>       <dbl>
 1 2001-01-01 1               0.340           0.444         0.236              1
 2 2001-02-01 1               0.239           0.376         0.101              1
 3 2001-03-01 1               0.162           0.206         0.118              1
 4 2001-04-01 1               0.0901          0.180         0.000664           1
 5 2001-05-01 1               0.112           0.142         0.0829             1
 6 2001-06-01 1               0.190           0.283         0.0980             1
 7 2001-07-01 1               0.111           0.149         0.0731             1
 8 2001-08-01 1               0.0361          0.0565        0.0157             1
 9 2001-09-01 1               0.136           0.140         0.132              1
10 2001-10-01 1               0.0317          0.0580        0.00533            1
# ℹ 123,542 more rows
# ℹ 6 more variables: horizon <int>, crop <chr>, contribution_signif <dbl>,
#   y_new <dbl>, Value_prices <dbl>, price_crop <dbl>

17.1.2 Step 2: Quantity Weights

For each crop and date \(t\), we define some weights for the regional observations using the data observed at horizon \(h=0\), as the sum of the monthly agricultural production over the regions considered in the analysis. The monthly production is expressed in monetary terms, by multiplying the quantities (y_new, i.e., \(y^{raw}\)) by unit price (price_crop, i.e., \(p_c\)).

\[\omega_{c,t} = \sum_{i} y^{\text{raw}}_{c,t,i} \times p_{c}\]

quantity_weight <- 
  weather_measure_crop |> 
  filter(horizon == 0) |> 
  group_by(crop, date, horizon, price_crop) |> 
  summarise(quantity_weight = sum(price_crop * y_new), .groups = "drop") |> 
  select(crop, date, quantity_weight)
quantity_weight
# A tibble: 720 × 3
   crop    date       quantity_weight
   <chr>   <date>               <dbl>
 1 Cassava 2001-01-01          38797.
 2 Cassava 2001-02-01          39625.
 3 Cassava 2001-03-01          44893.
 4 Cassava 2001-04-01          44893.
 5 Cassava 2001-05-01          41857.
 6 Cassava 2001-06-01          36333.
 7 Cassava 2001-07-01          36333.
 8 Cassava 2001-08-01          39766.
 9 Cassava 2001-09-01          36525.
10 Cassava 2001-10-01          36525.
# ℹ 710 more rows

17.1.3 Step 3: Crop-Specific Weather-Adjusted Agricultural Production

For each crop \(c\), at each date \(t\), we compute the weather-adjusted agricultural production, \(y_{c,t}^{\omega}\), as the sum of the significant crop-specific contributions of the weather to the agricultural production. The crop-specific contribution across regions is first aggregated at the national level, using an average of the crop and region-specific contribution of the weather to the monetary equivalence of the agricultural production.

\[y_{c,t}^{\omega} = \sum_{h}\sum_{i} \frac{\mathbb{1}_{\text{signif}_{c,i,t,h}} \times \gamma_{c,i,t,h} \times p_{c} \times y^{\text{raw}}_{c,t,i}}{\text{card}(I_{c,t})},\]

where \(\text{card(I)}\) is the number of regions that produce crop \(c\) at time \(t\). The characteristic function \(\mathbb{1}_{\text{signif}_{c,it,h}}\) is equal to 1 when the contribution is significantly different from 0 (using the 95% confidence intervals of the coefficients \(\beta_{c,h}^{T}\) and \(\beta_{c,h}^{P}\)), and is equal to 0 otherwise.

weather_adjusted_ag <- 
  weather_measure_crop |> 
  # each group: observations across regions, for a crop x date x horizon
  group_by(crop, date, horizon, price_crop) |> 
  # weather-adjusted agricultural production at each horizon
  # y_{c,t,h}^{w}
  summarise(
    y_w = sum(price_crop * contribution_signif *  y_new / n(), na.rm = TRUE),
    .groups = "drop"
  ) |> 
  group_by(crop, date) |> 
  # weather-adjusted agricultural production summed over horizons
  # y_{c,t}^{w}
  summarise(
    y_w = sum(y_w),
    .groups = "drop"
  )

17.1.4 Step 4: Aggregation at the National Level

Then, we aggregate the crop-specific weather-adjusted agricultural production at the national level using the following formula: \[y_{t}^{\omega} = \frac{\sum_{c} y_{c,t}^{\omega}}{\sum_{c}\omega_{c,t}},\]

where \(\omega_{c,t}\) are the quantity weights computed in the second step.

w_df <- 
  weather_adjusted_ag |> 
  left_join(quantity_weight, by = c("crop", "date")) |> 
  group_by(date) |> 
  summarise(
    w = sum(y_w) / sum(quantity_weight),
    .groups = "drop"
  )

17.1.5 Step 5: Detrending

Lastly, we express the national weather-adjusted production as a loss, and take it as a deviation from its trend:

\[ W_{t} = -100 \times (y_{t}^{\omega} - \overline{y_{t}^{\omega}}), \]

where \(y_{t}^{\omega}\) is the trend, obtained with the HP filter.

# Load detrending functions
source("../weatherperu/R/detrending.R")

w_df <- w_df |> 
  mutate(
    w_trend = hp_filter_trend(w, freq = 14400),
    w_dt = - 100 * (w - w_trend),
  )

17.2 Agricultural Production

In the second step in the creation of the synthetic measure of the weater, we computed quantity weights \(\omega_{c,t}\), which correspond to the agricultural production in month \(t\) for crop \(t\), expressed in monetary terms. Let us aggregate these values across crops to obtain a monthly agricultural production: \[y_t^{A} = \sum_{c}\omega_{c,t}\]

We then express these as percentage deviation from their trend computed using the HP filter.

agricultural_output <- 
  quantity_weight |> 
  group_by(date) |> 
  summarise(quantity_weight = sum(quantity_weight), .groups = "drop") |> 
  mutate(
    # Remove seasonality
    q_sa = adj_season_X13(quantity_weight, ymd("2001-01-01")),
    # Extract trend
    q_sa_trend = hp_filter_trend(q_sa, freq = 14400),
    # Percentage dev. from trend
    q = 100 * log(q_sa / q_sa_trend)
  ) |> 
  select(date, q)

Note: this data is actually not used.

17.3 Macroeconomic indicators

The vector of endogenous variables in the estimation, denoted as \(Y_t\), consists of eight variables: \(W_t\), \(RER_t\), \(\pi_t^{a}\), \(\pi_{t}\) , \(X_t\), \(y^A_t\), \(y_t\), and \(r_t\):

  • \(W_t\) represents the aggregate measure of weather-driven agricultural losses defined in Section 17.1, which quantifies the loss in agricultural value added due to weather shocks, expressed as a deviation from its trend. It is the focal variable of interest in this analysis.

  • \(RER_t\) denotes the Real Exchange Rate (RER), which reflects the relative value of the domestic currency against a basket of foreign currencies.

  • \(\pi^a_t\) corresponds to the percentage change of the Food Consumer Price Index (CPIA), which serves as a measure of food inflation.

  • \(\pi_t\) corresponds to the percentage change of the Consumer Price Index (CPI), which serves as a measure of inflation.

  • \(X_t\) denotes Exports.

  • \(y^A_t\) is the Agricultural production.

  • \(y_t\) represents the Gross Domestic Product (GDP), which serves as a measure of the overall economic activity and output in the country.

  • \(r_t\) is the nominal rate.

To construct the vectors \(Y_t\), we use data from the Central Reserve Bank of Perú.

The Real Exchange Rate (RER) data are obtained using the token PN01259PM, the Food Consumer Price Index (CPIA) data with token PN01336PM, the Consumer Price Index (CPI) data with token PN01270PM, the Exports data with token PN01461BM, the GDP data with token PN01773AM, the agricultural GDP with token PN01755AM, and the nominal rate with token PN07819NM.

Let us load the dataset of macroeconomic variables (see Chapter 3 for details on the construction of these variables).

load("../data/output/macro/df_macro.rda")

17.4 Merging the Data

The sample period for our analysis covers the time span from January 2003 (2003M1) to December 2015 (2015M12). This period provides a comprehensive view of the relationship between weather-driven agricultural losses and the selected economic indicators in Peru.

df_var <- 
  df_macro |> 
  left_join(
    w_df,
    by = "date"
  ) |> 
  mutate(
    w = w_dt,
    q = ya
  )
  
variable_names <- c(
  "Agricultural losses" = "w",
  "Real exchange rate" = "rer_dt_sa",
  "Food inflation rate (pp)" = "pia",
  "Inflation rate (pp)" = "pi",
  "Exports (pp)" = "x",
  "Agricultural output (pp)" = "q",
  "GDP (pp)" = "y",
  "Interest rate (pp)" = "r"
)

Let us add labels to the new columns:

df_var <- 
  df_var |>  
  labelled::set_variable_labels(
    w = "Agricultural losses"
  )

Let us divide the all the values (except exports) by 100:

df_var <- 
  df_var |>  
  labelled::set_variable_labels(
    w = "Agricultural losses",
    q = "Agricultural output (pp)"
  ) |> 
  mutate(
    w = w / 100, 
    rer_dt_sa = rer_dt_sa / 100, 
    pi = pi / 100, 
    pia = pia / 100, 
    # x
    q = q / 100, 
    y = y / 100, 
    r = r / 100
  )

Figure Figure 17.1 displays the time series data for the variables included in the vector \(Y\).

ggplot(
    data = df_var |> 
      filter(date >= "2003-01-01") |> 
      select(date, w, rer_dt_sa, pia, pi, x, q, y, r) |> 
      pivot_longer(cols = -date) |> 
      mutate(
        name = factor(
          name,
          levels = variable_names,
          labels = names(variable_names)
        )
      ),
    mapping = aes(x = date, y = value)
  ) +
  geom_line() +
  facet_wrap(~name, scales = "free_y") +
  theme_paper() +
  labs(x = NULL, y = NULL)
Figure 17.1: Time Series of Endogenous Variables for Vector Autoregression (VAR) Analysis in Peru (2003-2015)

Before proceeding to the estimation, there is one final step, which involves converting the data into the ts format.

start_date <- "2003-01-01"
df_var_ts <-
  df_var |> 
  filter(date >= start_date) |> 
  select(
    w, rer_dt_sa, pia, pi, x, q, y, r
  ) |>
  ts(start = c(year(start_date), month(start_date)), freq = 12)

17.5 VAR Estimation

We estimate a VAR(p) model with a constant term but no trend. Let us look how many lags we should use, using the automatic selection method provided by the VARselect() function from {vars}.

info_var_estim <- vars::VARselect(y = df_var_ts, type = "const", lag.max = 6)
info_var_estim
$selection
AIC(n)  HQ(n)  SC(n) FPE(n) 
     2      1      1      2 

$criteria
                   1             2             3             4             5
AIC(n) -7.747263e+01 -7.770196e+01 -7.739961e+01 -7.700066e+01 -7.688240e+01
HQ(n)  -7.688553e+01 -7.659299e+01 -7.576878e+01 -7.484796e+01 -7.420784e+01
SC(n)  -7.602753e+01 -7.497231e+01 -7.338543e+01 -7.170194e+01 -7.029915e+01
FPE(n)  2.262378e-34  1.810786e-34  2.492771e-34  3.840991e-34  4.570219e-34
                   6
AIC(n) -7.688737e+01
HQ(n)  -7.369094e+01
SC(n)  -6.901958e+01
FPE(n)  4.949715e-34

17.5.1 Results

Let us estimate a VAR(2) model with a constant term but no trend.

var_l1 <- vars::VAR(y = df_var_ts, p = 2, type = "const")
summary(var_l1)

VAR Estimation Results:
========================= 
Endogenous variables: w, rer_dt_sa, pia, pi, x, q, y, r 
Deterministic variables: const 
Sample size: 154 
Log Likelihood: 4365.114 
Roots of the characteristic polynomial:
0.9046 0.9046 0.8016 0.8016 0.5208 0.5208 0.4869 0.3924 0.3924 0.3918 0.3918 0.3161 0.3001 0.3001 0.2654 0.2654
Call:
vars::VAR(y = df_var_ts, p = 2, type = "const")


Estimation results for equation w: 
================================== 
w = w.l1 + rer_dt_sa.l1 + pia.l1 + pi.l1 + x.l1 + q.l1 + y.l1 + r.l1 + w.l2 + rer_dt_sa.l2 + pia.l2 + pi.l2 + x.l2 + q.l2 + y.l2 + r.l2 + const 

              Estimate Std. Error t value Pr(>|t|)    
w.l1          1.306040   0.080118  16.301  < 2e-16 ***
rer_dt_sa.l1  0.046111   0.054023   0.854   0.3948    
pia.l1       -0.136006   0.221138  -0.615   0.5396    
pi.l1         0.690791   0.459060   1.505   0.1347    
x.l1         -0.006499   0.006041  -1.076   0.2839    
q.l1         -0.004749   0.022919  -0.207   0.8362    
y.l1         -0.058412   0.054691  -1.068   0.2874    
r.l1          0.345238   0.270627   1.276   0.2042    
w.l2         -0.465249   0.080684  -5.766 5.14e-08 ***
rer_dt_sa.l2 -0.096123   0.055889  -1.720   0.0877 .  
pia.l2        0.023634   0.219890   0.107   0.9146    
pi.l2        -0.463362   0.452074  -1.025   0.3072    
x.l2          0.002580   0.005809   0.444   0.6576    
q.l2          0.014389   0.022552   0.638   0.5245    
y.l2         -0.043382   0.055677  -0.779   0.4372    
r.l2         -0.422871   0.263612  -1.604   0.1110    
const         0.007019   0.008466   0.829   0.4085    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Residual standard error: 0.006198 on 137 degrees of freedom
Multiple R-Squared: 0.8979, Adjusted R-squared: 0.886 
F-statistic:  75.3 on 16 and 137 DF,  p-value: < 2.2e-16 


Estimation results for equation rer_dt_sa: 
========================================== 
rer_dt_sa = w.l1 + rer_dt_sa.l1 + pia.l1 + pi.l1 + x.l1 + q.l1 + y.l1 + r.l1 + w.l2 + rer_dt_sa.l2 + pia.l2 + pi.l2 + x.l2 + q.l2 + y.l2 + r.l2 + const 

              Estimate Std. Error t value Pr(>|t|)    
w.l1         -0.048520   0.125584  -0.386   0.6998    
rer_dt_sa.l1  1.031043   0.084680  12.176   <2e-16 ***
pia.l1        0.416236   0.346630   1.201   0.2319    
pi.l1        -0.974084   0.719569  -1.354   0.1781    
x.l1          0.011715   0.009470   1.237   0.2182    
q.l1         -0.025749   0.035925  -0.717   0.4747    
y.l1          0.101000   0.085727   1.178   0.2408    
r.l1         -0.358932   0.424204  -0.846   0.3990    
w.l2          0.122906   0.126471   0.972   0.3329    
rer_dt_sa.l2 -0.200048   0.087605  -2.284   0.0239 *  
pia.l2        0.033474   0.344674   0.097   0.9228    
pi.l2         0.166914   0.708618   0.236   0.8141    
x.l2         -0.016094   0.009106  -1.767   0.0794 .  
q.l2         -0.014405   0.035350  -0.407   0.6843    
y.l2          0.011787   0.087273   0.135   0.8928    
r.l2          0.385006   0.413207   0.932   0.3531    
const         0.004251   0.013271   0.320   0.7492    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Residual standard error: 0.009716 on 137 degrees of freedom
Multiple R-Squared: 0.7759, Adjusted R-squared: 0.7498 
F-statistic: 29.65 on 16 and 137 DF,  p-value: < 2.2e-16 


Estimation results for equation pia: 
==================================== 
pia = w.l1 + rer_dt_sa.l1 + pia.l1 + pi.l1 + x.l1 + q.l1 + y.l1 + r.l1 + w.l2 + rer_dt_sa.l2 + pia.l2 + pi.l2 + x.l2 + q.l2 + y.l2 + r.l2 + const 

               Estimate Std. Error t value Pr(>|t|)  
w.l1          0.0228987  0.0583039   0.393   0.6951  
rer_dt_sa.l1  0.0593240  0.0393139   1.509   0.1336  
pia.l1        0.1766751  0.1609276   1.098   0.2742  
pi.l1         0.1011576  0.3340698   0.303   0.7625  
x.l1         -0.0049384  0.0043965  -1.123   0.2633  
q.l1         -0.0182040  0.0166785  -1.091   0.2770  
y.l1          0.0081665  0.0397998   0.205   0.8377  
r.l1         -0.0758842  0.1969423  -0.385   0.7006  
w.l2         -0.0329210  0.0587156  -0.561   0.5759  
rer_dt_sa.l2 -0.0072449  0.0406719  -0.178   0.8589  
pia.l2       -0.0134118  0.1600194  -0.084   0.9333  
pi.l2         0.0458875  0.3289856   0.139   0.8893  
x.l2          0.0027569  0.0042274   0.652   0.5154  
q.l2          0.0008317  0.0164116   0.051   0.9597  
y.l2          0.0822987  0.0405176   2.031   0.0442 *
r.l2          0.0449044  0.1918371   0.234   0.8153  
const         0.0058256  0.0061610   0.946   0.3460  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Residual standard error: 0.004511 on 137 degrees of freedom
Multiple R-Squared: 0.195,  Adjusted R-squared: 0.101 
F-statistic: 2.074 on 16 and 137 DF,  p-value: 0.01272 


Estimation results for equation pi: 
=================================== 
pi = w.l1 + rer_dt_sa.l1 + pia.l1 + pi.l1 + x.l1 + q.l1 + y.l1 + r.l1 + w.l2 + rer_dt_sa.l2 + pia.l2 + pi.l2 + x.l2 + q.l2 + y.l2 + r.l2 + const 

               Estimate Std. Error t value Pr(>|t|)  
w.l1          0.0080372  0.0283975   0.283   0.7776  
rer_dt_sa.l1  0.0443933  0.0191482   2.318   0.0219 *
pia.l1       -0.0271240  0.0783814  -0.346   0.7298  
pi.l1         0.2721367  0.1627121   1.673   0.0967 .
x.l1         -0.0016133  0.0021414  -0.753   0.4525  
q.l1         -0.0112904  0.0081234  -1.390   0.1668  
y.l1          0.0260703  0.0193849   1.345   0.1809  
r.l1         -0.0067475  0.0959227  -0.070   0.9440  
w.l2         -0.0171631  0.0285981  -0.600   0.5494  
rer_dt_sa.l2 -0.0149574  0.0198097  -0.755   0.4515  
pia.l2        0.0139319  0.0779391   0.179   0.8584  
pi.l2        -0.0333737  0.1602358  -0.208   0.8353  
x.l2          0.0012462  0.0020590   0.605   0.5460  
q.l2          0.0002241  0.0079934   0.028   0.9777  
y.l2          0.0350258  0.0197345   1.775   0.0781 .
r.l2         -0.0117855  0.0934362  -0.126   0.8998  
const         0.0030110  0.0030008   1.003   0.3174  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Residual standard error: 0.002197 on 137 degrees of freedom
Multiple R-Squared: 0.2757, Adjusted R-squared: 0.1911 
F-statistic:  3.26 on 16 and 137 DF,  p-value: 8.545e-05 


Estimation results for equation x: 
================================== 
x = w.l1 + rer_dt_sa.l1 + pia.l1 + pi.l1 + x.l1 + q.l1 + y.l1 + r.l1 + w.l2 + rer_dt_sa.l2 + pia.l2 + pi.l2 + x.l2 + q.l2 + y.l2 + r.l2 + const 

             Estimate Std. Error t value Pr(>|t|)    
w.l1          0.19287    1.13440   0.170   0.8652    
rer_dt_sa.l1 -0.18287    0.76491  -0.239   0.8114    
pia.l1       -1.44110    3.13111  -0.460   0.6461    
pi.l1         5.66205    6.49987   0.871   0.3852    
x.l1          0.14015    0.08554   1.638   0.1036    
q.l1         -0.49746    0.32451  -1.533   0.1276    
y.l1          1.14128    0.77437   1.474   0.1428    
r.l1         -1.09894    3.83183  -0.287   0.7747    
w.l2         -1.37597    1.14241  -1.204   0.2305    
rer_dt_sa.l2  0.07380    0.79134   0.093   0.9258    
pia.l2       -1.47822    3.11344  -0.475   0.6357    
pi.l2         3.89828    6.40095   0.609   0.5435    
x.l2          0.14727    0.08225   1.790   0.0756 .  
q.l2         -0.15771    0.31931  -0.494   0.6222    
y.l2          0.33067    0.78834   0.419   0.6755    
r.l2         -0.75509    3.73250  -0.202   0.8400    
const         0.79838    0.11987   6.660 6.09e-10 ***
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Residual standard error: 0.08776 on 137 degrees of freedom
Multiple R-Squared: 0.2285, Adjusted R-squared: 0.1384 
F-statistic: 2.536 on 16 and 137 DF,  p-value: 0.001903 


Estimation results for equation q: 
================================== 
q = w.l1 + rer_dt_sa.l1 + pia.l1 + pi.l1 + x.l1 + q.l1 + y.l1 + r.l1 + w.l2 + rer_dt_sa.l2 + pia.l2 + pi.l2 + x.l2 + q.l2 + y.l2 + r.l2 + const 

              Estimate Std. Error t value Pr(>|t|)  
w.l1         -0.221275   0.307297  -0.720   0.4727  
rer_dt_sa.l1 -0.165336   0.207208  -0.798   0.4263  
pia.l1       -0.404183   0.848187  -0.477   0.6345  
pi.l1        -0.947496   1.760751  -0.538   0.5914  
x.l1         -0.004343   0.023172  -0.187   0.8516  
q.l1          0.195050   0.087906   2.219   0.0281 *
y.l1          0.099675   0.209769   0.475   0.6354  
r.l1          0.664620   1.038006   0.640   0.5231  
w.l2         -0.117578   0.309467  -0.380   0.7046  
rer_dt_sa.l2  0.012057   0.214366   0.056   0.9552  
pia.l2       -1.124135   0.843400  -1.333   0.1848  
pi.l2         1.260305   1.733955   0.727   0.4686  
x.l2         -0.023058   0.022281  -1.035   0.3026  
q.l2         -0.143117   0.086499  -1.655   0.1003  
y.l2         -0.013976   0.213553  -0.065   0.9479  
r.l2         -0.292466   1.011098  -0.289   0.7728  
const         0.018331   0.032472   0.565   0.5733  
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Residual standard error: 0.02377 on 137 degrees of freedom
Multiple R-Squared: 0.215,  Adjusted R-squared: 0.1233 
F-statistic: 2.345 on 16 and 137 DF,  p-value: 0.004218 


Estimation results for equation y: 
================================== 
y = w.l1 + rer_dt_sa.l1 + pia.l1 + pi.l1 + x.l1 + q.l1 + y.l1 + r.l1 + w.l2 + rer_dt_sa.l2 + pia.l2 + pi.l2 + x.l2 + q.l2 + y.l2 + r.l2 + const 

              Estimate Std. Error t value Pr(>|t|)    
w.l1         -0.135287   0.127746  -1.059  0.29145    
rer_dt_sa.l1 -0.057330   0.086138  -0.666  0.50681    
pia.l1        0.235367   0.352599   0.668  0.50556    
pi.l1         0.543544   0.731961   0.743  0.45900    
x.l1         -0.003029   0.009633  -0.314  0.75370    
q.l1          0.041480   0.036543   1.135  0.25832    
y.l1          0.401592   0.087203   4.605 9.31e-06 ***
r.l1          0.364126   0.431509   0.844  0.40023    
w.l2          0.202041   0.128648   1.570  0.11861    
rer_dt_sa.l2  0.015182   0.089114   0.170  0.86497    
pia.l2       -0.226865   0.350609  -0.647  0.51868    
pi.l2         0.273563   0.720821   0.380  0.70489    
x.l2          0.012710   0.009262   1.372  0.17225    
q.l2          0.015528   0.035958   0.432  0.66654    
y.l2          0.244103   0.088776   2.750  0.00677 ** 
r.l2         -0.338894   0.420323  -0.806  0.42149    
const        -0.013156   0.013499  -0.975  0.33148    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Residual standard error: 0.009883 on 137 degrees of freedom
Multiple R-Squared: 0.5336, Adjusted R-squared: 0.4792 
F-statistic: 9.798 on 16 and 137 DF,  p-value: 5.699e-16 


Estimation results for equation r: 
================================== 
r = w.l1 + rer_dt_sa.l1 + pia.l1 + pi.l1 + x.l1 + q.l1 + y.l1 + r.l1 + w.l2 + rer_dt_sa.l2 + pia.l2 + pi.l2 + x.l2 + q.l2 + y.l2 + r.l2 + const 

               Estimate Std. Error t value Pr(>|t|)    
w.l1         -7.247e-03  2.164e-02  -0.335   0.7382    
rer_dt_sa.l1  7.094e-03  1.459e-02   0.486   0.6277    
pia.l1        3.625e-03  5.973e-02   0.061   0.9517    
pi.l1         2.501e-02  1.240e-01   0.202   0.8405    
x.l1         -7.099e-06  1.632e-03  -0.004   0.9965    
q.l1          2.544e-03  6.191e-03   0.411   0.6817    
y.l1          1.608e-02  1.477e-02   1.088   0.2783    
r.l1          1.459e+00  7.310e-02  19.960  < 2e-16 ***
w.l2          1.241e-02  2.179e-02   0.570   0.5699    
rer_dt_sa.l2 -8.054e-03  1.510e-02  -0.534   0.5945    
pia.l2       -8.419e-03  5.939e-02  -0.142   0.8875    
pi.l2         2.040e-01  1.221e-01   1.670   0.0971 .  
x.l2          5.125e-04  1.569e-03   0.327   0.7444    
q.l2         -4.291e-03  6.091e-03  -0.704   0.4824    
y.l2          2.622e-02  1.504e-02   1.743   0.0835 .  
r.l2         -5.185e-01  7.120e-02  -7.282 2.34e-11 ***
const         1.187e-03  2.287e-03   0.519   0.6046    
---
Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1


Residual standard error: 0.001674 on 137 degrees of freedom
Multiple R-Squared: 0.9819, Adjusted R-squared: 0.9797 
F-statistic: 463.6 on 16 and 137 DF,  p-value: < 2.2e-16 



Covariance matrix of residuals:
                   w  rer_dt_sa        pia         pi          x          q
w          3.842e-05 -8.365e-06  8.254e-07 -2.939e-07  1.410e-05  1.128e-05
rer_dt_sa -8.365e-06  9.440e-05 -4.134e-06 -2.720e-06 -3.258e-05  1.323e-05
pia        8.254e-07 -4.134e-06  2.035e-05  8.395e-06 -2.955e-05  3.655e-06
pi        -2.939e-07 -2.720e-06  8.395e-06  4.827e-06 -2.616e-05  3.657e-06
x          1.410e-05 -3.258e-05 -2.955e-05 -2.616e-05  7.703e-03 -3.240e-04
q          1.128e-05  1.323e-05  3.655e-06  3.657e-06 -3.240e-04  5.652e-04
y         -1.687e-06  5.904e-06  1.355e-06  2.014e-06 -4.146e-05  6.308e-05
r          1.040e-06  5.704e-07  1.956e-06  8.289e-07 -1.005e-05  1.266e-06
                   y          r
w         -1.687e-06  1.040e-06
rer_dt_sa  5.904e-06  5.704e-07
pia        1.355e-06  1.956e-06
pi         2.014e-06  8.289e-07
x         -4.146e-05 -1.005e-05
q          6.308e-05  1.266e-06
y          9.768e-05  3.728e-06
r          3.728e-06  2.803e-06

Correlation matrix of residuals:
                 w rer_dt_sa      pia       pi        x        q        y
w          1.00000  -0.13889  0.02952 -0.02158  0.02591  0.07654 -0.02754
rer_dt_sa -0.13889   1.00000 -0.09432 -0.12740 -0.03821  0.05728  0.06149
pia        0.02952  -0.09432  1.00000  0.84714 -0.07465  0.03408  0.03039
pi        -0.02158  -0.12740  0.84714  1.00000 -0.13567  0.07002  0.09276
x          0.02591  -0.03821 -0.07465 -0.13567  1.00000 -0.15528 -0.04780
q          0.07654   0.05728  0.03408  0.07002 -0.15528  1.00000  0.26844
y         -0.02754   0.06149  0.03039  0.09276 -0.04780  0.26844  1.00000
r          0.10026   0.03506  0.25906  0.22534 -0.06839  0.03181  0.22527
                 r
w          0.10026
rer_dt_sa  0.03506
pia        0.25906
pi         0.22534
x         -0.06839
q          0.03181
y          0.22527
r          1.00000

17.5.2 Restricted VAR

We impose some restrictions on the VAR:

a <- diag(1, 8)
a[lower.tri(a)] <- NA
a
     [,1] [,2] [,3] [,4] [,5] [,6] [,7] [,8]
[1,]    1    0    0    0    0    0    0    0
[2,]   NA    1    0    0    0    0    0    0
[3,]   NA   NA    1    0    0    0    0    0
[4,]   NA   NA   NA    1    0    0    0    0
[5,]   NA   NA   NA   NA    1    0    0    0
[6,]   NA   NA   NA   NA   NA    1    0    0
[7,]   NA   NA   NA   NA   NA   NA    1    0
[8,]   NA   NA   NA   NA   NA   NA   NA    1
svar_a <- vars::SVAR(var_l1, Amat = a, max.iter = 1000)
Warning in vars::SVAR(var_l1, Amat = a, max.iter = 1000): Convergence not
achieved after 1000 iterations. Convergence value: 6.81032508658627e-05 .

The matrix of the estimated coefficients:

svar_a$A
                   w  rer_dt_sa        pia         pi           x           q
w         1.00000000 0.00000000 0.00000000 0.00000000 0.000000000 0.000000000
rer_dt_sa 0.10443238 1.00000000 0.00000000 0.00000000 0.000000000 0.000000000
pia       0.09576007 0.09535393 1.00000000 0.00000000 0.000000000 0.000000000
pi        0.09565631 0.09347590 0.08923415 1.00000000 0.000000000 0.000000000
x         0.09077617 0.12705693 0.12991314 0.12808971 1.000000000 0.000000000
q         0.07624405 0.07291027 0.08563015 0.08710426 0.042308911 1.000000000
y         0.07910663 0.06949304 0.07726102 0.07790653 0.006098028 0.005853906
r         0.07799215 0.07468340 0.07802918 0.08026269 0.004230866 0.047414317
                   y r
w         0.00000000 0
rer_dt_sa 0.00000000 0
pia       0.00000000 0
pi        0.00000000 0
x         0.00000000 0
q         0.00000000 0
y         1.00000000 0
r         0.07505698 1
save(svar_a, df_var, file = "../R/output/var_objects_chirps.rda")

17.5.3 Impulse Response Functions

Let us focus on the impulse to the weather aggregate cost equation, with 95% confidence bootstrapped error bands (500 runs).

impulse_name <- "w"

The following estimations are not run in this notebook. The estimation takes about 10 minutes each.

nb_runs <- 500

irfs_95 <- vars::irf(
  svar_a, impulse = impulse_name, boot = TRUE, ci = .95, 
  n.ahead = 20, runs = nb_runs
)

And with 68% confidence bootstrapped error bands (500 runs, again).

irfs_68 <- vars::irf(
  svar_a, impulse = impulse_name, boot = TRUE, ci = .68, 
  n.ahead = 20, runs = nb_runs
)

The results can be saved:

save(irfs_95, file = "../R/output/irfs_95_chirps.rda")
save(irfs_68, file = "../R/output/irfs_68_chirps.rda")

Let us load previously estimated IRFs.

load("../R/output/irfs_95_chirps.rda")
load("../R/output/irfs_68_chirps.rda")
levels <- variable_names
labels <- names(variable_names)

Now, we can plot the resulting IRFs. Let us prepare the data for the response:

df_irfs <- 
  irfs_95$irf[[impulse_name]] |> 
  as_tibble() |> 
  mutate(horizon = row_number() - 1) |> 
  pivot_longer(cols = -horizon) |> 
  mutate(impulse = !!impulse_name)

df_irfs <- 
  df_irfs |> 
  mutate(
    name = factor(
      name,
      levels = !!levels,
      labels = !!labels
    )
  )

The error bands:

df_irfs_ci <- 
  map(
    .x = list(`95` = irfs_95, `68` = irfs_68),
    .f = function(irf_lvl) {
      map(
        .x = list(
          lower = irf_lvl$Lower[[impulse_name]], 
          mean = irf_lvl$irf[[impulse_name]],
          upper = irf_lvl$Upper[[impulse_name]]),
        .f = ~ .x |> 
          as_tibble() |> 
          mutate(horizon = row_number() - 1) |> 
          pivot_longer(cols = -horizon, values_to = "bound") |> 
          mutate(impulse = !!impulse_name)
      ) |> 
        list_rbind(names_to = "bound_type")
    }
  ) |> 
  list_rbind(names_to = "level") |> 
  pivot_wider(names_from = bound_type, values_from = bound)

df_irfs_ci <- 
  df_irfs_ci |> 
  mutate(
    name = factor(
      name,
      levels = !!levels,
      labels = !!labels),
    level = factor(level, levels = c(68, 95), labels = c("68%", "95%"))
  )

And lastly, the graph.

ggplot() +
  geom_ribbon(
    data = df_irfs_ci,
    mapping = aes(
      x = horizon,
      ymin = lower, ymax = upper,
      fill = level),
    alpha = .3
  ) +
  geom_line(
    data = df_irfs_ci,
    mapping = aes(x = horizon, y = mean),
    colour = "#0072B2"
  ) +
  geom_hline(yintercept = 0, colour = "#444444") +
  labs(x = "Horizon", y = NULL) +
  scale_fill_manual(
    "C.I. level", 
    values = c("68%" = "#0072B2", "95%" = "#56B4E9")) +
  facet_wrap(~name, scales = "free_y", ncol = 4) +
  theme_paper() +
  coord_cartesian(xlim = c(0, 20))
Figure 17.2: VAR(2) system response to one standard deviation orthogonal shock to the weather aggregate cost equation

The exact figure replication:

Code
library(tikzDevice)
library(lemon)
ggplot() +
  geom_ribbon(
    data = df_irfs_ci |> 
      filter(level == "68%") |> 
      mutate(level = str_replace(level, "\\%", "\\\\%")),
    mapping = aes(x = horizon,
                  ymin = lower, ymax = upper,
                  fill = level),
    alpha = .2
  ) +
  geom_line(
    data = df_irfs,
    mapping = aes(x = horizon, y = value),
    colour = "#009E73"
  ) +
  geom_hline(yintercept = 0, colour = "#444444") +
  labs(x = "Horizon", y = NULL) +
  scale_fill_manual(
    "C.I. level", 
    values = c("68\\%" = "gray10", "95\\%" = "gray60"),
    guide = "none") +
  facet_rep_wrap(~name, scales = "free_y", repeat.tick.labels = TRUE, ncol = 4) +
  theme_paper() +
  coord_cartesian(xlim = c(0, 20))
Figure 17.3: VAR(2) system response to one standard deviation orthogonal shock to the weather aggregate cost equation. The gray bands depict the 68% confidence intervals.

17.6 Comparison between PISCOp and CHIRPS data

We can plot the IRFs obtained using either the PISCOp rainfall data or the CHIRPS rainfall data.

Code
# PISCOp data
load("../R/output/irfs_68_piscop.rda")
load("../R/output/irfs_95_piscop.rda")

df_irfs_piscop <- 
  irfs_68$irf[[impulse_name]] |> 
  as_tibble() |> 
  mutate(horizon = row_number() - 1) |> 
  pivot_longer(cols = -horizon) |> 
  mutate(impulse = !!impulse_name)

df_irfs_piscop <- 
  df_irfs_piscop |> 
  mutate(
    name = factor(
      name,
      levels = !!levels,
      labels = !!labels
    )
  )

df_irfs_ci_piscop <- 
  map(
    .x = list(`95` = irfs_95, `68` = irfs_68),
    .f = function(irf_lvl) {
      map(
        .x = list(
          lower = irf_lvl$Lower[[impulse_name]], 
          mean = irf_lvl$irf[[impulse_name]],
          upper = irf_lvl$Upper[[impulse_name]]),
        .f = ~ .x |> 
          as_tibble() |> 
          mutate(horizon = row_number() - 1) |> 
          pivot_longer(cols = -horizon, values_to = "bound") |> 
          mutate(impulse = !!impulse_name)
      ) |> 
        list_rbind(names_to = "bound_type")
    }
  ) |> 
  list_rbind(names_to = "level") |> 
  pivot_wider(names_from = bound_type, values_from = bound)

df_irfs_ci_piscop <- 
  df_irfs_ci_piscop |> 
  mutate(
    name = factor(
      name,
      levels = !!levels,
      labels = !!labels),
    level = factor(level, levels = c(68, 95), labels = c("68%", "95%"))
  )

# CHIRPS data
load("../R/output/irfs_68_chirps.rda")
load("../R/output/irfs_95_chirps.rda")
df_irfs_chirps <- 
  irfs_68$irf[[impulse_name]] |> 
  as_tibble() |> 
  mutate(horizon = row_number() - 1) |> 
  pivot_longer(cols = -horizon) |> 
  mutate(impulse = !!impulse_name)

df_irfs_chirps <- 
  df_irfs_chirps |> 
  mutate(
    name = factor(
      name,
      levels = !!levels,
      labels = !!labels
    )
  )

df_irfs_ci_chirps <- 
  map(
    .x = list(`95` = irfs_95, `68` = irfs_68),
    .f = function(irf_lvl) {
      map(
        .x = list(
          lower = irf_lvl$Lower[[impulse_name]], 
          mean = irf_lvl$irf[[impulse_name]],
          upper = irf_lvl$Upper[[impulse_name]]),
        .f = ~ .x |> 
          as_tibble() |> 
          mutate(horizon = row_number() - 1) |> 
          pivot_longer(cols = -horizon, values_to = "bound") |> 
          mutate(impulse = !!impulse_name)
      ) |> 
        list_rbind(names_to = "bound_type")
    }
  ) |> 
  list_rbind(names_to = "level") |> 
  pivot_wider(names_from = bound_type, values_from = bound)

df_irfs_ci_chirps <- 
  df_irfs_ci_chirps |> 
  mutate(
    name = factor(
      name,
      levels = !!levels,
      labels = !!labels),
    level = factor(level, levels = c(68, 95), labels = c("68%", "95%"))
  )

# Merge results
df_irfs <- 
  df_irfs_piscop |> mutate(data = "PISCOp") |> 
  bind_rows(df_irfs_chirps |> mutate(data = "CHIRPS")) |> 
  mutate(data = factor(data, levels = c("PISCOp", "CHIRPS")))

df_irfs_ci <- 
  df_irfs_ci_piscop |> mutate(data = "PISCOp") |> 
  bind_rows(df_irfs_ci_chirps |> mutate(data = "CHIRPS"))

# Aesthetics
df_irfs_ci <- df_irfs_ci |> 
  mutate(
    fill_lab = str_c(data, "_", level),
    fill_lab = factor(
      fill_lab, 
      levels = c("PISCOp_68%", "PISCOp_95%", "CHIRPS_68%", "CHIRPS_95%"), 
      labels = c("PISCOp, 68%", "PISCOp, 95%", "CHIRPS, 68%", "CHIRPS, 95%")
    )
  )
Code
library(tikzDevice)
library(lemon)
ggplot() +
  geom_ribbon(
    data = df_irfs_ci |> 
      filter(level == "68%"),
    mapping = aes(x = horizon,
                  ymin = lower, ymax = upper,
                  fill = fill_lab),
    alpha = .2
  ) +
  geom_line(
    data = df_irfs,
    mapping = aes(x = horizon, y = value, colour = data),
    linewidth = 1.1
  ) +
  geom_hline(yintercept = 0, colour = "#444444") +
  labs(x = "Horizon", y = NULL) +
  scale_fill_manual(
    "Data, C.I. level", 
    values = c(
      "PISCOp, 68%" = "#117733", 
      "PISCOp, 95%" = "#44AA99", 
      "CHIRPS, 68%" = "#882255", 
      "CHIRPS, 95%" = "#CC6677"
    )
  ) +
  scale_colour_manual(
    NULL, values = c("PISCOp" = "#117733", "CHIRPS" = "#882255"), guide = "none"
  ) +
  facet_rep_wrap(~name, scales = "free_y", repeat.tick.labels = TRUE, ncol = 4) +
  theme_paper() +
  coord_cartesian(xlim = c(0, 20))
Figure 17.4: VAR(2) system response to an unit orthogonal shock to the weather aggregate cost equation, using either PISCOp data or CHIRPS data

17.7 Estimation with Local Projections

We can also estimate the propagation of the shock using local projections rather than VAR.

Let us build the table with the data:

df_lp <- 
  df_var |> 
  filter(date >= start_date) |> 
  select(
    w, rer_dt_sa, pia, pi, x, q, y, r
  )

The linear impulse response functions can be estimated using the lp_lin() function from {lpirfs}.

library(lpirfs)
# With 95% conf. int.
results_lin_95 <- lp_lin(
  endog_data     = df_lp,
  lags_endog_lin = 2,# 2 lags
  trend          = 0,# no trend
  shock_type     = 0,# std dev. shock
  confint        = 1.96,
  hor            = 20
)
# With 68% conf. int.
results_lin_68 <- lp_lin(
  endog_data     = df_lp,
  lags_endog_lin = 2,# 2 lags
  trend          = 0,# no trend
  shock_type     = 0,# std dev. shock
  confint        = 1,
  hor            = 20
)

We define a small function, get_irfs(), to format the IRFs from the object returned by lp_lin().

get_irfs <- function(resul_lin) {
  irf_lin_mean <- resul_lin[["irf_lin_mean"]]
  irf_lin_low <- resul_lin[["irf_lin_low"]]
  irf_lin_up <- resul_lin[["irf_lin_up"]]
  specs <- resul_lin$specs
  
  irfs_df <- NULL
  for (rr in 1:(specs$endog)) {
    for (ss in 1:(specs$endog)) {
      tbl_lin_mean <- as.matrix(t(irf_lin_mean[, 1:specs$hor, ss]))[, rr]
      tbl_lin_low <- as.matrix(t(irf_lin_low[, 1:specs$hor, ss]))[, rr]
      tbl_lin_up <- as.matrix(t(irf_lin_up[, 1:specs$hor, ss]))[, rr]
      tbl_lin <- tibble(
        horizon = seq_along(tbl_lin_mean), 
        mean = tbl_lin_mean, 
        low = tbl_lin_low, 
        up = tbl_lin_up,
        shocked = specs$column_names[ss],
        on = specs$column_names[rr]
      )
      irfs_df <- bind_rows(irfs_df, tbl_lin)
    }
  }
  
  irfs_df <- 
    irfs_df |>
    mutate(
      shocked = factor(shocked, levels = variable_names, labels = names(variable_names)),
      on = factor(on, levels = variable_names, labels = names(variable_names))
    )
  
  irfs_df
}

The formatted IRFs:

irfs_df <- 
  get_irfs(results_lin_95) |> mutate(level = "95%") |> 
  bind_rows(
    get_irfs(results_lin_68) |> mutate(level = "68%")
  )

And the figure:

Code
ggplot() +
  geom_ribbon(
    data = irfs_df |> filter(shocked == "Agricultural losses"), 
    mapping = aes(
      x = horizon,
      ymin = low, ymax = up,
      fill = level),
    alpha = .3
  ) +
  geom_line(
    data = irfs_df |> filter(shocked == "Agricultural losses"), ,
    mapping = aes(x = horizon, y = mean),
    colour = "#0072B2"
  ) +
  geom_hline(yintercept = 0, colour = "#444444") +
  labs(x = "Horizon", y = NULL) +
  scale_fill_manual(
    "C.I. level", 
    values = c("68%" = "#0072B2", "95%" = "#56B4E9")) +
  facet_wrap(~on, scales = "free_y", ncol = 4) +
  theme_paper() +
  coord_cartesian(xlim = c(0, 20)) +
  scale_y_continuous(labels = scales::label_percent())
Figure 17.5: System response to one standard deviation orthogonal shock to the weather aggregate cost equation. Estimations made with local projections.

And with the 68% confidence interval only:

Code
library(tikzDevice)
library(lemon)
ggplot(
    data = irfs_df |> filter(shocked == "Agricultural losses") |> 
      filter(level == "68%") |> 
      mutate(level = str_replace(level, "\\%", "\\\\%")) |> 
      mutate(
        mean = mean * 100,
        low = low * 100,
        up = up * 100
      )
  ) +
  geom_ribbon(
    mapping = aes(x = horizon,ymin = low, ymax = up, fill = level),
    alpha = .2
  ) +
  geom_line(
    mapping = aes(x = horizon, y = mean),
    colour = "#009E73"
  ) +
  geom_hline(yintercept = 0, colour = "#444444") +
  labs(x = "Horizon", y = NULL) +
  scale_fill_manual(
    "C.I. level", 
    values = c("68\\%" = "gray10", "95\\%" = "gray60"),
    guide = "none") +
  facet_rep_wrap(~on, scales = "free_y", repeat.tick.labels = TRUE, ncol = 4) +
  theme_paper() +
  coord_cartesian(xlim = c(0, 20))
Figure 17.6: System response to one standard deviation orthogonal shock to the weather aggregate cost equation. Estimations made with local projections. The gray bands depict the 68% confidence intervals.