diff --git a/presentation-template.Rproj b/2024-12-uwwne.Rproj similarity index 100% rename from presentation-template.Rproj rename to 2024-12-uwwne.Rproj diff --git a/bsvarSIGNs.png b/bsvarSIGNs.png new file mode 100644 index 0000000..5a3ce6e Binary files /dev/null and b/bsvarSIGNs.png differ diff --git a/bsvarSIGNs_cran.png b/bsvarSIGNs_cran.png new file mode 100644 index 0000000..1c9e1d5 Binary files /dev/null and b/bsvarSIGNs_cran.png differ diff --git a/bsvarSIGNs_progress.png b/bsvarSIGNs_progress.png new file mode 100644 index 0000000..bc7b50d Binary files /dev/null and b/bsvarSIGNs_progress.png differ diff --git a/bsvars.org.png b/bsvars.org.png new file mode 100644 index 0000000..5349fa9 Binary files /dev/null and b/bsvars.org.png differ diff --git a/bsvars_cran.png b/bsvars_cran.png new file mode 100644 index 0000000..7aaf3da Binary files /dev/null and b/bsvars_cran.png differ diff --git a/bsvars_oz.R b/bsvars_oz.R new file mode 100644 index 0000000..9413853 --- /dev/null +++ b/bsvars_oz.R @@ -0,0 +1,85 @@ + +library(bsvars) +set.seed(123) + + + +# Download data using the readrba package +############################################################ + +# Gross domestic product (GDP); Chain volume +rgdp_dwnld = readrba::read_rba(series_id = "GGDPCVGDP") +rgdp_tmp = xts::xts(rgdp_dwnld$value, rgdp_dwnld$date, tclass = 'yearqtr') +drgdp = na.omit(400 * diff(log(rgdp_tmp))) +drgdp = xts::to.quarterly(drgdp, OHLC = FALSE) + +# Consumer price index; All groups; Quarterly change (in per cent) +picpi_dwnld = readrba::read_rba(series_id = "GCPIAGSAQP") +pi = 4 * xts::xts(picpi_dwnld$value, picpi_dwnld$date, tclass = 'yearqtr') +pi = xts::to.quarterly(pi, OHLC = FALSE) + +# Interbank Overnight Cash Rate +cr_dwnld = readrba::read_rba(series_id = "FIRMMCRID") # Cash Rate Target +cr_tmp = xts::xts(cr_dwnld$value, cr_dwnld$date) +cr = xts::to.quarterly(cr_tmp, OHLC = FALSE) + +# Real Trade-Weighted Index +rtwi_dwnld = readrba::read_rba(series_id = "FRERTWI") +rtwi_tmp = xts::xts(rtwi_dwnld$value, rtwi_dwnld$date, tclass = 'yearqtr') +rtwi = 100 * na.omit(diff(log(rtwi_tmp))) +drtwi = xts::to.quarterly(rtwi, OHLC = FALSE) + +y = na.omit(merge(drgdp, pi, cr, drtwi)) +plot(y, main = "Australian monetary system", + legend.loc = "bottomleft", col = c("#FF00FF","#990099","#77001b","#330033")) + + + + +# Estimation setup +############################################################ +N = ncol(y) +p = 4 +S_burn = 1e3 +S = 5e3 + + +# estimation - lower-triangular model +############################################################ +# specify a model +spec = specify_bsvar$new( + as.matrix(y), + p = p, + stationary = rep(TRUE, N) +) + +# estimate a model +spec |> + estimate(S = S_burn) |> + estimate(S = S) -> post + +# compute and plot impulse responses +post |> + compute_impulse_responses(horizon = 20) |> + plot() + +# compute and plot forecast error variance decompositions +post |> + compute_variance_decompositions(horizon = 20) |> + plot() + +# compute and plot structural shocks +post |> + compute_structural_shocks() |> + plot() + +# compute and plot fitted values +post |> + compute_fitted_values() |> + plot() + +# compute and plot forecasts +post |> + forecast(horizon = 8, data_in_plot = 0.3) |> + plot() + diff --git a/bsvars_progress.png b/bsvars_progress.png new file mode 100644 index 0000000..57d3863 Binary files /dev/null and b/bsvars_progress.png differ diff --git a/index-speaker.html b/index-speaker.html index 48c7586..cead73a 100644 --- a/index-speaker.html +++ b/index-speaker.html @@ -11,7 +11,7 @@ - Bayesian Structural Vector Autoregressions + index @@ -29,6 +29,71 @@ margin: 0 0.8em 0.2em -1em; /* quarto-specific, see https://github.com/quarto-dev/quarto-cli/issues/4556 */ vertical-align: middle; } + /* CSS for syntax highlighting */ + pre > code.sourceCode { white-space: pre; position: relative; } + pre > code.sourceCode > span { display: inline-block; line-height: 1.25; } + pre > code.sourceCode > span:empty { height: 1.2em; } + .sourceCode { overflow: visible; } + code.sourceCode > span { color: inherit; text-decoration: inherit; } + div.sourceCode { margin: 1em 0; } + pre.sourceCode { margin: 0; } + @media screen { + div.sourceCode { overflow: auto; } + } + @media print { + pre > code.sourceCode { white-space: pre-wrap; } + pre > code.sourceCode > span { text-indent: -5em; padding-left: 5em; } + } + pre.numberSource code + { counter-reset: source-line 0; } + pre.numberSource code > span + { position: relative; left: -4em; counter-increment: source-line; } + pre.numberSource code > span > a:first-child::before + { content: counter(source-line); + position: relative; left: -1em; text-align: right; vertical-align: baseline; + border: none; display: inline-block; + -webkit-touch-callout: none; -webkit-user-select: none; + -khtml-user-select: none; -moz-user-select: none; + -ms-user-select: none; user-select: none; + padding: 0 4px; width: 4em; + color: #aaaaaa; + } + pre.numberSource { margin-left: 3em; border-left: 1px solid #aaaaaa; padding-left: 4px; } + div.sourceCode + { color: #003b4f; background-color: #f1f3f5; } + @media screen { + pre > code.sourceCode > span > a:first-child::before { text-decoration: underline; } + } + code span { color: #003b4f; } /* Normal */ + code span.al { color: #ad0000; } /* Alert */ + code span.an { color: #5e5e5e; } /* Annotation */ + code span.at { color: #657422; } /* Attribute */ + code span.bn { color: #ad0000; } /* BaseN */ + code span.bu { } /* BuiltIn */ + code span.cf { color: #003b4f; } /* ControlFlow */ + code span.ch { color: #20794d; } /* Char */ + code span.cn { color: #8f5902; } /* Constant */ + code span.co { color: #5e5e5e; } /* Comment */ + code span.cv { color: #5e5e5e; font-style: italic; } /* CommentVar */ + code span.do { color: #5e5e5e; font-style: italic; } /* Documentation */ + code span.dt { color: #ad0000; } /* DataType */ + code span.dv { color: #ad0000; } /* DecVal */ + code span.er { color: #ad0000; } /* Error */ + code span.ex { } /* Extension */ + code span.fl { color: #ad0000; } /* Float */ + code span.fu { color: #4758ab; } /* Function */ + code span.im { color: #00769e; } /* Import */ + code span.in { color: #5e5e5e; } /* Information */ + code span.kw { color: #003b4f; } /* Keyword */ + code span.op { color: #5e5e5e; } /* Operator */ + code span.ot { color: #003b4f; } /* Other */ + code span.pp { color: #ad0000; } /* Preprocessor */ + code span.sc { color: #5e5e5e; } /* SpecialChar */ + code span.ss { color: #20794d; } /* SpecialString */ + code span.st { color: #20794d; } /* String */ + code span.va { color: #111111; } /* Variable */ + code span.vs { color: #20794d; } /* VerbatimString */ + code span.wa { color: #5e5e5e; font-style: italic; } /* Warning */ @@ -324,94 +389,908 @@
-
-

Bayesian Structural Vector Autoregressions

-
-
-
-by Tomasz Woźniak +
+

+

+
+
+

Część pierwsza

+

\[ \]

+

Wielowymiarowe bayesowskie dynamiczne modele strukturalne z paczek bsvars i bsvarSIGNs dla R

+

\[ \]

+

cechy paczek bsvars i bsvarSIGNs

+

strukturalne modele VAR

+

identyfikacja modeli strukturalnych

+

modelowanie rozkładu i zmienności

+
+
+

Część druga

+

\[ \]

+

Analiza efektów australijskiej polityki monetarnej używając paczki bsvars

+

\[ \]

+

Analiza efektów australijskiej polityki monetarnej

+

ustawienie i estymacja modelu

+

analizy strukturalne i predyktywne

+
+
+

materiały

+

\[ \]

+

slajdy jako strona internetowa

+

repozytorium na GitHub dla reprodukcji wyników

+

\[ \]

+

bsvars.org officjalna strona

+

paczka bsvars na stronach CRAN

+

paczka bsvarSIGNs na stronach CRAN

+
+
+

cechy paczek bsvars i bsvarSIGNs

+
+
+

cechy paczek bsvars i bsvarSIGNs

+ +
+
+

+
+

-
-
-

+
+

cechy paczek bsvars i bsvarSIGNs

+

\[ \]

-

Structural Vector Autoregressions

-

Identification of Structural VARs

-

Dynamic Causal Effects

-

Bayesian Estimation

-

Monetary Policy Analysis Using the bsvars Package

+
    +
  • bayesowska estymacja modeli strukturalnych VAR
  • +
  • koherentna struktura kodu, skryptów i objektów
  • +
  • świetna szybkość obliczeniowa
  • +
  • najnowsze metody ekonometryczne i numeryczne
  • +
  • napisane w C++ dzięki paczkom Rcpp i RcppArmadillo
  • +
  • analiza danych w R
  • +
-
-

-

+
+

cechy paczek bsvars i bsvarSIGNs

+ +
+
+

+
    +
  • ładowanie paczki i danych
  • +
+
+
library(bsvars)
+data(us_fiscal_lsuw)
+
+
    +
  • łatwa inicjalizacja modelu
  • +
+
+
spec = specify_bsvar$new(us_fiscal_lsuw)
+
+
    +
  • prosta estymacja
  • +
+
+
burn = estimate(spec, S = 1000)
+post = estimate(burn, S = 10000)
+
+
+

+
    +
  • ładowanie paczki i danych
  • +
+
+
library(bsvarSIGNs)
+data(optimism)
+
+
    +
  • łatwa inicjalizacja modelu
  • +
+
+
spec = specify_bsvarSIGN$new(optimism)
+
+
    +
  • prosta estymacja
  • +
+
+
post = estimate(spec, S = 10000)
+
+
+
-
-

Materials

-

\[ \]

-

Lecture Slides as a Website

-

R script for your own Australian monetary policy analysis

-

GitHub repo to reproduce the slides and results

-

Tasks

+
+

cechy paczek bsvars i bsvarSIGNs

+ +
+
+

+
    +
  • analizy strukturalne
  • +
+
+
irfs = compute_impulse_responses(post , horizon = 12)
+fevd = compute_variance_decompositions(post, horizon = 12)
+hds  = compute_historical_decompositions(post)
+ss   = compute_structural_shocks(post)
+csds = compute_conditional_sd(post)
+sddr = verify_identification(post)
+
+
+

+
    +
  • analizy strukturalne
  • +
+
+
irfs = compute_impulse_responses(post , horizon = 12)
+fevd = compute_variance_decompositions(post, horizon = 12)
+hds  = compute_historical_decompositions(post)
+ss   = compute_structural_shocks(post)
+csds = compute_conditional_sd(post)
+
+
+
-
-

Structural Vector Autoregressions

+
+

cechy paczek bsvars i bsvarSIGNs

+ +
+
+

+
    +
  • analizy predyktywne
  • +
+
+
fvs  = compute_fitted_values(post)
+fore = forecast(post, horizon = 12)
+
+
    +
  • wykresy i podsumowania
  • +
+
+
plot(irfs)
+summary(irfs)
+
+
+

+
    +
  • analizy predyktywne
  • +
+
+
fvs  = compute_fitted_values(post)
+fore = forecast(post, horizon = 12)
+
+
    +
  • wykresy i podsumowania
  • +
+
+
plot(irfs)
+summary(irfs)
+
+
+
-
-

Structural Vector Autoregressions

+
+

cechy paczek bsvars i bsvarSIGNs

+ +
+
+

    -
  • go-to models for the analysis of policy effects
  • +
  • skrypty z przekierowaniem
-
+
+
library(bsvars)
+data(us_fiscal_lsuw)
+
+us_fiscal_lsuw |> 
+  specify_bsvar$new() |> 
+  estimate(S = 1000) |> 
+  estimate(S = 10000) -> post
+
+post |> compute_impulse_responses(horizon = 12) |> plot()
+post |> compute_variance_decompositions(horizon = 12) |> plot()
+post |> compute_historical_decompositions() |> plot()
+post |> compute_structural_shocks() |> plot()
+post |> compute_conditional_sd() |> plot()
+post |> forecast(horizon = 12) |> plot()
+post |> verify_identification() |> summary()
+
+
+

    -
  • facilitate the analysis of dynamic causal effects of a well-isolated cause
  • -
  • extensively used for: monetary and fiscal policy, financial markets, …
  • -
  • relatively simple to work with data and provide empirical evidence on the propagation of shocks through economies and markets
  • -
  • provide data-driven stylised facts to be incorporated in theoretical model
  • -
  • require identification of the cause of the dynamic effects
  • -
  • extendible: featuring many variations in specification +
  • skrypty z przekierowaniem
  • +
+
+
library(bsvarSIGNs)
+data(optimism)
+
+optimism |> 
+  specify_bsvarSIGN$new() |> 
+  estimate(S = 10000) -> post
+
+post |> compute_impulse_responses(horizon = 12) |> plot()
+post |> compute_variance_decompositions(horizon = 12) |> plot()
+post |> compute_historical_decompositions() |> plot()
+post |> compute_structural_shocks() |> plot()
+post |> compute_conditional_sd() |> plot()
+post |> forecast(horizon = 12) |> plot()
+
+
+
+
+
+

cechy paczek bsvars i bsvarSIGNs

+ +
+
+

    -
  • non-normality
  • -
  • heteroskedasticity
  • -
  • time-varying parameters
  • -
  • Bayesian
  • -
-
  • Proposed by Sims (1980)
  • +
  • monitorowanie postępu
  • +

    +
    +

    +
      +
    • monitorowanie postępu
    • +
    +

    +
    +
    +
    +

    strukturalne modele VAR

    +
    +
    +

    strukturalne modele VAR

    +
      +
    • podstawowe dla modelowania efektów polityki ekonomicznej
    • +
    • analiza dynamicznych efektów przyczynowych dobrze izolowanej przyczyny
    • +
    • stosunkowo proste w pracy z danymi i dostarczają empirycznych dowodów na propagację szoków przez gospodarki i rynki
    • +
    • dostarczają empirycznych faktów do uwzględnienia w modelach teoretyczne
    • +
    • szeroko stosowane w: polityce pieniężnej i fiskalnej, rynku finansowym, …
    • +
    • rozszerzalne: wiele wariantów specyfikacji +
        +
      • nieliniowość
      • +
      • heteroskedastyczność
      • +
      • zmienne parametry w czasie
      • +
      • modelowanie hierarchiczne bayesowskie
      • +
    • +
    • zaproponowane przez Sims (1980)
    • +
    -
    -

    Structural Vector Autoregressions

    +
    +

    strukturalne modele VAR

    -

    The model.

    +

    model.

    \[\begin{align} -\text{VAR equation: }&& y_t &= \mathbf{A}_1 y_{t-1} + \dots + \mathbf{A}_p y_{t-p} + \boldsymbol\mu_0 + \epsilon_t\\[1ex] -\text{structural equation: }&& \mathbf{B}\epsilon_t &= u_t\\[1ex] -\text{structural shocks: }&& u_t |Y_{t-1} &\sim N_N\left(\mathbf{0}_N,\mathbf{I}_N\right) +\text{równanie VAR: }&& y_t &= \mathbf{A}_1 y_{t-1} + \dots + \mathbf{A}_p y_{t-p} + \mathbf{A}_d x_{t} + \epsilon_t\\[1ex] +\text{równanie structuralne: }&& \mathbf{B}\epsilon_t &= u_t\\[1ex] +\text{structuralne szoki: }&& u_t |Y_{t-1} &\sim N_N\left(\mathbf{0}_N,\text{diag}\left(\boldsymbol\sigma_t^2\right)\right) \end{align}\]

    -

    Notation.

    +

    notacja.

    +
      +
    • \(y_t\) - wektor \(N\) zmiennych na okres \(t\)
    • +
    • \(\mathbf{A}_i\) i \(\mathbf{B}\) - \(N\times N\) macierze parametrów autoregresyjnych i strukturalnych
    • +
    • \(\epsilon_t\) i \(u_t\) - wektory \(N\) błędów statystycznych i szoków strukturalnych
    • +
    • \(\boldsymbol\sigma_t^2\) - wektor \(N\) wariancji szoków strukturalnych
    • +
    +
    +
    +
    +

    SVAR: hierarchiczne rozkłady a priori

    + +
    +
    +

    +
      +
    • normalny-uogólniony normalny rozkład a priori dla \(\mathbf{A}\) i \(\mathbf{B}\)
    • +
    • wielopoziomowa estymacja wariancji a priori
    • +
    • rozkład a priori z Minnesoty dla niestacjonarnych szeregów czasowych
    • +
    • bardziej precyzyjne estymacja i prognozowanie
    • +
    +
    + +
    +

    +
      +
    • rozkład a priori normalny i odwrócony Wisharta dla \(\mathbf{A}\) i \(\mathbf{\Sigma} = (\mathbf{B}'\mathbf{B})^{-1}\)
    • +
    • estymacja wariancji a priori
    • +
    • rozkład a priori z Minnesoty dla niestacjonarnych szeregów czasowych
    • +
    • bardziej precyzyjne estymacja i prognozowanie
    • +
    +
    +
    +
    +
    +

    SVAR: modelowanie zmienności

    + +
    +
    +

    +
      +
    • homoskedastyczność \(\boldsymbol\sigma_{n.t}^2 = 1\)

    • +
    • zmienność stochastyczna

    • +
    • stacjonarny proces Markova dla zmienności

    • +
    • nieparametryczny proces Markova dla zmienności

    • +
    • rozkłady szoków

      +
        +
      • normalny
      • +
      • skończona mieszanka rozkładów normalnych
      • +
      • nieparametryczna mieszanka rozkładów normalnych
      • +
      • rozkład t-Studenta
      • +
    • +
    +
    + +
    +

    +
      +
    • homoskedastyczność
    • +
    • normalny rozkład szoków
    • +
    +
    +
    +
    +
    +

    SVAR: identyfikacja

    + +
    +
    +

    +
      +
    • restrykcje zerowe
    • +
    • heteroskedastyczność
    • +
    • nienormalne rozkłady szoków
    • +
    +
    + +
    +

    +
      +
    • restrykcje znaków
    • +
    • restrykcje zerowe
    • +
    • restrykcje narracyjne
    • +
    +
    +
    +
    +
    +

    strukturalne modele VAR

    + +

    błędy statystyczne.

    +

    \[\begin{align} +&&&\\ +\text{równanie strukturalne: }&& \epsilon_t &= \mathbf{B}^{-1}u_t = \mathbf{\Theta}_0 u_t\\[1ex] +\text{błędy statystyczne: }&& \epsilon_t |Y_{t-1} &\sim N_N\left(\mathbf{0}_N,\Sigma\right)\\[1ex] +\text{kowariancja: }&& \mathbf\Sigma &= \mathbf{B}^{-1}\mathbf{B}^{-1\prime} = \Theta_0\Theta_0' +\end{align}\]

    +

    Notacja.

    +
      +
    • \(\mathbf\Sigma\) - \(N\times N\) kowariancja błędów statystycznych
    • +
    • \(\Theta_0 = \mathbf{B}^{-1}\) - \(N\times N\) macierz efektów strukturalnych
    • +
    +
    +
    +

    strukturalne modele VAR

    + +

    Wstaw równanie VAR w równanie strukturalne:

    +

    \[\begin{align} +\mathbf{B}y_t &= \mathbf{B}\mathbf{A}_1 y_{t-1} + \dots + \mathbf{B}\mathbf{A}_p y_{t-p} + \mathbf{B}\boldsymbol\mu_0 + u_t\\[1ex] +&\\ +\end{align}\]

    +

    relacje strukturanlne.

    +

    Niech \(N=2\)

    +

    \[\begin{align} +\mathbf{B}y_t &= \begin{bmatrix}B_{11}&B_{12}\\B_{21}&B_{22}\end{bmatrix}\begin{bmatrix}y_{1t}\\y_{2t}\end{bmatrix} +\end{align}\]

    +
    +
    +

    strukturalne modele VAR

    + +

    Wstaw równanie strukturalne dla \(\epsilon_t\) w równanie VAR:

    +

    \[\begin{align} +y_t &= \mathbf{A}_1 y_{t-1} + \dots + \mathbf{A}_p y_{t-p} + \boldsymbol\mu_0 + \mathbf{B}^{-1}u_t\\[1ex] +y_t &= \mathbf{A}_1 y_{t-1} + \dots + \mathbf{A}_p y_{t-p} + \boldsymbol\mu_0 + \mathbf{\Theta}_0 u_t +\end{align}\]

    +

    efekty strukturane.

    +

    Niech \(N=2\)

    +

    \[\begin{align} +\begin{bmatrix}y_{1t}\\y_{2t}\end{bmatrix} &= \dots + +\begin{bmatrix}\Theta_{11}&\Theta_{12}\\\Theta_{21}&\Theta_{22}\end{bmatrix}\begin{bmatrix}u_{1t}\\ u_{2t}\end{bmatrix} +\end{align}\]

    +
    +
    +

    identyfikacja modeli strukturalnych

    +
    +
    +

    identyfikacja modeli strukturalnych

    + +

    kowariancja i relacje strukturalne.

    +

    \[\begin{align} +&\\ +\mathbf\Sigma &= \mathbf{B}^{-1}\mathbf{B}^{-1\prime}\\[1ex] +\end{align}\]

    +
      +
    • \(\mathbf\Sigma\) może być estymowana z danych
    • +
    • układ równań strukturalnych do rozwiązanie dla \(\mathbf{B}\)
    • +
    • \(\mathbf\Sigma\) jest macierzą symetryczną \(N\times N\)
    • +
    • \(\mathbf\Sigma\) ma \(N(N+1)/2\) unikalnych elementów, tj. równań
    • +
    • \(\mathbf{B}\) jest \(N\times N\) macierzą z \(N^2\) elementami do estymacji
    • +
    • niewystarczająca liczba równań do estymacji \(\mathbf{B}\)
    • +
    • \(\mathbf{B}\) nie jest indentyfikowalna
    • +
    +
    +
    +

    identyfikacja modeli strukturalnych

    + +

    restrykcje zerowe.

    +

    \[\begin{align} +&\\ +\mathbf\Sigma &= \mathbf{B}^{-1}\mathbf{B}^{-1\prime}\\[1ex] +\end{align}\]

    +

    identyfikacja.

    +
      +
    • jedynie \(N(N+1)/2\) elementów w \(\mathbf{B}\) może być wyestymowanych
    • +
    • nałożenie \(N(N-1)/2\) restrykcji na \(\mathbf{B}\) ułatwia rozwiązanie
    • +
    • wiersze w \(\mathbf{B}\) (i kolumny w \(\mathbf\Theta_0\)) identyfikowane co do znaku
    • +
    • zmiana znaków wierszy w \(\mathbf{B}\) nie zmienia wartości \(\mathbf\Sigma\)
    • +
    • często zakładamy trójkątną macierz \(\mathbf{B}\)
    • +
    +
    +
    +

    identyfikacja modeli strukturalnych

    + +

    restrykcje zerowe.

    +

    Niech \(N=2\)

    +

    \[\begin{align} +\begin{bmatrix}\sigma_1^2&\sigma_{12}\\ \sigma_{12}&\sigma_2^2\end{bmatrix} &\qquad +\begin{bmatrix}B_{11}&B_{12}\\ B_{21}&B_{22}\end{bmatrix}\\[1ex] +\end{align}\]

    +
      +
    • 3 unikalne elementy w \(\mathbf\Sigma\) - 3 równania
    • +
    • 4 elemnty w \(\mathbf{B}\) do rozwiązania
    • +
    +

    identyfikacja.

    +

    \[\begin{align} +\begin{bmatrix}\sigma_1^2&\sigma_{12}\\ \sigma_{12}&\sigma_2^2\end{bmatrix} &\qquad +\begin{bmatrix}B_{11}& 0\\ B_{21}&B_{22}\end{bmatrix}\\[1ex] +\end{align}\]

    +
      +
    • 3 równania pozwalaja rozwiązać 3 niewiadome w \(\mathbf{B}\)
    • +
    +
    +
    +

    identyfikacja modeli strukturalnych

    + +

    identyfikacja przez heteroskedastyczność.

    +

    Rozważ:

    +
      +
    • dwie kowariancje, \(\mathbf\Sigma_1\) and \(\mathbf\Sigma_2\),
    • +
    • macież \(\mathbf{B}_0\) niezmienna w czasie
    • +
    • kowariancje heteroskedastycznych szoków strukturalnych \(\text{diag}\left(\boldsymbol\sigma_1^2\right)\) i \(\text{diag}\left(\boldsymbol\sigma_2^2\right)\)
    • +
    +

    \[\begin{align} +\mathbf\Sigma_1 &= \mathbf{B}_0^{-1}\text{diag}\left(\boldsymbol\sigma_1^2\right)\mathbf{B}_0^{-1\prime}\\[1ex] +\mathbf\Sigma_2 &= \mathbf{B}_0^{-1}\text{diag}\left(\boldsymbol\sigma_2^2\right)\mathbf{B}_0^{-1\prime} +\end{align}\]

    +
    +
    +

    identyfikacja modeli strukturalnych

    + +

    identyfikacja przez heteroskedastyczność.

    +

    \[\begin{align} +\mathbf\Sigma_1 &= \mathbf{B}_0^{-1}\text{diag}\left(\boldsymbol\sigma_1^2\right)\mathbf{B}_0^{-1\prime}\\[1ex] +\mathbf\Sigma_2 &= \mathbf{B}_0^{-1}\text{diag}\left(\boldsymbol\sigma_2^2\right)\mathbf{B}_0^{-1\prime} +\end{align}\]

    +

    identyfikacja.

      -
    • \(\mathbf{B}\) - \(N\times N\) structural matrix of contemporaneous relationships

    • -
    • \(u_t\) - \(N\)-vector of structural shocks at time \(t\)

      -

      Isolating these shocks allows us to identify dynamic effects of uncorrelated shocks on variables \(y_t\)

    • -
    • \(\epsilon_t\) - \(N\)-vector with error terms at time \(t\)

    • -
    • the rest as in the lecture on Bayesian VARs

    • +
    • \(\mathbf\Sigma_1\) i \(\mathbf\Sigma_2\) mają \(N^2+N\) unikalnych elementów
    • +
    • wszystkie \(N^2\) elementy w \(\mathbf{B}_0\) mogą być wyestymowane
    • +
    • oba wektory \(\boldsymbol\sigma_1^2\) i \(\boldsymbol\sigma_2^2\) mogą być wyestymowane dzięki założeniu: \(E\left[\text{diag}\left(\boldsymbol\sigma_i^2\right)\right] = \mathbf{I}_N\)
    +
    +
    +

    identyfikacja modeli strukturalnych

    + +

    Rozważ uogólnienie

    +

    \[\begin{align} +u_t |Y_{t-1} &\sim N_N\left(\mathbf{0}_N, \text{diag}\left(\boldsymbol\sigma_t^2\right)\right)\\[1ex] +\mathbf\Sigma_t &= \mathbf{B}_0^{-1}\text{diag}\left(\boldsymbol\sigma_t^2\right)\mathbf{B}_0^{-1\prime} +\end{align}\]

    +

    identyfikacja.

    +
      +
    • identyfikacja macierzy \(\mathbf{B}_0\) co do znaków i kolejności wierszy
    • +
    • szoki są identyfikowalne jeśli wariancje warunkowe nie są proporcjonalne
    • +
    • wariancje warunkowe \(\boldsymbol\sigma_t^2\) mogą być wyestymowane
    • +
    +

    modelowanie zmienności.

    +

    Wybierz model dla \(\boldsymbol\sigma_t^2\) o najlepszych właściwościach.

    -
    +
    +

    identyfikacja modeli strukturalnych

    + +
    +
    +

    identyfikacja modeli strukturalnych

    + +

    równanie strukturalne.

    +

    \[\begin{align} +\text{relacje strukturalne:}&&\mathbf{Q}\mathbf{B}\epsilon_t &= \mathbf{Q}u_t\\[1ex] +\text{efekty strukturalne:}&&\epsilon_t &= \mathbf{\Theta}_0\mathbf{Q}'\mathbf{Q} u_t\\[1ex] +\end{align}\]

    +

    identyfikacja co do macierzy obrotu.

    +

    \[\begin{align} +\mathbf\Sigma &= \mathbf{B}^{-1}\mathbf{Q}'\mathbf{Q}\mathbf{B}^{-1\prime} = \mathbf{\Theta}_0\mathbf{Q}'\mathbf{Q}\mathbf{\Theta}_0^{\prime}\\[1ex] +\mathbf{Q}'\mathbf{Q} &= \mathbf{I}_N\\[1ex] +\end{align}\]

    +
      +
    • funkcja wiarygodności nie zależy od \(\mathbf{Q}\)
    • +
    • identyfikacja modely zawęża typ \(\mathbf{Q}\)
    • +
    • restrykcje zerowe zmieniają typ macierzy \(\mathbf{Q}\) do diagonalnej z elementami \(\pm1\)
    • +
    +
    +
    +

    identyfikacja modeli strukturalnych

    + +

    restrykcje znaku.

    +

    \[\begin{align} +\text{relacje strukturalne:}&&\tilde{\mathbf{B}}\epsilon_t &= \tilde{u}_t\\[1ex] +\text{efekty strukturalne:}&&\epsilon_t &= \tilde{\mathbf{\Theta}}_0\tilde{u}_t\\[1ex] +\end{align}\]

    +
      +
    • restrykcje na znak elementów w \(\tilde{\mathbf{B}}\) i/lub \(\tilde{\mathbf{\Theta}}_0\)
    • +
    • zawęża zbiór identyfikowalny: model jest identyfikowalny co do macierzy obrotu \(\mathbf{Q}\) koherentnej z restrykcjami
    • +
    • estymacja ma za cel przybliżenie zbioru identyfikowalnego
    • +
    +

    restrykcje znaku i zerowe.

    +
      +
    • restrykcje zerowe i na znak elementów w \(\tilde{\mathbf{B}}\) i/lub \(\tilde{\mathbf{\Theta}}_0\)
    • +
    • zawęża zbiór identyfikowalny
    • +
    +
    +
    +

    identyfikacja modeli strukturalnych

    + +

    restrykcje narracyjne.

    +
      +
    • restrykcje na znak elementów lub wielkości \(u_t\) lub \(\tilde{u}_t\)
    • +
    • restrykcje w oparciu na narrację, teorię ekonomii i konsensus naukowy
    • +
    • należy dostosować metody estymacji
    • +
    • zawęża zbiór identyfikowalny
    • +
    +

    nowa cecha.

    +
      +
    • restrykcje zerowe, narracyjne i na znak w jednym modelu w paczce bsvarSIGNs
    • +
    +
    +
    +

    modelowanie rozkładu i zmienności

    +
    +
    +

    niescentrowana zmienność stochastyczna

    + +

    +

    \[\begin{align} +&\\ +\text{wariancja warunkowa:}&&\sigma_{n.t}^2 &= \exp\left\{\omega_n h_{n.t}\right\}\\ +\text{w skali log:}&&h_{n.t} &= \rho_n h_{n.t-1} + v_{n.t}\\ +\text{innowacje zmienności:}&&v_{n.t}&\sim N\left(0,1\right)\\ +\end{align}\]

    +
      +
    • świetna zdolność do prognozowania
    • +
    • normalizajca \(\sigma_{n.t}^2 = 1\)
    • +
    • verify_identification() przez ocene restrykcji \(H_0:\omega_n = 0\)
    • +
    +
    +
    +

    scentrowana zmienność stochastyczna

    + +

    +

    \[\begin{align} +&\\ +\text{wariancja warunkowa:}&&\sigma_{n.t}^2 &= \exp\left\{ \tilde{h}_{n.t}\right\}\\ +\text{w skali log:}&&\tilde{h}_{n.t} &= \rho_n \tilde{h}_{n.t-1} + \tilde{v}_{n.t}\\ +\text{innowacje zmienności:}&&\tilde{v}_{n.t}&\sim N\left(0,\omega_n^2\right)\\ +\end{align}\]

    +
      +
    • świetna zdolność do prognozowania
    • +
    +
    +
    +

    zmienność stochastyczna: rozkłady a priori

    + +
    +
    +

    proces Markowa dla zmienności.

    + +

    +

    \[\begin{align} +&\\ +\text{szoki strukturalne:}&&\mathbf{u}_t\mid s_t \sim N\left( \mathbf{0}_N, \text{diag}\left(\boldsymbol{\sigma}_{s_t}^2\right) \right)\\ +\text{a priori:}&& M^{-1}\left(\boldsymbol{\sigma}_{1}^2, \dots, \boldsymbol{\sigma}_{M}^2\right) \sim Dirichlet(\underline{a}\boldsymbol\imath')\\ +\text{proces Markowa:}&& s_t\sim \text{Markov}(\mathbf{P},\boldsymbol\pi_0) +\end{align}\]

    +
      +
    • modelowanie proces Markowa dla zmienności
    • +
    • zapewnia identyfikację
    • +
    • poprawa zdolności do prognozowania
    • +
    • verify_identification() przez ocenę restrykcji \(H_0:\boldsymbol{\sigma}_{1}^2, \dots, \boldsymbol{\sigma}_{M}^2 = 1\)
    • +
    +
    +
    +

    mieszanka rozkładów normalnych.

    + +

    +

    \[\begin{align} +&\\ +\text{szoki strukturalne:}&&\mathbf{u}_t\mid s_t \sim N\left( \mathbf{0}_N, \text{diag}\left(\boldsymbol{\sigma}_{s_t}^2\right) \right)\\ +\text{a priori:}&& M^{-1}\left(\boldsymbol{\sigma}_{1}^2, \dots, \boldsymbol{\sigma}_{M}^2\right) \sim Dirichlet(\underline{a}\boldsymbol\imath')\\ +\text{prawdopodobieństwo:}&& Pr[s_t]=\boldsymbol\pi_0 +\end{align}\]

    +
      +
    • modelowanie mieszanki rozkładów normalnych
    • +
    • zapewnia identyfikację
    • +
    • verify_identification() przez ocenę restrykcji \(H_0:\boldsymbol{\sigma}_{1}^2, \dots, \boldsymbol{\sigma}_{M}^2 = 1\)
    • +
    +
    +
    +

    rozkład t-studenta.

    + +

    +

    \[\begin{align} +&&&\\ +\text{szoki strukturalne:}&&\mathbf{u}_t\mid\mathbf{x}_t &\sim t\left( \mathbf{0}_N, \mathbf{I}_N, \nu \right) +\end{align}\]

    +
      +
    • \(\nu\) - szacowane z danych stopnie swobody
    • +
    • grube ogony zapewniają identyfikację
    • +
    • poprawa zdolności do prognozowania
    • +
    • verify_identification() przez ocenę restrykcji \(H_0:\nu \rightarrow\infty\)
    • +
    +
    +
    +

    +

    +
    +
    +

    Australian Monetary Policy Analysis

    +

    \[ \]

    +

    Download reproduction script

    +
    +
    +

    Australian Monetary Policy Analysis

    + +

    System of four variables.

    +

    Based on Turnip (2017)

    +

    \[\begin{align} +y_t = \begin{bmatrix} \Delta rgdp_t & \pi_t & cr_t & \Delta rtwi_t \end{bmatrix}' +\end{align}\]

    +

    A lower-triangular identification pattern.

    +

    \[\begin{align} +\begin{bmatrix} +B_{11}&0&0&0\\ +B_{21}&B_{22}&0&0\\ +B_{31}&B_{32}&B_{33}&0\\ +B_{41}&B_{42}&B_{43}&B_{44} +\end{bmatrix} +\begin{bmatrix} \Delta rgdp_t \\ \pi_t \\ cr_t \\ \Delta rtwi_t \end{bmatrix} \end{align}\]

    +
      +
    • In the extended model, the monetary policy shock is not identified
    • +
    • Use identification via heteroskedasticity to identify it
    • +
    +
    +
    +

    Four-Variable Monetary System

    +
    +
    # Gross domestic product (GDP); Chain volume
    +rgdp_dwnld      = readrba::read_rba(series_id = "GGDPCVGDP")
    +rgdp_tmp        = xts::xts(rgdp_dwnld$value, rgdp_dwnld$date, tclass = 'yearqtr')
    +drgdp           = na.omit(400 * diff(log(rgdp_tmp)))
    +drgdp           = xts::to.quarterly(drgdp, OHLC = FALSE)
    +
    +# Consumer price index; All groups; Quarterly change (in per cent)
    +picpi_dwnld     = readrba::read_rba(series_id = "GCPIAGSAQP")
    +pi              = 4 * xts::xts(picpi_dwnld$value, picpi_dwnld$date, tclass = 'yearqtr')
    +pi              = xts::to.quarterly(pi, OHLC = FALSE)
    +
    +# Interbank Overnight Cash Rate
    +cr_dwnld        = readrba::read_rba(series_id = "FIRMMCRID")   # Cash Rate Target
    +cr_tmp          = xts::xts(cr_dwnld$value, cr_dwnld$date)
    +cr              = xts::to.quarterly(cr_tmp, OHLC = FALSE)
    +
    +# Real Trade-Weighted Index
    +rtwi_dwnld      = readrba::read_rba(series_id = "FRERTWI")
    +rtwi_tmp        = xts::xts(rtwi_dwnld$value, rtwi_dwnld$date, tclass = 'yearqtr')
    +rtwi            = 100 * na.omit(diff(log(rtwi_tmp)))
    +drtwi            = xts::to.quarterly(rtwi, OHLC = FALSE)
    +
    +y               = na.omit(merge(drgdp, pi, cr, drtwi))
    +plot(y, main = "Australian monetary system",
    +     legend.loc = "bottomleft", col = c("#FF00FF","#990099","#ededed","#330033"))
    +
    + + +
    +

    Four-Variable Monetary System

    +
    +
    +
    +

    +
    +
    +
    +
    +

    Model Estimation

    + +

    Lower-triangular model with zero prior mean for \(\mathbf{A}\).

    +
    +
    # estimation - lower-triangular model
    +############################################################
    +library(bsvars)
    +set.seed(123)
    +
    +spec = specify_bsvar$new(
    +  as.matrix(y), 
    +  p = 4, 
    +  stationary = rep(TRUE, 4)
    +)
    +spec |>
    +  estimate(S = 1000) |>
    +  estimate(S = 5000) -> post
    +
    +
    **************************************************|
    +bsvars: Bayesian Structural Vector Autoregressions|
    +**************************************************|
    + Gibbs sampler for the SVAR model                 |
    +**************************************************|
    + Progress of the MCMC simulation for 1000 draws
    +    Every draw is saved via MCMC thinning
    + Press Esc to interrupt the computations
    +**************************************************|
    +**************************************************|
    +bsvars: Bayesian Structural Vector Autoregressions|
    +**************************************************|
    + Gibbs sampler for the SVAR model                 |
    +**************************************************|
    + Progress of the MCMC simulation for 5000 draws
    +    Every draw is saved via MCMC thinning
    + Press Esc to interrupt the computations
    +**************************************************|
    +
    +
    +
    +
    +

    Compute impulse responses

    + +
    +
    post |> 
    +  compute_impulse_responses(horizon = 20) |> 
    +  plot()
    + +
    +
    +
    +

    Compute forecast error variance decompositions

    + +
    +
    post |> 
    +  compute_variance_decompositions(horizon = 20) |> 
    +  plot()
    + +
    +
    +
    +

    Compute structural shocks

    + +
    +
    post |> 
    +  compute_structural_shocks() |> 
    +  plot()
    + +
    +
    +
    +

    Compute fitted values

    + +
    +
    post |> 
    +  compute_fitted_values() |> 
    +  plot()
    + +
    +
    +
    +

    Compute forecasts

    + +
    +
    post |> 
    +  forecast(horizon = 8) |> 
    +  plot(data_in_plot = 0.3)
    + +
    +
    +

    -

    +

    @@ -630,6 +1509,44 @@

    ] }); + + + + + +