Вектор алдаа засварлах загварын тооцоолол

Оршил

Эконометрикс II хичээлийн долларын төгрөгтэй харьцах ханш (EX), түүнд нөлөөлөгч гадаад валютын албан нөөцийн хэмжээ (OR) болон мөнгөний нийлүүлэлт (MS) гэсэн хувьсагчийн сүүлийн 10 жилийн өгөгдлийг ашиглан хоорондын хамаарлыг тайлбарлаж, R программ ашиглан Вектор алдаа засварлах загвар болон мөнгөний нийлүүлэлтэд нэг стандарт алдааны тохиолдолд бий болох шокыг өгч хувьсагчдын хариу үйлдлийг шинжиллээ

Багц болон өгөгдөл

setwd("/Applications/4-1/ECN431_econo2/HW/hw9_FINAL")

library(readxl)
library(tseries) # adf test
library(urca) # Johansen test
library(forecast)
library(tidyverse)
library(vars) # Lag selection
library(tsDyn) # VECM
library(formattable)
library(pastecs) # Desriptive statistic
library(highcharter)
library(broom)

data <- read_xlsx("data.xlsx", sheet=1)
data.ts <- ts(data[,-1],frequency = 12, start = c(2011,10))
data$date <- as.Date(data$date)

Хувьсагчийн хамаарал

Сонгосон валютын ханш болон мөнгөний нийлүүлэлтийн хувьд Paul R. Krugman, Maurice Obstfeld, Marc J. Melitz гэх эдийн засагчдын “ОЛОН УЛСЫН ЭДИЙН ЗАСАГ: Онол болон Бодлого” гэсэн номоос хамааралтай гэж үндэслэн сонгосон билээ. Уг номонд Мөнгөний нийлүүлэлт өссөнөөр богино хугацаанд хүүний түвшин буурч, дотоодын валютын ханш суларна гэж үздэг. Харин урт хугацаанд үнэ өсөж эргээд ханшийг чангаруулна гэж үздэг. (Krugman, 2018)

Гадаад валютын албан нөөцийн хэмжээ болон валютын ханшийн хамаарлын хувьд Эдийн засагч Frederic Mishkin “Шинээр үүсэж буй САНХҮҮГИЙН ХЯМРАЛЫН ДИНАМИК - ЗАХ ЗЭЭЛИЙН ЭДИЙН ЗАСАГ” гэх номондоо засгийн газрууд хямралын үед дотоодын ханш болон Төв банкаа хамгаалахын тулд албан нөөцөө ашигладаг бөгөөд нөөц шавхагдвал дотоодын ханшийн сулралтын зогсоох боломжгүй гэсэн байдаг. (Mishkin, 2011)

Тодорхойлогч статистик

ds <- as.data.frame(stat.desc(data[,-1]))
options(scipen = 999)
formattable(ds,digits=2)

	MS	EX	OR
nbr.val	121.00	121.00	121.00
nbr.null	0.00	0.00	0.00
nbr.na	0.00	0.00	0.00
min	6073.70	1291.94	1038.70
max	27719.40	2854.17	4891.60
range	21645.70	1562.23	3852.90
sum	1706496.50	262955.73	326028.70
median	11610.90	2307.80	2800.80
mean	14103.28	2173.19	2694.45
SE.mean	562.86	47.08	104.55
CI.mean.0.95	1114.43	93.22	207.01
var	38334767.72	268218.26	1322667.95
std.dev	6191.51	517.90	1150.07
coef.var	0.44	0.24	0.43

highchart() %>%
  hc_chart(type = 'line',style = list(fontFamily = "Times New Roman")) %>%
  hc_yAxis(title = list(text = "")) %>% 
  hc_series( 
    list(name = 'Actual value', 
         data = data$MS,
         color='#000066' , marker = list(enabled = F), lineWidth = 2),
    list(name = 'Fitted value', 
         data = fit1$.fitted, 
         color = '#800080', dashStyle = 'shortDot', marker = list(symbol = 'circle'), 
         lineWidth = 2)
  ) %>%
  hc_xAxis( categories = data$date) %>%
  hc_title(text="Мөнгөний нийлүүлэлт", align="center",
           style = list(fontWeight = "bold", fontSize = "20px"))%>% 
  hc_subtitle(text = "Хэмжих нэгж: тэрбум.төг",align = "right") %>% 
  hc_plotOptions(column = list(
    dataLabels = list(enabled = F),
    enableMouseTracking = T )
  )%>%
  hc_legend(enabled=F) %>% 
  hc_add_theme(hc_theme_smpl())

trend2 <- lm(EX~time(EX), data=data)
fit2 <- augment(trend2) %>% arrange(time(EX))
highchart() %>%
  hc_chart(type = 'line',style = list(fontFamily = "Times New Roman")) %>%
  hc_yAxis(title = list(text = "")) %>% 
  hc_series( 
    list(name = 'Actual value', 
         data = data$EX,
         color='#000066' , marker = list(enabled = F), lineWidth = 2),
    list(name = 'Fitted value', 
         data = fit2$.fitted, 
         color = '#800080', dashStyle = 'shortDot', marker = list(symbol = 'circle'), 
         lineWidth = 2)
  ) %>%
  hc_xAxis( categories = data$date) %>%
  hc_title(text="Валютын ханш", align="center",
           style = list(fontWeight = "bold", fontSize = "20px"))%>% 
  hc_subtitle(text = "Хэмжих нэгж: төг",align = "right") %>% 
  hc_plotOptions(column = list(
    dataLabels = list(enabled = F),
    enableMouseTracking = T )
  )%>%
  hc_legend(enabled=F) %>% 
  hc_add_theme(hc_theme_smpl())

trend3 <- lm(OR~time(OR), data=data)
fit3 <- augment(trend3) %>% arrange(time(OR))
highchart() %>%
  hc_chart(type = 'line',style = list(fontFamily = "Times New Roman")) %>%
  hc_yAxis(title = list(text = "")) %>% 
  hc_series( 
    list(name = 'Actual value', 
         data = data$OR,
         color='#000066' , marker = list(enabled = F), lineWidth = 2),
    list(name = 'Fitted value', 
         data = fit3$.fitted, 
         color = '#800080', dashStyle = 'shortDot', marker = list(symbol = 'circle'), 
         lineWidth = 2)
  ) %>%
  hc_xAxis( categories = data$date) %>%
  hc_title(text="Гадаад валютын албан нөөц", align="center",
           style = list(fontWeight = "bold", fontSize = "20px"))%>% 
  hc_subtitle(text = "Хэмжих нэгж: сая.доллар",align = "right") %>% 
  hc_plotOptions(column = list(
    dataLabels = list(enabled = F),
    enableMouseTracking = T )
  )%>%
  hc_legend(enabled=F) %>% 
  hc_add_theme(hc_theme_smpl())  

Нэгж язгуурын тест

Тухайн өгөгдөл хугацаан цувааг нэгж язгууртай эсэхийг Дики-Фуллерийн нэгж язгуурын тест ашиглан тодорхойлж болно. Дики-Фуллерийн нэгж язгуурын тест нь дараах таамаглалыг шалгаж үздэг. H_0: Хугацаан цуваа нэгж язгууртай. H_a: Хугацаан цуваа нэгж язгуургүй буюу стационарь.

# Unit root test
adf.test(data$MS)

## 
##  Augmented Dickey-Fuller Test
## 
## data:  data$MS
## Dickey-Fuller = -1.3434, Lag order = 4, p-value = 0.8493
## alternative hypothesis: stationary

adf.test(data$EX)

## 
##  Augmented Dickey-Fuller Test
## 
## data:  data$EX
## Dickey-Fuller = -2.1323, Lag order = 4, p-value = 0.5216
## alternative hypothesis: stationary

adf.test(data$OR)

## 
##  Augmented Dickey-Fuller Test
## 
## data:  data$OR
## Dickey-Fuller = -1.4799, Lag order = 4, p-value = 0.7926
## alternative hypothesis: stationary

Lag selection

lagselect <- VARselect(data.ts, lag.max = 6, type = "const")
lagselect$criteria

##                          1                   2                   3
## AIC(n)            29.39987            29.33472            29.42773
## HQ(n)             29.51613            29.53818            29.71838
## SC(n)             29.68630            29.83597            30.14380
## FPE(n) 5864607185097.62891 5496730457140.97168 6037717561645.10938
##                          4                   5                   6
## AIC(n)            29.52447            29.60431            29.70875
## HQ(n)             29.90231            30.06934            30.26098
## SC(n)             30.45536            30.75002            31.06928
## FPE(n) 6661602229228.46289 7233585909582.43555 8059899023354.09668

formattable(as.data.frame(lagselect$selection))

	lagselect$selection
AIC(n)	2
HQ(n)	1
SC(n)	1
FPE(n)	2

Ёхансёны коинтеграци тест

Мөрийн тест

jtest_trace <- ca.jo(data.ts, type="trace", ecdet= "const", K=2)
summary(jtest_trace)

## 
## ###################### 
## # Johansen-Procedure # 
## ###################### 
## 
## Test type: trace statistic , without linear trend and constant in cointegration 
## 
## Eigenvalues (lambda):
## [1]  0.1995067654425872472057  0.0476761738434682974530
## [3]  0.0267489749933941013682 -0.0000000000000001329415
## 
## Values of teststatistic and critical values of test:
## 
##           test 10pct  5pct  1pct
## r <= 2 |  3.23  7.52  9.24 12.97
## r <= 1 |  9.04 17.85 19.96 24.60
## r = 0  | 35.52 32.00 34.91 41.07
## 
## Eigenvectors, normalised to first column:
## (These are the cointegration relations)
## 
##                 MS.l2        EX.l2        OR.l2    constant
## MS.l2        1.000000     1.000000      1.00000    1.000000
## EX.l2      -12.507071   -10.516650     22.74042   -8.496409
## OR.l2       -2.167704    -2.675145    -14.23915   -1.225680
## constant 12888.737263 16707.598810 -27670.81448 7773.627823
## 
## Weights W:
## (This is the loading matrix)
## 
##              MS.l2        EX.l2         OR.l2                    constant
## MS.d -0.0293850462 -0.003886862  0.0007168154  0.000000000000000984618950
## EX.d -0.0004658556  0.003057814 -0.0001191364 -0.000000000000000008954114
## OR.d -0.0047451179  0.009930390  0.0021766109  0.000000000000000115522271

Хамгийн их хувийн утгын тест

jtest_eigen <- ca.jo(data.ts, type="eigen", ecdet= "const", K=2)
summary(jtest_eigen)

## 
## ###################### 
## # Johansen-Procedure # 
## ###################### 
## 
## Test type: maximal eigenvalue statistic (lambda max) , without linear trend and constant in cointegration 
## 
## Eigenvalues (lambda):
## [1]  0.1995067654425872472057  0.0476761738434682974530
## [3]  0.0267489749933941013682 -0.0000000000000001329415
## 
## Values of teststatistic and critical values of test:
## 
##           test 10pct  5pct  1pct
## r <= 2 |  3.23  7.52  9.24 12.97
## r <= 1 |  5.81 13.75 15.67 20.20
## r = 0  | 26.48 19.77 22.00 26.81
## 
## Eigenvectors, normalised to first column:
## (These are the cointegration relations)
## 
##                 MS.l2        EX.l2        OR.l2    constant
## MS.l2        1.000000     1.000000      1.00000    1.000000
## EX.l2      -12.507071   -10.516650     22.74042   -8.496409
## OR.l2       -2.167704    -2.675145    -14.23915   -1.225680
## constant 12888.737263 16707.598810 -27670.81448 7773.627823
## 
## Weights W:
## (This is the loading matrix)
## 
##              MS.l2        EX.l2         OR.l2                    constant
## MS.d -0.0293850462 -0.003886862  0.0007168154  0.000000000000000984618950
## EX.d -0.0004658556  0.003057814 -0.0001191364 -0.000000000000000008954114
## OR.d -0.0047451179  0.009930390  0.0021766109  0.000000000000000115522271

# VECM 
model1 <- VECM(data.ts, lag=2, r=1, estim="ML")
summary(model1)

## #############
## ###Model VECM 
## #############
## Full sample size: 121    End sample size: 118
## Number of variables: 3   Number of estimated slope parameters 24
## AIC 3471.874     BIC 3543.912    SSR 18868688
## Cointegrating vector (estimated by ML):
##    MS        EX       OR
## r1  1 -10.91108 -2.13351
## 
## 
##             ECT                 Intercept              MS -1              
## Equation MS -0.0537(0.0214)*    -671.3303(329.2289)*   0.0628(0.0990)     
## Equation EX 0.0028(0.0019)      47.8946(29.1323)       0.0140(0.0088)     
## Equation OR -0.0035(0.0168)     -13.2571(258.5992)     -0.0132(0.0778)    
##             EX -1               OR -1               MS -2              
## Equation MS -0.7570(1.0673)     -0.1122(0.1354)     0.1852(0.1003).    
## Equation EX 0.3891(0.0944)***   -0.0147(0.0120)     0.0014(0.0089)     
## Equation OR -0.6598(0.8384)     0.0348(0.1064)      -0.0327(0.0788)    
##             EX -2               OR -2              
## Equation MS -1.0262(1.0596)     -0.1909(0.1365)    
## Equation EX -0.0060(0.0938)     -0.0012(0.0121)    
## Equation OR -0.7118(0.8323)     -0.0184(0.1073)

model1_VAR <- vec2var(jtest_trace, r=1)
MStoMS <- irf(model1_VAR, impulse = "MS", response = "MS",n.ahead = 24)
MStoEX <- irf(model1_VAR, impulse = "MS", response = "EX",n.ahead = 24)
MStoOR <- irf(model1_VAR, impulse = "MS", response = "OR",n.ahead = 24)

par(mfrow=c(1,1))
plot(MStoMS, main= "MS shock to MS",lwd=2)

plot(MStoEX, main= "MS shock to EX",lwd=2)

plot(MStoOR, main= "MS shock to OR",lwd=2)