®suppressPackageStartupMessages(library('BBmisc'))
#'@ suppressPackageStartupMessages(library('rmsfuns'))
pkgs <- c('knitr', 'kableExtra', 'devtools', 'lubridate', 'data.table', 'quantmod', 'qrmtools', 'tidyquant', 'plyr', 'stringr', 'magrittr', 'dplyr', 'tidyverse', 'memoise', 'highcharter', 'formattable', 'DT', 'rugarch', 'ccgarch', 'mgarchBEKK', 'rmgarch')
suppressAll(lib(pkgs))
#'@ load_pkg(pkgs)
funs <- c('calc_fx.R', 'opt_arma.R', 'filterFX.R', 'filter_spec.R', 'mv_fx.R', 'read_umodels.R')
l_ply(funs, function(x) source(paste0('./function/', x)))
options(warn=-1)#, 'scipen'=100, 'digits'=4)
rm(pkgs)1 Introduction
From previous papers, I tried to apply few models for FOREX price forecasting and eventually got to know Fractional Intergrated GJR-GARCH is the best fit model as we can refer to GARCH模型中的ARIMA(p,d,q)参数最优化. The standalone ARFIMAX model and methods in the A short introduction to the rugarch package describe the autoarfima() function where we can easily get the optimal MA and AR figure.
Today I am zooming into the multivariate GARCH models.
2 Data
2.1 Read Data
Similar with GARCH模型中的ARIMA(p,d,q)参数最优化, I use the dataset from Binary-Q1 (Extention).
cr_code <- c('AUDUSD=X', 'EURUSD=X', 'GBPUSD=X', 'CHF=X', 'CAD=X',
'CNY=X', 'JPY=X')
#'@ names(cr_code) <- c('AUDUSD', 'EURUSD', 'GBPUSD', 'USDCHF', 'USDCAD',
#'@ 'USDCNY', 'USDJPY')
names(cr_code) <- c('USDAUD', 'USDEUR', 'USDGBP', 'USDCHF', 'USDCAD', 'USDCNY', 'USDJPY')
## Read presaved Yahoo data.
mbase <- sapply(names(cr_code), function(x) readRDS(paste0('./data/', x, '.rds')) %>% na.omit)
.price_types <- c('OHLC', 'HLC', 'HL', 'C')
## all currencies trading day.
timeID <- llply(mbase, function(x) as.character(index(x))) %>%
unlist
timeID %<>% plyr::count()
#timeID %>% dplyr::count(freq)
## A tibble: 4 x 2
# freq n
# <int> <int>
#1 1 1
#2 3 1
#3 6 3
#4 7 1472
timeID %<>% dplyr::filter(freq == 7) %>% .$x %>% unique %>% as.Date %>% sort
timeID <- c(timeID, xts::last(timeID) + days(1)) #the last date + 1 in order to predict the next day of last date to make whole dataset completed.
timeID0 <- ymd('2013-01-01')
timeID %<>% .[. >= timeID0]
.cl = TRUE3 Modelling
3.1 Introduce Multivariate Garch Models
Multivariate GARCH models including DCC, GO-GARCH and Copula-GARCH, CCC and BEKK. Paper Comparison of Multivariate GARCH Models with Application to Zero-Coupon Bond Volatility compares DCC and BEKK model on bond market with maturities of 6 months, 1 year and 2 years. The thesis concludes that the fitting performance of the BEKK is better than DCC in their case, the difference might due to the number of the parameters of BEKK model is comparatively more, so that the BEKK has a better capanility in explaning the information hidden in the hostory data. In opposite, the DCC model has an advantage over the BEKK model in the area of forecasting as the DCC model is more parsimonious than BEKK model. From my understanding means that if we compare with deviance or AIC/BIC the DCC will be more accurate. However, this paper will compare as well since forex market is not bond market.
R - Time Series : Comandos R para análises de séries temporais is a website to introduce the multivariate GARCH models (in Portuguese language).
Currency Hedging Strategies Using Dynamic Multivariate GARCH compares DCC, BEKK, CCC and VARMA-AGARCH models to examine the conditional volatilities among the spot and two distint futures maturities, namely near-month and next-to-near-month contracts. The estimated conditionl covariances matrices from these models were used to calculate the optimal portfolios weights and optimal hedge ratios.1 The empirical results in the paper reveal that there are not big differences either the near-month or next-to-near-month contract is used for hedge spot position on currencies. They also reveal that hedging ratios are lower for near-month contract when the USD/EUR and USD/JPY exchange rates are anlyzed. This result is explained in terms of the higher correlation between spot prices and the next-to-near-month future prices than that with near-month contract and additionally because of the lower volatility of the long maturity futures. Finally across all currencies and error densities, the CCC and VARMA-AGARCH models provide similar results in terms of hedging ratios, portfolio variance reduction and hedging effectiveness. Some difference might appear when the DCC and BEKK models are used. Below is the table summary of the paper.
| Model | Currency | AIC |
|---|---|---|
| EURS | ||
| CCC | EURS | 2.738605 |
| VARMA-AGARCH | EURS | 2.734926 |
| DCC | EURS | 2.721337 |
| BEKK | EURS | 2.735964 |
| GBPS | ||
| CCC | GBPS | 2.247209 |
| VARMA-AGARCH | GBPS | 2.241061 |
| DCC | GBPS | 2.205663 |
| BEKK | GBPS | 2.212324 |
| JPYS | ||
| CCC | JPYS | 2.827915 |
| VARMA-AGARCH | JPYS | 2.828964 |
| DCC | JPYS | 2.784974 |
| BEKK | JPYS | 2.788730 |
Table 3.1.1 : comparison of the models.
Table above shows DCC model is the best fit model.
Do We Really Need Both BEKK and DCC - A Tale of Two Multivariate GARCH Models compares few models and final model should be based on model performance within the appropriate framework in which they are used (such as covariance, correlation forecasting, risk monitoringm or portfolio allocation, to cite the most relevant), the paper concludes that the cDCC (constant DCC) model2 and BEKK model.
Forecasting the Daily Dynamic Hedge Ratios by GARCH Models - Evidence from the Agricultural Futures Markets compares few models which are bivariate GARCH, BEKK GARCH, GARCH-X, BEKK-X, Q-GARCH and GARCH-GJR in agricultural futures markets. The paper reveals that the BEKK model dominates others models for storable wheat and soybean for both forecasting horizons, and the asymmetric GJR andQ-GARCH models does the best forecasting performance for the non-storable products, live cattle and live hogs.
Dynamic Portfolio Optimization using Generalized Dynamic Conditional Heteroskedastic Factor Models studies the portfolio selection problem based on a generalized dynamic factor model (GDFM) with conditional heteroskedasticity in the idiosyncratic components. We propose a Generalized Smooth Transition Conditional Correlation (GSTCC) model for the idiosyncratic components combined with the GDFM. Among all the multivariate GARCH models that the authors propose, the generalized smooth transition conditional correlation provides the best result.
I try to surf over internet and the model has no yet widely use. Here I can only use the CCC, DCC models but the best performance GSTCC is not yet available in r packages. The cccgarch has STCC model but there has no examples to use it. I roughly read over the ccgarch package and noticed that all parameters required in matrix format which is only suitable for advance user use.
Forecasting Conditional Correlation for Exchange Rates using Multivariate GARCH Models with Historical Value-at-Risk Application compares the VaR for trade in USDSEK in T+1 and T+10 with intraday 30 minutes time interval. When comparing the BEKK and DCC model, the BEKK seems to perform better than the DCC in both forecasting conditional correlation and predicting VaR. On the contrary, the BEKK is much more computationally demanding, which most certainly would be even more noticeable when the number of assets increase.
3.2 Parameter Selection
My initially workable models result.
workable.dcc <- readRDS('data/fx/pt.dcc.rds')
#'@ dcc.AIC <- ldply(workable.dcc, function(x) {
#'@ ldply(x, function(y) {
#'@ list.select(y, AIC) %>%
#'@ data.frame %>% t %>% data.frame %>%
#'@ mutate(includes.Op = c(TRUE, FALSE))
#'@ }) %>% rename(.solver = .id)
#'@ }) %>%
#'@ dplyr::select(.id, .solver, includes.Op, Akaike, Bayes, Shibata, Hannan.Quinn)
dcc.AIC <- ldply(workable.dcc, function(x) {
zz <- ldply(x, function(y) {
zz <- ldply(y, function(z) {
z$AIC %>%
data.frame %>% t %>% data.frame
})
names(zz)[1] <- 'includes.Op'
zz
})
names(zz)[1] <- '.solver'
zz
})
dcc.AIC %>%
arrange(Akaike, Bayes) %>%
kable(caption = 'Akaike Information Criteria') %>%
kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(width = '100%', height = '400px')| .id | .solver | includes.Op | Akaike | Bayes | Shibata | Hannan.Quinn |
|---|---|---|---|---|---|---|
| DCC | solnp | TRUE | -2.330914 | -2.151473 | -2.333111 | -2.264012 |
| aDCC | solnp | TRUE | -2.330914 | -2.151473 | -2.333111 | -2.264012 |
| FDCC | solnp | TRUE | -2.330914 | -2.151473 | -2.333111 | -2.264012 |
| DCC | gosolnp | TRUE | -2.319914 | -2.140474 | -2.322111 | -2.253012 |
| aDCC | gosolnp | TRUE | -2.046191 | -1.866750 | -2.048388 | -1.979289 |
| FDCC | gosolnp | TRUE | -2.041882 | -1.862441 | -2.044078 | -1.974980 |
| aDCC | gosolnp | FALSE | 2.178180 | 2.300200 | 2.177151 | 2.223674 |
| DCC | gosolnp | FALSE | 2.199818 | 2.321838 | 2.198788 | 2.245311 |
| FDCC | gosolnp | FALSE | 2.217234 | 2.339254 | 2.216204 | 2.262728 |
| DCC | solnp | FALSE | 2.248041 | 2.370060 | 2.247011 | 2.293534 |
| aDCC | solnp | FALSE | 2.248041 | 2.370060 | 2.247011 | 2.293534 |
| FDCC | solnp | FALSE | 2.248041 | 2.370060 | 2.247011 | 2.293534 |
Table 3.2.1.1 : AIC comparison.
From above table, with -2.3309142 is the best fitted model.
dcc.logLik <- ldply(workable.dcc, function(x) {
zz = ldply(x, function(y) {
zz = ldply(y, function(z) {
attributes(z$fit)$mfit$llh
})
names(zz) <- c('includes.Op', 'log.Likelihood')
zz
})
names(zz)[1] <- '.solver'
zz
})
dcc.logLik %>%
arrange(log.Likelihood) %>%
kable(caption = 'Log-Likelihood') %>%
kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(width = '100%', height = '400px')| .id | .solver | includes.Op | log.Likelihood |
|---|---|---|---|
| DCC | solnp | FALSE | -1625.054 |
| aDCC | solnp | FALSE | -1625.054 |
| FDCC | solnp | FALSE | -1625.054 |
| FDCC | gosolnp | FALSE | -1602.319 |
| DCC | gosolnp | FALSE | -1589.466 |
| aDCC | gosolnp | FALSE | -1573.497 |
| FDCC | gosolnp | TRUE | 1556.909 |
| aDCC | gosolnp | TRUE | 1560.089 |
| DCC | gosolnp | TRUE | 1762.097 |
| DCC | solnp | TRUE | 1770.215 |
| aDCC | solnp | TRUE | 1770.215 |
| FDCC | solnp | TRUE | 1770.215 |
Table 3.2.1.2 : Log-Likelihood comparison.
3.2.1 Close Price
## ------- eval ----------
## Possible multivariate models.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp', 'nlminb', 'lbfgs', 'gosolnp')
## Includes the open price or not.
bk.base <- llply(mbase, Cl)
bk.base %<>% do.call(cbind, .) %>% na.omit
## Statistical modelling
bk.dcc <- llply(md, function(x) {
dm <- llply(sv, function(y) {
fit <- tryCatch(
mv_fx(bk.base, .model = x, .solver = y,
.include.Op = FALSE, .Cl.only = TRUE),
error = function(e) cat(paste0('bk.', x, '.', y, ' error.\n')))
if (!is.null('fit')) {
eval(parse(text = paste0(
"saveRDS(fit, 'data/fx/", paste0('bk.', x, '.', y), ".rds')")))
cat(paste0('bk.', x, '.', y, ' saved.\n'))
}
})
names(dm) <- sv
dm
})
names(bk.dcc) <- mdI executed above coding and there are quite some models occured errors. The FDCC models do faced error even though change all possible solvers. Below I read presaved data which executed above.
fls <- list.files('data/fx', pattern = '^bk.') %>% str_replace_all('.rds', '')
bk.dcc <- sapply(fls, function(x) readRDS(paste0('data/fx/', x, '.rds'))) %>%
filterNullHere I tried to compare the AIC values. The lowest value will be best fit model.
##compare AIC values.
dcc.AIC <- sapply(bk.dcc, function(x) data.frame(t(x$AIC))) %>%
t %>% data.frame(.id = rownames(.)) %>%
separate(.id, c('.id', '.model', '.solver')) %>%
dplyr::select(.id, .model, .solver, Akaike, Bayes, Shibata, Hannan.Quinn) %>%
unnest
rownames(dcc.AIC) <- NULL
dcc.AIC %>%
arrange(Akaike, Bayes) %>%
kable(caption = 'Akaike Information Criteria') %>%
kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(width = '100%')#, height = '400px')| .id | .model | .solver | Akaike | Bayes | Shibata | Hannan.Quinn |
|---|---|---|---|---|---|---|
| bk | DCC | solnp | -45.74467 | -45.33105 | -45.75574 | -45.59043 |
| bk | aDCC | solnp | -45.74331 | -45.32609 | -45.75456 | -45.58773 |
| bk | aDCC | gosolnp | -45.46348 | -45.04626 | -45.47473 | -45.30790 |
| bk | aDCC | nlminb | -45.43589 | -45.01867 | -45.44714 | -45.28032 |
| bk | DCC | nlminb | -45.41696 | -45.00334 | -45.42803 | -45.26273 |
| bk | DCC | gosolnp | -45.28846 | -44.87484 | -45.29953 | -45.13423 |
Table 3.2.3.1 : AIC comparison.
From above table, with -45.7446694 is the best fitted model. After that, look at the log-likehood figure as well to compare the correlation among models. The highest value will be best fit model.
##compare AIC values.
dcc.logLik <- sapply(bk.dcc, function(x) attributes(x$fit)$mfit$llh) %>%
t %>% t %>% data.frame(.id = rownames(.)) %>%
separate(.id, c('.id', '.model', '.solver'))
rownames(dcc.logLik) <- NULL
names(dcc.logLik)[1] <- 'log.Likelihood'
dcc.logLik %<>% dplyr::select(.id, .model, .solver, log.Likelihood)
dcc.logLik %>%
arrange(log.Likelihood) %>%
kable(caption = 'Log-Likelihood') %>%
kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive'))| .id | .model | .solver | log.Likelihood |
|---|---|---|---|
| bk | DCC | gosolnp | 33447.31 |
| bk | DCC | nlminb | 33541.89 |
| bk | aDCC | nlminb | 33556.82 |
| bk | aDCC | gosolnp | 33577.12 |
| bk | aDCC | solnp | 33783.08 |
| bk | DCC | solnp | 33783.08 |
Table 3.2.3.2 : Log-Likelihood comparison.
## Possible multivariate models.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp', 'nlminb', 'lbfgs', 'gosolnp')
## Includes the open price or not.
bk.base <- llply(mbase, Cl)
bk.base %<>% do.call(cbind, .) %>% na.omit
## Statistical modelling
bk.dcc <- llply(md, function(x) {
dm <- llply(sv, function(y) {
fit <- tryCatch(
mv_fx(bk.base, .model = x, .solver = y,
.include.Op = FALSE, .Cl.only = TRUE, .roll = TRUE),
error = function(e) cat(paste0('roll.bk.', x, '.', y, ' error.\n')))
if (!is.null('fit')) {
eval(parse(text = paste0(
"saveRDS(fit, 'data/fx/", paste0('roll.bk.', x, '.', y), ".rds')")))
cat(paste0('roll.bk.', x, '.', y, ' saved.\n'))
}
})
names(dm) <- sv
dm
})## roll.bk.DCC.solnp error.
## roll.bk.DCC.solnp saved.
## roll.bk.DCC.nlminb error.
## roll.bk.DCC.nlminb saved.
## roll.bk.DCC.lbfgs error.
## roll.bk.DCC.lbfgs saved.
## roll.bk.DCC.gosolnp error.
## roll.bk.DCC.gosolnp saved.
## roll.bk.aDCC.solnp error.
## roll.bk.aDCC.solnp saved.
## roll.bk.aDCC.nlminb error.
## roll.bk.aDCC.nlminb saved.
## roll.bk.aDCC.lbfgs error.
## roll.bk.aDCC.lbfgs saved.
## roll.bk.aDCC.gosolnp error.
## roll.bk.aDCC.gosolnp saved.
## roll.bk.FDCC.solnp error.
## roll.bk.FDCC.solnp saved.
## roll.bk.FDCC.nlminb error.
## roll.bk.FDCC.nlminb saved.
## roll.bk.FDCC.lbfgs error.
## roll.bk.FDCC.lbfgs saved.
## roll.bk.FDCC.gosolnp error.
## roll.bk.FDCC.gosolnp saved.names(bk.dcc) <- md3.2.2 Hi-Lo Price
3.2.2.1 Single Currency
Multivariate modelling for single currency. Here I tried to seperate to 2 type of forecasting dataset which are OHLC and HLC to know if includes the open price will be more accurate or not.
## ------------- eval ---------------
## Possible multivariate models.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp', 'nlminb', 'lbfgs', 'gosolnp')
op <- c(TRUE, FALSE)
## Includes the open price or not.
pt.base <- mbase[['USDJPY']][,1:4]
## Statistical modelling
pt.dcc <- llply(md, function(x) {
dm <- llply(sv, function(y) {
TF <- llply(op, function(z) {
fit <- tryCatch(
mv_fx(pt.base, .model = x, .solver = y,
.include.Op = z, .Cl.only = FALSE),
error = function(e)
cat(paste0('pt.', x, '.', y, '.', z,' error.\n')))
if (!is.null('fit')) {
eval(parse(text = paste0(
"saveRDS(fit, 'data/fx/",
paste0('pt.', x, '.', y, '.', z), ".rds')")))
cat(paste0('pt.', x, '.', y, '.', z, ' saved.\n'))
}
})
names(TF) <- op
TF
})
names(dm) <- sv
dm
})
names(pt.dcc) <- mdI executed above coding and there are quite some models occured errors. The FDCC models do faced error even though change all possible solvers. Below I read presaved data which executed above.
fls <- list.files('data/fx', pattern = '^pt.[^dcc]') %>% str_replace_all('.rds', '')
pt.dcc <- sapply(fls, function(x) readRDS(paste0('data/fx/', x, '.rds'))) %>%
filterNullHere I tried to compare the AIC values. The lowest value will be best fit model.
##compare AIC values.
dcc.AIC <- sapply(pt.dcc, function(x) data.frame(t(data.frame(x$AIC)))) %>%
t %>% data.frame(.id = rownames(.)) %>%
separate(.id, c('.id', '.model', '.solver', 'includes.Op')) %>%
dplyr::select(.id, .model, .solver, includes.Op, Akaike, Bayes, Shibata, Hannan.Quinn) %>% unnest
rownames(dcc.AIC) <- NULL
dcc.AIC %>%
arrange(Akaike, Bayes) %>%
kable(caption = 'Akaike Information Criteria') %>%
kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(width = '100%', height = '400px')| .id | .model | .solver | includes.Op | Akaike | Bayes | Shibata | Hannan.Quinn |
|---|---|---|---|---|---|---|---|
| pt | DCC | solnp | TRUE | -2.3322693 | -2.1564174 | -2.3343806 | -2.2667052 |
| pt | aDCC | solnp | TRUE | -2.3309142 | -2.1514735 | -2.3331106 | -2.2640121 |
| pt | aDCC | gosolnp | TRUE | -1.3263370 | -1.1468962 | -1.3285334 | -1.2594348 |
| pt | DCC | gosolnp | TRUE | -0.7601012 | -0.5842493 | -0.7622125 | -0.6945371 |
| pt | DCC | lbfgs | TRUE | -0.4781134 | -0.3022614 | -0.4802246 | -0.4125493 |
| pt | DCC | gosolnp | FALSE | 2.1804920 | 2.2989229 | 2.1795211 | 2.2246474 |
| pt | DCC | lbfgs | FALSE | 2.1805534 | 2.2989843 | 2.1795825 | 2.2247088 |
| pt | DCC | nlminb | FALSE | 2.2146236 | 2.3330545 | 2.2136527 | 2.2587790 |
| pt | DCC | solnp | FALSE | 2.2466854 | 2.3651163 | 2.2457145 | 2.2908408 |
| pt | aDCC | lbfgs | FALSE | 2.2473664 | 2.3693862 | 2.2463367 | 2.2928599 |
| pt | aDCC | nlminb | FALSE | 2.2473721 | 2.3693918 | 2.2463424 | 2.2928656 |
| pt | aDCC | solnp | FALSE | 2.2480405 | 2.3700603 | 2.2470108 | 2.2935340 |
| pt | aDCC | gosolnp | FALSE | 2.3093949 | 2.4314146 | 2.3083651 | 2.3548883 |
Table 3.2.4.1 : AIC comparison.
From above table, with -2.3322693 is the best fitted model. After that, look at the log-likehood figure as well to compare the correlation among models. The highest value will be best fit model.
##compare AIC values.
dcc.logLik <- sapply(pt.dcc, function(x) attributes(x$fit)$mfit$llh) %>%
t %>% t %>% data.frame(.id = rownames(.)) %>%
separate(.id, c('.id', '.model', '.solver', 'includes.Op'))
rownames(dcc.logLik) <- NULL
names(dcc.logLik)[1] <- 'log.Likelihood'
dcc.logLik %<>% dplyr::select(.id, .model, .solver, includes.Op, log.Likelihood)
dcc.logLik %>%
arrange(log.Likelihood) %>%
kable(caption = 'Log-Likelihood') %>%
kable_styling(bootstrap_options = c('striped', 'hover', 'condensed', 'responsive'))| .id | .model | .solver | includes.Op | log.Likelihood |
|---|---|---|---|---|
| pt | aDCC | gosolnp | FALSE | -1670.3334 |
| pt | aDCC | solnp | FALSE | -1625.0539 |
| pt | DCC | solnp | FALSE | -1625.0538 |
| pt | aDCC | nlminb | FALSE | -1624.5606 |
| pt | aDCC | lbfgs | FALSE | -1624.5564 |
| pt | DCC | nlminb | FALSE | -1601.3922 |
| pt | DCC | lbfgs | FALSE | -1576.2484 |
| pt | DCC | gosolnp | FALSE | -1576.2031 |
| pt | DCC | lbfgs | TRUE | 401.8477 |
| pt | DCC | gosolnp | TRUE | 609.9547 |
| pt | aDCC | gosolnp | TRUE | 1028.8367 |
| pt | aDCC | solnp | TRUE | 1770.2147 |
| pt | DCC | solnp | TRUE | 1770.2148 |
Table 3.2.4.2 : Log-Likelihood comparison.
The model pt.DCC.solnp.TRUE which highest logLik value 1770.2147539 is the best fitted model for correlation.
## ------------- eval ---------------
## Possible multivariate models.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp', 'nlminb', 'lbfgs', 'gosolnp')
op <- c(TRUE, FALSE)
## Includes the open price or not.
pt.base <- mbase[['USDJPY']][,1:4]
## Statistical modelling
pt.dcc <- llply(md, function(x) {
dm <- llply(sv, function(y) {
TF <- llply(op, function(z) {
fit <- tryCatch(
mv_fx(pt.base, .model = x, .solver = y,
.include.Op = z, .Cl.only = FALSE, .roll = TRUE),
error = function(e)
cat(paste0('roll.pt.', x, '.', y, '.', z,' error.\n')))
if (!is.null('fit')) {
eval(parse(text = paste0(
"saveRDS(fit, 'data/fx/",
paste0('roll.pt.', x, '.', y, '.', z), ".rds')")))
cat(paste0('roll.pt.', x, '.', y, '.', z, ' saved.\n'))
}
})
names(TF) <- op
TF
})
names(dm) <- sv
dm
})
names(pt.dcc) <- md3.2.2.2 Currency Basket
Multivariate modelling for a basket of currencies for Cl will compares in following section. The HL and HLC will be in another paper.
3.2.3 Concludes Parameter Selection
I initially wonder if I need to includes the open price in the models. Therefore I tried to compare above models. However the open price might not in use the my trading strategy. Therefore here I skip it. Here I seperates to 3 selection for trading:
- Hi-Lo
- Hi-Lo-Cl
- Cl
From previous univariate models comparison, gjrGARCH almost be the most accurate across all mentioned currencies. Due to the MSE of USDJPY will be higher than other currency, here I use USDJPY to save the time to compare the models. Above solver shows that the solnp and gosolnp will be more accurate, here I only use these 2 solvers. I skip the Open Price because it will not use in either be punter nor banker.
Source : [转载]詹姆斯-哈里斯-西蒙斯(James Harris Simons)
[转载]詹姆斯-哈里斯-西蒙斯(James Harris Simons) describe the open price of future market and the close price of last day was highly related. There will be another research (if any). However I tried to use previous day’s price to model in VAR=TRUE.
3.3 DCC
3.3.1 Abtract of DDC
Due to article The GARCH DCC Model and 2 Stage DCCMVT Estimation3 compares the model = c('DCC', 'aDCC') but not model = 'FDCC' with all distributions and concludes that aDCC with distribution = 'mvt' is the best fit model and distribution for multivariate GARCH model. Here I directly use mvt but in different solver parameters.
The paper Binary.com Interview Q1 - Comparison of Univariate GARCH Models describes the GARCH orders. How to identify the ARCH and GARCH lag length in dynamic conditional correlation GARCH model? describes the GARCH(1,1) and also DCC-GARCH as well.
Multivariate DCC-GARCH Model introduce the DCC and CCC models. In all tests for marginal goodness of fit the DCC-GARCH with skew Student’s t-distributed errors outperformed the DCC-GARCH with Gaussian and Student’s t-distributed errors. Comparing the DCC-GARCH model with the CCC-GARCH model using the Kupiec test showed that the DCC-GARCH model gave a better fit to the data.
3.3.1.1 VAR and Robust
Below models will set VAR=TRUE and and robust=FALSEVAR=FALSE to test if it is more accurate.
If you have a multivariate conditional mean specification (i.e. VAR) then you cannot have a univariate conditional mean specification (arma model)…they are mutually exclusive. In short, do not enter anything for mean.model in ugarchspec (include.mean is automatically set to FALSE if VAR is selected).
source : rmgarch:dccforecast() and mregfor or how to test significance of VAR coefficients in DCC GARCH Fit
Currently the DCCfit object (returned from running dccfit) does not return all the information on the VAR (coefficients can be extracted by looking at the model slot and ‘varcoef’ list i.e. fit at model$varcoef).
A better approach is to first estimate the VAR model using the function ‘varxfit’ in the package which returns the standard errors and all relevant information, and then passing this returned object to the dccfit routine (example follows).
#################
library(rmgarch)
data(dji30ret)
Data = dji30ret[, 1:3, drop = FALSE]
vfit = varxfit(X=Data, p=1, exogen = NULL, robust = FALSE,
gamma = 0.25, delta = 0.01, nc = 10, ns = 500, postpad = "constant")
uspec = ugarchspec(mean.model = list(armaOrder = c(0,0), include.mean =
FALSE), variance.model = list(garchOrder = c(1,1), model = "sGARCH"),
distribution.model = "norm")
spec = dccspec(uspec = multispec( replicate(3, uspec) ), VAR = TRUE,
lag = 1, dccOrder = c(1,1), asymmetric = FALSE, distribution = "mvnorm")
fit = dccfit(spec, data = Data, fit.control = list(eval.se=TRUE),
VAR.fit = vfit)
#################The package also includes for convenience the ‘varxfilter’, ‘varxforecast’ and ‘varxsim’ functions which are used by the multivariate garch routines internally.
As mentioned in the documentation, a comprehensive list of examples are included in the ‘inst/rmgarch.tests’ folder of the package.
Regards,
Alexios
source : [R-SIG-Finance] how to test significance of VAR coefficients in DCC GARCH Fit
.VARs = c(TRUE, FALSE)
#.rb = c(TRUE, FALSE)3.3.2 Hi-Lo
3.3.2.1 DCC and VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
HiLo.base <- c(Hi.base, Lo.base) %>% do.call(cbind, .) %>% na.omit
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^DCC.GARCH.USDJPY.HL.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
baseDT <- ymd('2013-01-01')
timeID %<>% .[!. %in% tmID] %>% .[-1]
timeID %<>% .[. > baseDT]
DCC.GARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLo.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
DCC.GARCH.USDJPY[[i]] <- tryCatch({ldply(md[1], function(y) {
df = tryCatch(
mv_fx(smp, .model = y, .solver = 'solnp', .currency = cr_code[7],#[i],
.price_type = 'HL', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.HL.', 'solnp', ' error.\n')))
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, t(df$AIC),
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(DCC.GARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(DCC.GARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(DCC.GARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/DCC.GARCH.USDJPY.HL.',
unique(DCC.GARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/DCC.GARCH.USDJPY.HL.',
unique(DCC.GARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}; rm(i)
}3.3.2.2 aDCC and VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
HiLo.base <- c(Hi.base, Lo.base) %>% do.call(cbind, .) %>% na.omit
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^aDCC.GARCH.USDJPY.HL.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
baseDT <- ymd('2013-01-01')
timeID %<>% .[!. %in% tmID] %>% .[-1]
timeID %<>% .[. > baseDT]
aDCC.GARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLo.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
aDCC.GARCH.USDJPY[[i]] <- tryCatch({ldply(md[2], function(y) {
df = tryCatch(
mv_fx(smp, .model = y, .solver = 'solnp', .currency = cr_code[7],#[i],
.price_type = 'HL', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.HL.', 'solnp', ' error.\n')))
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, t(df$AIC),
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(aDCC.GARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(aDCC.GARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(aDCC.GARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/aDCC.GARCH.USDJPY.HL.',
unique(aDCC.GARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/aDCC.GARCH.USDJPY.HL.',
unique(aDCC.GARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}; rm(i)
}3.3.2.3 FDCC and VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
HiLo.base <- c(Hi.base, Lo.base) %>% do.call(cbind, .) %>% na.omit
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^FDCC.GARCH.USDJPY.HL.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
baseDT <- ymd('2013-01-01')
timeID %<>% .[!. %in% tmID] %>% .[-1]
timeID %<>% .[. > baseDT]
FDCC.GARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLo.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
FDCC.GARCH.USDJPY[[i]] <- tryCatch({ldply(md[3], function(y) {
df = tryCatch(
mv_fx(smp, .model = y, .solver = 'solnp', .currency = cr_code[7],#[i],
.price_type = 'HL', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.HL.', 'solnp', ' error.\n')))
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, t(df$AIC),
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(FDCC.GARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(FDCC.GARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(FDCC.GARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/FDCC.GARCH.USDJPY.HL.',
unique(FDCC.GARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/FDCC.GARCH.USDJPY.HL.',
unique(FDCC.GARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}; rm(i)
}3.3.3 Hi-Lo-Cl
3.3.3.1 DCC and VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo-Cl.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
Cl.base <- llply(mbase['USDJPY'], Cl)
HiLoCl.base <- c(Hi.base, Lo.base, Cl.base) %>%
do.call(cbind, .) %>% na.omit
rm(Hi.base, Lo.base, Cl.base)
## only use USDJPY trading day.
timeID <- HiLoCl.base %>% index %>% ymd %>%
.[. >= timeID0] %>% c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^DCC.GARCH.USDJPY.HLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
baseDT <- ymd('2013-01-01')
timeID %<>% .[!. %in% tmID] %>% .[-1]
timeID %<>% .[. > baseDT]
DCC.GARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLoCl.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
DCC.GARCH.USDJPY[[i]] <- tryCatch({llply(md[1], function(y) {
df = tryCatch(
mv_fx(smp, .model = y, .solver = 'solnp', .currency = cr_code[7],#[i],
.price_type = 'HLC', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.HLC.', 'solnp', ' error.\n')))
res = suppressAll(data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, t(df$AIC)))
VaR = df$forecastVaR
names(res) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
names(VaR) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
return(list(res = res, VaR = VaR))
})[[1]]}, error = function(e) NULL)
if (is.null(DCC.GARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(DCC.GARCH.USDJPY[[i]]$res)[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(DCC.GARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/DCC.GARCH.USDJPY.HLC.',
unique(DCC.GARCH.USDJPY[[i]]$res$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/DCC.GARCH.USDJPY.HLC.',
unique(DCC.GARCH.USDJPY[[i]]$res$Date), '.rds saved!\n'))
}
}; rm(i)
}3.3.3.2 aDCC and VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo-Cl.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
Cl.base <- llply(mbase['USDJPY'], Cl)
HiLoCl.base <- c(Hi.base, Lo.base, Cl.base) %>%
do.call(cbind, .) %>% na.omit
rm(Hi.base, Lo.base, Cl.base)
## only use USDJPY trading day.
timeID <- HiLoCl.base %>% index %>% ymd %>%
.[. >= timeID0] %>% c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^aDCC.GARCH.USDJPY.HLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
baseDT <- ymd('2013-01-01')
timeID %<>% .[!. %in% tmID] %>% .[-1]
timeID %<>% .[. > baseDT]
aDCC.GARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLoCl.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
aDCC.GARCH.USDJPY[[i]] <- tryCatch({llply(md[2], function(y) {
df = tryCatch(
mv_fx(smp, .model = y, .solver = 'solnp', .currency = cr_code[7],#[i],
.price_type = 'HLC', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.HLC.', 'solnp', ' error.\n')))
res = suppressAll(data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, t(df$AIC)))
VaR = df$forecastVaR
names(res) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
names(VaR) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
return(list(res = res, VaR = VaR))
})[[1]]}, error = function(e) NULL)
if (is.null(aDCC.GARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(aDCC.GARCH.USDJPY[[i]]$res)[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(aDCC.GARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/aDCC.GARCH.USDJPY.HLC.',
unique(aDCC.GARCH.USDJPY[[i]]$res$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/aDCC.GARCH.USDJPY.HLC.',
unique(aDCC.GARCH.USDJPY[[i]]$res$Date), '.rds saved!\n'))
}
}; rm(i)
}3.3.3.3 FDCC and VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo-Cl.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
Cl.base <- llply(mbase['USDJPY'], Cl)
HiLoCl.base <- c(Hi.base, Lo.base, Cl.base) %>%
do.call(cbind, .) %>% na.omit
rm(Hi.base, Lo.base, Cl.base)
## only use USDJPY trading day.
timeID <- HiLoCl.base %>% index %>% ymd %>%
.[. >= timeID0] %>% c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^FDCC.GARCH.USDJPY.HLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
baseDT <- ymd('2013-01-01')
timeID %<>% .[!. %in% tmID] %>% .[-1]
timeID %<>% .[. > baseDT]
FDCC.GARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLoCl.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
FDCC.GARCH.USDJPY[[i]] <- tryCatch({llply(md[3], function(y) {
df = tryCatch(
mv_fx(smp, .model = y, .solver = 'solnp', .currency = cr_code[7],#[i],
.price_type = 'HLC', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.HLC.', 'solnp', ' error.\n')))
res = suppressAll(data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, t(df$AIC)))
VaR = df$forecastVaR
names(res) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
names(VaR) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
return(list(res = res, VaR = VaR))
})[[1]]}, error = function(e) NULL)
if (is.null(FDCC.GARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(FDCC.GARCH.USDJPY[[i]]$res)[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
if (!is.null(FDCC.GARCH.USDJPY[[i]])) {
saveRDS(FDCC.GARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/FDCC.GARCH.USDJPY.HLC.',
unique(FDCC.GARCH.USDJPY[[i]]$res$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/FDCC.GARCH.USDJPY.HLC.',
unique(FDCC.GARCH.USDJPY[[i]]$res$Date), '.rds saved!\n'))
}
}
}; rm(i)
}3.3.4 Cl
3.3.4.1 DCC and VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp')#, 'gosolnp')
## Cl.
Cl.base <- llply(mbase, Cl) %>% do.call('cbind', .)
Cl.base %<>% na.omit
## all currencies trading day.
#'@ timeID <- Cl.base %>% do.call('cbind', .) %>% index %>% ymd %>%
#'@ .[. >= timeID0] %>% c(., xts::last(.) + days(1))
#'@ tmID <- list.files('data/fx/USDJPY',
#'@ pattern = '^DCC.GARCH.C.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
#'@ str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
#'@ unlist %>% ymd
timeID <- Cl.base %>% index %>% ymd %>%
.[. >= timeID0] %>% c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^DCC.GARCH.C.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd %>% unique
baseDT <- ymd('2013-01-01')
timeID %<>% .[!. %in% tmID] %>% .[-1]
timeID %<>% .[. > baseDT]
for (dt in timeID) {
smp <- Cl.base
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
DCC.GARCH <- tryCatch({ldply(md[1], function(y) {
df = tryCatch(
mv_fx(smp, .model = y, .solver = 'solnp', .currency = 'ALL',
.price_type = 'C', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.C.', 'solnp', ' error.\n')))
df = suppressWarnings(
data.frame(Date = index(df$latestPrice)[1], Type = y,
df$latestPrice, df$forecastPrice, t(df$AIC),
VaR = df$forecastVaR))
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(DCC.GARCH)) {
subdir <- 'USDJPY'
} else {
#subdir <- substr(names(DCC.GARCH)[3], 1, 6)
subdir <- 'USDJPY'
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
if (!is.null(DCC.GARCH)) {
saveRDS(DCC.GARCH, paste0(
'data/fx/', subdir, '/DCC.GARCH.C.',
unique(DCC.GARCH$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/DCC.GARCH.C.',
unique(DCC.GARCH$Date), '.rds saved!\n'))
}
}
}3.3.4.2 aDCC and VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp')#, 'gosolnp')
## Cl.
Cl.base <- llply(mbase, Cl) %>% do.call('cbind', .)
Cl.base %<>% na.omit
timeID <- Cl.base %>% index %>% ymd %>%
.[. >= timeID0] %>% c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^aDCC.GARCH.C.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd %>% unique
baseDT <- ymd('2013-01-01')
timeID %<>% .[!. %in% tmID] %>% .[-1]
timeID %<>% .[. > baseDT]
for (dt in timeID) {
smp <- Cl.base
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
aDCC.GARCH <- tryCatch({ldply(md[2], function(y) {
df = tryCatch(
mv_fx(smp, .model = y, .solver = 'solnp', .currency = 'ALL',
.price_type = 'C', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.C.', 'solnp', ' error.\n')))
df = suppressWarnings(
data.frame(Date = index(df$latestPrice)[1], Type = y,
df$latestPrice, df$forecastPrice, t(df$AIC),
VaR = df$forecastVaR))
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(aDCC.GARCH)) {
subdir <- 'USDJPY'
} else {
#subdir <- substr(names(aDCC.GARCH)[3], 1, 6)
subdir <- 'USDJPY'
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
if (!is.null(aDCC.GARCH)) {
saveRDS(aDCC.GARCH, paste0(
'data/fx/', subdir, '/aDCC.GARCH.C.',
unique(aDCC.GARCH$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/aDCC.GARCH.C.',
unique(aDCC.GARCH$Date), '.rds saved!\n'))
}
}
}3.3.4.3 FDCC and VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp')#, 'gosolnp')
## Cl.
Cl.base <- llply(mbase, Cl) %>% do.call('cbind', .)
Cl.base %<>% na.omit
timeID <- Cl.base %>% index %>% ymd %>%
.[. >= timeID0] %>% c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^FDCC.GARCH.C.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
baseDT <- ymd('2013-01-01')
timeID %<>% .[!. %in% tmID] %>% .[-1]
timeID %<>% .[. > baseDT]
for (dt in timeID) {
smp <- Cl.base
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
FDCC.GARCH <- tryCatch({ldply(md[3], function(y) {
df = tryCatch(
mv_fx(smp, .model = y, .solver = 'solnp', .currency = 'ALL',
.price_type = 'C', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.C.', 'solnp', ' error.\n')))
df = suppressWarnings(
data.frame(Date = index(df$latestPrice)[1], Type = y,
df$latestPrice, df$forecastPrice, t(df$AIC),
VaR = df$forecastVaR))
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(FDCC.GARCH)) {
subdir <- 'USDJPY'
} else {
#subdir <- substr(names(FDCC.GARCH)[3], 1, 6)
subdir <- 'USDJPY'
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
if (!is.null(FDCC.GARCH)) {
saveRDS(FDCC.GARCH, paste0(
'data/fx/', subdir, '/FDCC.GARCH.C.',
unique(FDCC.GARCH$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/FDCC.GARCH.C.',
unique(FDCC.GARCH$Date), '.rds saved!\n'))
}
}
}3.3.5 Op-Hi-Lo-Cl
3.3.5.1 DCC and VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp')#, 'gosolnp')
## Op-Hi-Lo-Cl.
Op.base <- llply(mbase['USDJPY'], Op)
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
Cl.base <- llply(mbase['USDJPY'], Cl)
OpHiLoCl.base <- c(Op.base, Hi.base, Lo.base, Cl.base) %>%
do.call(cbind, .) %>% na.omit
rm(Op.base, Hi.base, Lo.base, Cl.base)
## only use USDJPY trading day.
timeID <- OpHiLoCl.base %>% index %>% ymd %>%
.[. >= timeID0] %>% c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^DCC.GARCH.USDJPY.OHLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
baseDT <- ymd('2013-01-01')
timeID %<>% .[!. %in% tmID] %>% .[-1]
timeID %<>% .[. > baseDT]
DCC.GARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- OpHiLoCl.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
DCC.GARCH.USDJPY[[i]] <- tryCatch({llply(md[1], function(y) {
df = tryCatch(
mv_fx(smp, .model = y, .solver = 'solnp', .currency = cr_code[7],#[i],
.price_type = 'OHLC', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.OHLC.', 'solnp', ' error.\n')))
res = suppressAll(data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, t(df$AIC)))
VaR = df$forecastVaR
names(res) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
names(VaR) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
return(list(res = res, VaR = VaR))
})[[1]]}, error = function(e) NULL)
if (is.null(DCC.GARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(DCC.GARCH.USDJPY[[i]]$res)[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(DCC.GARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/DCC.GARCH.USDJPY.OHLC.',
unique(DCC.GARCH.USDJPY[[i]]$res$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/DCC.GARCH.USDJPY.OHLC.',
unique(DCC.GARCH.USDJPY[[i]]$res$Date), '.rds saved!\n'))
}
}; rm(i)
}3.3.5.2 aDCC and VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp')#, 'gosolnp')
## Op-Hi-Lo-Cl.
Op.base <- llply(mbase['USDJPY'], Op)
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
Cl.base <- llply(mbase['USDJPY'], Cl)
OpHiLoCl.base <- c(Op.base, Hi.base, Lo.base, Cl.base) %>%
do.call(cbind, .) %>% na.omit
rm(Op.base, Hi.base, Lo.base, Cl.base)
## only use USDJPY trading day.
timeID <- OpHiLoCl.base %>% index %>% ymd %>%
.[. >= timeID0] %>% c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^aDCC.GARCH.USDJPY.OHLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
baseDT <- ymd('2013-01-01')
timeID %<>% .[!. %in% tmID] %>% .[-1]
timeID %<>% .[. > baseDT]
aDCC.GARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- OpHiLoCl.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
aDCC.GARCH.USDJPY[[i]] <- tryCatch({llply(md[2], function(y) {
df = tryCatch(
mv_fx(smp, .model = y, .solver = 'solnp', .currency = cr_code[7],#[i],
.price_type = 'OHLC', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.OHLC.', 'solnp', ' error.\n')))
res = suppressAll(data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, t(df$AIC)))
VaR = df$forecastVaR
names(res) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
names(VaR) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
return(list(res = res, VaR = VaR))
})[[1]]}, error = function(e) NULL)
if (is.null(aDCC.GARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(aDCC.GARCH.USDJPY[[i]]$res)[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(aDCC.GARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/aDCC.GARCH.USDJPY.OHLC.',
unique(aDCC.GARCH.USDJPY[[i]]$res$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/aDCC.GARCH.USDJPY.OHLC.',
unique(aDCC.GARCH.USDJPY[[i]]$res$Date), '.rds saved!\n'))
}
}; rm(i)
}3.3.5.3 FDCC and VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('DCC', 'aDCC', 'FDCC')
sv <- c('solnp')#, 'gosolnp')
## Op-Hi-Lo-Cl.
Op.base <- llply(mbase['USDJPY'], Op)
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
Cl.base <- llply(mbase['USDJPY'], Cl)
OpHiLoCl.base <- c(Op.base, Hi.base, Lo.base, Cl.base) %>%
do.call(cbind, .) %>% na.omit
rm(Op.base, Hi.base, Lo.base, Cl.base)
## only use USDJPY trading day.
timeID <- OpHiLoCl.base %>% index %>% ymd %>%
.[. >= timeID0] %>% c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^FDCC.GARCH.USDJPY.OHLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
baseDT <- ymd('2013-01-01')
timeID %<>% .[!. %in% tmID] %>% .[-1]
timeID %<>% .[. > baseDT]
FDCC.GARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- OpHiLoCl.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
baseDT %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
FDCC.GARCH.USDJPY[[i]] <- tryCatch({llply(md[3], function(y) {
df = tryCatch(
mv_fx(smp, .model = y, .solver = 'solnp', .currency = cr_code[7],#[i],
.price_type = 'OHLC', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.OHLC.', 'solnp', ' error.\n')))
res = suppressAll(data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, t(df$AIC)))
VaR = df$forecastVaR
names(res) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
names(VaR) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
return(list(res = res, VaR = VaR))
})[[1]]}, error = function(e) NULL)
if (is.null(FDCC.GARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(FDCC.GARCH.USDJPY[[i]]$res)[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(FDCC.GARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/FDCC.GARCH.USDJPY.OHLC.',
unique(FDCC.GARCH.USDJPY[[i]]$res$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/FDCC.GARCH.USDJPY.OHLC.',
unique(FDCC.GARCH.USDJPY[[i]]$res$Date), '.rds saved!\n'))
}
}; rm(i)
}3.4 GO-GARCH
3.4.1 Abstract
- Higher Moment CAPM with the GO-GARCH (NIG) model.
- VaR and Approximate VaR in the GO-GARCH (NIG) model.
- MGARCH Comparison using the Hong & Li Misspecification Test compares few models in
M(1,1), M(2,2), M(3,3), M(4,4)and concludes that thego-GARCHmodel will be better than normal DCC model inM(3,3), M(4,4)while normal DCC model better inM(1,1). mGARCH: Generalized Orthogonal GARCH model
From above example, the author compares different dimensions of multivariate matries.
# --------- draft ------------------
.dist.models <- c('mvnorm', 'manig', 'magh')
## attributes of univariate stage 1
attributes(attributes(fit)$mfit$ufit)
## attributes of univariate stage 2
names(attributes(attributes(attributes(fit)$mfit$ufit)[[1]][[1]])$fit)
names(attributes(attributes(attributes(fit)$mfit$ufit)[[1]][[2]])$fit)
names(attributes(attributes(attributes(fit)$mfit$ufit)[[1]][[3]])$fit)
## AIC
-2*as.numeric(logLik(fit))+2*(length(fit$coefficients)+1)
-2 * as.numeric(attributes(attributes(attributes(fit)$mfit$ufit)[[1]][[1]])$fit$LLH) + 2*(length(attributes(attributes(attributes(fit)$mfit$ufit)[[1]][[1]])$fit$coef) + 1)3.4.2 Hi-Lo
3.4.2.1 United ARIMA Order Multivariate
model = 'constant'
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
.dist.models <- c('mvnorm', 'manig', 'magh') #using default mvnorm
md <- c('constant', 'AR', 'VAR')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
HiLo.base <- c(Hi.base, Lo.base) %>% do.call(cbind, .) %>% na.omit
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^goGARCH.USDJPY.HL.constant.mvnorm.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
timeID %<>% .[!. %in% tmID]
timeID %<>% .[. > ymd('2013-01-01')]
timeID %<>% .[. > baseDT]
goGARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLo.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
goGARCH.USDJPY[[i]] <- tryCatch({ldply(md[1], function(y) {
df = tryCatch(
mv_fx(smp, .mv.model = 'go-GARCH', .model = y, .solver = 'solnp',
.currency = cr_code[7],#[i],
.price_type = 'HL', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0('.HL.', y, 'solnp', ' error.\n')))
aic = ldply(df$AIC, function(x) {
data.frame(t(x))
})
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, aic,
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(goGARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(goGARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(goGARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/goGARCH.USDJPY.HL.', md[1], '.',
.dist.models[1], '.',
unique(goGARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/goGARCH.USDJPY.HL.', md[1], '.',
.dist.models[1], '.',
unique(goGARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}; rm(i)
}model = 'AR'
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
.dist.models <- c('mvnorm', 'manig', 'magh') #using default mvnorm
md <- c('constant', 'AR', 'VAR')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
HiLo.base <- c(Hi.base, Lo.base) %>% do.call(cbind, .) %>% na.omit
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^goGARCH.USDJPY.HL.AR.mvnorm.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
timeID %<>% .[!. %in% tmID]
timeID %<>% .[. > ymd('2013-01-01')]
timeID %<>% .[. > baseDT]
goGARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLo.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
goGARCH.USDJPY[[i]] <- tryCatch({ldply(md[2], function(y) {
df = tryCatch(
mv_fx(smp, .mv.model = 'go-GARCH', .model = y, .solver = 'solnp',
.currency = cr_code[7],#[i],
.price_type = 'HL', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0('.HL.', y, 'solnp', ' error.\n')))
aic = ldply(df$AIC, function(x) {
data.frame(t(x))
})
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, aic,
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(goGARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(goGARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(goGARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/goGARCH.USDJPY.HL.', md[2], '.',
.dist.models[1], '.',
unique(goGARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/goGARCH.USDJPY.HL.', md[2], '.',
.dist.models[1], '.',
unique(goGARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}; rm(i)
}model = 'VAR'
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
.dist.models <- c('mvnorm', 'manig', 'magh') #using default mvnorm
md <- c('constant', 'AR', 'VAR')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
HiLo.base <- c(Hi.base, Lo.base) %>% do.call(cbind, .) %>% na.omit
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^goGARCH.USDJPY.HL.VAR.mvnorm.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
timeID %<>% .[!. %in% tmID]
timeID %<>% .[. > ymd('2013-01-01')]
timeID %<>% .[. > baseDT]
goGARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLo.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
goGARCH.USDJPY[[i]] <- tryCatch({ldply(md[3], function(y) {
df = tryCatch(
mv_fx(smp, .mv.model = 'go-GARCH', .model = y, .solver = 'solnp',
.currency = cr_code[7],#[i],
.price_type = 'HL', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0('.HL.', y, 'solnp', ' error.\n')))
aic = ldply(df$AIC, function(x) {
data.frame(t(x))
})
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, aic,
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(goGARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(goGARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(goGARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/goGARCH.USDJPY.HL.', md[3], '.',
.dist.models[1], '.',
unique(goGARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/goGARCH.USDJPY.HL.', md[3], '.',
.dist.models[1], '.',
unique(goGARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}; rm(i)
}3.4.2.2 Flexible ARIMA Order Multivariate
model = 'constant'
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
.dist.models <- c('mvnorm', 'manig', 'magh') #using default mvnorm
md <- c('constant', 'AR', 'VAR')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
HiLo.base <- c(Hi.base, Lo.base) %>% do.call(cbind, .) %>% na.omit
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^mvgoGARCH.USDJPY.HL.constant.mvnorm.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
timeID %<>% .[!. %in% tmID]
timeID %<>% .[. > ymd('2013-01-01')]
timeID %<>% .[. > baseDT]
mvgoGARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLo.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
mvgoGARCH.USDJPY[[i]] <- tryCatch({ldply(md[1], function(y) {
df = tryCatch(
mv_fx(smp, .mv.model = 'mv-goGARCH', .model = y, .solver = 'solnp',
.currency = cr_code[7],#[i],
.price_type = 'HL', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0('.HL.', y, 'solnp', ' error.\n')))
aic = ldply(df$AIC, function(x) {
data.frame(t(x))
})
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, aic,
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(mvgoGARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(mvgoGARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
if (!is.null(mvgoGARCH.USDJPY[[i]])) {
saveRDS(mvgoGARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/mvgoGARCH.USDJPY.F.HL.', md[1], '.',
.dist.models[1], '.',
unique(mvgoGARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/mvgoGARCH.USDJPY.F.HL.', md[1], '.',
.dist.models[1], '.',
unique(mvgoGARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}
}; rm(i)
}model = 'AR'
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
.dist.models <- c('mvnorm', 'manig', 'magh') #using default mvnorm
md <- c('constant', 'AR', 'VAR')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
HiLo.base <- c(Hi.base, Lo.base) %>% do.call(cbind, .) %>% na.omit
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^mvgoGARCH.USDJPY.HL.AR.mvnorm.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
timeID %<>% .[!. %in% tmID]
timeID %<>% .[. > ymd('2013-01-01')]
timeID %<>% .[. > baseDT]
mvgoGARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLo.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
mvgoGARCH.USDJPY[[i]] <- tryCatch({ldply(md[2], function(y) {
df = tryCatch(
mv_fx(smp, .mv.model = 'mv-goGARCH', .model = y, .solver = 'solnp',
.currency = cr_code[7],#[i],
.price_type = 'HL', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0('.HL.', y, 'solnp', ' error.\n')))
aic = ldply(df$AIC, function(x) {
data.frame(t(x))
})
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, aic,
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(mvgoGARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(mvgoGARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
if (!is.null(mvgoGARCH.USDJPY[[i]])) {
saveRDS(mvgoGARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/mvgoGARCH.USDJPY.F.HL.', md[2], '.',
.dist.models[1], '.',
unique(mvgoGARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/mvgoGARCH.USDJPY.F.HL.', md[2], '.',
.dist.models[1], '.',
unique(mvgoGARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}
}; rm(i)
}model = 'VAR'
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
.dist.models <- c('mvnorm', 'manig', 'magh') #using default mvnorm
md <- c('constant', 'AR', 'VAR')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
HiLo.base <- c(Hi.base, Lo.base) %>% do.call(cbind, .) %>% na.omit
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^mvgoGARCH.USDJPY.HL.VAR.mvnorm.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
timeID %<>% .[!. %in% tmID]
timeID %<>% .[. > ymd('2013-01-01')]
timeID %<>% .[. > baseDT]
mvgoGARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLo.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
mvgoGARCH.USDJPY[[i]] <- tryCatch({ldply(md[3], function(y) {
df = tryCatch(
mv_fx(smp, .mv.model = 'go-GARCH', .model = y, .solver = 'solnp',
.currency = cr_code[7],#[i],
.price_type = 'HL', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0('.HL.', y, 'solnp', ' error.\n')))
aic = ldply(df$AIC, function(x) {
data.frame(t(x))
})
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, aic,
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(mvgoGARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(mvgoGARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
if (!is.null(mvgoGARCH.USDJPY[[i]])) {
saveRDS(mvgoGARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/mvgoGARCH.USDJPY.F.HL.', md[3], '.',
.dist.models[1], '.',
unique(mvgoGARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/mvgoGARCH.USDJPY.F.HL.', md[3], '.',
.dist.models[1], '.',
unique(mvgoGARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}
}; rm(i)
}3.4.3 Cl
model = 'constant'
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
.dist.models <- c('mvnorm', 'manig', 'magh') #using default mvnorm
md <- c('constant', 'AR', 'VAR')
sv <- c('solnp')#, 'gosolnp')
## Cl.
Cl.base <- llply(mbase, Cl) %>% do.call('cbind', .)
Cl.base %<>% na.omit
timeID <- Cl.base %>% index %>% ymd %>%
.[. >= timeID0] %>% c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^mvgoGARCH.USDJPY.C.constant.mvnorm.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd %>% unique
baseDT <- ymd('2013-01-01')
timeID %<>% .[!. %in% tmID] %>% .[-1]
timeID %<>% .[. > baseDT]
mvgoGARCH.USDJPY <- list()
for (dt in timeID) {
smp <- Cl.base
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
mvgoGARCH.USDJPY[[i]] <- tryCatch({ldply(md[1], function(y) {
df = tryCatch(
mv_fx(smp, .mv.model = 'mv-goGARCH', .model = y, .solver = 'solnp',
.currency = 'ALL', .price_type = 'C', .VAR = FALSE,
.dist.model = .dist.models[2], .cluster = .cl),
error = function(e) cat(paste0('.C.', y, 'solnp', ' error.\n')))
aic = ldply(df$AIC, function(x) {
data.frame(t(x))
})
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, aic,
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(mvgoGARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(mvgoGARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
if (!is.null(mvgoGARCH.USDJPY[[i]])) {
saveRDS(mvgoGARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/mvgoGARCH.USDJPY.F.HL.', md[1], '.',
.dist.models[1], '.',
unique(mvgoGARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/mvgoGARCH.USDJPY.F.HL.', md[1], '.',
.dist.models[1], '.',
unique(mvgoGARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}
}model = 'AR'
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
.dist.models <- c('mvnorm', 'manig', 'magh') #using default mvnorm
md <- c('constant', 'AR', 'VAR')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
HiLo.base <- c(Hi.base, Lo.base) %>% do.call(cbind, .) %>% na.omit
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^mvgoGARCH.USDJPY.HL.AR.mvnorm.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
timeID %<>% .[!. %in% tmID]
timeID %<>% .[. > ymd('2013-01-01')]
timeID %<>% .[. > baseDT]
mvgoGARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLo.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
mvgoGARCH.USDJPY[[i]] <- tryCatch({ldply(md[2], function(y) {
df = tryCatch(
mv_fx(smp, .mv.model = 'mv-goGARCH', .model = y, .solver = 'solnp',
.currency = 'ALL', .dist.model = .dist.models[2],
.price_type = 'C', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0('.HL.', y, 'solnp', ' error.\n')))
aic = ldply(df$AIC, function(x) {
data.frame(t(x))
})
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, aic,
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(mvgoGARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(mvgoGARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
if (!is.null(mvgoGARCH.USDJPY[[i]])) {
saveRDS(mvgoGARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/mvgoGARCH.USDJPY.F.HL.', md[2], '.',
.dist.models[1], '.',
unique(mvgoGARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/mvgoGARCH.USDJPY.F.HL.', md[2], '.',
.dist.models[1], '.',
unique(mvgoGARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}
}; rm(i)
}model = 'VAR'
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
.dist.models <- c('mvnorm', 'manig', 'magh') #using default mvnorm
md <- c('constant', 'AR', 'VAR')
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
HiLo.base <- c(Hi.base, Lo.base) %>% do.call(cbind, .) %>% na.omit
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^mvgoGARCH.USDJPY.HL.VAR.mvnorm.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
timeID %<>% .[!. %in% tmID]
timeID %<>% .[. > ymd('2013-01-01')]
timeID %<>% .[. > baseDT]
mvgoGARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLo.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
mvgoGARCH.USDJPY[[i]] <- tryCatch({ldply(md[3], function(y) {
df = tryCatch(
mv_fx(smp, .mv.model = 'go-GARCH', .model = y, .solver = 'solnp',
.currency = 'ALL', .dist.model = .dist.models[2],
.price_type = 'C', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0('.HL.', y, 'solnp', ' error.\n')))
aic = ldply(df$AIC, function(x) {
data.frame(t(x))
})
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, aic,
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(mvgoGARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(mvgoGARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
if (!is.null(mvgoGARCH.USDJPY[[i]])) {
saveRDS(mvgoGARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/mvgoGARCH.USDJPY.F.HL.', md[3], '.',
.dist.models[1], '.',
unique(mvgoGARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/mvgoGARCH.USDJPY.F.HL.', md[3], '.',
.dist.models[1], '.',
unique(mvgoGARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}
}; rm(i)
}3.5 Copula-GARCH
3.5.1 Abtract
- 多元Copula-GARCH模型及其在金融风险分析上的应用
- The Copula-GARCH Model of Conditional Dependencies - An International Stock Market
- The Copula GARCH Model
- copula with rmgarch
- dynamic copula using rmgarch package (ignore previous question, don’t know how to delete it)
Global Risk Evolution and Diversification - A Copula-DCC-GARCH Model Approach compares normal DCC model with Copula-DCC model, and concludes that the Copula-DCC better than normal DCC model.
Multivariate GARCH and Dynamic Copula Models for Financial Time Series with an Application to Emerging Markets compares few DCC models :
- DCC
- ADCC
- GDCC
- AG-DCC
The author concludes that different model suit for different stock and bond markets.
> library(rmgarch)
> data(dji30ret)
> Data <- dji30ret[, 1:3, drop = FALSE]
> uspec <- ugarchspec(mean.model = list(armaOrder = c(0,0), include.mean = FALSE),
+ variance.model = list(garchOrder = c(1,1), model = 'sGARCH'),
+ distribution.model = 'std')
> cspec <- cgarchspec(uspec = multispec( replicate(3, uspec) ), VAR = FALSE,
+ robust = FALSE, lag = 1, lag.max = NULL,
+ lag.criterion = c('AIC', 'HQ', 'SC', 'FPE'),
+ external.regressors = NULL,
+ robust.control = list(gamma = 0.25, delta = 0.01, nc = 10, ns = 500),
+ dccOrder = c(1, 1), asymmetric = FALSE,
+ distribution.model = list(copula='mvt', method='ML',
+ time.varying = TRUE, transformation = 'parametric'),
+ start.pars = list(), fixed.pars = list())
> cfit <- cgarchfit(cspec, data =Data,
+ spd.control = list(lower=0.1, upper=0.9, type='pwm', kernel='epanech'),
+ fit.control = list(eval.se=TRUE, trace=TRUE, stationarity=TRUE),
+ solver = "solnp", solver.control = list(), out.sample = 0, parallel = FALSE,
+ parallel.control = list(pkg = c('multicore', 'snowfall'), cores = 2),
+ fit = NULL, VAR.fit = NULL) my questions are: 1) (very silly) how to get the estimated parameters (incl. s.e. p-value)? 2) how to plot the dynamics of correlation? 3) how to perform goodness-of-fit tests for marginal estimations? 4) how to perform goodness-of-fit tests for copula?
Can I do 1-step ahead forecasting using GARCH-Copula with the help of rmgarch package? for example I need to get the returns of each assets and their covariance at T+1 based on the parameters estimated using in-sample data until T? I followed your Example in the help of cgarchsim. Please correct me if I am wrong: 1) the (mean) forecast returns should be the simmean1 in your example 2) I think rcov(sim1) only report the 1st cov out of 3500 simulations. Then how to get the mean forecast cov?
> #I think the Example in ?cgarchsim has a copula of errors, although none of them is serious:
> spec = cgarchspec(uspec = multispec(replicate(3, uspec)), VAR = TRUE,
+ VAR.opt = list(lag = 1, lag.max = 4,
+ lag.criterion = c('AIC', 'HQ', 'SC', 'FPE'),
+ external.regressors = NULL), dccOrder = c(1,1),
+ distribution.model = list(copula = c('mvnorm'), method = c('ML'),
+ time.varying = TRUE, transformation = 'parametric'),
+ start.pars = list(), fixed.pars = list())
VAR.opt = list(lag = 1, lag.max = 4, lag.criterion = c('AIC', 'HQ', 'SC', 'FPE'),
+ external.regressors = NULL)
>
> sim1 = cgarchsim(fit1, n.sim = 1, n.start = 0, m.sim = 3500,
+ presigma = tail(sigma(fit1), 1),
+ startMethod = 'sample', preR = preR,
+ prereturns = tail( as.matrix(Dat), 4),
+ preresiduals = tail(residuals(.fitlist), 1), rseed = 1:3500)
>
> #if I use prereturns = tail(as.matrix(Dat), 4), it will report error. So instead, I use prereturns = tail( as.matrix(Dat), 1)
>
> forcmean = round(rgarch:::varxforecast(X = Dat, Bcoef = fit1@mfit$vrmodel$Bcoef, p = 4,
+ out.sample = 0, n.ahead = 1, n.roll = 0,
+ mregfor = NULL), 5) the rgarch package is offline. So can you suggest another way for this?
Thank you again!
The code in the rmgarch.tests folder is up to date. The code below that you quote is an outdated example and not from the rmgarch.tests folder but from the help page for cgarchsim (which I should update anyway when I find the time). Please only use the examples from the folder indicated (there are plenty!).
You are free to look inside the returned object or work with the extractor functions provided. e.g. slotNames(sim1) names(sim1@msim)
This is the 1-ahead simulation. Why would you expect the covariance and correlation to be uncertain? This is a non-bayesian setup which means that parameter uncertainty is not taken into account and hence the 1-ahead conditional covariance is given by the GARCH type dynamics without recourse to any uncertainty etc.
-Alexios
- GHST was added recently to rugarch and I have not updated the rmgarch package to accomodate this (I guess it is due for an update soon).
- If you only want mean-covariance, you can recover the conditional mean forecast directly by using the ‘varxforecast’ function (if using VAR) else from the univariate model using the ‘fitted’ method on the ‘uGARCHfit’ object (READ THE DOCUMENTATION). If you want a 1-ahead “scenario”, use the “m.sim” option.
- Only THE Gaussian and Student copula are implemented.
- ‘residuals(fit)’ is NOT standardized. You have to do that yourself by extracting the covariance and performing the appropriate decomposition/transformation in the multivariate case. However, if you want to fit your own copula in a 2nd stage after GARCH, very briefly:
- Filter data with univariate GARCH (see also ‘multifit’).
- Extract and standardize residuals: ‘residuals(fit)/sigma(fit)’.
- Transform into uniform (parametric approach) by extracting any conditional higher moment parameters from the GARCH fitted object and pass those with the standardized residuals to the “pdist” function of rugarch indicating the distribution used (read the documentation). For non-parametric or semi-parametric transformation you should look at the code in the cgarchfit function.
-Alexios
Source : copula with rmgarch
(there were some mistakes in the previous code, I’ve corrected it and I’m reposting) I’m trying to simulate 1-step ahead returns 5000 times for a portfolio of 9 variables. After specifying their GJR-GARCH specifications with SPD marginals, I use the following code (which was inspired by the examples in the ‘rmgarch.tests’ folder). I use the first 571x9 observations for fitting and the last 570 for out-of-sample analysis. Moreover, I use a moving-window approach, in the sense that I always use the last 571 observations in the cgarchfilter rather than [1:(T+i)] as in the example. Once the simulated returns ‘simx’ are stored in ‘simulatedreturns’, I compute the return of an equally-weighted portfolio as a 570x5000 matrix, i.e. one series of return of each observation for each simulation. Last, I compute VaR (90%, 95%, 99%) as the respective quantile (0.10, 0.05, 0.01).
My problem is that, contrary to the literature I’ve found on the topic, VaR is severely underestimated, I obtain a number of violations which is way more than expected (should be 57 for 90%VaR, 28 for 95%VaR, 6 for 99%VaR). Is there any error in the code I have below? I’ve followed the example by the letter and cannot understand what went wrong. Anyone can help? Any hint is GREATLY appreciated!
library(rugarch)
library(rmgarch)
data(dji30retw)
Dat = dji30retw[, 1:9, drop = FALSE]
model <- ugarchspec(variance.model=list(model="gjrGARCH", garchOrder=c(1,1),
variance.targeting=TRUE),
mean.model=list(armaOrder=c(0,0), include.mean=F, archm=F, archpow=1),
distribution.model="norm")
spec = cgarchspec(uspec = multispec(replicate(9, model)), VAR = FALSE, robust = FALSE,
lag.criterion = "AIC", external.regressors = NULL,
dccOrder = c(1,1), asymmetric = TRUE,
distribution.model = list(copula = "mvt", method = "ML",
time.varying = TRUE, transformation = "spd"))
fit = cgarchfit(spec, data = Dat, out.sample = 570, cluster = NULL,
spd.control = list(lower = 0.1, upper = 0.9, type = "mle", kernel = "normal"),
fit.control = list(eval.se=FALSE))
T = dim(Dat)[1]-570
simMu = simS = filtMu = filtS = matrix(NA, ncol = 9, nrow = 570)
simCor = simC = filtC = filtCor = array(NA, dim = c(9,9,570))
colSd = function(x) apply(x, 2, "sd")
specx = spec
for(i in 1:9) specx@umodel$fixed.pars[[i]] = as.list(fit@model$mpars[fit@model$midx[,i]==1,i])
setfixed(specx)<-as.list(fit@model$mpars[fit@model$midx[,10]==1,10])
simulatedreturns <- array(dim=c(570,9,5000))
for(i in 1:570){
if(i==1){
presigma = matrix(tail(sigma(fit), 1), ncol = 9)
prereturns = matrix(unlist(Dat[T, ]), ncol = 9, nrow = 1)
preresiduals = matrix(tail(residuals(fit),1), ncol = 9, nrow = 1)
preR = last(rcor(fit))[,,1]
diag(preR) = 1
preQ = fit@mfit$Qt[[length(fit@mfit$Qt)]]
preZ = tail(fit@mfit$Z, 1)
tmp = cgarchfilter(specx, Dat[2:(T+1), ], filter.control = list(n.old = T))
filtMu[i,] = tail(fitted(tmp), 1)
filtS[i,] = tail(sigma(tmp), 1)
filtC[,,i] = last(rcov(tmp))[,,1]
filtCor[,,i] = last(rcor(tmp))[,,1]
} else{
presigma = matrix(tail(sigma(tmp), 1), ncol = 9)
prereturns = matrix(unlist(Dat[(T+i-1), ]), ncol = 9, nrow = 1)
preresiduals = matrix(tail(residuals(tmp),1), ncol = 9, nrow = 1)
preR = last(rcor(tmp))[,,1]
diag(preR) = 1
preQ = tmp@mfilter$Qt[[length(tmp@mfilter$Qt)]]
preZ = tail(tmp@mfilter$Z, 1)
tmp = cgarchfilter(specx, Dat[(i+1):(T+i), ], filter.control = list(n.old = T))
filtMu[i,] = tail(fitted(tmp), 1)
filtS[i,] = tail(sigma(tmp), 1)
filtC[,,i] = last(rcov(tmp))[,,1]
filtCor[,,i] = last(rcor(tmp))[,,1]
}
sim = cgarchsim(fit, n.sim = 1, m.sim = 5000, startMethod = "sample",
preR = preR, preQ = preQ, preZ = preZ,
prereturns = prereturns, presigma = presigma,
preresiduals = preresiduals, cluster = NULL)
simx = t(sapply(sim@msim$simX, FUN = function(x) x[1,]))
simMu[i,] = colMeans(simx)
simC[,,i] = sim@msim$simH[[1]][,,1]
simCor[,,i] = sim@msim$simR[[1]][,,1]
simS[i,] = sqrt(diag(simC[,,i]))
simulatedreturns[i,,]=simx
} Source : dynamic copula using rmgarch package (ignore previous question, don’t know how to delete it)
Hi Robert, thank you for your reply (I apologize in advance if this is not the proper way to respond in the thread, I’m very new at this).
Portfolio return is computed as equal-weighted sum of the nine series. Since in the examples in the ‘rmgarchtests’ folder these are directly used in the GARCH-GPD-copula specification, I assume these are log returns, and therefore transform them into simple daily returns since log returns are time-additive but not “portfolio”-additive;
In ‘simulatedreturns’ I have 570 predicted returns for 9 series simulated 5000 times. Like before, I first transform them in simple returns;
the simulated portfolio returns are then computed as before, as equal-weighted sum since simple returns are additive across assets;
for VaR estimation I don’t using anything fancy, just the ‘quantile’ function. For each observation, I estimate the respective simulated quantile and subtract the actual return from it, and store the difference in vector ‘a’. If ‘a’ is negative (meaning VaR is greater in absolute terms than returns) then ‘b’ equals 0, if ‘a’ is positive then ‘b’=1.
Since I haven’t fixed the random number seed, it is possible that you obtain slightly different results. But the number of violations should be the approximately the same as mine, and nowhere close to the number expected.
This is the rest of the code, with comments reported above.
You have an idea what could have gone wrong?
#comment i)
#from log to simple returns
Simple = exp(Dat)-1
#return of equally weighted portfolio as weighted sum
portfolioreturn <- (1/9)*rowSums(Simple)
#since I'm only interested in returns in the testing period, I only take the last 570 observations
portfolioreturn <- portfolioreturn[572:1141] #we're only interested in returns in the testing period
#comment ii)
#transform simulated log returns into simple returns
simplereturns=exp(simulatedreturns)-1
#comment iii)
#return series of simulated portfolio (for each observation from 1 to 570 I have 5000 portfolio returns)
portfolio <- matrix(nrow=570,ncol=5000)
for (i in 1:570){
for (j in 1:5000){
portfolio[i,j]=(1/9)*(simplereturns[i,1,j]+simplereturns[i,2,j]+simplereturns[i,3,j]+simplereturns[i,4,j]
+simplereturns[i,5,j]+simplereturns[i,6,j]+simplereturns[i,7,j]+simplereturns[i,8,j]
+simplereturns[i,9,j])
}
}
#comment iv)
#estimation of 90%, 95% and 99% VaR as respective 10%, 5% and 1% quantiles
#a is a vector containing the difference between quantile and actual loss
#b is a vector equal to 0 when a is negative (as it should) and 1 when loss is greater than VaR (thus when a is positive)
#number of violations is then computed as sum(b), summing all ones;
a90 <- c()
for (i in 1:570){
a90[i]=quantile(portfolio[i,],0.1)-portfolioreturn[i]
}
b90 <- c()
for (i in 1:570){
if (a90[i]>0){b90[i]=1}
else {b90[i]=0}
}
sum(b90)#number of violations=171 (expected: 570*0.1=57)
a95 <- c()
for (i in 1:570){
a95[i]=quantile(portfolio[i,],0.05)-portfolioreturn[i]
}
b95 <- c()
for (i in 1:570){
if (a95[i]>0){b95[i]=1}
else {b95[i]=0}
}
sum(b95)#number of violations=127 (expected: 570*0.05=29)
a99 <- c()
for (i in 1:570){
a99[i]=quantile(portfolio[i,],0.01)-portfolioreturn[i]
}
b99 <- c()
for (i in 1:570){
if (a99[i]>0){b99[i]=1}
else {b99[i]=0}
}
sum(b99) #number of violations=69 (expected: 570*0.01=6)Source : dynamic copula using rmgarch package (ignore previous question, don’t know how to delete it)
3.5.2 Hi-Lo
From above DCC section (or refer to Comparison Summary), we know the DCC model is more accurate than aDCC model, here I directly use normal DCC model by set asymmetric = FALSE.
In order to forecast in Copula DCC model, just using cGARCHsim kindly refer to Forecasting for DCC Copula GARCH model in R.
3.5.2.1 VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('Kendall', 'ML') ## choose `Kendall`
trams <- c('parametric', 'empirical', 'spd') ## choose `parametric`
.dist.models <- c('mvnorm', 'mvt') ##choose `mvt`
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
HiLo.base <- c(Hi.base, Lo.base) %>% do.call(cbind, .) %>% na.omit
rm(Hi.base, Lo.base)
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^copulaGARCH.USDJPY.HL.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
timeID %<>% .[!. %in% tmID]
timeID %<>% .[. > ymd('2013-01-01')]
timeID %<>% .[. > baseDT]
copulaGARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLo.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
copulaGARCH.USDJPY[[i]] <- tryCatch({ldply(md[1], function(y) {
df = tryCatch(
mv_fx(smp, .mv.model = 'copula-GARCH', .model = y, .tram= trams[1],
.solver = 'solnp', .currency = cr_code[7],#[i],
.dist.model = .dist.models[2],
.price_type = 'HL', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.HL.', 'solnp', ' error.\n')))
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, t(df$AIC),
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(copulaGARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(copulaGARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(copulaGARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/copulaGARCH.USDJPY.HL.',
unique(copulaGARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/copulaGARCH.USDJPY.HL.',
unique(copulaGARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}; rm(i)
}# ---------- eval = FALSE ------------
> fit = cgarchfit(spec, data = Dat, out.sample = out, cluster = NULL,
+ spd.control = list(lower = 0.1, upper = 0.9, type = "mle",
+ kernel = "normal"),
+ fit.control = list(eval.se=FALSE))
Warning messages:
1: In sqrt(ans$h) : NaNs produced
2: In retval[sort.list(q)] <- val :
number of items to replace is not a multiple of replacement length
3: In sqrt(ans$h) : NaNs produced
4: In retval[sort.list(q)] <- val :
number of items to replace is not a multiple of replacement length
> fit
*-------------------------------------------------*
* Copula GARCH Fit *
*-------------------------------------------------*
Distribution : mvt
DCC Order : 1 1
Asymmetric : TRUE
No. of Parameters : 14
[VAR GARCH DCC UncQ]: [0+9+4+1]
No. of Series : 2
No. of Observations : 262
Log-Likelihood : -371.1513
Av.Log-Likelihood : -1.417
Optimal Parameters
---------------------------------------------------
Estimate Std. Error t value Pr(>|t|)
[USDJPY.High].ma1 0.042109 NA NA NA
[USDJPY.High].omega 0.115858 NA NA NA
[USDJPY.High].alpha1 0.123774 NA NA NA
[USDJPY.High].beta1 0.000267 NA NA NA
[USDJPY.High].gamma1 -0.151096 NA NA NA
[USDJPY.Low].omega 0.102946 NA NA NA
[USDJPY.Low].alpha1 0.000000 NA NA NA
[USDJPY.Low].beta1 0.000005 NA NA NA
[USDJPY.Low].gamma1 0.000034 NA NA NA
[Joint]dcca1 0.000000 NA NA NA
[Joint]dccb1 0.659608 NA NA NA
[Joint]dccg1 0.294882 NA NA NA
[Joint]mshape 9.818608 NA NA NA
Information Criteria
---------------------
Akaike 2.9325
Bayes 3.1095
Shibata 2.9278
Hannan-Quinn 3.0036
Elapsed time : 2.127833.5.2.2 VAR=TRUE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('Kendall', 'ML') ## choose `Kendall`
trams <- c('parametric', 'empirical', 'spd') ## choose `parametric`
.dist.models <- c('mvnorm', 'mvt') ##choose `mvt`
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
HiLo.base <- c(Hi.base, Lo.base) %>% do.call(cbind, .) %>% na.omit
rm(Hi.base, Lo.base)
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^copulaGARCH.USDJPY.HL.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
timeID %<>% .[!. %in% tmID]
timeID %<>% .[. > ymd('2013-01-01')]
timeID %<>% .[. > baseDT]
copulaGARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLo.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
copulaGARCH.USDJPY[[i]] <- tryCatch({ldply(md[1], function(y) {
df = tryCatch(
mv_fx(smp, .mv.model = 'copula-GARCH', .model = y, .tram= trams[1],
.solver = 'solnp', .currency = cr_code[7],#[i],
.dist.model = .dist.models[2],
.price_type = 'HL', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.HL.', 'solnp', ' error.\n')))
df = data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, t(df$AIC),
VaR = df$forecastVaR)
names(df) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
df
})}, error = function(e) NULL)
if (is.null(copulaGARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(copulaGARCH.USDJPY[[i]])[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(copulaGARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/copulaGARCH.USDJPY.HL.',
unique(copulaGARCH.USDJPY[[i]]$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/copulaGARCH.USDJPY.HL.',
unique(copulaGARCH.USDJPY[[i]]$Date), '.rds saved!\n'))
}
}; rm(i)
}3.5.3 Hi-Lo-Cl
3.5.3.1 VAR=FALSE
## ------------- Simulate mv_fx() ----------------------
## mv_fx just made the model and some argument flexible.
md <- c('Kendall', 'ML') ## choose `Kendall`
trams <- c('parametric', 'empirical', 'spd') ## choose `parametric`
.dist.models <- c('mvnorm', 'mvt') ##choose `mvt`
sv <- c('solnp')#, 'gosolnp')
## Hi-Lo-Cl.
Hi.base <- llply(mbase['USDJPY'], Hi)
Lo.base <- llply(mbase['USDJPY'], Lo)
Cl.base <- llply(mbase['USDJPY'], Cl)
HiLoCl.base <- c(Hi.base, Lo.base, Cl.base) %>%
do.call(cbind, .) %>% na.omit
rm(Hi.base, Lo.base, Cl.base)
## only use USDJPY trading day.
timeID <- HiLo.base %>%
index %>% ymd %>%
.[. >= timeID0] %>%
c(., xts::last(.) + days(1))
tmID <- list.files('data/fx/USDJPY',
pattern = '^copulaGARCH.USDJPY.HLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds') %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>% ymd
timeID %<>% .[!. %in% tmID]
timeID %<>% .[. > ymd('2013-01-01')]
timeID %<>% .[. > baseDT]
copulaGARCH.USDJPY <- list()
for (dt in timeID) {
for (i in seq(cr_code[7])) {
smp <- HiLoCl.base#[[names(cr_code)[i]]]
timeID2 <- c(index(smp), xts::last(index(smp)) + days(1))
if (dt %in% timeID2) {
dtr <- xts::last(index(smp[index(smp) < dt]), 1) #tail(..., 1)
dtr %<>% .[. > baseDT]
smp <- smp[paste0(dtr %m-% years(1), '/', dtr)]
copulaGARCH.USDJPY[[i]] <- tryCatch({llply(md[1], function(y) {
df = tryCatch(
mv_fx(smp, .mv.model = 'copula-GARCH', .model = y, .tram= trams[1],
.solver = 'solnp', .currency = cr_code[7],#[i],
.dist.model = .dist.models[2],
.price_type = 'HLC', .VAR = FALSE, .cluster = .cl),
error = function(e) cat(paste0(y, '.HLC.', 'solnp', ' error.\n')))
res = suppressAll(data.frame(Date = index(df$latestPrice[1]),
Type = paste0(names(df$latestPrice), '.', y),
df$latestPrice, df$forecastPrice, t(df$AIC)))
VaR = df$forecastVaR
names(res) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
names(VaR) %<>% str_replace_all('[0-9]{4}.[0-9]{2}.[0-9]{2}', 'T1')
return(list(res = res, VaR = VaR))
})[[1]]}, error = function(e) NULL)
if (is.null(copulaGARCH.USDJPY[[i]])) {
subdir <- 'USDJPY'
} else {
subdir <- substr(names(copulaGARCH.USDJPY[[i]]$res)[3], 1, 6)
}
if (!dir.exists(paste0('data/fx/', subdir)))
dir.create(paste0('data/fx/', subdir))
saveRDS(copulaGARCH.USDJPY[[i]], paste0(
'data/fx/', subdir, '/copulaGARCH.USDJPY.HLC.',
unique(copulaGARCH.USDJPY[[i]]$res$Date), '.rds'))
cat(paste0(
'data/fx/', subdir, '/copulaGARCH.USDJPY.HLC.',
unique(copulaGARCH.USDJPY[[i]]$res$Date), '.rds saved!\n'))
}
}; rm(i)
}# ---------- eval = FALSE ------------
> fit
*-------------------------------------------------*
* Copula GARCH Fit *
*-------------------------------------------------*
Distribution : mvt
DCC Order : 1 1
Asymmetric : TRUE
No. of Parameters : 22
[VAR GARCH DCC UncQ]: [0+15+4+3]
No. of Series : 3
No. of Observations : 262
Log-Likelihood : -543.0784
Av.Log-Likelihood : -2.073
Optimal Parameters
---------------------------------------------------
Estimate Std. Error t value Pr(>|t|)
[USDJPY.High].ma1 0.042109 NA NA NA
[USDJPY.High].omega 0.115858 NA NA NA
[USDJPY.High].alpha1 0.123774 NA NA NA
[USDJPY.High].beta1 0.000267 NA NA NA
[USDJPY.High].gamma1 -0.151096 NA NA NA
[USDJPY.Low].omega 0.102946 NA NA NA
[USDJPY.Low].alpha1 0.000000 NA NA NA
[USDJPY.Low].beta1 0.000005 NA NA NA
[USDJPY.Low].gamma1 0.000034 NA NA NA
[USDJPY.Close].ar1 0.447653 NA NA NA
[USDJPY.Close].ma1 0.003526 NA NA NA
[USDJPY.Close].omega 0.120137 NA NA NA
[USDJPY.Close].alpha1 0.413889 NA NA NA
[USDJPY.Close].beta1 0.000000 NA NA NA
[USDJPY.Close].gamma1 0.048600 NA NA NA
[Joint]dcca1 0.046461 NA NA NA
[Joint]dccb1 0.862936 NA NA NA
[Joint]dccg1 0.091663 NA NA NA
[Joint]mshape 6.327378 NA NA NA
Information Criteria
---------------------
Akaike 4.2907
Bayes 4.5494
Shibata 4.2811
Hannan-Quinn 4.3947
Elapsed time : 4.823512
traceback(cgarchsim(fit, n.sim = 1, m.sim = msm, startMethod = "sample",
preR = preR, preQ = preQ, preZ = preZ,
prereturns = prereturns, presigma = presigma,
preresiduals = preresiduals, cluster = NULL))
Error in .custzdist(custom.dist, zmatrix, m.sim, n) : row dimension
of custom innovations
matrix must be equal to n.sim+n.start
In addition: Warning message:
In .gjrgarchpath1(spec = spec, n.sim = n.sim, n.start = n.start, :
ugarchpath-->warning: n.start>=MA order for arfima model...automatically setting.3.5.4 Op-Hi-Lo-Cl
3.5.4.1 VAR=FALSE
# ---------- eval = FALSE ------------
> fit = cgarchfit(spec, data = Dat, out.sample = out, cluster = NULL,
+ spd.control = list(lower = 0.1, upper = 0.9, type = "mle",
+ kernel = "normal"),
+ fit.control = list(eval.se=FALSE))
Error in optim(theta, negloglik, hessian = TRUE, ..., tmp = excess) : non-finite finite-difference value [1]3.5.5 Cl
3.5.5.1 VAR=FALSE
# ---------- eval = FALSE ------------
> fit = cgarchfit(spec, data = Dat, out.sample = out, cluster = NULL,
+ spd.control = list(lower = 0.1, upper = 0.9, type = "mle",
+ kernel = "normal"),
+ fit.control = list(eval.se=FALSE))
Error in UseMethod("convergence") : no applicable method for 'convergence' applied to an object of class "try-error"
In addition: Warning messages:
1: In lsfit(log10(M), log10(ABSVAL), wt) : 50 missing values deleted
2: In lsfit(log10(M), log10(ABSVAL), wt) : 50 missing values deleted3.6 CCC
Multivariate DCC-GARCH Model introduce the DCC and CCC models. In all tests for marginal goodness of fit the DCC-GARCH with skew Student’s t-distributed errors outperformed the DCC-GARCH with Gaussian and Student’s t-distributed errors. Comparing the DCC-GARCH model with the CCC-GARCH model using the Kupiec test showed that the DCC-GARCH model gave a better fit to the data. Here I skip the cccgarch package.
Because the restriction of constant conditional correlation may be unrealistic in practice, a class of models termed Dynamic Conditional Correlation (DCC) due to Engle (2002) and Tse and Tsui (2002) where introduced which allow for the correlation matrix to be time varying with motion dynamics…
Source : [The rmgarch models: Background and properties]4
3.7 BEKK
- [问答] 向各位朋友求助关于MGARCH-BEKK模型的问题！万分感谢！ discuss about the BEKK model.
- Copulas and Financial Time Series introduce
MTSpackage which hasBEKK.
if (!((method == "Nelder-Mead") || (method == "BFGS") ||
(method == "CG") || (method == "L-BFGS-B") || (method ==
"SANN"))) {
stop("'", method, "' method is not available")
}3.8 mGJR (Bivariate GJR (bivariate asymmetric GARCH model))
mGJR(eps1, eps2, order = c(1, 1, 1), params = NULL, fixed = NULL, method = "BFGS")
if (!((method == "Nelder-Mead") || (method == "BFGS") ||
(method == "CG") || (method == "L-BFGS-B") || (method ==
"SANN"))) {
stop("'", method, "' method is not available")
}The mGJR() function in mgarchBEKK use diversified optim function.
4 Model Comparison
4.1 Hi-Lo
4.1.1 Multivariate
4.1.1.1 DCC Model
fls <- list.files('data/fx/USDJPY', pattern = 'DCC.GARCH.USDJPY.HL.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds')
validate <- fls %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>%
plyr::count() %>%
tbl_df
validate %>% dplyr::filter(freq != 3) %>%
kable(caption = 'Count missing observation') %>%
kable_styling(
bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(height = '400px')| x | freq |
|---|---|
| 2013-02-04 | 2 |
| 2013-04-09 | 2 |
| 2013-04-22 | 2 |
| 2013-04-23 | 1 |
| 2013-04-24 | 2 |
| 2014-10-29 | 2 |
## A tibble: 3 x 2
# x freq
# <fct> <int>
#1 2013-04-09 2
#2 2013-04-24 2
#3 2014-10-29 2
#timeID <- c('2013-04-09', '2013-04-24', '2014-10-29')
#
# llply(timeID, function(x) {
# grep(x, fls, value=TRUE)
# })
#[[1]]
#[1] "DCC.GARCH.USDJPY.HL.2013-04-09.rds" "FDCC.GARCH.USDJPY.HL.2013-04-09.rds"
#
#[[2]]
#[1] "aDCC.GARCH.USDJPY.HL.2013-04-24.rds" "FDCC.GARCH.USDJPY.HL.2013-04-24.rds"
#
#[[3]]
#[1] "aDCC.GARCH.USDJPY.HL.2014-10-29.rds" "DCC.GARCH.USDJPY.HL.2014-10-29.rds"
if (nrow(validate) > 0) {
td <- validate %>% dplyr::filter(freq != 3) %>% .$x %>% ymd
} else {
td <- NULL
}
## get only MSE and AIC/BIC but ommit VaR.
MSE.mv <- ldply(fls, function(x) {
dfm <- readRDS(paste0('data/fx/USDJPY/', x))
names(dfm) %<>% str_replace_all('USDJPY', 'Price')
dfm %>% separate(Type, c('Cat', 'Type', 'Model')) %>%
dplyr::select(Date, Cat, Model, Price.High, Price.Low,
Price.High.T1, Price.Low.T1,
Akaike, Bayes, Shibata, Hannan.Quinn) %>%
unique
}) %>% tbl_df %>%
dplyr::filter(!Date %in% td)| Model | MSE.High | MSE.Low | Mean.MSE | n | MSE.AIC | Akaike | MSE.BIC | Bayes | Shibata | Hannan.Quinn |
|---|---|---|---|---|---|---|---|---|---|---|
| aDCC | 0.0104166 | 0.0072286 | 0.0088226 | 1202 | 0.8436359 | 2.859926 | 0.8240639 | 3.125274 | 2.849709 | 2.966582 |
| DCC | 0.0103750 | 0.0070926 | 0.0087338 | 1202 | 0.8529692 | 2.860625 | 0.8333755 | 3.112345 | 2.851373 | 2.961803 |
| FDCC | 0.0103781 | 0.0069161 | 0.0086471 | 1202 | 0.8409110 | 2.859630 | 0.8213650 | 3.125069 | 2.849406 | 2.966322 |
In order to compare the models, I try to compare with :
- MSE of High Price (know the accuracy of High Price)
- MSE of Low Price (know the accuracy of Low Price)
- Mean value of MSE for High and Low Price (\(\frac{Hi+Lo}{2}\))
- MSE of AIC (know the accuracy of AIC)
- MSE of BIC (know the accuracy of BIC)
- Mean of AIC (Mean value of AIC)
- Mean of BIC (Mean value of BIC)
4.1.1.2 goGARCH Model
fls <- list.files('data/fx/USDJPY', pattern = 'goGARCH.USDJPY.HL.+.mvnorm.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds')
validate <- fls %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>%
plyr::count() %>%
tbl_df
validate %>% dplyr::filter(freq != 4) %>%
kable(caption = 'Count missing observation') %>%
kable_styling(
bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(height = '400px')| x | freq |
|---|---|
| 2017-08-29 | 3 |
if (nrow(validate) > 0) {
td <- validate %>% dplyr::filter(freq != 4) %>% .$x %>% ymd
} else {
td <- NULL
}
## get only MSE and AIC/BIC but ommit VaR.
MSE.mv <- ldply(fls, function(x) {
dfm <- readRDS(paste0('data/fx/USDJPY/', x))
names(dfm) %<>% str_replace_all('USDJPY', 'Price')
dfm %>% separate(Type, c('Cat', 'Type', 'Model')) %>%
dplyr::select(Date, Cat, Model, Price.High, Price.Low,
Price.High.T1, Price.Low.T1,
Akaike, Bayes, Shibata, Hannan.Quinn) %>%
unique
}) %>% tbl_df %>%
dplyr::filter(!Date %in% td)
MSE.mv$Cat <- rep(c('u-goGARCH', 'u-goGARCH', 'u-goGARCH', 'm-goGARCH'),
each = nrow(MSE.mv)/4)
MSE.mv %<>% mutate(Model = paste0(Cat, '.', Model)) %>%
dplyr::select(-Cat)| Model | MSE.High | MSE.Low | Mean.MSE | n | MSE.AIC | Akaike | MSE.BIC | Bayes | Shibata | Hannan.Quinn |
|---|---|---|---|---|---|---|---|---|---|---|
| m-goGARCH.VAR | 4.88125e-02 | 4.574020e-02 | 4.727630e-02 | 2428 | 3.8382798 | 0.8391498 | 3.8382790 | 0.8937053 | 0.8386911 | 0.8610781 |
| u-goGARCH.AR | 1.73445e-02 | 6.343199e+04 | 3.171600e+04 | 2428 | 0.0328177 | 2.7129350 | 0.0328200 | 2.7674905 | 2.7124763 | 2.7348633 |
| u-goGARCH.constant | 2.74660e+03 | 2.237132e+03 | 2.491866e+03 | 2428 | 0.1236724 | 2.5314728 | 0.1236766 | 2.5860283 | 2.5310141 | 2.5534011 |
| u-goGARCH.VAR | 4.88125e-02 | 4.574020e-02 | 4.727630e-02 | 2428 | 3.8382246 | 0.8393774 | 3.8382229 | 0.8939329 | 0.8389188 | 0.8613058 |
4.1.1.3 Copula-GARCH Model
4.1.2 Univariate
## Univariate
td <- validate %>% dplyr::filter(freq == 3) %>% .$x %>% ymd
## get only MSE and AIC/BIC but ommit VaR.
MSE.uni <- ldply(td, function(x) {
dfm <- readRDS(paste0('data/fx/USDJPY/pred2.', x, '.rds'))
names(dfm) %<>% str_replace_all('USDJPY', 'Price')
dfm %>% separate(Type, c('Cat', 'Type')) %>%
dplyr::filter(Type == 'Hi' | Type == 'Lo') %>%
mutate(Type2 = Type) %>%
spread(Type, Price) %>%
dplyr::rename(Price.High = Hi, Price.Low = Lo) %>%
spread(Type2, `Price.T+1`) %>%
dplyr::rename(Price.High.T1 = Hi, Price.Low.T1 = Lo) %>%
dplyr::select(Date, Cat, Price.High, Price.Low,
Price.High.T1, Price.Low.T1,
Akaike, Bayes, Shibata, Hannan.Quinn)
}) %>% tbl_df| Cat | MSE.High | MSE.Low | Mean.MSE | n | MSE.AIC | Akaike | MSE.BIC | Bayes | Shibata | Hannan.Quinn |
|---|---|---|---|---|---|---|---|---|---|---|
| USDJPY | 0 | 0 | 0 | 1 | 0.0099682 | 2.032438 | 0.0099682 | 2.114381 | 2.031412 | 2.065376 |
4.2 Hi-Lo-Cl
4.2.1 Multivariate
fls <- list.files('data/fx/USDJPY', pattern = '^DCC.GARCH.USDJPY.HLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds|^aDCC.GARCH.USDJPY.HLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds')
validate <- fls %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>%
plyr::count() %>%
tbl_df
validate %>% dplyr::filter(freq != 2) %>%
kable(caption = 'Count missing observation') %>%
kable_styling(
bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(height = '400px')| x | freq |
|---|---|
| 2013-02-21 | 1 |
| 2013-03-18 | 1 |
| 2013-04-10 | 1 |
| 2013-04-18 | 1 |
| 2014-10-23 | 1 |
| 2014-12-25 | 1 |
| 2015-02-13 | 1 |
| 2017-04-18 | 1 |
| 2017-05-15 | 1 |
| 2017-08-27 | 1 |
td <- validate %>% dplyr::filter(freq != 2) %>% .$x %>% ymd
## get only MSE and AIC/BIC but ommit VaR.
MSE.mv <- ldply(fls, function(x) {
dfm <- readRDS(paste0('data/fx/USDJPY/', x)) %>% .$res
names(dfm) %<>% str_replace_all('USDJPY', 'Price')
dfm %>% separate(Type, c('Cat', 'Type', 'Model')) %>%
dplyr::select(Date, Cat, Model, Price.High, Price.Low, Price.Close,
Price.High.T1, Price.Low.T1, Price.Close.T1,
Akaike, Bayes, Shibata, Hannan.Quinn) %>%
unique
}) %>% tbl_df %>%
dplyr::filter(!Date %in% td)| Model | MSE.High | MSE.Low | MSE.Close | Mean.MSE | n | MSE.AIC | Akaike | MSE.BIC | Bayes | Shibata | Hannan.Quinn |
|---|---|---|---|---|---|---|---|---|---|---|---|
| aDCC | 0.0104901 | 0.0072538 | 0.0059354 | 0.0078931 | 1193 | 1.584897 | 4.019224 | 1.541044 | 4.410206 | 3.998000 | 4.176378 |
| DCC | 0.0104524 | 0.0070658 | 0.0059115 | 0.0078099 | 1193 | 1.578816 | 4.008204 | 1.534932 | 4.385649 | 3.988323 | 4.159916 |
In order to compare the models, I try to compare with :
- MSE of High Price (know the accuracy of High Price)
- MSE of Low Price (know the accuracy of Low Price)
- Mean value of MSE for High and Low Price (\(\frac{Hi+Lo}{2}\))
- MSE of AIC (know the accuracy of AIC)
- MSE of BIC (know the accuracy of BIC)
- Mean of AIC (Mean value of AIC)
- Mean of BIC (Mean value of BIC)
4.2.2 Univariate
## Univariate
td <- validate %>% dplyr::filter(freq == 2) %>% .$x %>% ymd
## get only MSE and AIC/BIC but ommit VaR.
MSE.uni <- ldply(td, function(x) {
dfm <- readRDS(paste0('data/fx/USDJPY/pred2.', x, '.rds'))
names(dfm) %<>% str_replace_all('USDJPY', 'Price')
dfm %>% separate(Type, c('Cat', 'Type')) %>%
dplyr::filter(Type == 'Hi' | Type == 'Lo' | Type == 'Cl') %>%
mutate(Type2 = Type) %>%
spread(Type, Price) %>%
dplyr::rename(Price.High = Hi, Price.Low = Lo, Price.Close = Cl) %>%
spread(Type2, `Price.T+1`) %>%
dplyr::rename(Price.High.T1 = Hi, Price.Low.T1 = Lo, Price.Close.T1 = Cl) %>%
dplyr::select(Date, Cat, Price.High, Price.Low, Price.Close,
Price.High.T1, Price.Low.T1, Price.Close.T1,
Akaike, Bayes, Shibata, Hannan.Quinn)
}) %>% tbl_df| Cat | MSE.High | MSE.Low | MSE.Close | Mean.MSE | n | MSE.AIC | Akaike | MSE.BIC | Bayes | Shibata | Hannan.Quinn |
|---|---|---|---|---|---|---|---|---|---|---|---|
| USDJPY | 0.0104851 | 0.0074854 | 0.0057856 | 0.011878 | 1193 | 0.2401677 | 1.781701 | 0.2330108 | 1.88028 | 1.780161 | 1.821324 |
4.3 Comparison Summary
ctble <- suppressAll(read_table2('data/fx/mv_compare.txt'))
ctble %>%
kable(caption = 'Hi-Lo Price MSE Comparison') %>%
kable_styling(
bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(width = '100%')| Model | Price | MSE.High | MSE.Low | Mean.MSE | n |
|---|---|---|---|---|---|
| aDCC | HL | 0.0104166 | 0.0072141 | 0.0088153 | 1202 |
| DCC | HL | 0.0103750 | 0.0070781 | 0.0087266 | 1202 |
| FDCC | HL | 0.0103781 | 0.0069161 | 0.0086471 | 1202 |
| double-goGARCH.VAR | HL | 0.0488125 | 0.0457402 | 0.4727630 | 2428 |
| multi-goGARCH.VAR | HL | 0.0488125 | 0.0457402 | 0.4727630 | 2428 |
| Uni-gjrGARCH | HL | 0.0104909 | 0.0075998 | 0.0090453 | 2428 |
| aDCC | HLC | 0.0104906 | 0.0072984 | 0.0088945 | 1190 |
| DCC | HLC | 0.0104574 | 0.0070774 | 0.0087674 | 1190 |
| Uni-gjrGARCH | HLC | 0.0104902 | 0.0074981 | 0.0089941 | 3570 |
From above table, the observation number n for double-goGARCH.VAR, multi-goGARCH.VAR and Uni-gjrGARCH should be devided by 2 since the observation for Hi and Lo are seperated to 2 rows and <NA> value accordingly (Other models combine the Hi-Lo price in 1 row.).
fls <- list.files('data/fx/USDJPY', pattern = '^DCC.GARCH.USDJPY.HL.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds|^aDCC.GARCH.USDJPY.HL.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds|^FDCC.GARCH.USDJPY.HL.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds|goGARCH.USDJPY.HL.VAR.mvnorm.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds|pred2.+.rds|^DCC.GARCH.USDJPY.HLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds|^aDCC.GARCH.USDJPY.HLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds|^DCC.GARCH.USDJPY.OHLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds|^aDCC.GARCH.USDJPY.OHLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds')
## extract date
validate <- fls %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>%
plyr::count() %>%
tbl_df
validate %>% dplyr::filter(freq != 10) %>%
kable(caption = 'Count missing observation') %>%
kable_styling(
bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(height = '400px')| x | freq |
|---|---|
| 2012-12-31 | 4 |
| 2013-02-04 | 9 |
| 2013-02-05 | 5 |
| 2013-02-21 | 9 |
| 2013-02-25 | 5 |
| 2013-03-18 | 9 |
| 2013-03-20 | 5 |
| 2013-04-09 | 9 |
| 2013-04-10 | 9 |
| 2013-04-14 | 5 |
| 2013-04-16 | 9 |
| 2013-04-18 | 9 |
| 2013-04-22 | 9 |
| 2013-04-23 | 8 |
| 2013-04-24 | 7 |
| 2014-10-23 | 9 |
| 2014-10-28 | 5 |
| 2014-10-29 | 9 |
| 2014-12-15 | 8 |
| 2014-12-25 | 9 |
| 2014-12-29 | 8 |
| 2015-02-13 | 9 |
| 2015-02-17 | 8 |
| 2017-04-18 | 9 |
| 2017-04-20 | 3 |
| 2017-05-15 | 9 |
| 2017-05-17 | 3 |
| 2017-05-18 | 3 |
| 2017-08-27 | 9 |
| 2017-08-29 | 8 |
## Univariate
td <- validate %>% dplyr::filter(freq == 10) %>% .$x %>% ymd
flv <- llply(td, grep, fls, value = TRUE) %>% unlist %>% unique
## get only MSE and AIC/BIC but ommit VaR.
MSE.com <- ldply(flv, function(x) {
dfm <- readRDS(paste0('data/fx/USDJPY/', x))#[[1]]
if (!is.data.frame(dfm)) {
dfm %<>% .$res
}
names(dfm) %<>% str_replace_all('USDJPY', 'Price')
dfm %<>% separate(Type, c('Cat', 'Type', 'Model'))
if (ncol(dfm) == 10) {
dfm %<>% dplyr::filter(Type == 'Hi' | Type == 'Lo') %>%
mutate(Type2 = Type) %>%
spread(Type, Price) %>%
dplyr::rename(Price.High = Hi, Price.Low = Lo) %>%
spread(Type2, `Price.T+1`) %>%
dplyr::rename(Price.High.T1 = Hi, Price.Low.T1 = Lo) %>%
dplyr::select(Date, Price.High, Price.Low,
Price.High.T1, Price.Low.T1,
Akaike, Bayes, Shibata, Hannan.Quinn)
dfm %<>% mutate(Model = 'gjrGARCH', Cat = 'HL')
} else if (ncol(dfm) == 14) {
dfm %<>% dplyr::select(Date, Model, Price.High, Price.Low, #Price.Close,
Price.High.T1, Price.Low.T1, #Price.Close.T1,
Akaike, Bayes, Shibata, Hannan.Quinn) %>%
unique
dfm %<>% mutate(Cat = 'HLC')
} else if (ncol(dfm) == 16) {
if('Price.Open' %in% names(dfm)) {
dfm %<>% dplyr::select(Date, Model, Price.High, Price.Low,
Price.High.T1, Price.Low.T1,
Akaike, Bayes, Shibata, Hannan.Quinn) %>%
mutate(Akaike = mean(Akaike), Bayes = mean(Bayes),
Shibata = mean(Shibata), Hannan.Quinn = mean(Hannan.Quinn)) %>%
unique
dfm %<>% mutate(Cat = 'OHLC')
} else {
dfm %<>% dplyr::select(Date, Model, Price.High, Price.Low,
Price.High.T1, Price.Low.T1,
Akaike, Bayes, Shibata, Hannan.Quinn) %>%
mutate(Akaike = mean(Akaike), Bayes = mean(Bayes),
Shibata = mean(Shibata), Hannan.Quinn = mean(Hannan.Quinn)) %>%
unique
dfm %<>% mutate(Model = ifelse(Model == 'VAR', 'goGARCH.VAR', Model), Cat = 'HL')
}
} else {
dfm %<>% dfm
}
return(dfm)
}) %>% tbl_df| Cat | Model | MSE.High | MSE.Low | Mean.MSE | n | MSE.AIC | Akaike | MSE.BIC | Bayes | Shibata | Hannan.Quinn |
|---|---|---|---|---|---|---|---|---|---|---|---|
| HL | aDCC | 0.0104787 | 0.0072832 | 0.0088809 | 1186 | 0.8368909 | 2.8702948 | 0.8177028 | 3.135510 | 2.8600873 | 2.9768968 |
| HL | DCC | 0.0104366 | 0.0071453 | 0.0087909 | 1186 | 0.8461904 | 2.8710185 | 0.8269846 | 3.122606 | 2.8617763 | 2.9721430 |
| HL | FDCC | 0.0104397 | 0.0069650 | 0.0087024 | 1186 | 0.8341388 | 2.8699934 | 0.8149750 | 3.135300 | 2.8597787 | 2.9766324 |
| HL | gjrGARCH | 0.0105201 | 0.0074943 | 0.0090072 | 1186 | 0.2603848 | 1.7296100 | 0.2535299 | 1.828160 | 1.7280735 | 1.7692218 |
| HL | goGARCH.VAR | 0.0487091 | 0.0461564 | 0.0474328 | 2372 | 0.0702816 | 0.8411486 | 0.0702802 | 0.895705 | 0.8406899 | 0.8630773 |
| HLC | aDCC | 0.0105158 | 0.0072622 | 0.0088890 | 1186 | 1.5767510 | 4.0290342 | 1.5338664 | 4.419622 | 4.0078519 | 4.1860294 |
| HLC | DCC | 0.0104779 | 0.0070513 | 0.0087646 | 1186 | 1.5706349 | 4.0180163 | 1.5277492 | 4.395057 | 3.9981770 | 4.1695662 |
| OHLC | aDCC | 0.0130811 | 0.0074653 | 0.0102732 | 1186 | 3.4341186 | 0.8765582 | 3.4039592 | 1.392727 | 0.8409797 | 1.0840300 |
| OHLC | DCC | 0.0108598 | 0.0075201 | 0.0091900 | 1186 | 3.3009350 | 0.8625299 | 3.2689538 | 1.365060 | 0.8286468 | 1.0645195 |
Similar with previous table, the observation number n for double-goGARCH.VAR, multi-goGARCH.VAR and Uni-gjrGARCH should be devided by 2.
fls <- list.files('data/fx/USDJPY', pattern = 'pred2.+.rds|^DCC.GARCH.USDJPY.HLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds|^aDCC.GARCH.USDJPY.HLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds|DCC.GARCH.USDJPY.OHLC.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds')
## extract date
validate <- fls %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>%
plyr::count() %>%
tbl_df
validate %>% dplyr::filter(freq != 5) %>%
kable(caption = 'Count missing observation') %>%
kable_styling(
bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(height = '400px')| x | freq |
|---|---|
| 2012-12-31 | 1 |
| 2013-02-05 | 3 |
| 2013-02-21 | 4 |
| 2013-02-25 | 3 |
| 2013-03-18 | 4 |
| 2013-03-20 | 3 |
| 2013-04-10 | 4 |
| 2013-04-14 | 3 |
| 2013-04-16 | 4 |
| 2013-04-18 | 4 |
| 2013-04-24 | 3 |
| 2014-10-23 | 4 |
| 2014-10-28 | 3 |
| 2014-12-15 | 3 |
| 2014-12-25 | 4 |
| 2014-12-29 | 3 |
| 2015-02-13 | 4 |
| 2015-02-17 | 3 |
| 2017-04-18 | 4 |
| 2017-04-20 | 1 |
| 2017-05-15 | 4 |
| 2017-05-17 | 1 |
| 2017-05-18 | 1 |
| 2017-08-27 | 4 |
| 2017-08-29 | 3 |
## Univariate
td <- validate %>% dplyr::filter(freq == 5) %>% .$x %>% ymd
flv <- llply(td, grep, fls, value = TRUE) %>% unlist %>% unique
## get only MSE and AIC/BIC but ommit VaR.
MSE.com <- ldply(flv, function(x) {
dfm <- readRDS(paste0('data/fx/USDJPY/', x))#[[1]]
if (!is.data.frame(dfm)) {
dfm %<>% .$res
}
names(dfm) %<>% str_replace_all('USDJPY', 'Price')
dfm %<>% separate(Type, c('Cat', 'Type', 'Model'))
if (ncol(dfm) == 10) {
dfm %<>% dplyr::filter(Type == 'Op' | Type == 'Hi' |
Type == 'Lo' | Type == 'Cl') %>%
mutate(Type2 = Type) %>%
spread(Type, Price) %>%
dplyr::rename(Price.Open = Op, Price.High = Hi,
Price.Low = Lo, Price.Close = Cl) %>%
spread(Type2, `Price.T+1`) %>%
dplyr::rename(Price.Open.T1 = Op, Price.High.T1 = Hi,
Price.Low.T1 = Lo, Price.Close.T1 = Cl) %>%
dplyr::select(Date, Price.Open, Price.High, Price.Low, Price.Close,
Price.Open.T1, Price.High.T1, Price.Low.T1, Price.Close.T1,
Akaike, Bayes, Shibata, Hannan.Quinn)
dfm %<>% mutate(Model = 'gjrGARCH', Cat = 'OHLC')
} else if (ncol(dfm) == 14) {
dfm %<>% dplyr::select(Date, Model, Price.High, Price.Low, Price.Close,
Price.High.T1, Price.Low.T1, Price.Close.T1,
Akaike, Bayes, Shibata, Hannan.Quinn) %>%
unique
dfm %<>% mutate(Cat = 'HLC')
} else if (ncol(dfm) == 16) {
dfm %<>% dplyr::select(Date, Model,
Price.Open, Price.High, Price.Low, Price.Close,
Price.Open.T1, Price.High.T1, Price.Low.T1,
Price.Close.T1, Akaike, Bayes, Shibata, Hannan.Quinn) %>%
mutate(Akaike = mean(Akaike), Bayes = mean(Bayes),
Shibata = mean(Shibata), Hannan.Quinn = mean(Hannan.Quinn)) %>%
unique
dfm %<>% mutate(Cat = 'OHLC')
} else {
dfm %<>% dfm
}
return(dfm)
}) %>% tbl_df## Filter bias.
bias <- MSE.com %>%
mutate(Model = factor(Model)) %>%
dplyr::select(Date, Model, Cat, Price.Open.T1, Price.High.T1, Price.Low.T1, Price.Close.T1)
bias1 <- bias %>% dplyr::filter(Model != 'gjrGARCH')
bias2 <- bias %>% dplyr::filter(Model == 'gjrGARCH')
bias2A <- bias2[c(1:3)] %>% unique
bias2 <- bias2[-c(1:3)] %>%
rowSums(na.rm=TRUE) %>%
matrix(nc = 4, byrow=TRUE) %>%
as_data_frame %>%
dplyr::rename(Price.Open.T1 = V1, Price.High.T1 = V2,
Price.Low.T1 = V3, Price.Close.T1 = V4)
bias2 <- cbind(bias2A, bias2) %>% tbl_df
bias <- rbind(bias1, bias2) %>% tbl_df %>% arrange(Date)
rm(bias1, bias2A, bias2)
bias %<>%
mutate(
bias.open = if_else(Price.Open.T1>Price.High.T1|Price.Open.T1<Price.Low.T1, 1, 0),
bias.high = if_else(Price.High.T1<Price.Open.T1|Price.High.T1<Price.Low.T1|Price.High.T1<Price.Close.T1, 1, 0),
bias.low = if_else(Price.Low.T1>Price.Open.T1|Price.Low.T1>Price.High.T1|Price.Low.T1>Price.Close.T1, 1, 0),
bias.close = if_else(Price.Close.T1>Price.High.T1|Price.Close.T1<Price.Low.T1, 1, 0)) %>%
dplyr::select(Date, Model, Cat, Price.Open.T1, Price.High.T1, Price.Low.T1, Price.Close.T1, bias.open, bias.high, bias.low, bias.close) #%>%
#dplyr::filter(bias.open==1|bias.high==1|bias.low==1|bias.close==1)
bias## # A tibble: 5,955 x 11
## Date Model Cat Price.Open.T1 Price.High.T1 Price.Low.T1
## <date> <fct> <chr> <dbl> <dbl> <dbl>
## 1 2013-01-01 aDCC HLC NA 86.8 86.8
## 2 2013-01-01 aDCC OHLC 86.5 86.8 86.8
## 3 2013-01-01 DCC HLC NA 86.8 86.8
## 4 2013-01-01 DCC OHLC 86.5 86.8 86.8
## 5 2013-01-01 gjrG~ OHLC 86.8 86.8 86.5
## 6 2013-01-02 aDCC HLC NA 87.3 86.5
## 7 2013-01-02 aDCC OHLC 86.7 87.3 86.5
## 8 2013-01-02 DCC HLC NA 87.3 86.5
## 9 2013-01-02 DCC OHLC 86.7 87.3 86.5
## 10 2013-01-02 gjrG~ OHLC 86.5 87.3 86.7
## # ... with 5,945 more rows, and 5 more variables: Price.Close.T1 <dbl>,
## # bias.open <dbl>, bias.high <dbl>, bias.low <dbl>, bias.close <dbl>bias %>% ddply(.(Model, Cat), summarise,
bias.open = sum(bias.open, na.rm=TRUE)/length(bias.open),
bias.high = sum(bias.high, na.rm=TRUE)/length(bias.high),
bias.low = sum(bias.low, na.rm=TRUE)/length(bias.low),
bias.close = sum(bias.close, na.rm=TRUE)/length(bias.close),
bias = (bias.open + bias.high + bias.low + bias.close)/4,
n = length(Cat)) %>%
kable(caption = 'Forecasted Price Bias') %>%
kable_styling(
bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(width = '100%')#, height = '400px')| Model | Cat | bias.open | bias.high | bias.low | bias.close | bias | n |
|---|---|---|---|---|---|---|---|
| aDCC | HLC | 0.0000000 | 0.1192275 | 0.1032746 | 0.2157851 | 0.1095718 | 1191 |
| aDCC | OHLC | 0.1897565 | 0.1326616 | 0.1141898 | 0.2149454 | 0.1628883 | 1191 |
| DCC | HLC | 0.0000000 | 0.1183879 | 0.1032746 | 0.2149454 | 0.1091520 | 1191 |
| DCC | OHLC | 0.1897565 | 0.1326616 | 0.1150294 | 0.2174643 | 0.1637280 | 1191 |
| gjrGARCH | OHLC | 0.9756507 | 0.9076406 | 0.9378673 | 0.9269521 | 0.9370277 | 1191 |
From above comparison, we know that the bias the forecasted price of multivariate models will be farly accurate than univariate model.
ddply(MSE.com, .(Cat, Model), summarise,
MSE.Open = mean((Price.Open.T1 - Price.Open)^2, na.rm = TRUE),
MSE.High = mean((Price.High.T1 - Price.High)^2, na.rm = TRUE),
MSE.Low = mean((Price.Low.T1 - Price.Low)^2, na.rm = TRUE),
MSE.Close = mean((Price.Close.T1 - Price.Close)^2, na.rm = TRUE),
Mean.MSE = mean(c(MSE.Open, MSE.High, MSE.Low, MSE.Close), na.rm = TRUE),
n = length(Price.High[!is.na(Price.High)]),
MSE.AIC = mean((Akaike - mean(Akaike))^2, na.rm = TRUE),
Akaike = mean(Akaike),
MSE.BIC = mean((Bayes - mean(Bayes))^2, na.rm = TRUE),
Bayes = mean(Bayes),
Shibata = mean(Shibata),
Hannan.Quinn = mean(Hannan.Quinn)) %>%
tbl_df %>% mutate(
MSE.Open = round(MSE.Open, 7),
MSE.High = round(MSE.High, 7),
MSE.Low = round(MSE.Low, 7),
MSE.Close = round(MSE.Close, 7)) %>%
kable(caption = 'OHLC Price MSE, AIC, BIC') %>%
kable_styling(
bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(width = '100%')#, height = '400px')| Cat | Model | MSE.Open | MSE.High | MSE.Low | MSE.Close | Mean.MSE | n | MSE.AIC | Akaike | MSE.BIC | Bayes | Shibata | Hannan.Quinn |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| HLC | aDCC | NaN | 0.0104968 | 0.0072411 | 0.0059390 | 0.0078923 | 1191 | 1.5835733 | 4.0218006 | 1.539983 | 4.412671 | 4.0005885 | 4.178909 |
| HLC | DCC | NaN | 0.0104591 | 0.0070528 | 0.0059151 | 0.0078090 | 1191 | 1.5774995 | 4.0107744 | 1.533876 | 4.388109 | 3.9909048 | 4.162442 |
| OHLC | aDCC | 0.0058546 | 0.0130513 | 0.0074432 | 0.0056753 | 0.0080061 | 1191 | 3.4525977 | 0.8666801 | 3.420828 | 1.383302 | 0.8310406 | 1.074334 |
| OHLC | DCC | 0.0059137 | 0.0108394 | 0.0074980 | 0.0056442 | 0.0074738 | 1191 | 3.3198237 | 0.8526782 | 3.286245 | 1.355661 | 0.8187351 | 1.054850 |
| OHLC | gjrGARCH | 0.0060731 | 0.0105011 | 0.0074728 | 0.0057889 | 0.0074590 | 1191 | 0.2271299 | 1.8087614 | 0.219895 | 1.907229 | 1.8072245 | 1.848340 |
Similar with previous table, the observation number n for Uni-gjrGARCH should be devided by 2. Above table shows the Mean.MSE of both HLC and OHLC accordingly, here I look into more details which take only HLC figures for comparison.
ddply(MSE.com, .(Cat, Model), summarise,
MSE.High = mean((Price.High.T1 - Price.High)^2, na.rm = TRUE),
MSE.Low = mean((Price.Low.T1 - Price.Low)^2, na.rm = TRUE),
MSE.Close = mean((Price.Close.T1 - Price.Close)^2, na.rm = TRUE),
Mean.MSE = (MSE.High + MSE.Low + MSE.Close)/3,
n = length(Price.High[!is.na(Price.High)]),
MSE.AIC = mean((Akaike - mean(Akaike))^2, na.rm = TRUE),
Akaike = mean(Akaike),
MSE.BIC = mean((Bayes - mean(Bayes))^2, na.rm = TRUE),
Bayes = mean(Bayes),
Shibata = mean(Shibata),
Hannan.Quinn = mean(Hannan.Quinn)) %>%
tbl_df %>% mutate(
MSE.High = round(MSE.High, 7),
MSE.Low = round(MSE.Low, 7),
MSE.Close = round(MSE.Close, 7)) %>%
kable(caption = 'HLC Price MSE, AIC, BIC') %>%
kable_styling(
bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(width = '100%')#, height = '400px')| Cat | Model | MSE.High | MSE.Low | MSE.Close | Mean.MSE | n | MSE.AIC | Akaike | MSE.BIC | Bayes | Shibata | Hannan.Quinn |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| HLC | aDCC | 0.0104968 | 0.0072411 | 0.0059390 | 0.0078923 | 1191 | 1.5835733 | 4.0218006 | 1.539983 | 4.412671 | 4.0005885 | 4.178909 |
| HLC | DCC | 0.0104591 | 0.0070528 | 0.0059151 | 0.0078090 | 1191 | 1.5774995 | 4.0107744 | 1.533876 | 4.388109 | 3.9909048 | 4.162442 |
| OHLC | aDCC | 0.0130513 | 0.0074432 | 0.0056753 | 0.0087233 | 1191 | 3.4525977 | 0.8666801 | 3.420828 | 1.383302 | 0.8310406 | 1.074334 |
| OHLC | DCC | 0.0108394 | 0.0074980 | 0.0056442 | 0.0079938 | 1191 | 3.3198237 | 0.8526782 | 3.286245 | 1.355661 | 0.8187351 | 1.054850 |
| OHLC | gjrGARCH | 0.0105011 | 0.0074728 | 0.0057889 | 0.0079209 | 1191 | 0.2271299 | 1.8087614 | 0.219895 | 1.907229 | 1.8072245 | 1.848340 |
4.4 Cl
fls <- list.files('data/fx/USDJPY', pattern = '^DCC.GARCH.C.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds|^aDCC.GARCH.C.[0-9]{4}-[0-9]{2}-[0-9]{2}.rds')
fls2 <- llply(names(cr_code), function(x) {
list.files(paste0('data/fx/', x, '/'), pattern = 'pred2.+.rds')
}) %>% unlist
flsc <- c(fls, fls2)
## extract date
validate <- flsc %>%
str_extract_all('[0-9]{4}-[0-9]{2}-[0-9]{2}') %>%
unlist %>%
plyr::count() %>%
tbl_df
validate %>% dplyr::filter(freq != 9) %>%
kable(caption = 'Count missing observation') %>%
kable_styling(
bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(height = '400px')| x | freq |
|---|---|
| 2012-12-31 | 7 |
| 2013-07-08 | 7 |
| 2013-07-10 | 8 |
| 2013-07-14 | 7 |
| 2013-07-15 | 7 |
| 2013-07-16 | 7 |
| 2013-07-18 | 7 |
| 2013-07-22 | 8 |
| 2013-07-23 | 7 |
| 2013-07-24 | 7 |
| 2013-07-25 | 8 |
| 2013-07-28 | 7 |
| 2013-07-29 | 7 |
| 2013-07-31 | 8 |
| 2013-08-04 | 7 |
| 2013-08-05 | 7 |
| 2013-08-06 | 7 |
| 2013-08-07 | 7 |
| 2013-08-08 | 7 |
| 2013-08-11 | 7 |
| 2013-08-12 | 7 |
| 2013-08-13 | 7 |
| 2013-08-14 | 8 |
| 2013-08-15 | 8 |
| 2013-08-18 | 7 |
| 2013-08-20 | 7 |
| 2013-08-21 | 8 |
| 2013-08-22 | 7 |
| 2013-08-25 | 8 |
| 2013-08-26 | 7 |
| 2013-08-27 | 8 |
| 2013-08-28 | 7 |
| 2013-08-29 | 7 |
| 2013-09-01 | 7 |
| 2013-09-02 | 7 |
| 2013-09-03 | 8 |
| 2013-09-04 | 7 |
| 2013-09-08 | 7 |
| 2013-09-09 | 8 |
| 2013-09-11 | 7 |
| 2013-09-12 | 7 |
| 2013-09-15 | 8 |
| 2013-09-16 | 7 |
| 2013-09-18 | 7 |
| 2013-09-19 | 7 |
| 2013-09-23 | 7 |
| 2013-09-25 | 7 |
| 2013-09-30 | 8 |
| 2013-10-02 | 7 |
| 2013-10-06 | 8 |
| 2013-10-08 | 7 |
| 2013-10-10 | 7 |
| 2013-10-14 | 8 |
| 2013-10-16 | 7 |
| 2013-10-20 | 7 |
| 2013-10-21 | 7 |
| 2013-10-23 | 8 |
| 2013-10-24 | 7 |
| 2013-10-28 | 7 |
| 2013-10-29 | 7 |
| 2013-10-31 | 7 |
| 2013-11-01 | 7 |
| 2013-11-04 | 7 |
| 2013-11-06 | 7 |
| 2013-11-07 | 7 |
| 2013-11-08 | 8 |
| 2013-11-12 | 8 |
| 2013-11-13 | 7 |
| 2013-11-14 | 8 |
| 2013-11-15 | 7 |
| 2013-11-18 | 7 |
| 2013-11-19 | 8 |
| 2013-11-20 | 8 |
| 2013-11-22 | 8 |
| 2013-11-25 | 8 |
| 2013-11-28 | 8 |
| 2013-11-29 | 8 |
| 2013-12-02 | 8 |
| 2013-12-03 | 8 |
| 2013-12-05 | 8 |
| 2013-12-06 | 7 |
| 2013-12-10 | 7 |
| 2013-12-11 | 7 |
| 2013-12-12 | 8 |
| 2013-12-13 | 7 |
| 2013-12-16 | 8 |
| 2013-12-17 | 7 |
| 2013-12-19 | 7 |
| 2013-12-20 | 7 |
| 2013-12-23 | 7 |
| 2013-12-24 | 7 |
| 2013-12-26 | 7 |
| 2013-12-27 | 7 |
| 2014-01-02 | 8 |
| 2014-01-03 | 7 |
| 2014-01-06 | 7 |
| 2014-01-07 | 7 |
| 2014-01-08 | 7 |
| 2014-01-09 | 8 |
| 2014-01-10 | 7 |
| 2014-01-13 | 8 |
| 2014-01-14 | 8 |
| 2014-01-15 | 8 |
| 2014-01-16 | 8 |
| 2014-01-17 | 7 |
| 2014-01-20 | 7 |
| 2014-01-21 | 7 |
| 2014-01-22 | 7 |
| 2014-01-23 | 7 |
| 2014-01-24 | 7 |
| 2014-01-27 | 7 |
| 2014-01-28 | 8 |
| 2014-01-29 | 8 |
| 2014-01-30 | 7 |
| 2014-01-31 | 7 |
| 2014-02-03 | 7 |
| 2014-02-04 | 7 |
| 2014-02-05 | 8 |
| 2014-02-06 | 7 |
| 2014-02-10 | 7 |
| 2014-02-11 | 7 |
| 2014-02-12 | 7 |
| 2014-02-13 | 7 |
| 2014-02-14 | 8 |
| 2014-02-18 | 7 |
| 2014-02-20 | 8 |
| 2014-02-24 | 7 |
| 2014-02-25 | 7 |
| 2014-02-26 | 8 |
| 2014-02-28 | 7 |
| 2014-03-03 | 8 |
| 2014-03-05 | 7 |
| 2014-03-06 | 7 |
| 2014-03-10 | 8 |
| 2014-03-12 | 7 |
| 2014-03-13 | 7 |
| 2014-03-14 | 7 |
| 2014-03-24 | 8 |
| 2014-03-26 | 7 |
| 2014-04-02 | 8 |
| 2014-04-06 | 7 |
| 2014-04-07 | 7 |
| 2014-04-08 | 7 |
| 2014-04-09 | 7 |
| 2014-04-10 | 8 |
| 2014-05-04 | 8 |
| 2014-05-06 | 7 |
| 2014-05-11 | 7 |
| 2014-05-12 | 7 |
| 2014-05-13 | 7 |
| 2014-05-18 | 8 |
| 2014-05-20 | 7 |
| 2014-05-25 | 8 |
| 2014-05-27 | 8 |
| 2014-05-29 | 7 |
| 2014-06-01 | 8 |
| 2014-06-03 | 7 |
| 2014-06-05 | 7 |
| 2014-06-08 | 7 |
| 2014-07-29 | 8 |
| 2014-07-31 | 7 |
| 2015-01-15 | 8 |
| 2015-01-19 | 7 |
| 2015-01-20 | 7 |
| 2015-01-21 | 7 |
| 2015-01-22 | 7 |
| 2015-01-23 | 7 |
| 2015-01-26 | 7 |
| 2015-01-27 | 7 |
| 2015-01-28 | 7 |
| 2015-01-29 | 7 |
| 2015-01-30 | 7 |
| 2015-02-04 | 7 |
| 2015-02-05 | 8 |
| 2015-02-06 | 7 |
| 2015-02-09 | 7 |
| 2015-02-10 | 7 |
| 2015-02-11 | 7 |
| 2015-02-12 | 7 |
| 2015-02-13 | 7 |
| 2015-02-16 | 7 |
| 2015-02-17 | 7 |
| 2015-02-18 | 7 |
| 2015-02-19 | 8 |
| 2015-02-20 | 7 |
| 2015-02-23 | 7 |
| 2015-02-24 | 7 |
| 2015-02-25 | 7 |
| 2015-02-26 | 7 |
| 2015-02-27 | 7 |
| 2015-03-02 | 7 |
| 2015-03-03 | 7 |
| 2015-03-04 | 7 |
| 2015-03-05 | 7 |
| 2015-03-06 | 7 |
| 2015-03-09 | 8 |
| 2015-03-10 | 7 |
| 2015-03-11 | 7 |
| 2015-03-12 | 7 |
| 2015-03-13 | 7 |
| 2015-03-16 | 7 |
| 2015-03-17 | 7 |
| 2015-03-18 | 7 |
| 2015-03-19 | 7 |
| 2015-03-23 | 7 |
| 2015-03-24 | 7 |
| 2015-03-25 | 7 |
| 2015-03-26 | 7 |
| 2015-03-27 | 7 |
| 2015-03-29 | 7 |
| 2015-03-30 | 7 |
| 2015-03-31 | 7 |
| 2015-04-01 | 7 |
| 2015-04-02 | 7 |
| 2015-04-05 | 7 |
| 2015-04-06 | 7 |
| 2015-04-07 | 7 |
| 2015-04-08 | 7 |
| 2015-04-09 | 7 |
| 2015-04-13 | 7 |
| 2015-04-22 | 7 |
| 2015-04-30 | 7 |
| 2015-05-10 | 7 |
| 2015-05-13 | 7 |
| 2015-05-14 | 7 |
| 2015-05-17 | 7 |
| 2015-05-18 | 7 |
| 2015-05-19 | 7 |
| 2015-05-20 | 7 |
| 2015-05-21 | 7 |
| 2015-05-24 | 7 |
| 2015-05-31 | 7 |
| 2015-06-08 | 7 |
| 2015-06-09 | 8 |
| 2015-06-16 | 8 |
| 2015-06-17 | 8 |
| 2015-06-23 | 7 |
| 2015-08-09 | 7 |
| 2015-08-10 | 7 |
| 2015-08-11 | 7 |
| 2015-08-12 | 7 |
| 2015-08-13 | 7 |
| 2015-08-17 | 7 |
| 2015-08-18 | 7 |
| 2015-08-19 | 7 |
| 2015-08-20 | 7 |
| 2015-08-24 | 7 |
| 2015-08-26 | 7 |
| 2015-08-27 | 7 |
| 2015-08-30 | 7 |
| 2015-08-31 | 7 |
| 2015-09-02 | 7 |
| 2015-09-03 | 7 |
| 2015-09-06 | 7 |
| 2015-09-08 | 7 |
| 2015-09-09 | 7 |
| 2015-09-10 | 7 |
| 2015-09-13 | 7 |
| 2015-09-15 | 7 |
| 2015-09-16 | 7 |
| 2015-09-17 | 7 |
| 2015-09-20 | 7 |
| 2015-09-21 | 1 |
| 2015-09-22 | 7 |
| 2015-09-23 | 7 |
| 2015-09-24 | 7 |
| 2015-09-27 | 7 |
| 2015-09-28 | 7 |
| 2015-09-29 | 7 |
| 2015-10-04 | 7 |
| 2015-10-05 | 7 |
| 2015-10-06 | 7 |
| 2015-10-07 | 7 |
| 2015-10-08 | 7 |
| 2015-10-11 | 7 |
| 2015-10-12 | 7 |
| 2015-10-22 | 7 |
| 2015-10-27 | 8 |
| 2015-10-28 | 7 |
| 2015-10-29 | 7 |
| 2015-10-30 | 7 |
| 2015-11-02 | 7 |
| 2015-11-03 | 7 |
| 2015-11-04 | 7 |
| 2015-11-05 | 7 |
| 2015-11-06 | 7 |
| 2015-11-09 | 7 |
| 2015-11-10 | 7 |
| 2015-11-11 | 7 |
| 2015-11-12 | 7 |
| 2015-11-13 | 7 |
| 2015-12-18 | 8 |
| 2015-12-23 | 7 |
| 2015-12-29 | 7 |
| 2015-12-31 | 7 |
| 2017-04-26 | 6 |
## Univariate
td <- validate %>% dplyr::filter(freq == 9) %>% .$x %>% ymd
flv <- llply(td, grep, flsc, value = TRUE) %>% unlist %>% unique
## get only MSE and AIC/BIC but ommit VaR.
MSE.com <- llply(flv, function(x) {
dfm <- llply(names(cr_code), function(y) {
fm <- tryCatch(readRDS(paste0('data/fx/', y, '/', x)), error = function(e) NULL)
if (!is.null(fm)) {
fm %<>% tail(., 1)
if (ncol(fm) == 29) {
fm %<>% .[,1:20]
} else if (ncol(fm) == 8) {
fm %<>% bind_rows
} else {
fm %<>% fm
}
}
fm
})
dfm %<>% bind_rows
names(dfm) %<>% str_replace_all('(Close.T1|T\\+1)', 'T1')
names(dfm) %<>% str_replace_all('.Close', '')
dfm$Type %<>% str_replace_all('.+.Cl', 'gjrGARCH') %>% factor
#if (ncol(dfm) == 20) {
# dfm %<>% .[,c('Date', 'Type', 'USDAUD', 'USDEUR', 'USDGBP', 'USDCHF',
# 'USDCAD', 'USDCNY', 'USDJPY', 'USDAUD.T+1', 'USDEUR.T+1',
# 'USDGBP.T+1', 'USDCHF.T+1', 'USDCAD.T+1', 'USDCNY.T+1',
# 'USDJPY.T+1', 'Akaike', 'Bayes', 'Shibata', 'Hannan.Quinn')]
#}
dfm
})
MSE.com %<>% bind_rows %>% tbl_dfddply(MSE.com, .(Type), summarise,
MSE.USDAUD = mean((USDAUD.T1 - USDAUD)^2, na.rm = TRUE),
MSE.USDEUR = mean((USDEUR.T1 - USDEUR)^2, na.rm = TRUE),
MSE.USDGBP = mean((USDGBP.T1 - USDGBP)^2, na.rm = TRUE),
MSE.USDCHF = mean((USDCHF.T1 - USDCHF)^2, na.rm = TRUE),
MSE.USDCAD = mean((USDCAD.T1 - USDCAD)^2, na.rm = TRUE),
MSE.USDCNY = mean((USDCNY.T1 - USDCNY)^2, na.rm = TRUE),
MSE.USDJPY = mean((USDJPY.T1 - USDJPY)^2, na.rm = TRUE),
Mean.MSE = (MSE.USDAUD + MSE.USDEUR + MSE.USDGBP +
MSE.USDCHF + MSE.USDCAD + MSE.USDCNY +
MSE.USDJPY)/7,
n = length(Type[!is.na(Type)]),
MSE.AIC = mean((Akaike - mean(Akaike))^2, na.rm = TRUE),
Akaike = mean(Akaike),
MSE.BIC = mean((Bayes - mean(Bayes))^2, na.rm = TRUE),
Bayes = mean(Bayes),
Shibata = mean(Shibata),
Hannan.Quinn = mean(Hannan.Quinn)) %>%
tbl_df %>% #mutate(
# MSE.USDAUD = round(MSE.USDAUD, 7),
# MSE.USDEUR = round(MSE.USDEUR, 7),
# MSE.USDGBP = round(MSE.USDGBP, 7),
# MSE.USDCHF = round(MSE.USDCHF, 7),
# MSE.USDCAD = round(MSE.USDCAD, 7),
# MSE.USDCNY = round(MSE.USDCNY, 7),
# MSE.USDJPY = round(MSE.USDJPY, 7)) %>%
kable(caption = 'Close Price MSE, AIC, BIC') %>%
kable_styling(
bootstrap_options = c('striped', 'hover', 'condensed', 'responsive')) %>%
scroll_box(width = '100%')#, height = '400px')| Type | MSE.USDAUD | MSE.USDEUR | MSE.USDGBP | MSE.USDCHF | MSE.USDCAD | MSE.USDCNY | MSE.USDJPY | Mean.MSE | n | MSE.AIC | Akaike | MSE.BIC | Bayes | Shibata | Hannan.Quinn |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| aDCC | 5e-07 | 3e-07 | 7e-07 | 3e-07 | 3e-07 | 1.09e-05 | 0.0071937 | 0.0010295 | 921 | 14.54212 | -45.992721 | 14.41634 | -44.983557 | -46.110446 | -45.587080 |
| DCC | 5e-07 | 3e-07 | 7e-07 | 4e-07 | 3e-07 | 1.07e-05 | 0.0073265 | 0.0010485 | 921 | 14.54206 | -45.999592 | 14.41636 | -45.004077 | -46.114564 | -45.599437 |
| gjrGARCH | 5e-07 | 2e-07 | 6e-07 | 3e-07 | 3e-07 | 1.07e-05 | 0.0073928 | 0.0010579 | 6447 | 11.58387 | -6.187886 | 11.59466 | -6.090504 | -6.189389 | -6.148744 |
Table : The observation for univariate is 7 x n since seven currencies.
5 Conclusion
A comprehensive set of examples is available in the rmgarch.tests folder of the source. There are 5 main files, covering the Copula, DCC, FDCC and GO-GARCH models and the fScenario and fMoments methods for use in portfolio and risk management applications (see the parma package)…
Source : The rmgarch models: Background and properties5
Here I believed go-GARCH, Copula-GARCH will be more accurate than normal DCC models. Due to there are a lot of errors, here I force to use normal DCC models.
DCC.HLC with 0.0078121 aDCC.C 0.0010308 is best fit models for trading.
In order to moving forward, the binary.com Interview Question I - Interday Betting Strategy Models Comparison (Financial Betting and Stock Market) and binary.com Interview Question I - Interday High Frequency Trading Models Comparison.
6 Appendix
6.1 Documenting File Creation
It’s useful to record some information about how your file was created.
- File creation date: 2018-09-04
- File latest updated date: 2018-10-23
- R version 3.5.1 (2018-07-02)
- R version (short form): 3.5.1
- rmarkdown package version: 1.10
- File version: 1.0.1
- Author Profile: ®γσ, Eng Lian Hu
- GitHub: Source Code
- Additional session information:
| Category | session_info | Category | Sys.info |
|---|---|---|---|
| version | R version 3.5.1 (2018-07-02) | sysname | Windows |
| os | Windows 10 x64 | release | 10 x64 |
| system | x86_64, mingw32 | version | build 17134 |
| ui | RTerm | nodename | RSTUDIO-SCIBROK |
| language | en | machine | x86-64 |
| collate | Japanese_Japan.932 | login | scibr |
| ctype | Japanese_Japan.932 | user | scibr |
| tz | Asia/Tokyo | effective_user | scibr |
| date | 2018-10-23 | Current time | 2018-10-23 03:14:41 JST |
6.2 Reference
- Betting Strategy and Model Validation - Part II
- binary.com Job Application - Quantitative Analyst sample question
- GARCH模型中的
ARIMA(p,d,q)参数最优化 - The
rmgarchModels - Background and Properties - Financial Econometrics Practical - Univariate Volatility Modelling
- The GARCH-DCC Model and 2-Stage DCC(MVT) Estimation
- Multivariate Volatility Forecasting, Part 2 – Equicorrelation
- The Kelly Criterion - Implementation, Simulation and Backtest
- The Kelly Criterion and Bet Comparison in Spread Betting
- The Kelly Criterion for Spread Bets
- The Market for English Premier League (EPL) Odds
- Valuation of Soccer Spread Bets
- Stochastic Modelling and Optimization Methods in Investments
- How Does the Fortune’s Formula-Kelly Capital Growth Model Perform
- Information Theory and Gambling or Economics
- Investment Portfolio Optimization with GARCH Models
- Kelly Criterion Revisited - Optimal Bets
- Medium Term Simulations of the Full Kelly and Fractional
- Money Management (V1)
- Money Management (V2)
- Optimal Betting under Parameter Uncertainty - Improving the Kelly Criterion
- Enhancing Trading Strategies with Order Book Signals
- Creating Optimal Portfolios of Stocks with Time-Varying Risk
- Dynamic Portfolio Optimization using Generalized Dynamic Conditoinal Heteroskedastic Factor Models
- Comparison of BEKK GARCH and DCC GARCH Models - An Empirical Study
- Do We Really Need Both BEKK and DCC - A Tale of Two Multivariate GARCH Models
- Forecasting Conditional Correlation for Exchange Rates using Multivariate GARCH Models with Historical Value-at-Risk Application
- Volatility Spillover and Time-Varying Conditional Correlation between the European and US Stock Markets
- Applying MGARCH Models in Finance
- Comparison of Multivariate GARCH Models with Application to Zero-Coupon Bond Volatility
- Forecasting the Daily Dynamic Hedge Ratios by GARCH Models - Evidence from the Agricultural Futures Markets
- Currency Hedging Strategies Using Dynamic Multivariate GARCH
- Multivariate DCC-GARCH Model
- Introduction to the
rugarchPackage - 解密复兴科技 - 基于隐蔽马尔科夫模型的时序分析方法
- [转载]詹姆斯-哈里斯-西蒙斯(James Harris Simons)
Powered by - Copyright® Intellectual Property Rights of 
Scibrokes®個人の経営企業