Проект по АВР-2
library(readxl)
library(dplyr)##
## Присоединяю пакет: 'dplyr'## Следующие объекты скрыты от 'package:stats':
##
## filter, lag## Следующие объекты скрыты от 'package:base':
##
## intersect, setdiff, setequal, unionlibrary(lubridate)##
## Присоединяю пакет: 'lubridate'## Следующие объекты скрыты от 'package:base':
##
## date, intersect, setdiff, unionlibrary(zoo)##
## Присоединяю пакет: 'zoo'## Следующие объекты скрыты от 'package:base':
##
## as.Date, as.Date.numericlibrary(forecast)## Registered S3 method overwritten by 'quantmod':
## method from
## as.zoo.data.frame zoolibrary(vars)## Загрузка требуемого пакета: MASS##
## Присоединяю пакет: 'MASS'## Следующий объект скрыт от 'package:dplyr':
##
## select## Загрузка требуемого пакета: strucchange## Загрузка требуемого пакета: sandwich## Загрузка требуемого пакета: urca## Загрузка требуемого пакета: lmtestlibrary(mFilter)
library(BVAR)##
## Присоединяю пакет: 'BVAR'## Следующие объекты скрыты от 'package:vars':
##
## fevd, irflibrary(urca)
library(svars)## Registered S3 method overwritten by 'svars':
## method from
## stability.varest varslibrary(Metrics)##
## Присоединяю пакет: 'Metrics'## Следующий объект скрыт от 'package:BVAR':
##
## rmse## Следующий объект скрыт от 'package:forecast':
##
## accuracyОбработка данных
Данные
ВРП в постоянных ценах 2021 года, руб.
Инфляция, %
Доходы и расходы консолидированного бюджета РФ, руб.
Ключевая ставка, %
Частота: квартальная
Период: 3кв2013 - 4 кв.2024
Количество наблюдений: 48 наблюдений
Источник: Росстат, ЦБ РФ, Минфин РФ
gdp <- read_excel("Data.xlsx", sheet = "gdp")
budget <- read_excel("Data.xlsx",sheet = "budget")
key_rate <- read_excel("Data.xlsx", sheet = "key_rate")
cpi <- read_excel("Data.xlsx", sheet = "cpi")
#ВВП
gdp_ts <- ts(
gdp[[3]],
start = c(gdp[1,1],gdp[1,2]),
frequency = 4
)
#Сезонная сглажка
stl_fit <- stl(gdp_ts, s.window = "periodic")
gdp_des <- seasadj(stl_fit)
#Бюджетные показатели
budget_q <- budget %>%
arrange(year, quarter) %>%
group_by(year) %>%
mutate(
across(
fed_revenue:cons_expend,
~ . - lag(., default = 0),
.names = "{.col}_q"
)
) %>%
ungroup()
cons_revenue_q = ts(budget_q$cons_revenue_q, start = c(2011,1), frequency = 4)
cons_expend_q = ts(budget_q$cons_expend_q, start = c(2011,1), frequency = 4)
stl_fit <- stl(cons_revenue_q, s.window = "periodic")
cons_revenue_des <- seasadj(stl_fit)
stl_fit <- stl(cons_expend_q, s.window = "periodic")
cons_expend_des <- seasadj(stl_fit)
#Ключевая ставка
key_rate_q <- key_rate %>%
mutate(
year = year(date),
quarter = quarter(date),
yearqtr = paste0(year, " Q", quarter)
) %>%
group_by(yearqtr) %>%
summarise(
key_rate_q = mean(key_rate, na.rm = TRUE),
.groups = "drop"
)
key_rate_ts <- ts(key_rate_q[[2]],frequency = 4, start = c(2013,3))
#Инфляция
cpi_ts <- ts(
cpi[[3]],
start = c(cpi[1,1],cpi[1,2]),
frequency = 4
)
stl_fit <- stl(cpi_ts, s.window = "periodic")
cpi_des <- seasadj(stl_fit)
#Cтандартизируем для одного порядка
gdp <- window(gdp_des, start = c(2013, 3), end = c(2023, 4))/10^12
infl <- window(cpi_des, start = c(2013, 3), end = c(2023, 4))-100
key_rate<- window(key_rate_ts, start = c(2013, 3), end = c(2023, 4))
cons_re <- window(cons_revenue_des, start = c(2013, 3), end = c(2023, 4))/10^12
cons_ex <- window(cons_expend_des, start = c(2013, 3), end = c(2023, 4))/10^12
balance_budget<- (-(cons_ex - cons_re)/gdp)*100 #подготовка к интепретации расчета бюджетного импульса
#Данные для расчета метрик прогноза
gdp_pr <- window(gdp_des, start = c(2013, 3), end = c(2024, 4))/10^12
infl_pr <- window(cpi_des, start = c(2013, 3), end = c(2024, 4))-100
key_rate_pr<- window(key_rate_ts, start = c(2013, 3), end = c(2024, 4))
cons_re_pr <- window(cons_revenue_des, start = c(2013, 3), end = c(2024, 4))/10^12
cons_ex_pr <- window(cons_expend_des, start = c(2013, 3), end = c(2024, 4))/10^12
balance_budget_pr<- (-(cons_ex_pr - cons_re_pr)/gdp_pr)*100par(mfrow = c(2, 2),
mar = c(4, 4, 2, 1))
# 1-й график
plot(gdp,
main = "ВВП SA",
xlab = "", ylab = "трлн. руб.")
# 2-й
plot(infl,
main = "ИПЦ SA",
xlab = "", ylab = "%")
# 3-й
plot(balance_budget,
main = "Дефицит бюджета к ВВП",
xlab = "Время", ylab = "%")
# 4-й
plot(key_rate,
main = "Ключевая ставка ЦБ РФ",
xlab = "Время", ylab = "%")
# Вернуть настройки по умолчанию (опционально)
par(mfrow = c(1,1))Проверка временных рядов на стационарность
ADF (H0 ) Временной ряд имеет единичный корень
KPSS (H0 ): Временной ряд трендово-стационарен.
GDP
gdp_adf = ur.df(gdp, type = 'trend', selectlags = 'AIC')
summary(gdp_adf)##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression trend
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 + 1 + tt + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -2.0727 -0.2883 -0.0109 0.3773 1.1263
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 17.24341 5.24455 3.288 0.00226 **
## z.lag.1 -0.57133 0.17323 -3.298 0.00220 **
## tt 0.05733 0.01724 3.324 0.00205 **
## z.diff.lag 0.25562 0.17308 1.477 0.14840
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.6209 on 36 degrees of freedom
## Multiple R-squared: 0.2463, Adjusted R-squared: 0.1835
## F-statistic: 3.922 on 3 and 36 DF, p-value: 0.01605
##
##
## Value of test-statistic is: -3.2981 4.4737 5.8687
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau3 -4.15 -3.50 -3.18
## phi2 7.02 5.13 4.31
## phi3 9.31 6.73 5.61gdp_kpss <- ur.kpss(gdp, type="mu", lags="short")
summary(gdp_kpss)##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 3 lags.
##
## Value of test-statistic is: 1.0309
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739Вывод: Гипотеза об единичном корне на уровне 10% отвергается (ADF), но не 5% Гипотеза о стационарности ряда отвергается (KPSS). Ряд нестационарен.
Inflation
infl_adf = ur.df(infl, type = 'none', selectlags = 'AIC')
summary(infl_adf)##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression none
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 - 1 + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -4.8967 -0.2401 0.3644 1.0326 4.2989
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## z.lag.1 -0.1909 0.1162 -1.643 0.109
## z.diff.lag -0.2347 0.1588 -1.478 0.148
##
## Residual standard error: 1.56 on 38 degrees of freedom
## Multiple R-squared: 0.1682, Adjusted R-squared: 0.1245
## F-statistic: 3.843 on 2 and 38 DF, p-value: 0.0302
##
##
## Value of test-statistic is: -1.6429
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau1 -2.62 -1.95 -1.61infl_kpss <- ur.kpss(infl, type="mu", lags="short")
summary(infl_kpss)##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 3 lags.
##
## Value of test-statistic is: 0.1461
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739Вывод: Гипотеза об единичном корне на уровне 10% отвергается (ADF), но не 5% Гипотеза о стационарности ряда отвергается (KPSS). Ряд нестационарен.
Key_Rate
key_rate_adf = ur.df(key_rate, type = 'none', selectlags = 'AIC')
summary(key_rate_adf)##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression none
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 - 1 + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5.1750 -0.4280 0.0566 0.5397 8.1310
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## z.lag.1 -0.004416 0.038938 -0.113 0.910
## z.diff.lag 0.189568 0.170515 1.112 0.273
##
## Residual standard error: 2.163 on 38 degrees of freedom
## Multiple R-squared: 0.03169, Adjusted R-squared: -0.01928
## F-statistic: 0.6218 on 2 and 38 DF, p-value: 0.5424
##
##
## Value of test-statistic is: -0.1134
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau1 -2.62 -1.95 -1.61key_rate_kpss <- ur.kpss(key_rate, type="mu", lags="short")
summary(key_rate_kpss)##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 3 lags.
##
## Value of test-statistic is: 0.1447
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739Вывод: ряд точно нестационарный
Fiscal Deficit
budget_adf = ur.df(balance_budget, type = 'none', selectlags = 'AIC')
summary(budget_adf)##
## ###############################################
## # Augmented Dickey-Fuller Test Unit Root Test #
## ###############################################
##
## Test regression none
##
##
## Call:
## lm(formula = z.diff ~ z.lag.1 - 1 + z.diff.lag)
##
## Residuals:
## Min 1Q Median 3Q Max
## -6.2143 -0.8763 -0.3831 0.7775 5.1640
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## z.lag.1 -0.4086 0.1371 -2.980 0.005 **
## z.diff.lag 0.1567 0.1642 0.954 0.346
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 2.344 on 38 degrees of freedom
## Multiple R-squared: 0.1911, Adjusted R-squared: 0.1486
## F-statistic: 4.49 on 2 and 38 DF, p-value: 0.01776
##
##
## Value of test-statistic is: -2.9802
##
## Critical values for test statistics:
## 1pct 5pct 10pct
## tau1 -2.62 -1.95 -1.61budget_kpss <- ur.kpss(balance_budget, type="mu", lags="short")
summary(budget_kpss)##
## #######################
## # KPSS Unit Root Test #
## #######################
##
## Test is of type: mu with 3 lags.
##
## Value of test-statistic is: 0.0941
##
## Critical value for a significance level of:
## 10pct 5pct 2.5pct 1pct
## critical values 0.347 0.463 0.574 0.739Вывод: Ряд стационарен по обоим тестам
Проверка на коинтеграцию (Тест Йохансенна)
H0 - число коинтеграционных связей не превышает r
data <-cbind(log(gdp) , key_rate, infl, balance_budget)
colnames(data) <- c("gdp", "key_rate", "infl", "balance_budget" )
data <- window(data, start = c (2013, 3))info_p <- VARselect(data, lag.max = 7, type = "const")
info_p$selection## AIC(n) HQ(n) SC(n) FPE(n)
## 7 7 7 7library(urca)
data_mat <- as.matrix(data)
#Johansen_test
johansen_test<- ca.jo(data_mat, type = c("eigen", "trace"), ecdet = 'const', K=2)
summary(johansen_test)##
## ######################
## # Johansen-Procedure #
## ######################
##
## Test type: maximal eigenvalue statistic (lambda max) , without linear trend and constant in cointegration
##
## Eigenvalues (lambda):
## [1] 5.230384e-01 2.012984e-01 1.464993e-01 4.584355e-02 -4.285205e-16
##
## Values of teststatistic and critical values of test:
##
## test 10pct 5pct 1pct
## r <= 3 | 1.88 7.52 9.24 12.97
## r <= 2 | 6.34 13.75 15.67 20.20
## r <= 1 | 8.99 19.77 22.00 26.81
## r = 0 | 29.61 25.56 28.14 33.24
##
## Eigenvectors, normalised to first column:
## (These are the cointegration relations)
##
## gdp.l2 key_rate.l2 infl.l2 balance_budget.l2
## gdp.l2 1.00000000 1.00000000 1.000000000 1.0000000000
## key_rate.l2 0.03546194 0.03613236 -0.032513066 -0.0077972724
## infl.l2 0.33262965 -0.08009082 0.037578382 0.0147895735
## balance_budget.l2 0.05999855 0.03970860 0.007892919 -0.0007338505
## constant -4.25872922 -3.59930009 -3.197953894 -3.4891995350
## constant
## gdp.l2 1.000000000
## key_rate.l2 0.011590743
## infl.l2 -0.012763497
## balance_budget.l2 -0.009424885
## constant -3.542638223
##
## Weights W:
## (This is the loading matrix)
##
## gdp.l2 key_rate.l2 infl.l2 balance_budget.l2
## gdp.d -0.007613388 -0.03310195 0.0307017 -0.04463809
## key_rate.d -0.699879988 -1.98359930 5.9348845 2.75578618
## infl.d -1.712169480 0.98918347 0.8770806 1.21915757
## balance_budget.d -1.422994008 -7.01386257 -1.0460776 1.45050730
## constant
## gdp.d 2.121146e-14
## key_rate.d -1.252294e-11
## infl.d 1.933389e-12
## balance_budget.d 1.798571e-11Вывод: Ряды имеют одну коинтеграционную связь
\[ \text{ECT}_t = \log(\text{GDP}_{t-1})+ 0.0355 \cdot \text{rate}_{t-1}+ 0.3323 \cdot \text{infl}_{t-1}+ 0.0599 \cdot \text{budget}_{t-1}- 4.2587 \]
data_without_fiscal <-cbind(log(gdp) , key_rate, infl)
colnames(data_without_fiscal) <- c("gdp", "key_rate", "infl" )
data_without_fiscal<- window(data_without_fiscal, start = c (2013, 3))
data_mat <- as.matrix(data_without_fiscal)
#Johansen_test
johansen_test<- ca.jo(data_mat, type = c("eigen", "trace"), ecdet = 'const', K=2)
summary(johansen_test)##
## ######################
## # Johansen-Procedure #
## ######################
##
## Test type: maximal eigenvalue statistic (lambda max) , without linear trend and constant in cointegration
##
## Eigenvalues (lambda):
## [1] 4.685424e-01 1.492643e-01 5.005274e-02 -6.587824e-16
##
## Values of teststatistic and critical values of test:
##
## test 10pct 5pct 1pct
## r <= 2 | 2.05 7.52 9.24 12.97
## r <= 1 | 6.47 13.75 15.67 20.20
## r = 0 | 25.29 19.77 22.00 26.81
##
## Eigenvectors, normalised to first column:
## (These are the cointegration relations)
##
## gdp.l2 key_rate.l2 infl.l2 constant
## gdp.l2 1.00000000 1.0000000 1.0000000000 1.00000000
## key_rate.l2 0.02384742 -0.3569555 -0.0009670821 0.01297618
## infl.l2 0.44275307 0.4706325 0.0039602166 -0.01920745
## constant -4.40641526 -0.9193621 -3.4970651906 -3.51566232
##
## Weights W:
## (This is the loading matrix)
##
## gdp.l2 key_rate.l2 infl.l2 constant
## gdp.d -0.002566283 0.005975472 -0.07915403 -6.357981e-14
## key_rate.d -0.485167619 0.815242275 4.64269741 4.014649e-12
## infl.d -1.401388104 0.075587571 1.89700776 1.515759e-12Вывод: Ряды сохраняют коинтгерационную связь даже с исключение fiscal policy
Построение эконометрической модели VECM и SVEC
vecm_model <- cajorls(johansen_test, r = 1)vecm_var <- vec2var(johansen_test, r = 1)Построение эконометрической модели VAR и SVAR
gdp_fd <- diff(log(gdp))
infl_fd <- diff(infl)
key_rate_fd <-diff(key_rate)
balance_budget_fd <-diff(balance_budget)
#Для прогноза
gdp_pr_fd <- diff(log(gdp_pr))
infl_pr_fd <- diff(infl_pr)
key_rate_pr_fd <-diff(key_rate_pr)
balance_budget_pr_fd <-diff(balance_budget_pr)
data_pr_fd<- cbind(gdp_pr_fd , key_rate_pr_fd, infl_pr_fd, balance_budget_pr_fd)
data_var <-cbind(gdp_fd , key_rate_fd, infl_fd, balance_budget_fd)
colnames(data_var) <- c("gdp_fd", "key_rate_fd", "infl_fd", "balance_budget_fd" )
data_var <- window(data_var, start = c (2014, 1))par(mfrow = c(2, 2),
mar = c(4, 4, 2, 1))
# 1-й график
plot(gdp_fd,
main = "Темп прироста ВВП",
xlab = "Время")
# 2-й
plot(infl_fd,
main = "Ускорение/замедление ИПЦ",
xlab = "", ylab = "пп.")
# 3-й
plot(balance_budget_fd,
main = "Фискальный импульс",
xlab = "Время", ylab = 'пп.')
# 4-й
plot(key_rate_fd,
main = "Изменение Ключевой ставки ЦБ РФ",
xlab = "Время", ylab = "пп.")
# Вернуть настройки по умолчанию (опционально)
par(mfrow = c(1,1))Оценка модели VAR
info_p <- VARselect(data_var, lag.max = 3, type = "const")
info_p$selection## AIC(n) HQ(n) SC(n) FPE(n)
## 1 1 1 1model_var <- VAR(data_var, p = 1, type = "const", season = NULL, exog = NULL)
summary(model_var )##
## VAR Estimation Results:
## =========================
## Endogenous variables: gdp_fd, key_rate_fd, infl_fd, balance_budget_fd
## Deterministic variables: const
## Sample size: 39
## Log Likelihood: -123.833
## Roots of the characteristic polynomial:
## 0.5997 0.4143 0.4143 0.1592
## Call:
## VAR(y = data_var, p = 1, type = "const", exogen = NULL)
##
##
## Estimation results for equation gdp_fd:
## =======================================
## gdp_fd = gdp_fd.l1 + key_rate_fd.l1 + infl_fd.l1 + balance_budget_fd.l1 + const
##
## Estimate Std. Error t value Pr(>|t|)
## gdp_fd.l1 0.0416459 0.1848560 0.225 0.823
## key_rate_fd.l1 -0.0016005 0.0021833 -0.733 0.469
## infl_fd.l1 -0.0007316 0.0023688 -0.309 0.759
## balance_budget_fd.l1 -0.0018555 0.0017446 -1.064 0.295
## const 0.0036651 0.0034797 1.053 0.300
##
##
## Residual standard error: 0.0213 on 34 degrees of freedom
## Multiple R-Squared: 0.1178, Adjusted R-squared: 0.014
## F-statistic: 1.135 on 4 and 34 DF, p-value: 0.3566
##
##
## Estimation results for equation key_rate_fd:
## ============================================
## key_rate_fd = gdp_fd.l1 + key_rate_fd.l1 + infl_fd.l1 + balance_budget_fd.l1 + const
##
## Estimate Std. Error t value Pr(>|t|)
## gdp_fd.l1 36.143470 18.341653 1.971 0.057 .
## key_rate_fd.l1 0.206173 0.216628 0.952 0.348
## infl_fd.l1 -0.066687 0.235031 -0.284 0.778
## balance_budget_fd.l1 0.008653 0.173097 0.050 0.960
## const 0.096194 0.345263 0.279 0.782
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 2.114 on 34 degrees of freedom
## Multiple R-Squared: 0.1614, Adjusted R-squared: 0.06271
## F-statistic: 1.636 on 4 and 34 DF, p-value: 0.1879
##
##
## Estimation results for equation infl_fd:
## ========================================
## infl_fd = gdp_fd.l1 + key_rate_fd.l1 + infl_fd.l1 + balance_budget_fd.l1 + const
##
## Estimate Std. Error t value Pr(>|t|)
## gdp_fd.l1 14.08702 11.20370 1.257 0.217194
## key_rate_fd.l1 0.49068 0.13232 3.708 0.000741 ***
## infl_fd.l1 -0.62979 0.14356 -4.387 0.000106 ***
## balance_budget_fd.l1 0.05628 0.10573 0.532 0.597986
## const -0.05013 0.21090 -0.238 0.813538
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 1.291 on 34 degrees of freedom
## Multiple R-Squared: 0.4853, Adjusted R-squared: 0.4248
## F-statistic: 8.016 on 4 and 34 DF, p-value: 0.0001154
##
##
## Estimation results for equation balance_budget_fd:
## ==================================================
## balance_budget_fd = gdp_fd.l1 + key_rate_fd.l1 + infl_fd.l1 + balance_budget_fd.l1 + const
##
## Estimate Std. Error t value Pr(>|t|)
## gdp_fd.l1 53.29723 20.81619 2.560 0.0151 *
## key_rate_fd.l1 -0.26325 0.24585 -1.071 0.2918
## infl_fd.l1 -0.03615 0.26674 -0.136 0.8930
## balance_budget_fd.l1 -0.10582 0.19645 -0.539 0.5936
## const -0.19069 0.39184 -0.487 0.6296
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 2.399 on 34 degrees of freedom
## Multiple R-Squared: 0.2404, Adjusted R-squared: 0.1511
## F-statistic: 2.691 on 4 and 34 DF, p-value: 0.04742
##
##
##
## Covariance matrix of residuals:
## gdp_fd key_rate_fd infl_fd balance_budget_fd
## gdp_fd 0.0004538 0.005492 -0.00129 0.0155
## key_rate_fd 0.0054924 4.467250 1.29984 1.8023
## infl_fd -0.0012903 1.299836 1.66681 0.6573
## balance_budget_fd 0.0154966 1.802301 0.65726 5.7539
##
## Correlation matrix of residuals:
## gdp_fd key_rate_fd infl_fd balance_budget_fd
## gdp_fd 1.00000 0.1220 -0.04692 0.3033
## key_rate_fd 0.12199 1.0000 0.47635 0.3555
## infl_fd -0.04692 0.4763 1.00000 0.2122
## balance_budget_fd 0.30328 0.3555 0.21223 1.0000#Все кварталы после начала пандемии
dum <- rep(0, dim(data_var)[1])
dum[25:40]<-1
dum <- data.frame(dummy = dum) model_var_dum <- VAR(data_var, p = 1, type = "const", season = NULL, exog = dum)
summary(model_var_dum)##
## VAR Estimation Results:
## =========================
## Endogenous variables: gdp_fd, key_rate_fd, infl_fd, balance_budget_fd
## Deterministic variables: const
## Sample size: 39
## Log Likelihood: -123.279
## Roots of the characteristic polynomial:
## 0.5993 0.4158 0.4158 0.1466
## Call:
## VAR(y = data_var, p = 1, type = "const", exogen = dum)
##
##
## Estimation results for equation gdp_fd:
## =======================================
## gdp_fd = gdp_fd.l1 + key_rate_fd.l1 + infl_fd.l1 + balance_budget_fd.l1 + const + dummy
##
## Estimate Std. Error t value Pr(>|t|)
## gdp_fd.l1 0.0422421 0.1873856 0.225 0.823
## key_rate_fd.l1 -0.0016305 0.0022152 -0.736 0.467
## infl_fd.l1 -0.0007379 0.0024011 -0.307 0.761
## balance_budget_fd.l1 -0.0018367 0.0017694 -1.038 0.307
## const 0.0027915 0.0045550 0.613 0.544
## dummy 0.0021349 0.0070434 0.303 0.764
##
##
## Residual standard error: 0.02159 on 33 degrees of freedom
## Multiple R-Squared: 0.1202, Adjusted R-squared: -0.01306
## F-statistic: 0.902 on 5 and 33 DF, p-value: 0.4914
##
##
## Estimation results for equation key_rate_fd:
## ============================================
## key_rate_fd = gdp_fd.l1 + key_rate_fd.l1 + infl_fd.l1 + balance_budget_fd.l1 + const + dummy
##
## Estimate Std. Error t value Pr(>|t|)
## gdp_fd.l1 36.30026 18.43607 1.969 0.0574 .
## key_rate_fd.l1 0.19831 0.21795 0.910 0.3695
## infl_fd.l1 -0.06836 0.23624 -0.289 0.7741
## balance_budget_fd.l1 0.01359 0.17409 0.078 0.9382
## const -0.13354 0.44814 -0.298 0.7676
## dummy 0.56141 0.69297 0.810 0.4237
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 2.124 on 33 degrees of freedom
## Multiple R-Squared: 0.1777, Adjusted R-squared: 0.05314
## F-statistic: 1.427 on 5 and 33 DF, p-value: 0.2406
##
##
## Estimation results for equation infl_fd:
## ========================================
## infl_fd = gdp_fd.l1 + key_rate_fd.l1 + infl_fd.l1 + balance_budget_fd.l1 + const + dummy
##
## Estimate Std. Error t value Pr(>|t|)
## gdp_fd.l1 14.13014 11.35031 1.245 0.221932
## key_rate_fd.l1 0.48852 0.13418 3.641 0.000921 ***
## infl_fd.l1 -0.63025 0.14544 -4.333 0.000129 ***
## balance_budget_fd.l1 0.05764 0.10718 0.538 0.594324
## const -0.11331 0.27590 -0.411 0.683961
## dummy 0.15439 0.42663 0.362 0.719747
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 1.308 on 33 degrees of freedom
## Multiple R-Squared: 0.4874, Adjusted R-squared: 0.4097
## F-statistic: 6.275 on 5 and 33 DF, p-value: 0.0003405
##
##
## Estimation results for equation balance_budget_fd:
## ==================================================
## balance_budget_fd = gdp_fd.l1 + key_rate_fd.l1 + infl_fd.l1 + balance_budget_fd.l1 + const + dummy
##
## Estimate Std. Error t value Pr(>|t|)
## gdp_fd.l1 53.27589 21.12743 2.522 0.0167 *
## key_rate_fd.l1 -0.26218 0.24976 -1.050 0.3015
## infl_fd.l1 -0.03592 0.27072 -0.133 0.8953
## balance_budget_fd.l1 -0.10649 0.19950 -0.534 0.5971
## const -0.15941 0.51357 -0.310 0.7582
## dummy -0.07644 0.79414 -0.096 0.9239
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
##
## Residual standard error: 2.434 on 33 degrees of freedom
## Multiple R-Squared: 0.2407, Adjusted R-squared: 0.1256
## F-statistic: 2.092 on 5 and 33 DF, p-value: 0.09133
##
##
##
## Covariance matrix of residuals:
## gdp_fd key_rate_fd infl_fd balance_budget_fd
## gdp_fd 0.0004662 0.005318 -0.001423 0.01601
## key_rate_fd 0.0053175 4.512864 1.314542 1.86914
## infl_fd -0.0014233 1.314542 1.710531 0.68054
## balance_budget_fd 0.0160127 1.869137 0.680539 5.92664
##
## Correlation matrix of residuals:
## gdp_fd key_rate_fd infl_fd balance_budget_fd
## gdp_fd 1.0000 0.1159 -0.0504 0.3046
## key_rate_fd 0.1159 1.0000 0.4731 0.3614
## infl_fd -0.0504 0.4731 1.0000 0.2137
## balance_budget_fd 0.3046 0.3614 0.2137 1.0000Вывод: Введение дамми-переменных ухудшило результаты
Тесты на проверку адекватности оценок OLS
var_res_serial <- serial.test(model_var , lags.pt = 3, type = "PT.asymptotic")
var_res_serial##
## Portmanteau Test (asymptotic)
##
## data: Residuals of VAR object model_var
## Chi-squared = 32.32, df = 32, p-value = 0.4509var_res_arch <- arch.test(model_var , lags.multi = 3, multivariate.only = TRUE)
var_res_arch##
## ARCH (multivariate)
##
## data: Residuals of VAR object model_var
## Chi-squared = 322.44, df = 300, p-value = 0.1784var_res_norm <- normality.test(model_var , multivariate.only = TRUE)
var_res_norm## $JB
##
## JB-Test (multivariate)
##
## data: Residuals of VAR object model_var
## Chi-squared = 54.306, df = 8, p-value = 6.021e-09
##
##
## $Skewness
##
## Skewness only (multivariate)
##
## data: Residuals of VAR object model_var
## Chi-squared = 17.049, df = 4, p-value = 0.001891
##
##
## $Kurtosis
##
## Kurtosis only (multivariate)
##
## data: Residuals of VAR object model_var
## Chi-squared = 37.257, df = 4, p-value = 1.594e-07Вывод: Автокорреляция и гетероскедастичность отсуствие в ошибках по результатам теста. Однако, их нормальность отсутствует.
Оценка SVAR модели с помощью разложения Холецкого
- Порядок переменных в матрицы B
-
Фискальный импульс - самая экзогенная величина. Реагирует только на свой структурный фискальный шок.
Изменение ключевой ставки. Реагирует на фискальный и монетарный шоки.
Ускорение/замедление инфляции. Реакция на шок политик и свой собственный.
Темпы прироста ВВП. Реагируют на все три шока и свой свобственный.
data_svar <-cbind(balance_budget_fd, key_rate_fd, infl_fd, gdp_fd)
colnames(data_svar) <- c("balance_budget_fd", "key_rate_fd", "infl_fd", "gdp_fd")
data_svar <- window(data_svar, start = c (2014, 1))model_var_s <- VAR(data_svar, p = 1, type = "const", season = NULL, exog = dum)# Строим матрицу A (Cholesky: нижнетреугольная)
a.mat <- diag(4)
diag(a.mat) <- NA # Диагональ — свободные коэффициенты
a.mat[2,1] <- NA # key_rate_fd ← budget
a.mat[3,1] <- NA # infl_fd ← budget
a.mat[3,2] <- NA # infl_fd ← rate
a.mat[4,1] <- NA # gdp_fd ← budget
a.mat[4,2] <- NA # gdp_fd ← rate
a.mat[4,3] <- NA # gdp_fd ← infl
# Строим матрицу B (диагональная, только дисперсии шоков)
b.mat <- diag(4)
diag(b.mat) <- NA
# Строим SVAR-модель (идентификация Холецкого)
model_svar <- SVAR(model_var_s, Amat = a.mat, Bmat = b.mat, max.iter = 1000, hessian = TRUE, lrtest = FALSE)Построение IRF c идентификацией
irf_mi = vars::irf(model_svar, impulse = "key_rate_fd",
response = c('balance_budget_fd', 'gdp_fd', 'infl_fd'),
n.ahead = 12, ortho = TRUE, cumulative = TRUE, runs = 100, lrtest = FALSE)
irf_fi = vars::irf(model_svar, impulse = 'balance_budget_fd',
response = c('key_rate_fd', 'gdp_fd', 'infl_fd'),
n.ahead = 12, ortho = TRUE, cumulative = TRUE, runs = 100, lrtest = FALSE)
plot(irf_fi)
plot(irf_mi)
irf_fi_gdp = vars::irf(model_svar, impulse = "key_rate_fd", response = 'gdp_fd',
n.ahead = 12, ortho = TRUE, cumulative = TRUE, runs = 100)
irf_mi_gdp = vars::irf(model_svar, impulse = 'balance_budget_fd', response = "gdp_fd",
n.ahead = 12, ortho = TRUE, cumulative = TRUE, runs = 100)
plot(irf_fi_gdp)
plot(irf_mi_gdp)
Построение прогноза
len = length(data_pr_fd[,1])
pred = 4
preds = predict(model_var, n.ahead = 4, ci = 0.95)gdp_mape <- mape(as.data.frame(preds$fcst$gdp_fd)[,1], data_pr_fd[(len-pred+1):len, 1])
key_rate_mape <- mape(as.data.frame(preds$fcst$key_rate_fd)[,1], data_pr_fd[(len-pred+1):len, 2])
infl_mape <- mape(as.data.frame(preds$fcst$infl_fd)[,1], data_pr_fd[(len-pred+1):len, 3])
balance_budget_fd_mape <- mape(as.data.frame(preds$fcst$balance_budget_fd)[,1], data_pr_fd[(len-pred+1):len, 4])
cat(gdp_mape, key_rate_mape, infl_mape, balance_budget_fd_mape )## 5.693225 6.4418 2.684801 542.4267Хуже всего модель работает для фискального импульса
par(mfrow = c(2, 2))
plot(preds, names = 'gdp_fd')
plot(preds, names = 'infl_fd')
plot(preds, names = 'key_rate_fd')
plot(preds, names = 'balance_budget_fd')
par(mfrow = c(1, 1))